diff --git a/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy b/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy
--- a/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy
+++ b/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy
@@ -1,9074 +1,9074 @@
 (*  Title:      Stateful_Protocol_Model.thy
     Author:     Andreas Viktor Hess, DTU
     Author:     Sebastian A. Mödersheim, DTU
     Author:     Achim D. Brucker, University of Exeter
     Author:     Anders Schlichtkrull, DTU
     SPDX-License-Identifier: BSD-3-Clause
 *)
 
 section\<open>Stateful Protocol Model\<close>
 theory Stateful_Protocol_Model
   imports Stateful_Protocol_Composition_and_Typing.Stateful_Compositionality
           Transactions Term_Abstraction
 begin
 
 subsection \<open>Locale Setup\<close>
 locale stateful_protocol_model =
   fixes arity\<^sub>f::"'fun \<Rightarrow> nat"
     and arity\<^sub>s::"'sets \<Rightarrow> nat"
     and public\<^sub>f::"'fun \<Rightarrow> bool"
     and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets,'lbl) prot_fun, nat) term list \<times> nat list)"
     and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
     and label_witness1::"'lbl"
     and label_witness2::"'lbl"
   assumes Ana\<^sub>f_assm1: "\<forall>f. let (K, M) = Ana\<^sub>f f in (\<forall>k \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K).
       is_Fun k \<longrightarrow> (is_Fu (the_Fun k)) \<and> length (args k) = arity\<^sub>f (the_Fu (the_Fun k)))"
     and Ana\<^sub>f_assm2: "\<forall>f. let (K, M) = Ana\<^sub>f f in \<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K) \<union> set M. i < arity\<^sub>f f"
     and public\<^sub>f_assm: "\<forall>f. arity\<^sub>f f > (0::nat) \<longrightarrow> public\<^sub>f f"
     and \<Gamma>\<^sub>f_assm: "\<forall>f. arity\<^sub>f f = (0::nat) \<longrightarrow> \<Gamma>\<^sub>f f \<noteq> None"
     and label_witness_assm: "label_witness1 \<noteq> label_witness2"
 begin
 
 lemma Ana\<^sub>f_assm1_alt: 
   assumes "Ana\<^sub>f f = (K,M)" "k \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)"
   shows "(\<exists>x. k = Var x) \<or> (\<exists>h T. k = Fun (Fu h) T \<and> length T = arity\<^sub>f h)"
 proof (cases k)
   case (Fun g T)
   let ?P = "\<lambda>k. is_Fun k \<longrightarrow> is_Fu (the_Fun k) \<and> length (args k) = arity\<^sub>f (the_Fu (the_Fun k))"
   let ?Q = "\<lambda>K M. \<forall>k \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K). ?P k"
 
   have "?Q (fst (Ana\<^sub>f f)) (snd (Ana\<^sub>f f))" using Ana\<^sub>f_assm1 split_beta[of ?Q "Ana\<^sub>f f"] by meson
   hence "?Q K M" using assms(1) by simp
   hence "?P k" using assms(2) by blast
   thus ?thesis using Fun by (cases g) auto
 qed simp
 
 lemma Ana\<^sub>f_assm2_alt:
   assumes "Ana\<^sub>f f = (K,M)" "i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K) \<union> set M"
   shows "i < arity\<^sub>f f"
 using Ana\<^sub>f_assm2 assms by fastforce
 
 
 subsection \<open>Definitions\<close>
 fun arity where
   "arity (Fu f) = arity\<^sub>f f"
 | "arity (Set s) = arity\<^sub>s s"
 | "arity (Val _) = 0"
 | "arity (Abs _) = 0"
 | "arity Pair = 2"
 | "arity (Attack _) = 0"
 | "arity OccursFact = 2"
 | "arity OccursSec = 0"
 | "arity (PubConst _ _) = 0"
 
 fun public where
   "public (Fu f) = public\<^sub>f f"
 | "public (Set s) = (arity\<^sub>s s > 0)"
 | "public (Val n) = False"
 | "public (Abs _) = False"
 | "public Pair = True"
 | "public (Attack _) = False"
 | "public OccursFact = True"
 | "public OccursSec = False"
 | "public (PubConst _ _) = True"
 
 fun Ana where
   "Ana (Fun (Fu f) T) = (
     if arity\<^sub>f f = length T \<and> arity\<^sub>f f > 0
     then let (K,M) = Ana\<^sub>f f in (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M)
     else ([], []))"
 | "Ana _ = ([], [])"
 
 definition \<Gamma>\<^sub>v where
   "\<Gamma>\<^sub>v v \<equiv> (
     if (\<forall>t \<in> subterms (fst v).
           case t of (TComp f T) \<Rightarrow> arity f > 0 \<and> arity f = length T | _ \<Rightarrow> True)
     then fst v
     else TAtom Bottom)"
 
 fun \<Gamma> where
   "\<Gamma> (Var v) = \<Gamma>\<^sub>v v"
 | "\<Gamma> (Fun f T) = (
     if arity f = 0
     then case f of
       (Fu g) \<Rightarrow> TAtom (case \<Gamma>\<^sub>f g of Some a \<Rightarrow> Atom a | None \<Rightarrow> Bottom)
     | (Val _) \<Rightarrow> TAtom Value
     | (Abs _) \<Rightarrow> TAtom AbsValue
     | (Set _) \<Rightarrow> TAtom SetType
     | (Attack _) \<Rightarrow> TAtom AttackType
     | OccursSec \<Rightarrow> TAtom OccursSecType
     | (PubConst a _) \<Rightarrow> TAtom a
     | _ \<Rightarrow> TAtom Bottom
     else TComp f (map \<Gamma> T))"
 
 lemma \<Gamma>_consts_simps[simp]:
   "arity\<^sub>f g = 0 \<Longrightarrow> \<Gamma> (Fun (Fu g) []::('fun,'atom,'sets,'lbl) prot_term)
                     = TAtom (case \<Gamma>\<^sub>f g of Some a \<Rightarrow> Atom a | None \<Rightarrow> Bottom)"
   "\<Gamma> (Fun (Val n) []::('fun,'atom,'sets,'lbl) prot_term) = TAtom Value"
   "\<Gamma> (Fun (Abs b) []::('fun,'atom,'sets,'lbl) prot_term) = TAtom AbsValue"
   "arity\<^sub>s s = 0 \<Longrightarrow> \<Gamma> (Fun (Set s) []::('fun,'atom,'sets,'lbl) prot_term) = TAtom SetType"
   "\<Gamma> (Fun (Attack x) []::('fun,'atom,'sets,'lbl) prot_term) = TAtom AttackType"
   "\<Gamma> (Fun OccursSec []::('fun,'atom,'sets,'lbl) prot_term) = TAtom OccursSecType"
   "\<Gamma> (Fun (PubConst a t) []::('fun,'atom,'sets,'lbl) prot_term) = TAtom a"
 by simp+
 
 lemma \<Gamma>_Fu_simps[simp]:
   "arity\<^sub>f f \<noteq> 0 \<Longrightarrow> \<Gamma> (Fun (Fu f) T) = TComp (Fu f) (map \<Gamma> T)" (is "?A1 \<Longrightarrow> ?A2")
   "arity\<^sub>f f = 0 \<Longrightarrow> \<Gamma>\<^sub>f f = Some a \<Longrightarrow> \<Gamma> (Fun (Fu f) T) = TAtom (Atom a)" (is "?B1 \<Longrightarrow> ?B2 \<Longrightarrow> ?B3")
   "arity\<^sub>f f = 0 \<Longrightarrow> \<Gamma>\<^sub>f f = None \<Longrightarrow> \<Gamma> (Fun (Fu f) T) = TAtom Bottom" (is "?C1 \<Longrightarrow> ?C2 \<Longrightarrow> ?C3")
   "\<Gamma> (Fun (Fu f) T) \<noteq> TAtom Value" (is ?D)
   "\<Gamma> (Fun (Fu f) T) \<noteq> TAtom AttackType" (is ?E)
   "\<Gamma> (Fun (Fu f) T) \<noteq> TAtom OccursSecType" (is ?F)
 proof -
   show "?A1 \<Longrightarrow> ?A2" by simp
   show "?B1 \<Longrightarrow> ?B2 \<Longrightarrow> ?B3" by simp
   show "?C1 \<Longrightarrow> ?C2 \<Longrightarrow> ?C3" by simp
   show ?D by (cases "\<Gamma>\<^sub>f f") simp_all
   show ?E by (cases "\<Gamma>\<^sub>f f") simp_all
   show ?F by (cases "\<Gamma>\<^sub>f f") simp_all
 qed
 
 lemma \<Gamma>_Set_simps[simp]:
   "arity\<^sub>s s \<noteq> 0 \<Longrightarrow> \<Gamma> (Fun (Set s) T) = TComp (Set s) (map \<Gamma> T)"
   "\<Gamma> (Fun (Set s) T) = TAtom SetType \<or> \<Gamma> (Fun (Set s) T) = TComp (Set s) (map \<Gamma> T)"
   "\<Gamma> (Fun (Set s) T) \<noteq> TAtom Value"
   "\<Gamma> (Fun (Set s) T) \<noteq> TAtom (Atom a)"
   "\<Gamma> (Fun (Set s) T) \<noteq> TAtom AttackType"
   "\<Gamma> (Fun (Set s) T) \<noteq> TAtom OccursSecType"
   "\<Gamma> (Fun (Set s) T) \<noteq> TAtom Bottom"
 by auto
 
 
 subsection \<open>Locale Interpretations\<close>
 lemma Ana_Fu_cases:
   assumes "Ana (Fun f T) = (K,M)"
     and "f = Fu g"
     and "Ana\<^sub>f g = (K',M')"
   shows "(K,M) = (if arity\<^sub>f g = length T \<and> arity\<^sub>f g > 0
                   then (K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')
                   else ([],[]))" (is ?A)
     and "(K,M) = (K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M') \<or> (K,M) = ([],[])" (is ?B)
 proof -
   show ?A using assms by (cases "arity\<^sub>f g = length T \<and> arity\<^sub>f g > 0") auto
   thus ?B by metis
 qed
 
 lemma Ana_Fu_intro:
   assumes "arity\<^sub>f f = length T" "arity\<^sub>f f > 0"
     and "Ana\<^sub>f f = (K',M')"
   shows "Ana (Fun (Fu f) T) = (K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')"
 using assms by simp
 
 lemma Ana_Fu_elim:
   assumes "Ana (Fun f T) = (K,M)"
     and "f = Fu g"
     and "Ana\<^sub>f g = (K',M')"
     and "(K,M) \<noteq> ([],[])"
   shows "arity\<^sub>f g = length T" (is ?A)
     and "(K,M) = (K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')" (is ?B)
 proof -
   show ?A using assms by force
   moreover have "arity\<^sub>f g > 0" using assms by force
   ultimately show ?B using assms by auto
 qed
 
 lemma Ana_nonempty_inv:
   assumes "Ana t \<noteq> ([],[])"
   shows "\<exists>f T. t = Fun (Fu f) T \<and> arity\<^sub>f f = length T \<and> arity\<^sub>f f > 0 \<and>
                (\<exists>K M. Ana\<^sub>f f = (K, M) \<and> Ana t = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M))"
 using assms
 proof (induction t rule: Ana.induct)
   case (1 f T)
   hence *: "arity\<^sub>f f = length T" "0 < arity\<^sub>f f"
            "Ana (Fun (Fu f) T) = (case Ana\<^sub>f f of (K, M) \<Rightarrow> (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M))"
     using Ana.simps(1)[of f T] unfolding Let_def by metis+
 
   obtain K M where **: "Ana\<^sub>f f = (K, M)" by (metis surj_pair)
   hence "Ana (Fun (Fu f) T) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M)" using *(3) by simp
   thus ?case using ** *(1,2) by blast
 qed simp_all
 
 lemma assm1:
   assumes "Ana t = (K,M)"
   shows "fv\<^sub>s\<^sub>e\<^sub>t (set K) \<subseteq> fv t"
 using assms
 proof (induction t rule: term.induct)
   case (Fun f T)
   have aux: "fv\<^sub>s\<^sub>e\<^sub>t (set K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) T) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (set T)"
     when K: "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K). i < length T"
     for K::"(('fun,'atom,'sets,'lbl) prot_fun, nat) term list"
   proof
     fix x assume "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) T)"
     then obtain k where k: "k \<in> set K" "x \<in> fv (k \<cdot> (!) T)" by moura
     have "\<forall>i \<in> fv k. i < length T" using K k(1) by simp
     thus "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set T)"
       by (metis (no_types, lifting) k(2) contra_subsetD fv_set_mono image_subsetI nth_mem
                                     subst_apply_fv_unfold)
   qed
 
   { fix g assume f: "f = Fu g" and K: "K \<noteq> []"
     obtain K' M' where *: "Ana\<^sub>f g = (K',M')" by moura
     have "(K, M) \<noteq> ([], [])" using K by simp
     hence "(K, M) = (K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')" "arity\<^sub>f g = length T"
       using Ana_Fu_cases(1)[OF Fun.prems f *]
       by presburger+
     hence ?case using aux[of K'] Ana\<^sub>f_assm2_alt[OF *] by auto
   } thus ?case using Fun by (cases f) fastforce+
 qed simp
 
 lemma assm2:
   assumes "Ana t = (K,M)"
   and "\<And>g S'. Fun g S' \<sqsubseteq> t \<Longrightarrow> length S' = arity g"
   and "k \<in> set K"
   and "Fun f T' \<sqsubseteq> k"
   shows "length T' = arity f"
 using assms
 proof (induction t rule: term.induct)
   case (Fun g T)
   obtain h where 2: "g = Fu h"
     using Fun.prems(1,3) by (cases g) auto
   obtain K' M' where 1: "Ana\<^sub>f h = (K',M')" by moura
   have "(K,M) \<noteq> ([],[])" using Fun.prems(3) by auto
   hence "(K,M) = (K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')"
         "\<And>i. i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K') \<union> set M' \<Longrightarrow> i < length T"
     using Ana_Fu_cases(1)[OF Fun.prems(1) 2 1] Ana\<^sub>f_assm2_alt[OF 1]
     by presburger+
   hence "K = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T" and 3: "\<forall>i\<in>fv\<^sub>s\<^sub>e\<^sub>t (set K'). i < length T" by simp_all
   then obtain k' where k': "k' \<in> set K'" "k = k' \<cdot> (!) T" using Fun.prems(3) by moura
   hence 4: "Fun f T' \<in> subterms (k' \<cdot> (!) T)" "fv k' \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (set K')"
     using Fun.prems(4) by auto
   show ?case
   proof (cases "\<exists>i \<in> fv k'. Fun f T' \<in> subterms (T ! i)")
     case True
     hence "Fun f T' \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set T)" using k' Fun.prems(4) 3 by auto
     thus ?thesis using Fun.prems(2) by auto
   next
     case False
     then obtain S where "Fun f S \<in> subterms k'" "Fun f T' = Fun f S \<cdot> (!) T"
       using k'(2) Fun.prems(4) subterm_subst_not_img_subterm by force
     thus ?thesis using Ana\<^sub>f_assm1_alt[OF 1, of "Fun f S"] k'(1) by (cases f) auto
   qed
 qed simp
 
 lemma assm4:
   assumes "Ana (Fun f T) = (K, M)"
   shows "set M \<subseteq> set T"
 using assms
 proof (cases f)
   case (Fu g)
   obtain K' M' where *: "Ana\<^sub>f g = (K',M')" by moura
   have "M = [] \<or> (arity\<^sub>f g = length T \<and> M = map ((!) T) M')"
     using Ana_Fu_cases(1)[OF assms Fu *]
     by (meson prod.inject)
   thus ?thesis using Ana\<^sub>f_assm2_alt[OF *] by auto
 qed auto
 
 lemma assm5: "Ana t = (K,M) \<Longrightarrow> K \<noteq> [] \<or> M \<noteq> [] \<Longrightarrow> Ana (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>)"
 proof (induction t rule: term.induct)
   case (Fun f T) thus ?case
   proof (cases f)
     case (Fu g)
     obtain K' M' where *: "Ana\<^sub>f g = (K',M')" by moura
     have **: "K = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T" "M = map ((!) T) M'"
              "arity\<^sub>f g = length T" "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K') \<union> set M'. i < arity\<^sub>f g" "0 < arity\<^sub>f g"
       using Fun.prems(2) Ana_Fu_cases(1)[OF Fun.prems(1) Fu *] Ana\<^sub>f_assm2_alt[OF *]
       by (meson prod.inject)+
 
     have ***: "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K'). i < length T" "\<forall>i \<in> set M'. i < length T" using **(3,4) by auto
     
     have "K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta> = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) (map (\<lambda>t. t \<cdot> \<delta>) T)"
          "M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta> = map ((!) (map (\<lambda>t. t \<cdot> \<delta>) T)) M'"
       using subst_idx_map[OF ***(2), of \<delta>]
             subst_idx_map'[OF ***(1), of \<delta>]
             **(1,2)
       by fast+
     thus ?thesis using Fu * **(3,5) by auto
   qed auto
 qed simp
 
 sublocale intruder_model arity public Ana
 apply unfold_locales
 by (metis assm1, metis assm2, rule Ana.simps, metis assm4, metis assm5)
 
 adhoc_overloading INTRUDER_SYNTH intruder_synth
 adhoc_overloading INTRUDER_DEDUCT intruder_deduct
 
 lemma assm6: "arity c = 0 \<Longrightarrow> \<exists>a. \<forall>X. \<Gamma> (Fun c X) = TAtom a" by (cases c) auto
 
 lemma assm7: "0 < arity f \<Longrightarrow> \<Gamma> (Fun f T) = TComp f (map \<Gamma> T)" by auto
 
 lemma assm8: "infinite {c. \<Gamma> (Fun c []::('fun,'atom,'sets,'lbl) prot_term) = TAtom a \<and> public c}"
   (is "?P a")
 proof -
   let ?T = "\<lambda>f. (range f)::('fun,'atom,'sets,'lbl) prot_fun set"
   let ?A = "\<lambda>f. \<forall>x::nat \<in> UNIV. \<forall>y::nat \<in> UNIV. (f x = f y) = (x = y)"
   let ?B = "\<lambda>f. \<forall>x::nat \<in> UNIV. f x \<in> ?T f"
   let ?C = "\<lambda>f. \<forall>y::('fun,'atom,'sets,'lbl) prot_fun \<in> ?T f. \<exists>x \<in> UNIV. y = f x"
   let ?D = "\<lambda>f b. ?T f \<subseteq> {c. \<Gamma> (Fun c []::('fun,'atom,'sets,'lbl) prot_term) = TAtom b \<and> public c}"
 
   have sub_lmm: "?P b" when "?A f" "?C f" "?C f" "?D f b" for b f
   proof -
     have "\<exists>g::nat \<Rightarrow> ('fun,'atom,'sets,'lbl) prot_fun. bij_betw g UNIV (?T f)"
       using bij_betwI'[of UNIV f "?T f"] that(1,2,3) by blast
     hence "infinite (?T f)" by (metis nat_not_finite bij_betw_finite)
     thus ?thesis using infinite_super[OF that(4)] by blast
   qed
 
   show ?thesis
   proof (cases a)
     case (Atom b) thus ?thesis using sub_lmm[of "PubConst (Atom b)" a] by force
   next
     case Value thus ?thesis using sub_lmm[of "PubConst Value" a] by force
   next
     case SetType thus ?thesis using sub_lmm[of "PubConst SetType" a] by fastforce
   next
     case AttackType thus ?thesis using sub_lmm[of "PubConst AttackType" a] by fastforce
   next
     case Bottom thus ?thesis using sub_lmm[of "PubConst Bottom" a] by fastforce
   next
     case OccursSecType thus ?thesis using sub_lmm[of "PubConst OccursSecType" a] by fastforce
   next
     case AbsValue thus ?thesis using sub_lmm[of "PubConst AbsValue" a] by force
   qed
 qed
 
 lemma assm9: "TComp f T \<sqsubseteq> \<Gamma> t \<Longrightarrow> arity f > 0"
 proof (induction t rule: term.induct)
   case (Var x)
   hence "\<Gamma> (Var x) \<noteq> TAtom Bottom" by force
   hence "\<forall>t \<in> subterms (fst x). case t of
             TComp f T \<Rightarrow> arity f > 0 \<and> arity f = length T
           | _ \<Rightarrow> True"
     using Var \<Gamma>.simps(1)[of x] unfolding \<Gamma>\<^sub>v_def by meson
   thus ?case using Var by (fastforce simp add: \<Gamma>\<^sub>v_def)
 next
   case (Fun g S)
   have "arity g \<noteq> 0" using Fun.prems Var_subtermeq assm6 by force
   thus ?case using Fun by (cases "TComp f T = TComp g (map \<Gamma> S)") auto
 qed
 
 lemma assm10: "wf\<^sub>t\<^sub>r\<^sub>m (\<Gamma> (Var x))"
 unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (auto simp add: \<Gamma>\<^sub>v_def)
 
 lemma assm11: "arity f > 0 \<Longrightarrow> public f" using public\<^sub>f_assm by (cases f) auto
 
 lemma assm12: "\<Gamma> (Var (\<tau>, n)) = \<Gamma> (Var (\<tau>, m))" by (simp add: \<Gamma>\<^sub>v_def)
 
 lemma assm13: "arity c = 0 \<Longrightarrow> Ana (Fun c T) = ([],[])" by (cases c) simp_all
 
 lemma assm14:
   assumes "Ana (Fun f T) = (K,M)"
   shows "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>)"
 proof -
   show ?thesis
   proof (cases "(K, M) = ([],[])")
     case True
     { fix g assume f: "f = Fu g"
       obtain K' M' where "Ana\<^sub>f g = (K',M')" by moura
       hence ?thesis using assms f True by auto
     } thus ?thesis using True assms by (cases f) auto
   next
     case False
     then obtain g where **: "f = Fu g" using assms by (cases f) auto
     obtain K' M' where *: "Ana\<^sub>f g = (K',M')" by moura
     have ***: "K = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T" "M = map ((!) T) M'" "arity\<^sub>f g = length T"
               "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K') \<union> set M'. i < arity\<^sub>f g"
       using Ana_Fu_cases(1)[OF assms ** *] False Ana\<^sub>f_assm2_alt[OF *]
       by (meson prod.inject)+
     have ****: "\<forall>i\<in>fv\<^sub>s\<^sub>e\<^sub>t (set K'). i < length T" "\<forall>i\<in>set M'. i < length T" using ***(3,4) by auto
     have "K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta> = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) (map (\<lambda>t. t \<cdot> \<delta>) T)"
          "M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta> = map ((!) (map (\<lambda>t. t \<cdot> \<delta>) T)) M'"
       using subst_idx_map[OF ****(2), of \<delta>]
             subst_idx_map'[OF ****(1), of \<delta>]
             ***(1,2)
       by auto
     thus ?thesis using assms * ** ***(3) by auto
   qed
 qed
 
 sublocale labeled_stateful_typing' arity public Ana \<Gamma> Pair label_witness1 label_witness2
   apply unfold_locales
   subgoal by (metis assm6)
   subgoal by (metis assm7)
   subgoal by (metis assm9)
   subgoal by (rule assm10)
   subgoal by (metis assm12)
   subgoal by (metis assm13)
   subgoal by (metis assm14)
   subgoal by (rule label_witness_assm)
   subgoal by (rule arity.simps(5))
   subgoal by (metis assm14)
   subgoal by (metis assm8)
   subgoal by (metis assm11)
   done
 
 
 subsection \<open>The Protocol Transition System, Defined in Terms of the Reachable Constraints\<close>
 definition transaction_decl_subst where
   "transaction_decl_subst (\<xi>::('fun,'atom,'sets,'lbl) prot_subst) T \<equiv>
     subst_domain \<xi> = fst ` set (transaction_decl T ()) \<and>
     (\<forall>(x,cs) \<in> set (transaction_decl T ()). \<exists>c \<in> cs.
       \<xi> x = Fun (Fu c) [] \<and>
       arity (Fu c::('fun,'atom,'sets,'lbl) prot_fun) = 0) \<and>
     wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<xi>"
 
 definition transaction_fresh_subst where
   "transaction_fresh_subst \<sigma> T M \<equiv>
     subst_domain \<sigma> = set (transaction_fresh T) \<and>
     (\<forall>t \<in> subst_range \<sigma>. \<exists>c. t = Fun c [] \<and> \<not>public c \<and> arity c = 0) \<and>
     (\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t M) \<and>
     (\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)) \<and>
     wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma> \<and> inj_on \<sigma> (subst_domain \<sigma>)"
 
 (* NB: We need the protocol P as a parameter for this definition---even though we will only apply \<alpha>
        to a single transaction T of P---because we have to ensure that \<alpha>(fv(T)) is disjoint from
        the bound variables of P and \<A>. *)
 definition transaction_renaming_subst where
   "transaction_renaming_subst \<alpha> P X \<equiv>
     \<exists>n \<ge> max_var_set (\<Union>(vars_transaction ` set P) \<union> X). \<alpha> = var_rename n"
 
 definition (in intruder_model) constraint_model where
   "constraint_model \<I> \<A> \<equiv> 
     constr_sem_stateful \<I> (unlabel \<A>) \<and>
     interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I> \<and>
     wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
 
 definition (in typed_model) welltyped_constraint_model where
   "welltyped_constraint_model \<I> \<A> \<equiv> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I> \<and> constraint_model \<I> \<A>"
 
 text \<open>
   The set of symbolic constraints reachable in any symbolic run of the protocol \<open>P\<close>.
   
   \<open>\<xi>\<close> instantiates the "declared variables" of transaction \<open>T\<close> with ground terms.
   \<open>\<sigma>\<close> instantiates the fresh variables of transaction \<open>T\<close> with fresh terms.
   \<open>\<alpha>\<close> is a variable-renaming whose range consists of fresh variables.
 \<close>
 inductive_set reachable_constraints::
   "('fun,'atom,'sets,'lbl) prot \<Rightarrow> ('fun,'atom,'sets,'lbl) prot_constr set"
   for P::"('fun,'atom,'sets,'lbl) prot"
 where
   init[simp]:
   "[] \<in> reachable_constraints P"
 | step:
   "\<lbrakk>\<A> \<in> reachable_constraints P;
     T \<in> set P;
     transaction_decl_subst \<xi> T;
     transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>);
     transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)
    \<rbrakk> \<Longrightarrow> \<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<in> reachable_constraints P"
 
 
 subsection \<open>Minor Lemmata\<close>
 lemma \<Gamma>\<^sub>v_TAtom[simp]: "\<Gamma>\<^sub>v (TAtom a, n) = TAtom a"
 unfolding \<Gamma>\<^sub>v_def by simp
 
 lemma \<Gamma>\<^sub>v_TAtom':
   assumes "a \<noteq> Bottom"
   shows "\<Gamma>\<^sub>v (\<tau>, n) = TAtom a \<longleftrightarrow> \<tau> = TAtom a"
 proof
   assume "\<Gamma>\<^sub>v (\<tau>, n) = TAtom a"
   thus "\<tau> = TAtom a" by (metis (no_types, lifting) assms \<Gamma>\<^sub>v_def fst_conv term.inject(1)) 
 qed simp
 
 lemma \<Gamma>\<^sub>v_TAtom_inv:
   "\<Gamma>\<^sub>v x = TAtom (Atom a) \<Longrightarrow> \<exists>m. x = (TAtom (Atom a), m)"
   "\<Gamma>\<^sub>v x = TAtom Value \<Longrightarrow> \<exists>m. x = (TAtom Value, m)"
   "\<Gamma>\<^sub>v x = TAtom SetType \<Longrightarrow> \<exists>m. x = (TAtom SetType, m)"
   "\<Gamma>\<^sub>v x = TAtom AttackType \<Longrightarrow> \<exists>m. x = (TAtom AttackType, m)"
   "\<Gamma>\<^sub>v x = TAtom OccursSecType \<Longrightarrow> \<exists>m. x = (TAtom OccursSecType, m)"
 by (metis \<Gamma>\<^sub>v_TAtom' surj_pair prot_atom.distinct(7),
     metis \<Gamma>\<^sub>v_TAtom' surj_pair prot_atom.distinct(18),
     metis \<Gamma>\<^sub>v_TAtom' surj_pair prot_atom.distinct(26),
     metis \<Gamma>\<^sub>v_TAtom' surj_pair prot_atom.distinct(32),
     metis \<Gamma>\<^sub>v_TAtom' surj_pair prot_atom.distinct(38))
 
 lemma \<Gamma>\<^sub>v_TAtom'':
   "(fst x = TAtom (Atom a)) = (\<Gamma>\<^sub>v x = TAtom (Atom a))" (is "?A = ?A'")
   "(fst x = TAtom Value) = (\<Gamma>\<^sub>v x = TAtom Value)" (is "?B = ?B'")
   "(fst x = TAtom SetType) = (\<Gamma>\<^sub>v x = TAtom SetType)" (is "?C = ?C'")
   "(fst x = TAtom AttackType) = (\<Gamma>\<^sub>v x = TAtom AttackType)" (is "?D = ?D'")
   "(fst x = TAtom OccursSecType) = (\<Gamma>\<^sub>v x = TAtom OccursSecType)" (is "?E = ?E'")
 proof -
   have 1: "?A \<Longrightarrow> ?A'" "?B \<Longrightarrow> ?B'" "?C \<Longrightarrow> ?C'" "?D \<Longrightarrow> ?D'" "?E \<Longrightarrow> ?E'"
     by (metis \<Gamma>\<^sub>v_TAtom prod.collapse)+
 
   have 2: "?A' \<Longrightarrow> ?A" "?B' \<Longrightarrow> ?B" "?C' \<Longrightarrow> ?C" "?D' \<Longrightarrow> ?D" "?E' \<Longrightarrow> ?E"
     using \<Gamma>\<^sub>v_TAtom \<Gamma>\<^sub>v_TAtom_inv(1) apply fastforce
     using \<Gamma>\<^sub>v_TAtom \<Gamma>\<^sub>v_TAtom_inv(2) apply fastforce
     using \<Gamma>\<^sub>v_TAtom \<Gamma>\<^sub>v_TAtom_inv(3) apply fastforce
     using \<Gamma>\<^sub>v_TAtom \<Gamma>\<^sub>v_TAtom_inv(4) apply fastforce
     using \<Gamma>\<^sub>v_TAtom \<Gamma>\<^sub>v_TAtom_inv(5) by fastforce
 
   show "?A = ?A'" "?B = ?B'" "?C = ?C'" "?D = ?D'" "?E = ?E'"
     using 1 2 by metis+
 qed
 
 lemma \<Gamma>\<^sub>v_Var_image:
   "\<Gamma>\<^sub>v ` X = \<Gamma> ` Var ` X"
 by force
 
 lemma \<Gamma>_Fu_const:
   assumes "arity\<^sub>f g = 0"
   shows "\<exists>a. \<Gamma> (Fun (Fu g) T) = TAtom (Atom a)"
 proof -
   have "\<Gamma>\<^sub>f g \<noteq> None" using assms \<Gamma>\<^sub>f_assm by blast
   thus ?thesis using assms by force
 qed
 
 lemma Fun_Value_type_inv:
   fixes T::"('fun,'atom,'sets,'lbl) prot_term list"
   assumes "\<Gamma> (Fun f T) = TAtom Value"
   shows "(\<exists>n. f = Val n) \<or> (\<exists>bs. f = Abs bs) \<or> (\<exists>n. f = PubConst Value n)"
 proof -
   have *: "arity f = 0" by (metis const_type_inv assms) 
   show ?thesis  using assms
   proof (cases f)
     case (Fu g)
     hence "arity\<^sub>f g = 0" using * by simp
     hence False using Fu \<Gamma>_Fu_const[of g T] assms by auto
     thus ?thesis by metis
   next
     case (Set s)
     hence "arity\<^sub>s s = 0" using * by simp
     hence False using Set assms by auto
     thus ?thesis by metis
   qed simp_all
 qed
 
 lemma Ana\<^sub>f_keys_not_val_terms:
   assumes "Ana\<^sub>f f = (K, T)"
     and "k \<in> set K"
     and "g \<in> funs_term k"
   shows "\<not>is_Val g"
     and "\<not>is_PubConstValue g"
     and "\<not>is_Abs g"
 proof -
   { assume "is_Val g"
     then obtain n S where *: "Fun (Val n) S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)"
       using assms(2) funs_term_Fun_subterm[OF assms(3)]
       by (cases g) auto
     hence False using Ana\<^sub>f_assm1_alt[OF assms(1) *] by simp
   } moreover {
     assume "is_PubConstValue g"
     then obtain n S where *: "Fun (PubConst Value n) S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)"
       using assms(2) funs_term_Fun_subterm[OF assms(3)]
       unfolding is_PubConstValue_def by (cases g) auto
     hence False using Ana\<^sub>f_assm1_alt[OF assms(1) *] by simp
   } moreover {
     assume "is_Abs g"
     then obtain a S where *: "Fun (Abs a) S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)"
       using assms(2) funs_term_Fun_subterm[OF assms(3)]
       by (cases g) auto
     hence False using Ana\<^sub>f_assm1_alt[OF assms(1) *] by simp
   } ultimately show "\<not>is_Val g" "\<not>is_PubConstValue g" "\<not>is_Abs g" by metis+
 qed
 
 lemma Ana\<^sub>f_keys_not_pairs:
   assumes "Ana\<^sub>f f = (K, T)"
     and "k \<in> set K"
     and "g \<in> funs_term k"
   shows "g \<noteq> Pair"
 proof
   assume "g = Pair"
   then obtain S where *: "Fun Pair S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)"
     using assms(2) funs_term_Fun_subterm[OF assms(3)]
     by (cases g) auto
   show False using Ana\<^sub>f_assm1_alt[OF assms(1) *] by simp
 qed
 
 lemma Ana_Fu_keys_funs_term_subset:
   fixes K::"('fun,'atom,'sets,'lbl) prot_term list"
   assumes "Ana (Fun (Fu f) S) = (K, T)"
     and "Ana\<^sub>f f = (K', T')"
   shows "\<Union>(funs_term ` set K) \<subseteq> \<Union>(funs_term ` set K') \<union> funs_term (Fun (Fu f) S)"
 proof -
   { fix k assume k: "k \<in> set K"
     then obtain k' where k':
         "k' \<in> set K'" "k = k' \<cdot> (!) S" "arity\<^sub>f f = length S"
         "subterms k' \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (set K')"
       using assms Ana_Fu_elim[OF assms(1) _ assms(2)] by fastforce
 
     have 1: "funs_term k' \<subseteq> \<Union>(funs_term ` set K')" using k'(1) by auto
 
     have "i < length S" when "i \<in> fv k'" for i
       using that Ana\<^sub>f_assm2_alt[OF assms(2), of i] k'(1,3)
       by auto
     hence 2: "funs_term (S ! i) \<subseteq> funs_term (Fun (Fu f) S)" when "i \<in> fv k'" for i
       using that by force
   
     have "funs_term k \<subseteq> \<Union>(funs_term ` set K') \<union> funs_term (Fun (Fu f) S)"
       using funs_term_subst[of k' "(!) S"] k'(2) 1 2 by fast
   } thus ?thesis by blast
 qed
 
 lemma Ana_Fu_keys_not_pubval_terms:
   fixes k::"('fun,'atom,'sets,'lbl) prot_term"
   assumes "Ana (Fun (Fu f) S) = (K, T)"
     and "Ana\<^sub>f f = (K', T')"
     and "k \<in> set K"
     and "\<forall>g \<in> funs_term (Fun (Fu f) S). \<not>is_PubConstValue g"
   shows "\<forall>g \<in> funs_term k. \<not>is_PubConstValue g"
 using assms(3,4) Ana\<^sub>f_keys_not_val_terms(1,2)[OF assms(2)]
       Ana_Fu_keys_funs_term_subset[OF assms(1,2)]
 by blast
 
 lemma Ana_Fu_keys_not_abs_terms:
   fixes k::"('fun,'atom,'sets,'lbl) prot_term"
   assumes "Ana (Fun (Fu f) S) = (K, T)"
     and "Ana\<^sub>f f = (K', T')"
     and "k \<in> set K"
     and "\<forall>g \<in> funs_term (Fun (Fu f) S). \<not>is_Abs g"
   shows "\<forall>g \<in> funs_term k. \<not>is_Abs g"
 using assms(3,4) Ana\<^sub>f_keys_not_val_terms(3)[OF assms(2)]
       Ana_Fu_keys_funs_term_subset[OF assms(1,2)]
 by blast
 
 lemma Ana_Fu_keys_not_pairs:
   fixes k::"('fun,'atom,'sets,'lbl) prot_term"
   assumes "Ana (Fun (Fu f) S) = (K, T)"
     and "Ana\<^sub>f f = (K', T')"
     and "k \<in> set K"
     and "\<forall>g \<in> funs_term (Fun (Fu f) S). g \<noteq> Pair"
   shows "\<forall>g \<in> funs_term k. g \<noteq> Pair"
 using assms(3,4) Ana\<^sub>f_keys_not_pairs[OF assms(2)]
       Ana_Fu_keys_funs_term_subset[OF assms(1,2)]
 by blast
 
 lemma Ana_Fu_keys_length_eq:
   assumes "length T = length S"
   shows "length (fst (Ana (Fun (Fu f) T))) = length (fst (Ana (Fun (Fu f) S)))"
 proof (cases "arity\<^sub>f f = length T \<and> arity\<^sub>f f > 0")
   case True thus ?thesis using assms by (cases "Ana\<^sub>f f") auto
 next
   case False thus ?thesis using assms by force
 qed
 
 lemma Ana_key_PubConstValue_subterm_in_term: 
   fixes k::"('fun,'atom,'sets,'lbl) prot_term"
   assumes KR: "Ana t = (K, R)"
     and k: "k \<in> set K"
     and n: "Fun (PubConst Value n) [] \<sqsubseteq> k"
   shows "Fun (PubConst Value n) [] \<sqsubseteq> t"
 proof (cases t)
   case (Var x) thus ?thesis using KR k n by force
 next
   case (Fun f ts)
   note t = this
   then obtain g where f: "f = Fu g" using KR k by (cases f) auto
   obtain K' R' where KR': "Ana\<^sub>f g = (K', R')" by fastforce
 
   have K: "K = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) ts"
     using k Ana_Fu_elim(2)[OF KR[unfolded t] f KR'] by force
 
   obtain k' where k': "k' \<in> set K'" "k = k' \<cdot> (!) ts" using k K by auto
 
   have 0: "\<not>(Fun (PubConst Value n) [] \<sqsubseteq> k')"
   proof
     assume *: "Fun (PubConst Value n) [] \<sqsubseteq> k'"
     have **: "PubConst Value n \<in> funs_term k'"
       using funs_term_Fun_subterm'[OF *] by (cases k') auto
     show False
       using Ana\<^sub>f_keys_not_val_terms(2)[OF KR' k'(1) **]
       unfolding is_PubConstValue_def by force
   qed
   hence "\<exists>i \<in> fv k'. Fun (PubConst Value n) [] \<sqsubseteq> ts ! i"
     by (metis n const_subterm_subst_var_obtain k'(2))
   then obtain i where i: "i \<in> fv k'" "Fun (PubConst Value n) [] \<sqsubseteq> ts ! i" by blast
 
   have "i < length ts"
     using i(1) KR' k'(1) Ana\<^sub>f_assm2_alt[OF KR', of i]
           Ana_Fu_elim(1)[OF KR[unfolded t] f KR'] k
     by fastforce
   thus ?thesis using i(2) unfolding t by force
 qed
 
 lemma deduct_occurs_in_ik:
   fixes t::"('fun,'atom,'sets,'lbl) prot_term"
   assumes t: "M \<turnstile> occurs t"
     and M: "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t M. OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
            "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t M. OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
            "Fun OccursSec [] \<notin> M"
   shows "occurs t \<in> M"
 using private_fun_deduct_in_ik''[of M OccursFact "[Fun OccursSec [], t]" OccursSec] t M 
 by fastforce
 
 lemma deduct_val_const_swap:
   fixes \<theta> \<sigma>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<turnstile> t \<cdot> \<theta>"
     and "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. (\<exists>n. \<theta> x = Fun (Val n) []) \<or> (\<exists>n. \<theta> x = Fun (PubConst Value n) [])"
     and "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. (\<exists>n. \<sigma> x = Fun (Val n) [])"
     and "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. (\<exists>n. \<theta> x = Fun (PubConst Value n) []) \<longrightarrow> \<sigma> x \<in> M \<union> N"
     and "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. (\<exists>n. \<theta> x = Fun (Val n) []) \<longrightarrow> \<theta> x = \<sigma> x"
     and "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. \<forall>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. \<theta> x = \<theta> y \<longleftrightarrow> \<sigma> x = \<sigma> y"
     and "\<forall>n. \<not>(Fun (PubConst Value n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t insert t M)"
   shows "(M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N \<turnstile> t \<cdot> \<sigma>"
 proof -
   obtain n where n: "intruder_deduct_num (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) n (t \<cdot> \<theta>)"
     using assms(1) deduct_num_if_deduct by blast
   hence "\<exists>m \<le> n. intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) m (t \<cdot> \<sigma>)" using assms(2-)
   proof (induction n arbitrary: t rule: nat_less_induct)
     case (1 n)
     note prems = "1.prems"
     note IH = "1.IH"
 
     show ?case
     proof (cases "t \<cdot> \<theta> \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>")
       case True
       note 2 = this
       have 3: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. \<exists>c. \<theta> x = Fun c []"
               "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. \<exists>c. \<sigma> x = Fun c []"
         using prems(2,3) by (blast, blast)
       have "t \<cdot> \<sigma> \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>"
         using subst_const_swap_eq_mem[OF 2 _ 3 prems(6)] prems(2,5,7) by metis
       thus ?thesis using intruder_deduct_num.AxiomN by auto
     next
       case False
       then obtain n' where n: "n = Suc n'" using prems(1) deduct_zero_in_ik by (cases n) fast+
 
       have M_subterms_eq:
           "subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) = subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
           "subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) = subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>"
         subgoal using prems(2) subterms_subst''[of M \<theta>] by blast
         subgoal using prems(3) subterms_subst''[of M \<sigma>] by blast
         done
 
       from deduct_inv[OF prems(1)] show ?thesis
       proof (elim disjE)
         assume "t \<cdot> \<theta> \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>" thus ?thesis using False by argo
       next
         assume "\<exists>f ts. t \<cdot> \<theta> = Fun f ts \<and> public f \<and> length ts = arity f \<and>
                      (\<forall>t \<in> set ts. \<exists>l < n. intruder_deduct_num (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) l t)"
         then obtain f ts where t:
             "t \<cdot> \<theta> = Fun f ts" "public f" "length ts = arity f"
             "\<forall>t \<in> set ts. \<exists>l < n. intruder_deduct_num (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) l t"
           by blast
   
         show ?thesis
         proof (cases t)
           case (Var x)
           hence ts: "ts = []" and f: "\<exists>c. f = PubConst Value c"
             using t(1,2) prems(2) by (force, auto)
           have "\<sigma> x \<in> M \<union> N" using prems(4) Var f ts t(1) by auto
           moreover have "fv (\<sigma> x) = {}" using prems(3) Var by auto
           hence "\<sigma> x \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>" when "\<sigma> x \<in> M" using that subst_ground_ident[of "\<sigma> x" \<sigma>] by force
           ultimately have "\<sigma> x \<in> (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N" by fast
           thus ?thesis using intruder_deduct_num.AxiomN Var by force
         next
           case (Fun g ss)
           hence f: "f = g" and ts: "ts = ss \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>" using t(1) by auto
   
           have ss: "\<exists>l < n. intruder_deduct_num (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) l (s \<cdot> \<theta>)" when s: "s \<in> set ss" for s
             using t(4) ts s by auto
   
           have IH': "\<exists>l < n. intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) l (s \<cdot> \<sigma>)"
             when s: "s \<in> set ss" for s
           proof -
             obtain l where l: "l < n" "intruder_deduct_num (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) l (s \<cdot> \<theta>)"
               using ss s by blast
             
             have *: "fv s \<subseteq> fv t" "subterms\<^sub>s\<^sub>e\<^sub>t (insert s M) \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (insert t M)"
               using s unfolding Fun f ts by auto
 
             have "\<exists>l' \<le> l. intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) l' (s \<cdot> \<sigma>)"
             proof -
               have "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv s.
                       (\<exists>n. \<theta> x = Fun (Val n) []) \<or> (\<exists>n. \<theta> x = Fun (PubConst Value n) [])"
                    "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv s. \<exists>n. \<sigma> x = Fun (Val n) []"
                    "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv s. (\<exists>n. \<theta> x = Fun (PubConst Value n) []) \<longrightarrow> \<sigma> x \<in> M \<union> N"
                    "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv s. (\<exists>n. \<theta> x = Fun (Val n) []) \<longrightarrow> \<theta> x = \<sigma> x"
                    "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv s. \<forall>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv s. \<theta> x = \<theta> y \<longleftrightarrow> \<sigma> x = \<sigma> y"
                    "\<forall>n. Fun (PubConst Value n) [] \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (insert s M)"
                 subgoal using prems(2) *(1) by blast
                 subgoal using prems(3) *(1) by blast
                 subgoal using prems(4) *(1) by blast
                 subgoal using prems(5) *(1) by blast
                 subgoal using prems(6) *(1) by blast
                 subgoal using prems(7) *(2) by blast
                 done
               thus ?thesis using IH l by presburger
             qed
             then obtain l' where l': "l' \<le> l" "intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) l' (s \<cdot> \<sigma>)"
               by blast
 
             have "l' < n" using l'(1) l(1) by linarith
             thus ?thesis using l'(2) by blast
           qed
   
           have g: "length (ss \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma>) = arity g" "public g"
             using t(2,3) unfolding f ts by auto
 
           let ?P = "\<lambda>s l. l < n \<and> intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) l s"
           define steps where "steps \<equiv> \<lambda>s. SOME l. ?P s l"
   
           have 2: "steps (s \<cdot> \<sigma>) < n" "intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) (steps (s \<cdot> \<sigma>)) (s \<cdot> \<sigma>)"
             when s: "s \<in> set ss" for s
             using someI_ex[OF IH'[OF s]] unfolding steps_def by (blast, blast)
   
           have 3: "Suc (Max (insert 0 (steps ` set (ss \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma>)))) \<le> n"
           proof (cases "ss = []")
             case True show ?thesis unfolding True n by simp
           next
             case False thus ?thesis
               using 2 Max_nat_finite_lt[of "set (ss \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma>)" steps n] by (simp add: Suc_leI)
           qed
   
           show ?thesis
             using intruder_deduct_num.ComposeN[OF g, of "(M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N" steps] 2(2) 3
             unfolding Fun by auto
         qed
       next
         assume "\<exists>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>).
                   (\<exists>l < n. intruder_deduct_num (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) l s) \<and>
                   (\<forall>k \<in> set (fst (Ana s)). \<exists>l < n. intruder_deduct_num (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) l k) \<and>
                   t \<cdot> \<theta> \<in> set (snd (Ana s))"
         then obtain s l
             where s:
               "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
               "\<forall>k \<in> set (fst (Ana s)). \<exists>l < n. intruder_deduct_num (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) l k"
               "t \<cdot> \<theta> \<in> set (snd (Ana s))"
             and l: "l < n" "intruder_deduct_num (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) l s"
           by (metis (no_types, lifting) M_subterms_eq(1))
 
         obtain u where u: "u \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M" "s = u \<cdot> \<theta>" using s(1) by blast
 
         have u_fv: "fv u \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M" by (metis fv_subset_subterms u(1))
 
         have "\<nexists>x. u = Var x"
         proof
           assume "\<exists>x. u = Var x"
           then obtain x where x: "u = Var x" by blast
           then obtain c where c: "s = Fun c []" using u prems(2) u_fv by auto
           thus False using s(3) Ana_subterm by (cases "Ana s") force
         qed
         then obtain f ts where u': "u = Fun f ts" by (cases u) auto
 
         obtain K R where KR: "Ana u = (K,R)" by (metis surj_pair)
 
         have KR': "Ana s = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>, R \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)"
           using KR Ana_subst'[OF KR[unfolded u'], of \<theta>] unfolding u(2) u' by blast
         hence s': 
             "\<forall>k \<in> set K. \<exists>l < n. intruder_deduct_num (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) l (k \<cdot> \<theta>)"
             "t \<cdot> \<theta> \<in> set (R \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)"
           using s(2,3) by auto
 
         have IH1: "\<exists>l < n. intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) l (u \<cdot> \<sigma>)"
         proof -
           have "subterms u \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t M" using u(1) subterms_subset by auto
           hence "subterms\<^sub>s\<^sub>e\<^sub>t (insert u M) = subterms\<^sub>s\<^sub>e\<^sub>t M" by blast
           hence *: "subterms\<^sub>s\<^sub>e\<^sub>t (insert u M) \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (insert t M)" by auto
 
           have "\<exists>l' \<le> l. intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) l' (u \<cdot> \<sigma>)"
           proof -
             have "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv u.
                     (\<exists>n. \<theta> x = Fun (Val n) []) \<or> (\<exists>n. \<theta> x = Fun (PubConst Value n) [])"
                  "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv u. \<exists>n. \<sigma> x = Fun (Val n) []"
                  "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv u. (\<exists>n. \<theta> x = Fun (PubConst Value n) []) \<longrightarrow> \<sigma> x \<in> M \<union> N"
                  "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv u. (\<exists>n. \<theta> x = Fun (Val n) []) \<longrightarrow> \<theta> x = \<sigma> x"
                  "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv u. \<forall>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv u. \<theta> x = \<theta> y \<longleftrightarrow> \<sigma> x = \<sigma> y"
                  "\<forall>n. Fun (PubConst Value n) [] \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (insert u M)"
               subgoal using prems(2) u_fv by blast
               subgoal using prems(3) u_fv by blast
               subgoal using prems(4) u_fv by blast
               subgoal using prems(5) u_fv by blast
               subgoal using prems(6) u_fv by blast
               subgoal using prems(7) * by blast
               done
             thus ?thesis using IH l unfolding u(2) by presburger
           qed
           then obtain l' where l': "l' \<le> l" "intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) l' (u \<cdot> \<sigma>)"
             by blast
 
           have "l' < n" using l'(1) l(1) by linarith
           thus ?thesis using l'(2) by blast
         qed
 
         have IH2: "\<exists>l < n. intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) l (k \<cdot> \<sigma>)" when k: "k \<in> set K" for k
           using k IH prems(2-) Ana\<^sub>f_keys_not_val_terms s'(1) KR u(1)
         proof -
           have *: "fv k \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M" using k KR Ana_keys_fv u(1) fv_subset_subterms by blast
 
           have **: "Fun (PubConst Value n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M" when "Fun (PubConst Value n) [] \<sqsubseteq> k" for n
             using in_subterms_subset_Union[OF u(1)]
                   Ana_key_PubConstValue_subterm_in_term[OF KR k that]
             by fast
 
           obtain lk where lk: "lk < n" "intruder_deduct_num (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) lk (k \<cdot> \<theta>)"
             using s'(1) k by fast
 
           have "\<exists>l' \<le> lk. intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) l' (k \<cdot> \<sigma>)"
           proof -
             have "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv k.
                     (\<exists>n. \<theta> x = Fun (Val n) []) \<or> (\<exists>n. \<theta> x = Fun (PubConst Value n) [])"
                  "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv k. \<exists>n. \<sigma> x = Fun (Val n) []"
                  "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv k. (\<exists>n. \<theta> x = Fun (PubConst Value n) []) \<longrightarrow> \<sigma> x \<in> M \<union> N"
                  "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv k. (\<exists>n. \<theta> x = Fun (Val n) []) \<longrightarrow> \<theta> x = \<sigma> x"
                  "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv k. \<forall>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv k. \<theta> x = \<theta> y \<longleftrightarrow> \<sigma> x = \<sigma> y"
                  "\<forall>n. Fun (PubConst Value n) [] \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (insert k M)"
               subgoal using prems(2) * by blast
               subgoal using prems(3) * by blast
               subgoal using prems(4) * by blast
               subgoal using prems(5) * by blast
               subgoal using prems(6) * by blast
               subgoal using prems(7) ** by blast
               done
             thus ?thesis using IH lk by presburger
           qed
           then obtain lk' where lk': "lk' \<le> lk" "intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) lk' (k \<cdot> \<sigma>)"
             by blast
 
           have "lk' < n" using lk'(1) lk(1) by linarith
           thus ?thesis using lk'(2) by blast
         qed
 
         have KR'': "Ana (u \<cdot> \<sigma>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma>, R \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma>)"
           using Ana_subst' KR unfolding u' by blast
 
         obtain r where r: "r \<in> set R" "t \<cdot> \<theta> = r \<cdot> \<theta>"
           using s'(2) by fastforce
 
         have r': "t \<cdot> \<sigma> \<in> set (R \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma>)"
         proof -
           have r_subterm_u: "r \<sqsubseteq> u" using r(1) KR Ana_subterm by blast
 
           have r_fv: "fv r \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
             by (meson r_subterm_u u(1) fv_subset_subterms in_mono in_subterms_subset_Union)
 
           have t_subterms_M: "subterms t \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (insert t M)"
             by blast
 
           have r_subterm_M: "subterms r \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (insert t M)"
             using subterms_subset[OF r_subterm_u] in_subterms_subset_Union[OF u(1)]
             by (auto intro: subterms\<^sub>s\<^sub>e\<^sub>t_mono)
 
           have *: "\<forall>x \<in> fv t \<union> fv r. \<theta> x = \<sigma> x \<or> \<not>(\<theta> x \<sqsubseteq> t) \<and> \<not>(\<theta> x \<sqsubseteq> r)"
           proof
             fix x assume "x \<in> fv t \<union> fv r"
             hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t" using r_fv by blast
             thus "\<theta> x = \<sigma> x \<or> \<not>(\<theta> x \<sqsubseteq> t) \<and> \<not>(\<theta> x \<sqsubseteq> r)"
               using prems(2,5,7) r_subterm_M t_subterms_M
               by (metis (no_types, opaque_lifting) in_mono)
           qed
 
           have **: "\<forall>x \<in> fv t \<union> fv r. \<exists>c. \<theta> x = Fun c []"
                    "\<forall>x \<in> fv t \<union> fv r. \<exists>c. \<sigma> x = Fun c []"
                    "\<forall>x \<in> fv t \<union> fv r. \<forall>y \<in> fv t \<union> fv r. \<theta> x = \<theta> y \<longleftrightarrow> \<sigma> x = \<sigma> y"
             subgoal using prems(2) r_fv by blast
             subgoal using prems(3) r_fv by blast
             subgoal using prems(6) r_fv by blast
             done
           
           have "t \<cdot> \<sigma> = r \<cdot> \<sigma>" by (rule subst_const_swap_eq'[OF r(2) * **])
           thus ?thesis using r(1) by simp
         qed
 
         obtain l1 where l1: "l1 < n" "intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) l1 (u \<cdot> \<sigma>)"
           using IH1 by blast
 
         let ?P = "\<lambda>s l. l < n \<and> intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) l s"
         define steps where "steps \<equiv> \<lambda>s. SOME l. ?P s l"
 
         have 2: "steps (k \<cdot> \<sigma>) < n" "intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) (steps (k \<cdot> \<sigma>)) (k \<cdot> \<sigma>)"
           when k: "k \<in> set K" for k
           using someI_ex[OF IH2[OF k]] unfolding steps_def by (blast, blast)
 
         have 3: "Suc (Max (insert l1 (steps ` set (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma>)))) \<le> n"
         proof (cases "K = []")
           case True show ?thesis using l1(1) unfolding True n by simp
         next
           case False thus ?thesis
             using l1(1) 2 Max_nat_finite_lt[of "set (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma>)" steps n] by (simp add: Suc_leI)
         qed
 
         have IH2': "intruder_deduct_num ((M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>) \<union> N) (steps k) k"
           when k: "k \<in> set (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma>)" for k
           using IH2 k 2 by auto
 
         show ?thesis
           using l1(1) intruder_deduct_num.DecomposeN[OF l1(2) KR'' IH2' r'] 3 by fast
       qed
     qed
   qed
   thus ?thesis using deduct_if_deduct_num by blast
 qed
 
 lemma constraint_model_Nil:
   assumes I: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
   shows "constraint_model I []"
 using I unfolding constraint_model_def by simp
 
 lemma welltyped_constraint_model_Nil:
   assumes I: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
   shows "welltyped_constraint_model I []"
 using I(1) constraint_model_Nil[OF I(2,3)] unfolding welltyped_constraint_model_def by simp
 
 lemma constraint_model_prefix:
   assumes "constraint_model I (A@B)"
   shows "constraint_model I A"
 by (metis assms strand_sem_append_stateful unlabel_append constraint_model_def)
 
 lemma welltyped_constraint_model_prefix:
   assumes "welltyped_constraint_model I (A@B)"
   shows "welltyped_constraint_model I A"
 by (metis assms constraint_model_prefix welltyped_constraint_model_def)
 
 lemma welltyped_constraint_model_deduct_append:
   assumes "welltyped_constraint_model I A"
     and "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> s \<cdot> I"
   shows "welltyped_constraint_model I (A@[(l,send\<langle>[s]\<rangle>)])"
 using assms strand_sem_append_stateful[of "{}" "{}" "unlabel A" _ I]
 unfolding welltyped_constraint_model_def constraint_model_def by simp
 
 lemma welltyped_constraint_model_deduct_split:
   assumes "welltyped_constraint_model I (A@[(l,send\<langle>[s]\<rangle>)])"
   shows "welltyped_constraint_model I A"
     and "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> s \<cdot> I"
 using assms strand_sem_append_stateful[of "{}" "{}" "unlabel A" _ I]
 unfolding welltyped_constraint_model_def constraint_model_def by simp_all
 
 lemma welltyped_constraint_model_deduct_iff:
   "welltyped_constraint_model I (A@[(l,send\<langle>[s]\<rangle>)]) \<longleftrightarrow>
     welltyped_constraint_model I A \<and> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> s \<cdot> I"
 by (metis welltyped_constraint_model_deduct_append welltyped_constraint_model_deduct_split)  
 
 lemma welltyped_constraint_model_attack_if_receive_attack:
   assumes I: "welltyped_constraint_model \<I> \<A>"
     and rcv_attack: "receive\<langle>ts\<rangle> \<in> set (unlabel \<A>)" "attack\<langle>n\<rangle> \<in> set ts"
   shows "welltyped_constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
 proof -
   have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> attack\<langle>n\<rangle>"
     using rcv_attack in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of "attack\<langle>n\<rangle>" "unlabel \<A>"]
           ideduct_subst[OF intruder_deduct.Axiom[of "attack\<langle>n\<rangle>" "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"], of \<I>]
     by auto
   thus ?thesis
     using I strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" "[send\<langle>[attack\<langle>n\<rangle>]\<rangle>]" \<I>]
     unfolding welltyped_constraint_model_def constraint_model_def by auto
 qed
 
 lemma constraint_model_Val_is_Value_term:
   assumes "welltyped_constraint_model I A"
     and "t \<cdot> I = Fun (Val n) []"
   shows "t = Fun (Val n) [] \<or> (\<exists>m. t = Var (TAtom Value, m))"
 proof -
   have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" using assms(1) unfolding welltyped_constraint_model_def by simp
   moreover have "\<Gamma> (Fun (Val n) []) = TAtom Value" by auto
   ultimately have *: "\<Gamma> t = TAtom Value" by (metis (no_types) assms(2) wt_subst_trm'')
 
   show ?thesis
   proof (cases t)
     case (Var x)
     obtain \<tau> m where x: "x = (\<tau>, m)" by (metis surj_pair)
     have "\<Gamma>\<^sub>v x = TAtom Value" using * Var by auto
     hence "\<tau> = TAtom Value" using x \<Gamma>\<^sub>v_TAtom'[of Value \<tau> m] by simp
     thus ?thesis using x Var by metis
   next
     case (Fun f T) thus ?thesis using assms(2) by auto
   qed
 qed
 
 lemma wellformed_transaction_sem_receives:
   fixes T::"('fun,'atom,'sets,'lbl) prot_transaction"
   assumes T_valid: "wellformed_transaction T"
     and \<I>: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I>"
     and s: "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
   shows "\<forall>t \<in> set ts. IK \<turnstile> t \<cdot> \<I>"
 proof -
   let ?R = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
   let ?S = "\<lambda>A. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
   let ?S' = "?S (transaction_receive T)"
 
   obtain l B s where B:
       "(l,send\<langle>ts\<rangle>) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
       "prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
     using s dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2)[of ts "transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst[of "send\<langle>ts\<rangle>" "transaction_receive T" \<theta>]
     by blast
 
   have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>])) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[send\<langle>ts\<rangle>]"
     using B(1) unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst singleton_lst_proj(4)
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc subst_lsst_append subst_lsst_singleton
     by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps)
 
   have "strand_sem_stateful IK DB ?S' \<I>"
     using \<I> strand_sem_append_stateful[of IK DB _ _ \<I>] transaction_dual_subst_unfold[of T \<theta>]
     by fastforce
   hence "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[send\<langle>ts\<rangle>]) \<I>"
     using B 1 unfolding prefix_def unlabel_def
     by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def map_append strand_sem_append_stateful) 
   hence t_deduct: "\<forall>t \<in> set ts. IK \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile> t \<cdot> \<I>"
     using strand_sem_append_stateful[of IK DB "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" "[send\<langle>ts\<rangle>]" \<I>]
     by simp
 
   have "\<forall>s \<in> set (unlabel (transaction_receive T)). \<exists>t. s = receive\<langle>t\<rangle>"
     using T_valid wellformed_transaction_unlabel_cases(1)[OF T_valid] by auto
   moreover { fix A::"('fun,'atom,'sets,'lbl) prot_strand" and \<theta>
     assume "\<forall>s \<in> set (unlabel A). \<exists>t. s = receive\<langle>t\<rangle>"
     hence "\<forall>s \<in> set (unlabel (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)). \<exists>t. s = receive\<langle>t\<rangle>"
     proof (induction A)
       case (Cons a A) thus ?case using subst_lsst_cons[of a A \<theta>] by (cases a) auto
     qed simp
     hence "\<forall>s \<in> set (unlabel (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)). \<exists>t. s = receive\<langle>t\<rangle>"
       by (simp add: list.pred_set is_Receive_def)
     hence "\<forall>s \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))). \<exists>t. s = send\<langle>t\<rangle>"
       by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv(2) unlabel_in unlabel_mem_has_label)
   }
   ultimately have "\<forall>s \<in> set ?R. \<exists>ts. s = send\<langle>ts\<rangle>" by simp
   hence "ik\<^sub>s\<^sub>s\<^sub>t ?R = {}" unfolding unlabel_def ik\<^sub>s\<^sub>s\<^sub>t_def by fast
   hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) = {}"
     using B(2) 1 ik\<^sub>s\<^sub>s\<^sub>t_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append
     by (metis (no_types, lifting) Un_empty map_append prefix_def unlabel_def) 
   thus ?thesis using t_deduct by simp
 qed
 
 lemma wellformed_transaction_sem_pos_checks:
   assumes T_valid: "wellformed_transaction T"
     and \<I>: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I>"
   shows "\<langle>ac: t \<in> u\<rangle> \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<Longrightarrow> (t \<cdot> \<I>, u \<cdot> \<I>) \<in> DB"
     and "\<langle>ac: t \<doteq> u\<rangle> \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<Longrightarrow> t \<cdot> \<I> = u \<cdot> \<I>"
 proof -
   let ?s = "\<langle>ac: t \<in> u\<rangle>"
   let ?s' = "\<langle>ac: t \<doteq> u\<rangle>"
   let ?C = "set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
   let ?R = "transaction_receive T@transaction_checks T"
   let ?R' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
   let ?S = "\<lambda>A. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
   let ?S' = "?S (transaction_receive T)@?S (transaction_checks T)"
   let ?P = "\<lambda>a. is_Receive a \<or> is_Check_or_Assignment a"
   let ?Q = "\<lambda>a. is_Send a \<or> is_Check_or_Assignment a"
   let ?dbupd = "\<lambda>B. dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I> DB"
 
   have s_in: "?s \<in> ?C \<Longrightarrow> ?s \<in> set (unlabel (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
              "?s' \<in> ?C \<Longrightarrow> ?s' \<in> set (unlabel (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
     using subst_lsst_append[of "transaction_receive T"]
           unlabel_append[of "transaction_receive T"]
     by auto
 
   have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>])) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[s']"
     when B: "(l,s') = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)" "s' = \<langle>ac: t \<in> u\<rangle> \<or> s' = \<langle>ac: t \<doteq> u\<rangle>"
     for l s s' and B::"('fun,'atom,'sets,'lbl) prot_strand"
     using B unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst singleton_lst_proj(4)
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc subst_lsst_append subst_lsst_singleton
     by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps)
 
 
   have 2: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[s']) \<I>"
     when B: "(l,s') = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
             "prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
             "s' = \<langle>ac: t \<in> u\<rangle> \<or> s' = \<langle>ac: t \<doteq> u\<rangle>"
     for l s s' and B::"('fun,'atom,'sets,'lbl) prot_strand"
   proof -
     have "strand_sem_stateful IK DB ?S' \<I>"
       using \<I> strand_sem_append_stateful[of IK DB _ _ \<I>] transaction_dual_subst_unfold[of T \<theta>]
       by fastforce
     thus ?thesis
       using B(2) 1[OF B(1,3)] strand_sem_append_stateful subst_lsst_append
       unfolding prefix_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by (metis (no_types) map_append)
   qed
 
   have s_sem:
       "?s \<in> ?C \<Longrightarrow> (l,?s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) \<Longrightarrow> (t \<cdot> \<I>, u \<cdot> \<I>) \<in> ?dbupd B"
       "?s' \<in> ?C \<Longrightarrow> (l,?s') = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) \<Longrightarrow> t \<cdot> \<I> = u \<cdot> \<I>"
     when B: "prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
     for l s and B::"('fun,'atom,'sets,'lbl) prot_strand"
     using 2[OF _ B] strand_sem_append_stateful[of IK DB "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" _ \<I>]
     by (fastforce, fastforce)
 
   have 3: "\<forall>a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))). \<not>is_Insert a \<and> \<not>is_Delete a"
     when B: "prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
     for l s and B::"('fun,'atom,'sets,'lbl) prot_strand"
   proof -
     have "\<forall>a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))). ?Q a"
     proof
       fix a assume a: "a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
   
       have "?P a" when a: "a \<in> set (unlabel ?R)" for a
         using a wellformed_transaction_unlabel_cases(1,2)[OF T_valid]
         unfolding unlabel_def by fastforce
       hence "?P a" when a: "a \<in> set (unlabel (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" for a
         using a stateful_strand_step_cases_subst(2,11)[of _ \<theta>] subst_lsst_unlabel[of ?R \<theta>]
         unfolding subst_apply_stateful_strand_def by auto
       hence B_P: "\<forall>a \<in> set (unlabel (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)). ?P a"
         using unlabel_mono[OF set_mono_prefix[OF append_prefixD[OF B]]]  by blast
   
       obtain l where "(l,a) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
         using a by (meson unlabel_mem_has_label)
       then obtain b where b: "(l,b) \<in> set (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,b) = (l,a)"
         using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD by blast
       hence "?P b" using B_P unfolding unlabel_def by fastforce
       thus "?Q a" using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv[OF b(2)] by (cases b) auto
     qed
     thus ?thesis by fastforce
   qed
 
   show "(t \<cdot> \<I>, u \<cdot> \<I>) \<in> DB" when s: "?s \<in> ?C"
   proof -
     obtain l B s where B:
         "(l,?s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
         "prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
       using s_in(1)[OF s] dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(6)[of _ t u]
             dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst[of ?s ?R \<theta>]
       by blast
 
     show ?thesis
       using 3[OF B(2)] s_sem(1)[OF B(2) s B(1)]
             dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" \<I> DB]
       by simp
   qed
 
   show "t \<cdot> \<I> = u \<cdot> \<I>" when s: "?s' \<in> ?C"
   proof -
     obtain l B s where B:
         "(l,?s') = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
         "prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
       using s_in(2)[OF s] dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(3)[of _ t u]
             dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst[of ?s' ?R \<theta>]
       by blast
 
     show ?thesis
       using 3[OF B(2)] s_sem(2)[OF B(2) s B(1)]
             dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" \<I> DB]
       by simp
   qed
 qed
 
 lemma wellformed_transaction_sem_neg_checks:
   assumes T_valid: "wellformed_transaction T"
     and \<I>: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I>"
     and "NegChecks X F G \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
   shows "negchecks_model \<I> DB X F G"
 proof -
   let ?s = "NegChecks X F G"
   let ?R = "transaction_receive T@transaction_checks T"
   let ?R' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
   let ?S = "\<lambda>A. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
   let ?S' = "?S (transaction_receive T)@?S (transaction_checks T)"
   let ?P = "\<lambda>a. is_Receive a \<or> is_Check_or_Assignment a"
   let ?Q = "\<lambda>a. is_Send a \<or> is_Check_or_Assignment a"
   let ?U = "\<lambda>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>)"
 
   have s: "?s \<in> set (unlabel (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
     using assms(3) subst_lsst_append[of "transaction_receive T"]
           unlabel_append[of "transaction_receive T"]
     by auto
 
   obtain l B s where B:
       "(l,?s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
       "prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
     using s dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(7)[of X F G]
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst[of ?s ?R \<theta>]
     by blast
 
   have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>])) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[?s]"
     using B(1) unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst singleton_lst_proj(4)
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc subst_lsst_append subst_lsst_singleton
     by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps)
 
   have "strand_sem_stateful IK DB ?S' \<I>"
     using \<I> strand_sem_append_stateful[of IK DB _ _ \<I>] transaction_dual_subst_unfold[of T \<theta>]
     by fastforce
   hence "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[?s]) \<I>"
     using B 1 strand_sem_append_stateful subst_lsst_append
     unfolding prefix_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def
     by (metis (no_types) map_append)
   hence s_sem: "negchecks_model \<I> (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I> DB) X F G"
     using strand_sem_append_stateful[of IK DB "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" "[?s]" \<I>]
     by fastforce
 
   have "\<forall>a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))). ?Q a"
   proof
     fix a assume a: "a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
 
     have "?P a" when a: "a \<in> set (unlabel ?R)" for a
       using a wellformed_transaction_unlabel_cases(1,2,3)[OF T_valid]
       unfolding unlabel_def by fastforce
     hence "?P a" when a: "a \<in> set (unlabel (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" for a
       using a stateful_strand_step_cases_subst(2,11)[of _ \<theta>] subst_lsst_unlabel[of ?R \<theta>]
       unfolding subst_apply_stateful_strand_def by auto
     hence B_P: "\<forall>a \<in> set (unlabel (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)). ?P a"
       using unlabel_mono[OF set_mono_prefix[OF append_prefixD[OF B(2)]]]
       by blast
 
     obtain l where "(l,a) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
       using a by (meson unlabel_mem_has_label)
     then obtain b where b: "(l,b) \<in> set (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,b) = (l,a)"
       using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD by blast
     hence "?P b" using B_P unfolding unlabel_def by fastforce
     thus "?Q a" using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv[OF b(2)] by (cases b) auto
   qed
   hence "\<forall>a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))). \<not>is_Insert a \<and> \<not>is_Delete a" by fastforce
   thus ?thesis using dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" \<I> DB] s_sem by simp
 qed
 
 lemma wellformed_transaction_sem_neg_checks':
   assumes T_valid: "wellformed_transaction T"
     and \<I>: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I>"
     and c: "NegChecks X [] [(t,u)] \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
   shows "\<forall>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>) \<longrightarrow> (t \<cdot> \<delta> \<cdot> \<I>, u \<cdot> \<delta> \<cdot> \<I>) \<notin> DB" (is ?A)
     and "X = [] \<Longrightarrow> (t \<cdot> \<I>, u \<cdot> \<I>) \<notin> DB" (is "?B \<Longrightarrow> ?B'")
 proof -
   show ?A
     using wellformed_transaction_sem_neg_checks[OF T_valid \<I> c]
     unfolding negchecks_model_def by auto
   moreover have "\<delta> = Var" "t \<cdot> \<delta> = t"
     when "subst_domain \<delta> = set []" for t and \<delta>::"('fun, 'atom, 'sets, 'lbl) prot_subst"
     using that by auto
   moreover have "subst_domain Var = set []" "range_vars Var = {}"
     by simp_all
   ultimately show "?B \<Longrightarrow> ?B'" unfolding range_vars_alt_def by metis
 qed
 
 lemma wellformed_transaction_sem_iff:
   fixes T \<theta>
   defines "A \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
     and "rm \<equiv> \<lambda>X. rm_vars (set X)"
   assumes T: "wellformed_transaction T"
     and I: " interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
   shows "strand_sem_stateful M D A I \<longleftrightarrow> (
     (\<forall>l ts. (l,receive\<langle>ts\<rangle>) \<in> set (transaction_receive T) \<longrightarrow> (\<forall>t \<in> set ts. M \<turnstile> t \<cdot> \<theta> \<cdot> I)) \<and>
     (\<forall>l ac t s. (l,\<langle>ac: t \<doteq> s\<rangle>) \<in> set (transaction_checks T) \<longrightarrow> t \<cdot> \<theta> \<cdot> I = s \<cdot> \<theta> \<cdot> I) \<and>
     (\<forall>l ac t s. (l,\<langle>ac: t \<in> s\<rangle>) \<in> set (transaction_checks T) \<longrightarrow> (t \<cdot> \<theta> \<cdot> I, s \<cdot> \<theta> \<cdot> I) \<in> D) \<and>
     (\<forall>l X F G. (l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) \<in> set (transaction_checks T) \<longrightarrow>
       (\<forall>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>) \<longrightarrow>
             (\<exists>(t,s) \<in> set F. t \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I \<noteq> s \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I) \<or>
             (\<exists>(t,s) \<in> set G. (t \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I, s \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I) \<notin> D))))"
     (is "?A \<longleftrightarrow> ?B")
 proof
   note 0 = A_def transaction_dual_subst_unlabel_unfold
   note 1 = wellformed_transaction_sem_receives[OF T, of M D \<theta> I, unfolded A_def[symmetric]]
            wellformed_transaction_sem_pos_checks[OF T, of M D \<theta> I, unfolded A_def[symmetric]]
            wellformed_transaction_sem_neg_checks[OF T, of M D \<theta> I, unfolded A_def[symmetric]]
   note 2 = stateful_strand_step_subst_inI[OF unlabel_in]
   note 3 = unlabel_subst
   note 4 = strand_sem_append_stateful[of M D _ _ I]
 
   let ?C = "\<lambda>T. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
   let ?P = "\<lambda>X \<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>)"
   let ?sem = "\<lambda>M D T. strand_sem_stateful M D (?C T) I"
   let ?negchecks = "\<lambda>X F G. \<forall>\<delta>. ?P X \<delta> \<longrightarrow>
                                  (\<exists>(t,s) \<in> set F. t \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I \<noteq> s \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I) \<or>
                                  (\<exists>(t,s) \<in> set G. (t \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I, s \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I) \<notin> D)"
 
   have "list_all is_Receive (unlabel (transaction_receive T))"
        "list_all is_Check_or_Assignment (unlabel (transaction_checks T))"
        "list_all is_Update (unlabel (transaction_updates T))"
        "list_all is_Send (unlabel (transaction_send T))"
     using T unfolding wellformed_transaction_def by (blast, blast, blast, blast)
   hence 5: "list_all is_Send (?C (transaction_receive T))"
            "list_all is_Check_or_Assignment (?C (transaction_checks T))"
            "list_all is_Update (?C (transaction_updates T))"
            "list_all is_Receive (?C (transaction_send T))"
     by (metis (no_types) subst_sst_list_all(2) unlabel_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(1),
         metis (no_types) subst_sst_list_all(11) unlabel_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(11),
         metis (no_types) subst_sst_list_all(10) unlabel_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(10),
         metis (no_types) subst_sst_list_all(1) unlabel_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(2))
   
   have "\<forall>a \<in> set (?C (transaction_receive T)). \<not>is_Receive a \<and> \<not>is_Insert a \<and> \<not>is_Delete a"
        "\<forall>a \<in> set (?C (transaction_checks T)). \<not>is_Receive a \<and> \<not>is_Insert a \<and> \<not>is_Delete a"
     using 5(1,2) unfolding list_all_iff by (blast,blast)
   hence 6:
       "M \<union> (ik\<^sub>s\<^sub>s\<^sub>t (?C (transaction_receive T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t I) = M"
       "dbupd\<^sub>s\<^sub>s\<^sub>t (?C (transaction_receive T)) I D = D"
       "M \<union> (ik\<^sub>s\<^sub>s\<^sub>t (?C (transaction_checks T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t I) = M"
       "dbupd\<^sub>s\<^sub>s\<^sub>t (?C (transaction_checks T)) I D = D"
     by (metis ik\<^sub>s\<^sub>s\<^sub>t_snoc_no_receive_empty sup_bot.right_neutral, metis dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd,
         metis ik\<^sub>s\<^sub>s\<^sub>t_snoc_no_receive_empty sup_bot.right_neutral, metis dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd)
 
   have ?B when A: ?A
   proof -
     have "M \<turnstile> t \<cdot> \<theta> \<cdot> I"
       when "(l, receive\<langle>ts\<rangle>) \<in> set (transaction_receive T)" "t \<in> set ts" for l ts t
       using that(2) 1(1)[OF A, of "ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>"] 2(2)[OF that(1)] unfolding 3 by auto
     moreover have "t \<cdot> \<theta> \<cdot> I = s \<cdot> \<theta> \<cdot> I"
       when "(l, \<langle>ac: t \<doteq> s\<rangle>) \<in> set (transaction_checks T)" for l ac t s
       using 1(3)[OF A] 2(3)[OF that] unfolding 3 by blast
     moreover have "(t \<cdot> \<theta> \<cdot> I, s \<cdot> \<theta> \<cdot> I) \<in> D"
       when "(l, \<langle>ac: t \<in> s\<rangle>) \<in> set (transaction_checks T)" for l ac t s
       using 1(2)[OF A] 2(6)[OF that] unfolding 3 by blast
     moreover have "?negchecks X F G"
       when "(l, \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) \<in> set (transaction_checks T)" for l X F G
       using 1(4)[OF A 2(7)[OF that, of \<theta>, unfolded 3]]
       unfolding negchecks_model_def rm_def subst_apply_pairs_def by fastforce
     ultimately show ?B by blast
   qed
   thus "?A \<Longrightarrow> ?B" by fast
 
   have ?A when B: ?B
   proof -
     have 7: "\<forall>t \<in> set ts. M \<turnstile> t \<cdot> I" when ts: "send\<langle>ts\<rangle> \<in> set (?C (transaction_receive T))" for ts
     proof -
       obtain l ss where "(l,receive\<langle>ss\<rangle>) \<in> set (transaction_receive T)" "ts = ss \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>"
         by (metis ts dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) subst_lsst_memD(1) unlabel_mem_has_label)
       thus ?thesis using B by auto
     qed
 
     have 8: "t \<cdot> I = s \<cdot> I" when ts: "\<langle>ac: t \<doteq> s\<rangle> \<in> set (?C (transaction_checks T))" for ac t s
     proof -
       obtain l t' s' where "(l,\<langle>ac: t' \<doteq> s'\<rangle>) \<in> set (transaction_checks T)" "t = t' \<cdot> \<theta>" "s = s' \<cdot> \<theta>"
         by (metis ts dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(3) subst_lsst_memD(3) unlabel_mem_has_label)
       thus ?thesis using B by auto
     qed
 
     have 9: "(t \<cdot> I, s \<cdot> I) \<in> D" when ts: "\<langle>ac: t \<in> s\<rangle> \<in> set (?C (transaction_checks T))" for ac t s
     proof -
       obtain l t' s' where "(l,\<langle>ac: t' \<in> s'\<rangle>) \<in> set (transaction_checks T)" "t = t' \<cdot> \<theta>" "s = s' \<cdot> \<theta>"
         by (metis ts dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(6) subst_lsst_memD(6) unlabel_mem_has_label)
       thus ?thesis using B by auto
     qed
 
     have 10: "negchecks_model I D X F G"
       when ts: "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set (?C (transaction_checks T))" for X F G
     proof -
       obtain l F' G' where *:
           "(l,\<forall>X\<langle>\<or>\<noteq>: F' \<or>\<notin>: G'\<rangle>) \<in> set (transaction_checks T)"
           "F = F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>" "G = G' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>"
         using unlabel_mem_has_label[OF iffD2[OF dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(7) ts]]
               subst_lsst_memD(7)[of _ X F G "transaction_checks T" \<theta>]
         by fast
 
       have "?negchecks X F' G'" using *(1) B by blast
       moreover have "\<exists>(t,s) \<in> set F. t \<cdot> \<delta> \<circ>\<^sub>s I \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s I"
         when "(t,s) \<in> set F'" "t \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I \<noteq> s \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I" for \<delta> t s
         using that unfolding rm_def *(2) subst_apply_pairs_def by force
       moreover have "\<exists>(t,s) \<in> set G. (t,s) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s I \<notin> D"
         when "(t,s) \<in> set G'" "(t \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I, s \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I) \<notin> D" for \<delta> t s
         using that unfolding rm_def *(3) subst_apply_pairs_def by force
       ultimately show ?thesis
         unfolding negchecks_model_def by auto
     qed
     
     have "?sem M D (transaction_receive T)"
       using 7 strand_sem_stateful_if_sends_deduct[OF 5(1)] by blast
     moreover have "?sem M D (transaction_checks T)"
       using 8 9 10 strand_sem_stateful_if_checks[OF 5(2)] by blast
     moreover have "?sem M D (transaction_updates T)" for M D
       using 5(3) strand_sem_stateful_if_no_send_or_check unfolding list_all_iff by blast
     moreover have "?sem M D (transaction_send T)" for M D
       using 5(4) strand_sem_stateful_if_no_send_or_check unfolding list_all_iff by blast
     ultimately show ?thesis
       using 4[of "?C (transaction_receive T)"
                  "?C (transaction_checks T)@?C (transaction_updates T)@?C (transaction_send T)"]
             4[of "?C (transaction_checks T)" "?C (transaction_updates T)@?C (transaction_send T)"]
             4[of "?C (transaction_updates T)" "?C (transaction_send T)"]
       unfolding 0 6 by blast
   qed
   thus "?B \<Longrightarrow> ?A" by fast
 qed
 
 lemma wellformed_transaction_unlabel_sem_iff:
   fixes T \<theta>
   defines "A \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
     and "rm \<equiv> \<lambda>X. rm_vars (set X)"
   assumes T: "wellformed_transaction T"
     and I: " interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
   shows "strand_sem_stateful M D A I \<longleftrightarrow> (
     (\<forall>ts. receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_receive T)) \<longrightarrow> (\<forall>t \<in> set ts. M \<turnstile> t \<cdot> \<theta> \<cdot> I)) \<and>
     (\<forall>ac t s. \<langle>ac: t \<doteq> s\<rangle> \<in> set (unlabel (transaction_checks T)) \<longrightarrow> t \<cdot> \<theta> \<cdot> I = s \<cdot> \<theta> \<cdot> I) \<and>
     (\<forall>ac t s. \<langle>ac: t \<in> s\<rangle> \<in> set (unlabel (transaction_checks T)) \<longrightarrow> (t \<cdot> \<theta> \<cdot> I, s \<cdot> \<theta> \<cdot> I) \<in> D) \<and>
     (\<forall>X F G. \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set (unlabel (transaction_checks T)) \<longrightarrow>
       (\<forall>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>) \<longrightarrow>
             (\<exists>(t,s) \<in> set F. t \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I \<noteq> s \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I) \<or>
             (\<exists>(t,s) \<in> set G. (t \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I, s \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I) \<notin> D))))"
 using wellformed_transaction_sem_iff[OF T I, of M D \<theta>]
       unlabel_in[of _ _ "transaction_receive T"] unlabel_mem_has_label[of _ "transaction_receive T"]
       unlabel_in[of _ _ "transaction_checks T"] unlabel_mem_has_label[of _ "transaction_checks T"]
 unfolding A_def[symmetric] rm_def by meson
 
 lemma dual_transaction_ik_is_transaction_send'':
   fixes \<delta> \<I>::"('a,'b,'c,'d) prot_subst"
   assumes "wellformed_transaction T"
   shows "(ik\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>))) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a =
          (trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a" (is "?A = ?B")
 using dual_transaction_ik_is_transaction_send[OF assms]
       subst_lsst_unlabel[of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" \<delta>]
       ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))" \<delta>]
       dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" \<delta>]
 by (auto simp add: abs_apply_terms_def)
 
 lemma while_prot_terms_fun_mono:
   "mono (\<lambda>M'. M \<union> \<Union>(subterms ` M') \<union> \<Union>((set \<circ> fst \<circ> Ana) ` M'))"
 unfolding mono_def by fast
 
 lemma while_prot_terms_SMP_overapprox:
   fixes M::"('fun,'atom,'sets,'lbl) prot_terms"
   assumes N_supset: "M \<union> \<Union>(subterms ` N) \<union> \<Union>((set \<circ> fst \<circ> Ana) ` N) \<subseteq> N"
     and Value_vars_only: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t N. \<Gamma>\<^sub>v x = TAtom Value"
   shows "SMP M \<subseteq> {a \<cdot> \<delta> | a \<delta>. a \<in> N \<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 -
   define f where "f \<equiv> \<lambda>M'. M \<union> \<Union>(subterms ` M') \<union> \<Union>((set \<circ> fst \<circ> Ana) ` M')"
   define S where "S \<equiv> {a \<cdot> \<delta> | a \<delta>. a \<in> N \<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>)}"
 
   note 0 = Value_vars_only
   
   have "t \<in> S" when "t \<in> SMP M" for t
   using that
   proof (induction t rule: SMP.induct)
     case (MP t)
     hence "t \<in> N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" using N_supset by auto
     hence "t \<cdot> Var \<in> S" unfolding S_def by blast
     thus ?case by simp
   next
     case (Subterm t t')
     then obtain \<delta> a where a: "a \<cdot> \<delta> = t" "a \<in> N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
       by (auto simp add: S_def)
     hence "\<forall>x \<in> fv a. \<exists>\<tau>. \<Gamma> (Var x) = TAtom \<tau>" using 0 by auto
     hence *: "\<forall>x \<in> fv a. (\<exists>f. \<delta> x = Fun f []) \<or> (\<exists>y. \<delta> x = Var y)"
       using a(3) TAtom_term_cases[OF wf_trm_subst_rangeD[OF a(4)]]
       by (metis wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
     obtain b where b: "b \<cdot> \<delta> = t'" "b \<in> subterms a"
       using subterms_subst_subterm[OF *, of t'] Subterm.hyps(2) a(1)
       by fast
     hence "b \<in> N" using N_supset a(2) by blast
     thus ?case using a b(1) unfolding S_def by blast
   next
     case (Substitution t \<theta>)
     then obtain \<delta> a where a: "a \<cdot> \<delta> = t" "a \<in> N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
       by (auto simp add: S_def)
     have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<delta> \<circ>\<^sub>s \<theta>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<delta> \<circ>\<^sub>s \<theta>))"
       by (fact wt_subst_compose[OF a(3) Substitution.hyps(2)],
           fact wf_trms_subst_compose[OF a(4) Substitution.hyps(3)])
     moreover have "t \<cdot> \<theta> = a \<cdot> \<delta> \<circ>\<^sub>s \<theta>" using a(1) subst_subst_compose[of a \<delta> \<theta>] by simp
     ultimately show ?case using a(2) unfolding S_def by blast
   next
     case (Ana t K T k)
     then obtain \<delta> a where a: "a \<cdot> \<delta> = t" "a \<in> N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
       by (auto simp add: S_def)
     obtain Ka Ta where a': "Ana a = (Ka,Ta)" by moura
     have *: "K = Ka \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>"
     proof (cases a)
       case (Var x)
       then obtain g U where gU: "t = Fun g U"
         using a(1) Ana.hyps(2,3) Ana_var
         by (cases t) simp_all
       have "\<Gamma> (Var x) = TAtom Value" using Var a(2) 0 by auto
       hence "\<Gamma> (Fun g U) = TAtom Value"
         using a(1,3) Var gU wt_subst_trm''[OF a(3), of a]
         by argo
       thus ?thesis using gU Fun_Value_type_inv Ana.hyps(2,3) by fastforce  
     next
       case (Fun g U) thus ?thesis using a(1) a' Ana.hyps(2) Ana_subst'[of g U] by simp
     qed
     then obtain ka where ka: "k = ka \<cdot> \<delta>" "ka \<in> set Ka" using Ana.hyps(3) by auto
     have "ka \<in> set ((fst \<circ> Ana) a)" using ka(2) a' by simp
     hence "ka \<in> N" using a(2) N_supset by auto
     thus ?case using ka a(3,4) unfolding S_def by blast
   qed
   thus ?thesis unfolding S_def by blast
 qed
 
 
 subsection \<open>Admissible Transactions\<close>
 definition admissible_transaction_checks where
   "admissible_transaction_checks T \<equiv>
     \<forall>x \<in> set (unlabel (transaction_checks T)).
       (is_InSet x \<longrightarrow>
           is_Var (the_elem_term x) \<and> is_Fun_Set (the_set_term x) \<and>
           fst (the_Var (the_elem_term x)) = TAtom Value) \<and>
       (is_NegChecks x \<longrightarrow>
           bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = [] \<and>
           ((the_eqs x = [] \<and> length (the_ins x) = 1) \<or>
            (the_ins x = [] \<and> length (the_eqs x) = 1))) \<and>
       (is_NegChecks x \<and> the_eqs x = [] \<longrightarrow> (let h = hd (the_ins x) in
           is_Var (fst h) \<and> is_Fun_Set (snd h) \<and>
           fst (the_Var (fst h)) = TAtom Value))"
 
 definition admissible_transaction_updates where
   "admissible_transaction_updates T \<equiv>
     \<forall>x \<in> set (unlabel (transaction_updates T)).
       is_Update x \<and> is_Var (the_elem_term x) \<and> is_Fun_Set (the_set_term x) \<and>
       fst (the_Var (the_elem_term x)) = TAtom Value"
 
 definition admissible_transaction_terms where
   "admissible_transaction_terms T \<equiv>
     wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) \<and>
     (\<forall>f \<in> \<Union>(funs_term ` trms_transaction T).
       \<not>is_Val f \<and> \<not>is_Abs f \<and> \<not>is_PubConst f \<and> f \<noteq> Pair) \<and>
     (\<forall>r \<in> set (unlabel (transaction_strand T)).
       (\<exists>f \<in> \<Union>(funs_term ` (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r)). is_Attack f) \<longrightarrow>
         transaction_fresh T = [] \<and>
         is_Send r \<and> length (the_msgs r) = 1 \<and> is_Fun_Attack (hd (the_msgs r)))"
 
 definition admissible_transaction_send_occurs_form where
   "admissible_transaction_send_occurs_form T \<equiv> (
     let snds = transaction_send T;
         frsh = transaction_fresh T
     in \<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t snds. OccursFact \<in> funs_term t \<or> OccursSec \<in> funs_term t \<longrightarrow>
         (\<exists>x \<in> set frsh. t = occurs (Var x))
 )"
 
 definition admissible_transaction_occurs_checks where
   "admissible_transaction_occurs_checks T \<equiv> (
     let occ_in = \<lambda>x S. occurs (Var x) \<in> set (the_msgs (hd (unlabel S)));
         rcvs = transaction_receive T;
         snds = transaction_send T;
         frsh = transaction_fresh T;
         fvs = fv_transaction T
     in admissible_transaction_send_occurs_form T \<and>
        ((\<exists>x \<in> fvs - set frsh. fst x = TAtom Value) \<longrightarrow> (
           rcvs \<noteq> [] \<and> is_Receive (hd (unlabel rcvs)) \<and>
           (\<forall>x \<in> fvs - set frsh. fst x = TAtom Value \<longrightarrow> occ_in x rcvs))) \<and>
        (frsh \<noteq> [] \<longrightarrow> (
           snds \<noteq> [] \<and> is_Send (hd (unlabel snds)) \<and>
           (\<forall>x \<in> set frsh. occ_in x snds)))
 )"
 
 definition admissible_transaction_no_occurs_msgs where
   "admissible_transaction_no_occurs_msgs T \<equiv> (
     let no_occ = \<lambda>t. is_Fun t \<longrightarrow> the_Fun t \<noteq> OccursFact;
         rcvs = transaction_receive T;
         snds = transaction_send T
     in list_all (\<lambda>a. is_Receive (snd a) \<longrightarrow> list_all no_occ (the_msgs (snd a))) rcvs \<and>
        list_all (\<lambda>a. is_Send (snd a)    \<longrightarrow> list_all no_occ (the_msgs (snd a))) snds
 )"
 
 definition admissible_transaction' where
   "admissible_transaction' T \<equiv> (
     wellformed_transaction T \<and>
     transaction_decl T () = [] \<and>
     list_all (\<lambda>x. fst x = TAtom Value) (transaction_fresh T) \<and>
     (\<forall>x \<in> vars_transaction T. is_Var (fst x) \<and> (the_Var (fst x) = Value)) \<and>
     bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = {} \<and>
     set (transaction_fresh T) \<subseteq>
       fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (filter (is_Insert \<circ> snd) (transaction_updates T)) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<and>
     (\<forall>x \<in> fv_transaction T - set (transaction_fresh T).
      \<forall>y \<in> fv_transaction T - set (transaction_fresh T).
       x \<noteq> y \<longrightarrow> \<langle>Var x != Var y\<rangle> \<in> set (unlabel (transaction_checks T)) \<or>
                 \<langle>Var y != Var x\<rangle> \<in> set (unlabel (transaction_checks T))) \<and>
     fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) - set (transaction_fresh T)
       \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<and>
     (\<forall>r \<in> set (unlabel (transaction_checks T)).
       is_Equality r \<longrightarrow> fv (the_rhs r) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)) \<and>
     fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<subseteq>
       fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union>
       fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (filter (\<lambda>s. is_InSet (snd s) \<and> the_check (snd s) = Assign) (transaction_checks T)) \<and>
     list_all (\<lambda>a. is_Receive (snd a) \<longrightarrow> the_msgs (snd a) \<noteq> []) (transaction_receive T) \<and>
     list_all (\<lambda>a. is_Send (snd a) \<longrightarrow> the_msgs (snd a) \<noteq> []) (transaction_send T) \<and>
     admissible_transaction_checks T \<and>
     admissible_transaction_updates T \<and>
     admissible_transaction_terms T \<and>
     admissible_transaction_send_occurs_form T
 )"
 
 definition admissible_transaction where
   "admissible_transaction T \<equiv>
     admissible_transaction' T \<and>
     admissible_transaction_no_occurs_msgs T"
 
 definition has_initial_value_producing_transaction where
   "has_initial_value_producing_transaction P \<equiv>
     let f = \<lambda>s.
       list_all (\<lambda>T. list_all (\<lambda>a. ((is_Delete a \<or> is_InSet a) \<longrightarrow> the_set_term a \<noteq> \<langle>s\<rangle>\<^sub>s) \<and>
                                   (is_NegChecks a \<longrightarrow> list_all (\<lambda>(_,t). t \<noteq> \<langle>s\<rangle>\<^sub>s) (the_ins a)))
                              (unlabel (transaction_checks T@transaction_updates T)))
                P
     in list_ex (\<lambda>T.
         length (transaction_fresh T) = 1 \<and> transaction_receive T = [] \<and>
         transaction_checks T = [] \<and> length (transaction_send T) = 1 \<and>
         (let x = hd (transaction_fresh T); a = hd (transaction_send T); u = transaction_updates T
          in is_Send (snd a) \<and> Var x \<in> set (the_msgs (snd a)) \<and>
             fv\<^sub>s\<^sub>e\<^sub>t (set (the_msgs (snd a))) = {x} \<and>
             (u \<noteq> [] \<longrightarrow> (
               let b = hd u; c = snd b
               in tl u = [] \<and> is_Insert c \<and> the_elem_term c = Var x \<and>
                  is_Fun_Set (the_set_term c) \<and> f (the_Set (the_Fun (the_set_term c))))))
        ) P"
 
 
 lemma admissible_transaction_is_wellformed_transaction:
   assumes "admissible_transaction' T"
   shows "wellformed_transaction T"
     and "admissible_transaction_checks T"
     and "admissible_transaction_updates T"
     and "admissible_transaction_terms T"
     and "admissible_transaction_send_occurs_form T"
 using assms unfolding admissible_transaction'_def by blast+
 
 lemma admissible_transaction_no_occurs_msgsE:
   assumes T: "admissible_transaction' T" "admissible_transaction_no_occurs_msgs T"
   shows "\<forall>ts. send\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T)) \<or>
               receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T)) \<longrightarrow>
                 (\<forall>t s. t \<in> set ts \<longrightarrow> t \<noteq> occurs s)"
 proof -
   note 1 = admissible_transaction_is_wellformed_transaction(1)[OF T(1)]
 
   have 2: "send\<langle>ts\<rangle> \<in> set (unlabel (transaction_send T))"
     when "send\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T))" for ts
     using wellformed_transaction_strand_unlabel_memberD(8)[OF 1 that] by fast
 
   have 3: "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_receive T))"
     when "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T))" for ts
     using wellformed_transaction_strand_unlabel_memberD(1)[OF 1 that] by fast
 
   show ?thesis
     using T(2) 2 3 wellformed_transaction_unlabel_cases(1,4)[OF 1]
     unfolding admissible_transaction_no_occurs_msgs_def Let_def list_all_iff
     by (metis sndI stateful_strand_step.discI(1,2) stateful_strand_step.sel(1,2)
               term.discI(2) term.sel(2) unlabel_mem_has_label)
 qed
 
 lemma admissible_transactionE:
   assumes T: "admissible_transaction' T"
   shows "transaction_decl T () = []" (is ?A)
     and "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value" (is ?B)
     and "\<forall>x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T). \<Gamma>\<^sub>v x = TAtom Value" (is ?C)
     and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = {}" (is ?D1)
     and "fv_transaction T \<inter> bvars_transaction T = {}" (is ?D2)
     and "set (transaction_fresh T) \<subseteq>
           fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (filter (is_Insert \<circ> snd) (transaction_updates T)) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
       (is ?E)
     and "set (transaction_fresh T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
       (is ?F)
     and "\<forall>x \<in> fv_transaction T - set (transaction_fresh T).
          \<forall>y \<in> fv_transaction T - set (transaction_fresh T).
           x \<noteq> y \<longrightarrow> \<langle>Var x != Var y\<rangle> \<in> set (unlabel (transaction_checks T)) \<or>
                     \<langle>Var y != Var x\<rangle> \<in> set (unlabel (transaction_checks T))"
       (is ?G)
     and "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T).
           x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<or>
           (\<exists>t s. select\<langle>t,s\<rangle> \<in> set (unlabel (transaction_checks T)) \<and> x \<in> fv t \<union> fv s)"
       (is ?H)
     and "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) - set (transaction_fresh T) \<subseteq>
           fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
       (is ?I)
     and "\<forall>x \<in> set (unlabel (transaction_checks T)).
           is_Equality x \<longrightarrow> fv (the_rhs x) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
       (is ?J) (* TODO: why do we need this requirement? *)
     and "set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}" (is ?K1)
     and "set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) = {}" (is ?K2)
     and "list_all (\<lambda>x. fst x = Var Value) (transaction_fresh T)" (is ?K3)
     and "\<forall>x \<in> vars_transaction T. \<not>TAtom AttackType \<sqsubseteq> \<Gamma>\<^sub>v x" (is ?K4)
     and "\<forall>l ts. (l,receive\<langle>ts\<rangle>) \<in> set (transaction_receive T) \<longrightarrow> ts \<noteq> []" (is ?L1)
     and "\<forall>l ts. (l,send\<langle>ts\<rangle>) \<in> set (transaction_send T) \<longrightarrow> ts \<noteq> []" (is ?L2)
 proof -
   show ?A ?D1 ?D2 ?G ?I ?J ?K3
     using T unfolding admissible_transaction'_def
     by (blast, blast, blast, blast, blast, blast, blast)
 
   have "list_all (\<lambda>a. is_Receive (snd a) \<longrightarrow> the_msgs (snd a) \<noteq> []) (transaction_receive T)"
        "list_all (\<lambda>a. is_Send (snd a) \<longrightarrow> the_msgs (snd a) \<noteq> []) (transaction_send T)"
     using T unfolding admissible_transaction'_def by auto
   thus ?L1 ?L2 unfolding list_all_iff by (force,force)
 
   have "list_all (\<lambda>x. fst x = Var Value) (transaction_fresh T)"
        "\<forall>x\<in>vars_transaction T. is_Var (fst x) \<and> the_Var (fst x) = Value"
     using T unfolding admissible_transaction'_def by (blast, blast)
   thus ?B ?C ?K4 using \<Gamma>\<^sub>v_TAtom''(2) unfolding list_all_iff by (blast, force, force)
 
   show ?E using T unfolding admissible_transaction'_def by argo
   thus ?F unfolding unlabel_def by auto
 
   show ?K1 ?K2
     using T unfolding admissible_transaction'_def wellformed_transaction_def by (argo, argo)
 
   let ?selects = "filter (\<lambda>s. is_InSet (snd s) \<and> the_check (snd s) = Assign) (transaction_checks T)"
 
   show ?H
   proof
     fix x assume "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
     hence "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<or> x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?selects"
       using T unfolding admissible_transaction'_def by blast
     thus "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<or>
           (\<exists>t s. select\<langle>t,s\<rangle> \<in> set (unlabel (transaction_checks T)) \<and> x \<in> fv t \<union> fv s)"
     proof
       assume "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?selects"
       then obtain r where r: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p r" "r \<in> set (unlabel (transaction_checks T))"
                              "is_InSet r" "the_check r = Assign"
         unfolding unlabel_def by force
       thus ?thesis by (cases r) auto
     qed simp
   qed
 qed
 
 lemma admissible_transactionE':
   assumes T: "admissible_transaction T"
   shows "admissible_transaction' T" (is ?A)
     and "admissible_transaction_no_occurs_msgs T" (is ?B)
     and "\<forall>ts. send\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T)) \<or>
               receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T)) \<longrightarrow>
                 (\<forall>t s. t \<in> set ts \<longrightarrow> t \<noteq> occurs s)"
       (is ?C)
 proof -
   show 0: ?A ?B using T unfolding admissible_transaction_def by (blast, blast)
   show ?C using admissible_transaction_no_occurs_msgsE[OF 0] by blast
 qed
 
 lemma transaction_inserts_are_Value_vars:
   assumes T_valid: "wellformed_transaction T"
     and "admissible_transaction_updates T"
     and "insert\<langle>t,s\<rangle> \<in> set (unlabel (transaction_strand T))"
   shows "\<exists>n. t = Var (TAtom Value, n)"
     and "\<exists>u. s = Fun (Set u) []"
 proof -
   let ?x = "insert\<langle>t,s\<rangle>"
 
   have "?x \<in> set (unlabel (transaction_updates T))"
     using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x]    
     by (auto simp add: transaction_strand_def unlabel_def)
   hence *: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value"
            "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []"
            "is_Set (the_Fun (the_set_term ?x))"
     using assms(2) unfolding admissible_transaction_updates_def is_Fun_Set_def by fastforce+
   
   show "\<exists>n. t = Var (TAtom Value, n)" using *(1,2) by (cases t) auto
   show "\<exists>u. s = Fun (Set u) []" using *(3,4,5) unfolding is_Set_def by (cases s) auto
 qed
 
 lemma transaction_deletes_are_Value_vars:
   assumes T_valid: "wellformed_transaction T"
     and "admissible_transaction_updates T"
     and "delete\<langle>t,s\<rangle> \<in> set (unlabel (transaction_strand T))"
   shows "\<exists>n. t = Var (TAtom Value, n)"
     and "\<exists>u. s = Fun (Set u) []"
 proof -
   let ?x = "delete\<langle>t,s\<rangle>"
 
   have "?x \<in> set (unlabel (transaction_updates T))"
     using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x]    
     by (auto simp add: transaction_strand_def unlabel_def)
   hence *: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value"
            "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []"
            "is_Set (the_Fun (the_set_term ?x))"
     using assms(2) unfolding admissible_transaction_updates_def is_Fun_Set_def by fastforce+
   
   show "\<exists>n. t = Var (TAtom Value, n)" using *(1,2) by (cases t) auto
   show "\<exists>u. s = Fun (Set u) []" using *(3,4,5) unfolding is_Set_def by (cases s) auto
 qed
 
 lemma transaction_selects_are_Value_vars:
   assumes T_valid: "wellformed_transaction T"
     and "admissible_transaction_checks T"
     and "select\<langle>t,s\<rangle> \<in> set (unlabel (transaction_strand T))"
   shows "\<exists>n. t = Var (TAtom Value, n) \<and> (TAtom Value, n) \<notin> set (transaction_fresh T)" (is ?A)
     and "\<exists>u. s = Fun (Set u) []" (is ?B)
 proof -
   let ?x = "select\<langle>t,s\<rangle>"
 
   have *: "?x \<in> set (unlabel (transaction_checks T))"
     using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x]    
     by (auto simp add: transaction_strand_def unlabel_def)
   
   have **: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value"
            "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []"
            "is_Set (the_Fun (the_set_term ?x))"
     using * assms(2) unfolding admissible_transaction_checks_def is_Fun_Set_def by fastforce+
 
   have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
     using * by force
   hence ***: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \<inter> set (transaction_fresh T) = {}"
     using T_valid unfolding wellformed_transaction_def by fast
 
   show ?A using **(1,2) *** by (cases t) auto
   show ?B using **(3,4,5) unfolding is_Set_def by (cases s) auto
 qed
 
 lemma transaction_inset_checks_are_Value_vars:
   assumes T_valid: "admissible_transaction' T"
     and t: "\<langle>t in s\<rangle> \<in> set (unlabel (transaction_strand T))"
   shows "\<exists>n. t = Var (TAtom Value, n) \<and> (TAtom Value, n) \<notin> set (transaction_fresh T)" (is ?A)
     and "\<exists>u. s = Fun (Set u) []" (is ?B)
 proof -
   let ?x = "\<langle>t in s\<rangle>"
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_valid]
   note T_adm_checks = admissible_transaction_is_wellformed_transaction(2)[OF T_valid]
 
   have *: "?x \<in> set (unlabel (transaction_checks T))"
     using t wellformed_transaction_unlabel_cases[OF T_wf, of ?x]
     unfolding transaction_strand_def unlabel_def by fastforce
   
   have **: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value"
            "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []"
            "is_Set (the_Fun (the_set_term ?x))"
     using * T_adm_checks unfolding admissible_transaction_checks_def is_Fun_Set_def by fastforce+
 
   have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
     using * by force
   hence ***: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \<inter> set (transaction_fresh T) = {}"
     using T_wf unfolding wellformed_transaction_def by fast
 
   show ?A using **(1,2) *** by (cases t) auto
   show ?B using **(3,4,5) unfolding is_Set_def by (cases s) auto
 qed
 
 lemma transaction_notinset_checks_are_Value_vars:
   assumes T_adm: "admissible_transaction' T"
     and FG: "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set (unlabel (transaction_strand T))"
     and t: "(t,s) \<in> set G"
   shows "\<exists>n. t = Var (TAtom Value, n) \<and> (TAtom Value, n) \<notin> set (transaction_fresh T)" (is ?A)
     and "\<exists>u. s = Fun (Set u) []" (is ?B)
     and "F = []" (is ?C)
     and "G = [(t,s)]" (is ?D)
 proof -
   let ?x = "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>"
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
   note T_adm_checks = admissible_transaction_is_wellformed_transaction(2)[OF T_adm]
 
   have 0: "?x \<in> set (unlabel (transaction_checks T))"
     using FG wellformed_transaction_unlabel_cases[OF T_wf, of ?x]    
     by (auto simp add: transaction_strand_def unlabel_def)
   hence 1: "F = [] \<and> length G = 1"
     using T_adm_checks t unfolding admissible_transaction_checks_def by fastforce
   hence "hd G = (t,s)" using t by (cases "the_ins ?x") auto
   hence **: "is_Var t" "fst (the_Var t) = TAtom Value" "is_Fun s" "args s = []" "is_Set (the_Fun s)"
     using 1 Set.bspec[OF T_adm_checks[unfolded admissible_transaction_checks_def] 0]
     unfolding is_Fun_Set_def by auto
 
   show ?C using 1 by blast
   show ?D using 1 t by force
 
   have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
        "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x) \<subseteq> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
     using 0 by force+
   moreover have
       "set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}"
       "set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) = {}"
     using T_wf unfolding wellformed_transaction_def by fast+
   ultimately have
       "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \<inter> set (transaction_fresh T) = {}"
       "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x) \<inter> set (transaction_fresh T) = {}"
     using admissible_transactionE(7)[OF T_adm]
           wellformed_transaction_wf\<^sub>s\<^sub>s\<^sub>t(2)[OF T_wf]
           fv_transaction_unfold[of T] bvars_transaction_unfold[of T]
     by (blast, blast)
   hence ***: "fv t \<inter> set (transaction_fresh T) = {}"
     using t by auto
 
   show ?A using **(1,2) *** by (cases t) auto
   show ?B using **(3,4,5) unfolding is_Set_def by (cases s) auto
 qed
 
 lemma transaction_noteqs_checks_case:
   assumes T_adm: "admissible_transaction' T"
     and FG: "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set (unlabel (transaction_strand T))"
     and G: "G = []"
   shows "\<exists>t s. F = [(t,s)]" (is ?A)
 proof -
   let ?x = "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>"
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
   note T_adm_checks = admissible_transaction_is_wellformed_transaction(2)[OF T_adm]
 
   have "?x \<in> set (unlabel (transaction_checks T))"
     using FG wellformed_transaction_unlabel_cases[OF T_wf, of ?x]    
     by (auto simp add: transaction_strand_def unlabel_def)
   hence "length F = 1"
     using T_adm_checks unfolding admissible_transaction_checks_def G by fastforce
   thus ?thesis by fast
 qed
 
 lemma admissible_transaction_fresh_vars_notin:
   assumes T: "admissible_transaction' T"
     and x: "x \<in> set (transaction_fresh T)"
   shows "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" (is ?A)
     and "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?B)
     and "x \<notin> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" (is ?C)
     and "x \<notin> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?D)
     and "x \<notin> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" (is ?E)
     and "x \<notin> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?F)
 proof -
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T]
 
   have 0:
       "set (transaction_fresh T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
       "set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}"
       "set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) = {}"
       "fv_transaction T \<inter> bvars_transaction T = {}"
     using admissible_transactionE[OF T] by argo+
 
   have 1: "set (transaction_fresh T) \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) = {}"
     using 0(1,4) fv_transaction_unfold[of T] bvars_transaction_unfold[of T] by blast
 
   have 2:
       "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
       "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}"
     using bvars_wellformed_transaction_unfold[OF T_wf]
           vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_receive T)"]
     by blast+
   
   show ?A ?B ?C ?E ?F using 0 1 2 x by (fast, fast, fast, fast, fast)
 
   show ?D using 0(3) 1 x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_checks T)"] by fast
 qed
 
 lemma admissible_transaction_fv_in_receives_or_selects:
   assumes T: "admissible_transaction' T"
     and x: "x \<in> fv_transaction T" "x \<notin> set (transaction_fresh T)"
   shows "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<or>
          (x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<and>
           (\<exists>t s. select\<langle>t,s\<rangle> \<in> set (unlabel (transaction_checks T)) \<and> x \<in> fv t \<union> fv s))"
 proof -
   have "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<union>
             fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
     using x(1) fv\<^sub>s\<^sub>s\<^sub>t_append unlabel_append 
     by (metis transaction_strand_def append_assoc)
   thus ?thesis using x(2) admissible_transactionE(9,10)[OF T] by blast
 qed
 
 lemma admissible_transaction_fv_in_receives_or_selects':
   assumes T: "admissible_transaction' T"
     and x: "x \<in> fv_transaction T" "x \<notin> set (transaction_fresh T)"
   shows "(\<exists>ts. receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_receive T)) \<and> x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts)) \<or>
          (\<exists>s. select\<langle>Var x, s\<rangle> \<in> set (unlabel (transaction_checks T)))"
 proof (cases "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)")
   case True thus ?thesis
     using wellformed_transaction_unlabel_cases(1)[
             OF admissible_transaction_is_wellformed_transaction(1)[OF T]]
     by force
 next
   case False
   then obtain t s where t: "select\<langle>t,s\<rangle> \<in> set (unlabel (transaction_checks T))" "x \<in> fv t \<union> fv s"
     using admissible_transaction_fv_in_receives_or_selects[OF T x] by blast
 
   have t': "select\<langle>t,s\<rangle> \<in> set (unlabel (transaction_strand T))"
     using t(1) unfolding transaction_strand_def by simp
 
   show ?thesis
     using t transaction_selects_are_Value_vars[
               OF admissible_transaction_is_wellformed_transaction(1,2)[OF T] t']
     by force
 qed
 
 lemma admissible_transaction_fv_in_receives_or_selects_subst:
   assumes T: "admissible_transaction' T"
     and x: "x \<in> fv_transaction T" "x \<notin> set (transaction_fresh T)"
   shows "(\<exists>ts. receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<and> \<theta> x \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts) \<or>
          (\<exists>s. select\<langle>\<theta> x, s\<rangle> \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
 proof -
   note 0 = admissible_transaction_fv_in_receives_or_selects'[OF T x]
 
   have 1: "\<theta> x \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)" when ts: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts)" for ts
     using that subst_mono_fv[of x _ \<theta>] by auto
 
   have 2: "receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle> \<in> set (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)" when "receive\<langle>ts\<rangle> \<in> set A" for ts A
     using that by fast
 
   have 3: "select\<langle>t \<cdot> \<theta>,s \<cdot> \<theta>\<rangle> \<in> set (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)" when "select\<langle>t,s\<rangle> \<in> set A" for t s A
     using that by fast
 
   show ?thesis
     using 0 1 2[of _ "unlabel (transaction_receive T)"]
           3[of _ _ "unlabel (transaction_checks T)"]
-    unfolding unlabel_subst by (metis subst_apply_term.simps(1)) 
+    unfolding unlabel_subst by (metis eval_term.simps(1)) 
 qed
 
 lemma admissible_transaction_fv_in_receives_or_selects_dual_subst:
   defines "f \<equiv> \<lambda>S. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S)"
   assumes T: "admissible_transaction' T"
     and x: "x \<in> fv_transaction T" "x \<notin> set (transaction_fresh T)"
   shows "(\<exists>ts. send\<langle>ts\<rangle> \<in> set (f (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<and> \<theta> x \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts) \<or>
          (\<exists>s. select\<langle>\<theta> x, s\<rangle> \<in> set (f (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
 using admissible_transaction_fv_in_receives_or_selects_subst[OF T x, of \<theta>]
 by (metis (no_types, lifting) f_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(6)) 
 
 lemma admissible_transaction_decl_subst_empty':
   assumes T: "transaction_decl T () = []"
     and \<xi>: "transaction_decl_subst \<xi> T"
   shows "\<xi> = Var"
 proof -
   have "subst_domain \<xi> = {}"
     using \<xi> T unfolding transaction_decl_subst_def by auto
   thus ?thesis by auto
 qed
 
 lemma admissible_transaction_decl_subst_empty:
   assumes T: "admissible_transaction' T"
     and \<xi>: "transaction_decl_subst \<xi> T"
   shows "\<xi> = Var"
 by (rule admissible_transaction_decl_subst_empty'[OF admissible_transactionE(1)[OF T] \<xi>])
 
 lemma admissible_transaction_no_bvars:
   assumes "admissible_transaction' T"
   shows "fv_transaction T = vars_transaction T"
     and "bvars_transaction T = {}"
 using admissible_transactionE(4)[OF assms]
       bvars_wellformed_transaction_unfold vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t
 by (fast, fast)
 
 lemma admissible_transactions_fv_bvars_disj:
   assumes "\<forall>T \<in> set P. admissible_transaction' T"
   shows "(\<Union>T \<in> set P. fv_transaction T) \<inter> (\<Union>T \<in> set P. bvars_transaction T) = {}"
 using assms admissible_transaction_no_bvars(2) by fast
 
 lemma admissible_transaction_occurs_fv_types:
   assumes "admissible_transaction' T"
     and "x \<in> vars_transaction T"
   shows "\<exists>a. \<Gamma> (Var x) = TAtom a \<and> \<Gamma> (Var x) \<noteq> TAtom OccursSecType"
 proof -
   have "is_Var (fst x)" "the_Var (fst x) = Value"
     using assms unfolding admissible_transaction'_def by blast+
   thus ?thesis using \<Gamma>\<^sub>v_TAtom''(2)[of x] by force
 qed
 
 lemma admissible_transaction_Value_vars_are_fv:
   assumes "admissible_transaction' T"
     and "x \<in> vars_transaction T"
     and "\<Gamma>\<^sub>v x = TAtom Value"
   shows "x \<in> fv_transaction T"
 using assms(2,3) \<Gamma>\<^sub>v_TAtom''(2)[of x] vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
       admissible_transactionE(4)[OF assms(1)]
 by fast
 
 lemma transaction_receive_deduct:
   assumes T_wf: "wellformed_transaction T"
     and \<I>: "constraint_model \<I> (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T M"
     and \<alpha>: "transaction_renaming_subst \<alpha> P X"
     and t: "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
   shows "\<forall>t \<in> set ts. ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>"
 proof -
   define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   have t': "send\<langle>ts\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
     using t dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) unfolding \<theta>_def by blast
   then obtain T1 T2 where T: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) = T1@send\<langle>ts\<rangle>#T2"
     using t' by (meson split_list)
 
   have "constr_sem_stateful \<I> (unlabel A@unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
     using \<I> unlabel_append[of A] unfolding constraint_model_def \<theta>_def by simp
   hence "constr_sem_stateful \<I> (unlabel A@T1@[send\<langle>ts\<rangle>])"
     using strand_sem_append_stateful[of "{}" "{}" "unlabel A@T1@[send\<langle>ts\<rangle>]" _ \<I>]
           transaction_dual_subst_unlabel_unfold[of T \<theta>] T
     by (metis append.assoc append_Cons append_Nil)
   hence "\<forall>t \<in> set ts. ik\<^sub>s\<^sub>s\<^sub>t (unlabel A@T1) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>"
     using strand_sem_append_stateful[of "{}" "{}" "unlabel A@T1" "[send\<langle>ts\<rangle>]" \<I>] T
     by force
   moreover have "\<not>is_Receive x"
     when x: "x \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))" for x
   proof -
     have *: "is_Receive a" when "a \<in> set (unlabel (transaction_receive T))" for a
       using T_wf Ball_set[of "unlabel (transaction_receive T)" is_Receive] that
       unfolding wellformed_transaction_def
       by blast
 
     obtain l where l: "(l,x) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
       using x unfolding unlabel_def by fastforce
     then obtain ly where ly: "ly \<in> set (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" "(l,x) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ly"
       unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
 
     obtain j y where j: "ly = (j,y)" by (metis surj_pair)
     hence "j = l" using ly(2) by (cases y) auto
     hence y: "(l,y) \<in> set (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" "(l,x) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,y)"
       by (metis j ly(1), metis j ly(2))
 
     obtain z where z:
         "z \<in> set (unlabel (transaction_receive T))"
         "(l,z) \<in> set (transaction_receive T)"
         "(l,y) = (l,z) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>"
       using y(1) unfolding subst_apply_labeled_stateful_strand_def unlabel_def by force
 
     have "is_Receive y" using *[OF z(1)] z(3) by (cases z) auto
     thus "\<not>is_Receive x" using l y by (cases y) auto
   qed
   hence "\<not>is_Receive x" when "x \<in> set T1" for x using T that by simp
   hence "ik\<^sub>s\<^sub>s\<^sub>t T1 = {}" unfolding ik\<^sub>s\<^sub>s\<^sub>t_def is_Receive_def by fast
   hence "ik\<^sub>s\<^sub>s\<^sub>t (unlabel A@T1) = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" using ik\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" T1] by simp
   ultimately show ?thesis by (simp add: \<theta>_def)
 qed
 
 lemma transaction_checks_db:
   assumes T: "admissible_transaction' T"
     and \<I>: "constraint_model \<I> (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T M"
     and \<alpha>: "transaction_renaming_subst \<alpha> P X"
   shows "\<langle>Var (TAtom Value, n) in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))
           \<Longrightarrow> (\<alpha> (TAtom Value, n) \<cdot> \<I>, Fun (Set s) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<I>)"
       (is "?A \<Longrightarrow> ?B")
     and "\<langle>Var (TAtom Value, n) not in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))
           \<Longrightarrow> (\<alpha> (TAtom Value, n) \<cdot> \<I>, Fun (Set s) []) \<notin> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<I>)"
       (is "?C \<Longrightarrow> ?D")
 proof -
   let ?x = "\<lambda>n. (TAtom Value, n)"
   let ?s = "Fun (Set s) []"
   let ?T = "transaction_receive T@transaction_checks T"
   let ?T' = "?T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
   let ?S = "\<lambda>S. transaction_receive T@S"
   let ?S' = "\<lambda>S. ?S S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T \<xi>]
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T]
 
   have "constr_sem_stateful \<I> (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)))"
     using \<I> unfolding constraint_model_def by simp
   moreover have
       "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
        dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S (T1@[c]) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)@
        dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T2@transaction_updates T@transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
     when "transaction_checks T = T1@c#T2" for T1 T2 c \<delta>
     using that dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append
     unfolding transaction_strand_def
     by (metis append.assoc append_Cons append_Nil)
   ultimately have T'_model: "constr_sem_stateful \<I> (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,c)]))))"
     when "transaction_checks T = T1@(l,c)#T2" for T1 T2 l c
     using strand_sem_append_stateful[of _ _ _ _ \<I>]
     by (simp add: that transaction_strand_def)
 
   show "?A \<Longrightarrow> ?B"
   proof -
     assume a: ?A
     hence *: "\<langle>Var (?x n) in ?s\<rangle> \<in> set (unlabel ?T)"
       unfolding transaction_strand_def unlabel_def by simp
     then obtain l T1 T2 where T1: "transaction_checks T = T1@(l,\<langle>Var (?x n) in ?s\<rangle>)#T2"
       by (metis a split_list unlabel_mem_has_label)
 
     have "?x n \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
       using a by force
     hence "?x n \<notin> set (transaction_fresh T)"
       using a admissible_transaction_fresh_vars_notin[OF T] by fast
     hence "unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,\<langle>Var (?x n) in ?s\<rangle>)]))) =
            unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1))@[\<langle>\<alpha> (?x n) in ?s\<rangle>]"
       using T a \<sigma> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append unlabel_append \<xi>_empty
       by (fastforce simp add: transaction_fresh_subst_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def
-                              subst_apply_labeled_stateful_strand_def)
+                              subst_apply_labeled_stateful_strand_def subst_compose)
     moreover have "db\<^sub>s\<^sub>s\<^sub>t (unlabel A) = db\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1)))"
       by (simp add: T1 db\<^sub>s\<^sub>s\<^sub>t_transaction_prefix_eq[OF T_wf] del: unlabel_append)
     ultimately have "\<exists>M. strand_sem_stateful M (set (db\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<I>)) [\<langle>\<alpha> (?x n) in ?s\<rangle>] \<I>"
       using T'_model[OF T1] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of _ \<I>] strand_sem_append_stateful[of _ _ _ _ \<I>]
       by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def del: unlabel_append)
     thus ?B by simp
   qed
 
   show "?C \<Longrightarrow> ?D"
   proof -
     assume a: ?C
     hence *: "\<langle>Var (?x n) not in ?s\<rangle> \<in> set (unlabel ?T)"
       unfolding transaction_strand_def unlabel_def by simp
     then obtain l T1 T2 where T1: "transaction_checks T = T1@(l,\<langle>Var (?x n) not in ?s\<rangle>)#T2"
       by (metis a split_list unlabel_mem_has_label)
 
     have "?x n \<in> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<langle>Var (?x n) not in ?s\<rangle>"
       using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_cases(9)[of "[]" "Var (?x n)" ?s] by auto
     hence "?x n \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
       using a unfolding vars\<^sub>s\<^sub>s\<^sub>t_def by force
     hence "?x n \<notin> set (transaction_fresh T)"
       using a admissible_transaction_fresh_vars_notin[OF T] by fast
     hence "unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,\<langle>Var (?x n) not in ?s\<rangle>)]))) =
            unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1))@[\<langle>\<alpha> (?x n) not in ?s\<rangle>]"
       using T a \<sigma> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append unlabel_append \<xi>_empty
       by (fastforce simp add: transaction_fresh_subst_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def
-                              subst_apply_labeled_stateful_strand_def)
+                              subst_apply_labeled_stateful_strand_def subst_compose)
     moreover have "db\<^sub>s\<^sub>s\<^sub>t (unlabel A) = db\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1)))"
       by (simp add: T1 db\<^sub>s\<^sub>s\<^sub>t_transaction_prefix_eq[OF T_wf] del: unlabel_append)
     ultimately have "\<exists>M. strand_sem_stateful M (set (db\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<I>)) [\<langle>\<alpha> (?x n) not in ?s\<rangle>] \<I>"
       using T'_model[OF T1] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of _ \<I>] strand_sem_append_stateful[of _ _ _ _ \<I>]
       by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def del: unlabel_append)
     thus ?D using stateful_strand_sem_NegChecks_no_bvars(1)[of _ _ _ ?s \<I>] by simp
   qed
 qed
 
 lemma transaction_selects_db:
   assumes T: "admissible_transaction' T"
     and \<I>: "constraint_model \<I> (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T M"
     and \<alpha>: "transaction_renaming_subst \<alpha> P X"
   shows "select\<langle>Var (TAtom Value, n), Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))
           \<Longrightarrow> (\<alpha> (TAtom Value, n) \<cdot> \<I>, Fun (Set s) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<I>)"
       (is "?A \<Longrightarrow> ?B")
 proof -
   let ?x = "\<lambda>n. (TAtom Value, n)"
   let ?s = "Fun (Set s) []"
   let ?T = "transaction_receive T@transaction_checks T"
   let ?T' = "?T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
   let ?S = "\<lambda>S. transaction_receive T@S"
   let ?S' = "\<lambda>S. ?S S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T \<xi>]
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T]
 
   have "constr_sem_stateful \<I> (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)))"
     using \<I> unfolding constraint_model_def by simp
   moreover have
       "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
        dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S (T1@[c]) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)@
        dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T2@transaction_updates T@transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
     when "transaction_checks T = T1@c#T2" for T1 T2 c \<delta>
     using that dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append
     unfolding transaction_strand_def by (metis append.assoc append_Cons append_Nil)
   ultimately have T'_model: "constr_sem_stateful \<I> (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,c)]))))"
     when "transaction_checks T = T1@(l,c)#T2" for T1 T2 l c
     using strand_sem_append_stateful[of _ _ _ _ \<I>]
     by (simp add: that transaction_strand_def)
 
   show "?A \<Longrightarrow> ?B"
   proof -
     assume a: ?A
     hence *: "select\<langle>Var (?x n), ?s\<rangle> \<in> set (unlabel ?T)"
       unfolding transaction_strand_def unlabel_def by simp
     then obtain l T1 T2 where T1: "transaction_checks T = T1@(l,select\<langle>Var (?x n), ?s\<rangle>)#T2"
       by (metis a split_list unlabel_mem_has_label)
 
     have "?x n \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
       using a by force
     hence "?x n \<notin> set (transaction_fresh T)"
       using a admissible_transaction_fresh_vars_notin[OF T] by fast
     hence "unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,select\<langle>Var (?x n), ?s\<rangle>)]))) =
            unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1))@[select\<langle>\<alpha> (?x n), ?s\<rangle>]"
       using T a \<sigma> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append unlabel_append \<xi>_empty
       by (fastforce simp add: transaction_fresh_subst_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def
-                              subst_apply_labeled_stateful_strand_def)
+                              subst_apply_labeled_stateful_strand_def subst_compose)
     moreover have "db\<^sub>s\<^sub>s\<^sub>t (unlabel A) = db\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1)))"
       by (simp add: T1 db\<^sub>s\<^sub>s\<^sub>t_transaction_prefix_eq[OF T_wf] del: unlabel_append)
     ultimately have "\<exists>M. strand_sem_stateful M (set (db\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<I>)) [\<langle>\<alpha> (?x n) in ?s\<rangle>] \<I>"
       using T'_model[OF T1] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of _ \<I>] strand_sem_append_stateful[of _ _ _ _ \<I>]
       by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def del: unlabel_append)
     thus ?B by simp
   qed
 qed
 
 lemma admissible_transaction_terms_no_Value_consts:
   assumes "admissible_transaction_terms T"
     and "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"
   shows "\<nexists>a T. t = Fun (Val a) T" (is ?A)
     and "\<nexists>a T. t = Fun (Abs a) T" (is ?B)
     and "\<nexists>a T. t = Fun (PubConst Value a) T" (is ?C)
 proof -
   have "\<not>is_Val f" "\<not>is_Abs f" "\<not>is_PubConstValue f"
     when "f \<in> \<Union>(funs_term ` (trms_transaction T))" for f
     using that assms(1)[unfolded admissible_transaction_terms_def]
     unfolding is_PubConstValue_def by (blast,blast,blast)
   moreover have "f \<in> \<Union>(funs_term ` (trms_transaction T))"
     when "f \<in> funs_term t" for f
     using that assms(2) funs_term_subterms_eq(2)[of "trms_transaction T"] by blast+
   ultimately have *: "\<not>is_Val f" "\<not>is_Abs f" "\<not>is_PubConstValue f"
     when "f \<in> funs_term t" for f
     using that by presburger+
 
   show ?A using *(1) by force
   show ?B using *(2) by force
   show ?C using *(3) unfolding is_PubConstValue_def by force
 qed
 
 lemma admissible_transactions_no_Value_consts:
   assumes "admissible_transaction' T"
     and "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"
   shows "\<nexists>a T. t = Fun (Val a) T" (is ?A)
     and "\<nexists>a T. t = Fun (Abs a) T" (is ?B)
     and "\<nexists>a T. t = Fun (PubConst Value a) T" (is ?C)
 using admissible_transaction_terms_no_Value_consts[OF
         admissible_transaction_is_wellformed_transaction(4)[OF assms(1)] assms(2)]
 by auto
 
 lemma admissible_transactions_no_Value_consts':
   assumes "admissible_transaction' T"
     and "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)"
   shows "\<nexists>a T. Fun (Val a) T \<in> subterms t"
     and "\<nexists>a T. Fun (Abs a) T \<in> subterms t"
 using admissible_transactions_no_Value_consts[OF assms(1)] assms(2) by fast+
 
 lemma admissible_transactions_no_Value_consts'':
   assumes "admissible_transaction' T"
   shows "\<forall>n. PubConst Value n \<notin> \<Union>(funs_term ` trms_transaction T)"
     and "\<forall>n. Abs n \<notin> \<Union>(funs_term ` trms_transaction T)"
 using assms
 unfolding admissible_transaction'_def admissible_transaction_terms_def
 by (meson prot_fun.discI(6), meson prot_fun.discI(4))
 
 lemma admissible_transactions_no_PubConsts:
   assumes "admissible_transaction' T"
     and "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"
   shows "\<nexists>a n T. t = Fun (PubConst a n) T"
 proof -
   have "\<not>is_PubConst f"
     when "f \<in> \<Union>(funs_term ` (trms_transaction T))" for f
     using that conjunct1[OF conjunct2[OF admissible_transaction_is_wellformed_transaction(4)[
             OF assms(1), unfolded admissible_transaction_terms_def]]]
     by blast
   moreover have "f \<in> \<Union>(funs_term ` (trms_transaction T))"
     when "f \<in> funs_term t" for f
     using that assms(2) funs_term_subterms_eq(2)[of "trms_transaction T"] by blast+
   ultimately have *: "\<not>is_PubConst f"
     when "f \<in> funs_term t" for f
     using that by presburger+
 
   show ?thesis using * by force
 qed
 
 lemma admissible_transactions_no_PubConsts':
   assumes "admissible_transaction' T"
     and "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)"
   shows "\<nexists>a n T. Fun (PubConst a n) T \<in> subterms t"
 using admissible_transactions_no_PubConsts[OF assms(1)] assms(2) by fast+
 
 lemma admissible_transaction_strand_step_cases:
   assumes T_adm: "admissible_transaction' T"
   shows "r \<in> set (unlabel (transaction_receive T)) \<Longrightarrow> \<exists>t. r = receive\<langle>t\<rangle>"
         (is "?A \<Longrightarrow> ?A'")
     and "r \<in> set (unlabel (transaction_checks T)) \<Longrightarrow>
             (\<exists>x s. (r = \<langle>Var x in Fun (Set s) []\<rangle> \<or> r = select\<langle>Var x, Fun (Set s) []\<rangle> \<or>
                    r = \<langle>Var x not in Fun (Set s) []\<rangle>) \<and>
                    fst x = TAtom Value \<and> x \<in> fv_transaction T - set (transaction_fresh T)) \<or>
             (\<exists>s t. r = \<langle>s == t\<rangle> \<or> r = \<langle>s := t\<rangle> \<or> r = \<langle>s != t\<rangle>)"
         (is "?B \<Longrightarrow> ?B'")
     and "r \<in> set (unlabel (transaction_updates T)) \<Longrightarrow>
             \<exists>x s. (r = insert\<langle>Var x, Fun (Set s) []\<rangle> \<or> r = delete\<langle>Var x, Fun (Set s) []\<rangle>) \<and>
                   fst x = TAtom Value"
         (is "?C \<Longrightarrow> ?C'")
     and "r \<in> set (unlabel (transaction_send T)) \<Longrightarrow> \<exists>t. r = send\<langle>t\<rangle>"
         (is "?D \<Longrightarrow> ?D'")
 proof -
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
 
   show "?A \<Longrightarrow> ?A'"
     using T_wf Ball_set[of "unlabel (transaction_receive T)" is_Receive]
     unfolding wellformed_transaction_def is_Receive_def
     by blast
 
   show "?D \<Longrightarrow> ?D'"
     using T_wf Ball_set[of "unlabel (transaction_send T)" is_Send]
     unfolding wellformed_transaction_def is_Send_def
     by blast
 
   show "?B \<Longrightarrow> ?B'"
   proof -
     assume r: ?B
     note adm_checks = admissible_transaction_is_wellformed_transaction(1,2)[OF T_adm]
 
     have fv_r1: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p r \<subseteq> fv_transaction T"
       using r fv_transaction_unfold[of T] by auto
   
     have fv_r2: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p r \<inter> set (transaction_fresh T) = {}"
       using r T_wf unfolding wellformed_transaction_def by fastforce
 
     have "list_all is_Check_or_Assignment (unlabel (transaction_checks T))"
       using adm_checks(1) unfolding wellformed_transaction_def by blast
     hence "is_InSet r \<or> is_Equality r \<or> is_NegChecks r"
       using r unfolding list_all_iff by blast
     thus ?B'
     proof (elim disjE conjE)
       assume *: "is_InSet r"
       hence **: "is_Var (the_elem_term r)" "is_Fun (the_set_term r)"
                 "is_Set (the_Fun (the_set_term r))" "args (the_set_term r) = []"
                 "fst (the_Var (the_elem_term r)) = TAtom Value"
         using r adm_checks unfolding admissible_transaction_checks_def is_Fun_Set_def
         by fast+
       
       obtain ac rt rs where r': "r = \<langle>ac: rt \<in> rs\<rangle>" using * by (cases r) auto
       obtain x where x: "rt = Var x" "fst x = TAtom Value" using **(1,5) r' by auto
       obtain f S where fS: "rs = Fun f S" using **(2) r' by auto
       obtain s where s: "f = Set s" using **(3) fS r' by (cases f) auto
       hence S: "S = []" using **(4) fS r' by auto
   
       show ?B' using r' x fS s S fv_r1 fv_r2 by (cases ac) simp_all
     next
       assume *: "is_NegChecks r"
       hence **: "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p r = []"
                 "(the_eqs r = [] \<and> length (the_ins r) = 1) \<or>
                  (the_ins r = [] \<and> length (the_eqs r) = 1)"
         using r adm_checks unfolding admissible_transaction_checks_def by fast+
       show ?B' using **(2)
       proof (elim disjE conjE)
         assume ***: "the_eqs r = []" "length (the_ins r) = 1"
         then obtain t s where ts: "the_ins r = [(t,s)]" by (cases "the_ins r") auto
         hence "hd (the_ins r) = (t,s)" by simp
         hence ****: "is_Var (fst (t,s))" "is_Fun (snd (t,s))"
                     "is_Set (the_Fun (snd (t,s)))" "args (snd (t,s)) = []"
                     "fst (the_Var (fst (t,s))) = TAtom Value"
           using * ***(1) Set.bspec[OF adm_checks(2)[unfolded admissible_transaction_checks_def] r]
           unfolding is_Fun_Set_def by simp_all
         obtain x where x: "t = Var x" "fst x = TAtom Value" using ts ****(1,5) by (cases t) simp_all
         obtain f S where fS: "s = Fun f S" using ts ****(2) by (cases s) simp_all
         obtain ss where ss: "f = Set ss" using fS ****(3) by (cases f) simp_all
         have S: "S = []" using ts fS ss ****(4) by simp
         
         show ?B' using ts x fS ss S *** **(1) * fv_r1 fv_r2 by (cases r) auto
       next
         assume ***: "the_ins r = []" "length (the_eqs r) = 1"
         then obtain t s where "the_eqs r = [(t,s)]" by (cases "the_eqs r") auto
         thus ?B' using *** **(1) * by (cases r) auto
       qed
     qed (auto simp add: is_Equality_def the_check_def intro: poscheckvariant.exhaust)
   qed
 
   show "?C \<Longrightarrow> ?C'"
   proof -
     assume r: ?C
     note adm_upds = admissible_transaction_is_wellformed_transaction(3)[OF T_adm]
 
     have *: "is_Update r" "is_Var (the_elem_term r)" "is_Fun (the_set_term r)"
             "is_Set (the_Fun (the_set_term r))" "args (the_set_term r) = []"
             "fst (the_Var (the_elem_term r)) = TAtom Value"
       using r adm_upds unfolding admissible_transaction_updates_def is_Fun_Set_def by fast+
 
     obtain t s where ts: "r = insert\<langle>t,s\<rangle> \<or> r = delete\<langle>t,s\<rangle>" using *(1) by (cases r) auto
     obtain x where x: "t = Var x" "fst x = TAtom Value" using ts *(2,6) by (cases t) auto
     obtain f T where fT: "s = Fun f T" using ts *(3) by (cases s) auto
     obtain ss where ss: "f = Set ss" using ts fT *(4) by (cases f) fastforce+
     have T: "T = []" using ts fT *(5) ss by (cases T) auto
 
     show ?C'
       using ts x fT ss T by blast
   qed
 qed
 
 lemma protocol_transaction_vars_TAtom_typed:
   assumes T_adm: "admissible_transaction' T"
   shows "\<forall>x \<in> vars_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
     and "\<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
     and "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
 proof -
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
 
   show "\<forall>x \<in> vars_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
     using admissible_transactionE(3)[OF T_adm] by fast
   thus "\<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
     using vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t by fast
 
   show "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
     using admissible_transactionE(2)[OF T_adm] by argo
 qed
 
 lemma protocol_transactions_no_pubconsts:
   assumes "admissible_transaction' T"
   shows "Fun (Val n) S \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)"
     and "Fun (PubConst Value n) S \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)"
 using assms admissible_transactions_no_Value_consts(1,3) by (blast, blast)
 
 lemma protocol_transactions_no_abss:
   assumes "admissible_transaction' T"
   shows "Fun (Abs n) S \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)"
 using assms admissible_transactions_no_Value_consts(2)
 by fast
 
 lemma admissible_transaction_strand_sem_fv_ineq:
   assumes T_adm: "admissible_transaction' T"
     and \<I>: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I>"
     and x: "x \<in> fv_transaction T - set (transaction_fresh T)"
     and y: "y \<in> fv_transaction T - set (transaction_fresh T)"
     and x_not_y: "x \<noteq> y"
   shows "\<theta> x \<cdot> \<I> \<noteq> \<theta> y \<cdot> \<I>"
 proof -
   have "\<langle>Var x != Var y\<rangle> \<in> set (unlabel (transaction_checks T)) \<or>
         \<langle>Var y != Var x\<rangle> \<in> set (unlabel (transaction_checks T))"
     using x y x_not_y admissible_transactionE(8)[OF T_adm] by auto
   hence "\<langle>Var x != Var y\<rangle> \<in> set (unlabel (transaction_strand T)) \<or>
          \<langle>Var y != Var x\<rangle> \<in> set (unlabel (transaction_strand T))"
     unfolding transaction_strand_def unlabel_def by auto
   hence "\<langle>\<theta> x != \<theta> y\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<or>
          \<langle>\<theta> y != \<theta> x\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
     using stateful_strand_step_subst_inI(8)[of _ _ "unlabel (transaction_strand T)" \<theta>]
           subst_lsst_unlabel[of "transaction_strand T" \<theta>]
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(7)[of "[]" _ "[]"]
     by force
   then obtain B where B:
       "prefix (B@[\<langle>\<theta> x != \<theta> y\<rangle>]) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<or>
        prefix (B@[\<langle>\<theta> y != \<theta> x\<rangle>]) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
     unfolding prefix_def
     by (metis (no_types, opaque_lifting) append.assoc append_Cons append_Nil split_list)
   thus ?thesis
     using \<I> strand_sem_append_stateful[of IK DB _ _ \<I>]
           stateful_strand_sem_NegChecks_no_bvars(2)
     unfolding prefix_def
     by metis 
 qed
 
 lemma admissible_transaction_sem_iff:
   fixes \<theta> and T::"('fun,'atom,'sets,'lbl) prot_transaction"
   defines "A \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
   assumes T: "admissible_transaction' T"
     and I: " interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
   shows "strand_sem_stateful M D A I \<longleftrightarrow> (
     (\<forall>l ts. (l,receive\<langle>ts\<rangle>) \<in> set (transaction_receive T) \<longrightarrow> (\<forall>t \<in> set ts. M \<turnstile> t \<cdot> \<theta> \<cdot> I)) \<and>
     (\<forall>l ac t s. (l,\<langle>ac: t \<doteq> s\<rangle>) \<in> set (transaction_checks T) \<longrightarrow> t \<cdot> \<theta> \<cdot> I = s \<cdot> \<theta> \<cdot> I) \<and>
     (\<forall>l ac t s. (l,\<langle>ac: t \<in> s\<rangle>) \<in> set (transaction_checks T) \<longrightarrow> (t \<cdot> \<theta> \<cdot> I, s \<cdot> \<theta> \<cdot> I) \<in> D) \<and>
     (\<forall>l t s. (l,\<langle>t != s\<rangle>) \<in> set (transaction_checks T) \<longrightarrow> t \<cdot> \<theta> \<cdot> I \<noteq> s \<cdot> \<theta> \<cdot> I) \<and>
     (\<forall>l t s. (l,\<langle>t not in s\<rangle>) \<in> set (transaction_checks T) \<longrightarrow> (t \<cdot> \<theta> \<cdot> I, s \<cdot> \<theta> \<cdot> I) \<notin> D))"
     (is "?A \<longleftrightarrow> ?B")
 proof -
   define P where "P \<equiv>
     \<lambda>X. \<lambda>\<delta>::('fun,'atom,'sets,'lbl) prot_subst. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>)"
   define rm where "rm \<equiv> \<lambda>X. \<lambda>\<delta>::('fun,'atom,'sets,'lbl) prot_subst. rm_vars (set X) \<delta>"
   define chks where "chks \<equiv> transaction_checks T"
   define q1 where "q1 \<equiv> \<lambda>t X \<delta>. t \<cdot> rm X \<theta> \<cdot> \<delta> \<cdot> I"
   define q2 where "q2 \<equiv> \<lambda>t. t \<cdot> \<theta> \<cdot> I"
 
   note 0 = admissible_transaction_is_wellformed_transaction[OF T]
   note 1 = wellformed_transaction_sem_iff[OF 0(1) I, of M D \<theta>, unfolded A_def[symmetric]]
   note 2 = admissible_transactionE[OF T]
 
   have 3: "rm X \<theta> = \<theta>" when "X = []" for X using that unfolding rm_def by auto
 
   have 4: "P X \<delta> \<longleftrightarrow> \<delta> = Var" when "X = []" for X and \<delta>
     using that unfolding P_def by auto
 
   have 5: "\<exists>t s. \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> = \<langle>t != s\<rangle> \<or> \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> = \<langle>t not in s\<rangle>"
     when X: "(l, \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) \<in> set chks" for l X F G
   proof -
     have *: "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set (unlabel (transaction_strand T))"
       using X transaction_strand_subsets(2)[of T] unlabel_in unfolding chks_def by fast
     hence **: "X = []" using 2(4) by auto
 
     note *** = transaction_notinset_checks_are_Value_vars(3,4)[OF T *]
                transaction_noteqs_checks_case[OF T *]
 
     show ?thesis
     proof (cases "G = []")
       case True thus ?thesis using ** ***(3) by blast
     next
       case False
       then obtain t s where g: "(t,s) \<in> set G" by (cases G) auto
       show ?thesis using ** ***(1,2)[OF g] by blast
     qed
   qed
 
   have 6: "q1 t X \<delta> = q2 t" when "P X \<delta>" "X = []" for X \<delta> t
     using that 3 4 unfolding q1_def q2_def by simp
 
   let ?negcheck_sem = "\<lambda>X F G. \<forall>\<delta>. P X \<delta> \<longrightarrow>
                                 (\<exists>(t,s) \<in> set F. q1 t X \<delta> \<noteq> q1 s X \<delta>) \<or>
                                 (\<exists>(t,s) \<in> set G. (q1 t X \<delta>, q1 s X \<delta>) \<notin> D)"
 
   have "(\<forall>l X F G. (l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) \<in> set chks \<longrightarrow> ?negcheck_sem X F G) \<longleftrightarrow>
         ((\<forall>l t s. (l,\<langle>t != s\<rangle>) \<in> set chks \<longrightarrow> q2 t \<noteq> q2 s) \<and>
          (\<forall>l t s. (l,\<langle>t not in s\<rangle>) \<in> set chks \<longrightarrow> (q2 t, q2 s) \<notin> D))"
     (is "?A \<longleftrightarrow> ?B")
   proof
     have "q2 t \<noteq> q2 s" when t: "(l,\<langle>t != s\<rangle>) \<in> set chks" ?A for l t s
     proof -
       have "?negcheck_sem [] [(t,s)] []" using t by blast
       thus ?thesis using 4[of "[]"] 6[of "[]"] by force
     qed
     moreover have "(q2 t, q2 s) \<notin> D" when t: "(l,\<langle>t not in s\<rangle>) \<in> set chks" ?A for l t s
     proof -
       have "?negcheck_sem [] [] [(t,s)]" using t by blast
       thus ?thesis using 4[of "[]"] 6[of "[]"] by force
     qed 
     ultimately show "?A \<Longrightarrow> ?B" by blast
 
     have "?negcheck_sem X F G"
       when t: "(l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) \<in> set chks" ?B for l X F G
     proof -
       obtain t s where ts: "(X = [] \<and> F = [(t,s)] \<and> G = []) \<or> (X = [] \<and> F = [] \<and> G = [(t,s)])"
         using 5[OF t(1)] by blast
       hence "(X = [] \<and> F = [(t,s)] \<and> G = [] \<and> q2 t \<noteq> q2 s) \<or>
              (X = [] \<and> F = [] \<and> G = [(t,s)] \<and> (q2 t, q2 s) \<notin> D)" using t by blast
       thus ?thesis using 4[of "[]"] 6[of "[]"] by fastforce
     qed
     thus "?B \<Longrightarrow> ?A" by simp
   qed
   thus ?thesis using 1 unfolding rm_def chks_def P_def q1_def q2_def by simp
 qed
 
 lemma admissible_transaction_terms_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s:
   assumes "admissible_transaction_terms T"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)"
 by (rule conjunct1[OF assms[unfolded admissible_transaction_terms_def wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric]]])
 
 lemma admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s:
   assumes "admissible_transaction' T"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)" 
 proof -
   have "admissible_transaction_terms T" using assms[unfolded admissible_transaction'_def] by fast
   thus ?thesis by (metis admissible_transaction_terms_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s)
 qed
 
 lemma admissible_transaction_no_Ana_Attack:
   assumes "admissible_transaction_terms T"
     and "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)"
   shows "attack\<langle>n\<rangle> \<notin> set (snd (Ana t))"
 proof -
   obtain r where r: "r \<in> set (unlabel (transaction_strand T))" "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r)"
     using assms(2) by force
 
   obtain K M where t: "Ana t = (K, M)"
     by (metis surj_pair)
 
   show ?thesis
   proof
     assume n: "attack\<langle>n\<rangle> \<in> set (snd (Ana t))"
     hence "attack\<langle>n\<rangle> \<in> set M" using t by simp
     hence n': "attack\<langle>n\<rangle> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r)"
       using Ana_subterm[OF t] r(2) subterms_subset by fast
     hence "\<exists>f \<in> \<Union>(funs_term ` trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r). is_Attack f"
       using funs_term_Fun_subterm' unfolding is_Attack_def by fast
     hence "is_Send r" "length (the_msgs r) = 1" "is_Fun (hd (the_msgs r))"
           "is_Attack (the_Fun (hd (the_msgs r)))" "args (hd (the_msgs r)) = []"
       using assms(1) r(1) unfolding admissible_transaction_terms_def is_Fun_Attack_def by metis+
     hence "t = attack\<langle>n\<rangle>"
       using n' r(2) unfolding is_Send_def is_Attack_def by (cases "the_msgs r") auto
     thus False using n by fastforce
   qed
 qed
 
 lemma admissible_transaction_Value_vars:
   assumes T: "admissible_transaction' T"
     and x: "x \<in> fv_transaction T"
   shows "\<Gamma>\<^sub>v x = TAtom Value"
 proof -
   have "x \<in> vars_transaction T"
     using x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
     by blast
   thus "\<Gamma>\<^sub>v x = TAtom Value"
     using admissible_transactionE(3)[OF T] by simp
 qed
 
 lemma admissible_transaction_occurs_checksE1:
   assumes T: "admissible_transaction_occurs_checks T"
     and x: "x \<in> fv_transaction T - set (transaction_fresh T)" "\<Gamma>\<^sub>v x = TAtom Value"
   obtains l ts S where
     "transaction_receive T = (l,receive\<langle>ts\<rangle>)#S" "occurs (Var x) \<in> set ts"
 proof -
   let ?rcvs = "transaction_receive T"
   let ?frsh = "transaction_fresh T"
   let ?fvs = "fv_transaction T"
 
   have *: "?rcvs \<noteq> []" "is_Receive (hd (unlabel ?rcvs))"
           "\<forall>x \<in> ?fvs - set ?frsh. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
             occurs (Var x) \<in> set (the_msgs (hd (unlabel ?rcvs)))"
     using T x unfolding admissible_transaction_occurs_checks_def \<Gamma>\<^sub>v_TAtom''(2) by meson+
 
   obtain r S where S: "?rcvs = r#S"
     using *(1) by (cases ?rcvs) auto
 
   obtain l ts where r: "r = (l,receive\<langle>ts\<rangle>)"
     by (metis *(1,2) S list.map_sel(1) list.sel(1) prod.collapse is_Receive_def unlabel_def) 
 
   have 0: "occurs (Var x) \<in> set ts" using *(3) x S r by fastforce
 
   show ?thesis using that[unfolded S r, of l ts S] 0 by blast
 qed
 
 lemma admissible_transaction_occurs_checksE2:
   assumes T: "admissible_transaction_occurs_checks T"
     and x: "x \<in> set (transaction_fresh T)"
   obtains l ts S where
     "transaction_send T = (l,send\<langle>ts\<rangle>)#S" "occurs (Var x) \<in> set ts"
 proof -
   let ?snds = "transaction_send T"
   let ?frsh = "transaction_fresh T"
   let ?fvs = "fv_transaction T"
   define ts where "ts \<equiv> the_msgs (hd (unlabel ?snds))"
 
   let ?P = "\<forall>x \<in> set ?frsh. occurs (Var x) \<in> set ts"
 
   have "?frsh \<noteq> []" using x by auto
   hence *: "?snds \<noteq> []" "is_Send (hd (unlabel ?snds))" "?P"
     using T x unfolding admissible_transaction_occurs_checks_def ts_def by meson+
 
   obtain r S where S: "?snds = r#S"
     using *(1) by (cases ?snds) auto
 
   obtain l where r: "r = (l,send\<langle>ts\<rangle>)"
     by (metis *(1,2) S list.map_sel(1) list.sel(1) prod.collapse unlabel_def ts_def
               stateful_strand_step.collapse(1)) 
 
   have ts: "occurs (Var x) \<in> set ts"
     using x *(3) unfolding S by auto
 
   show ?thesis using that[unfolded S r, of l ts S] ts by blast
 qed
 
 lemma admissible_transaction_occurs_checksE3:
   assumes T: "admissible_transaction_occurs_checks T"
     and t: "OccursFact \<in> funs_term t \<or> OccursSec \<in> funs_term t" "t \<in> set ts"
     and ts: "send\<langle>ts\<rangle> \<in> set (unlabel (transaction_send T))"
   obtains x where "t = occurs (Var x)" "x \<in> set (transaction_fresh T)"
 proof -
   let ?P = "\<lambda>t. \<exists>x \<in> set (transaction_fresh T). t = occurs (Var x)"
 
   have "?P t"
     when "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "OccursFact \<in> funs_term t \<or> OccursSec \<in> funs_term t"
     for t
     using assms that
     unfolding admissible_transaction_occurs_checks_def
               admissible_transaction_send_occurs_form_def
     by metis
   moreover have "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
     using t(2) ts unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by fastforce
   ultimately have "?P t" using t(1) by blast
   thus thesis using that by blast
 qed
 
 lemma admissible_transaction_occurs_checksE4:
   assumes T: "admissible_transaction_occurs_checks T"
     and ts: "send\<langle>ts\<rangle> \<in> set (unlabel (transaction_send T))"
     and t: "occurs t \<in> set ts"
   obtains x where "t = Var x" "x \<in> set (transaction_fresh T)"
 using admissible_transaction_occurs_checksE3[OF T _ t ts] by auto
 
 lemma admissible_transaction_occurs_checksE5:
   assumes T: "admissible_transaction_occurs_checks T"
   shows "Fun OccursSec [] \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
 proof -
   have "\<exists>x \<in> set (transaction_fresh T). t = occurs (Var x)"
     when "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "OccursFact \<in> funs_term t \<or> OccursSec \<in> funs_term t"
     for t
     using assms that
     unfolding admissible_transaction_occurs_checks_def
               admissible_transaction_send_occurs_form_def
     by metis
   thus ?thesis by fastforce
 qed
 
 lemma admissible_transaction_occurs_checksE6:
   assumes T: "admissible_transaction_occurs_checks T"
     and t: "t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
   shows "Fun OccursSec [] \<notin> set (snd (Ana t))" (is ?A)
     and "occurs k \<notin> set (snd (Ana t))" (is ?B)
 proof -
   obtain t' where t': "t' \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "t \<sqsubseteq> t'" using t by blast
   have "?A \<and> ?B"
   proof (rule ccontr)
     assume *: "\<not>(?A \<and> ?B)"
     hence "OccursSec \<in> funs_term t' \<or> OccursFact \<in> funs_term t'"
       by (meson t'(2) Ana_subterm' funs_term_Fun_subterm' term.order.trans) 
     then obtain x where x: "x \<in> set (transaction_fresh T)" "t' = occurs (Var x)"
       using t'(1) T
       unfolding admissible_transaction_occurs_checks_def
                 admissible_transaction_send_occurs_form_def
       by metis
     have "t = occurs (Var x) \<or> t = Var x \<or> t = Fun OccursSec []" using x(2) t'(2) by auto
     thus False using * by fastforce
   qed
   thus ?A ?B by simp_all
 qed
 
 lemma has_initial_value_producing_transactionE:
   fixes P::"('fun,'atom,'sets,'lbl) prot"
   assumes P: "has_initial_value_producing_transaction P"
     and P_adm: "\<forall>T \<in> set P. admissible_transaction' T"
   obtains T x s ts upds l l' where
     "\<Gamma>\<^sub>v x = TAtom Value" "Var x \<in> set ts" "fv\<^sub>s\<^sub>e\<^sub>t (set ts) = {x}"
     "\<forall>n. \<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts)" "T \<in> set P"
     "T = Transaction (\<lambda>(). []) [x] [] [] upds [(l, send\<langle>ts\<rangle>)]"
     "upds = [] \<or> (upds = [(l', insert\<langle>Var x, \<langle>s\<rangle>\<^sub>s\<rangle>)] \<and>
       (\<forall>T \<in> set P. \<forall>(l,a) \<in> set (transaction_strand T). \<forall>t.
         a \<noteq> select\<langle>t, \<langle>s\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> \<langle>t in \<langle>s\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> \<langle>t not in \<langle>s\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> delete\<langle>t, \<langle>s\<rangle>\<^sub>s\<rangle>)) \<or>
      T = Transaction (\<lambda>(). []) [x] [] [] [] [(l, send\<langle>ts\<rangle>)]"
 proof -
   define f where "f \<equiv> \<lambda>s.
       list_all (\<lambda>T. list_all (\<lambda>a. ((is_Delete a \<or> is_InSet a) \<longrightarrow> the_set_term a \<noteq> \<langle>s\<rangle>\<^sub>s) \<and>
                                   (is_NegChecks a \<longrightarrow> list_all (\<lambda>(_,t). t \<noteq> \<langle>s\<rangle>\<^sub>s) (the_ins a)))
                              (unlabel (transaction_checks T@transaction_updates T)))
                P"
 
   obtain T where T0:
       "T \<in> set P"
       "length (transaction_fresh T) = 1" "transaction_receive T = []"
       "transaction_checks T = []" "length (transaction_send T) = 1"
       "let x = hd (transaction_fresh T); a = hd (transaction_send T); u = transaction_updates T
        in is_Send (snd a) \<and> Var x \<in> set (the_msgs (snd a)) \<and>
           fv\<^sub>s\<^sub>e\<^sub>t (set (the_msgs (snd a))) = {x} \<and>
           (u \<noteq> [] \<longrightarrow> (
             let b = hd u; c = snd b
             in tl u = [] \<and> is_Insert c \<and> the_elem_term c = Var x \<and>
                is_Fun_Set (the_set_term c) \<and> f (the_Set (the_Fun (the_set_term c)))))"
     using P unfolding has_initial_value_producing_transaction_def Let_def list_ex_iff f_def by blast
 
   obtain x upds ts h s l l' where T1:
       "T = Transaction h [x] [] [] upds [(l, send\<langle>ts\<rangle>)]"
       "Var x \<in> set ts" "fv\<^sub>s\<^sub>e\<^sub>t (set ts) = {x}"
       "upds = [] \<or> (upds = [(l', insert\<langle>Var x, \<langle>s\<rangle>\<^sub>s\<rangle>)] \<and> f s)"
   proof (cases T)
     case T: (Transaction A B C D E F)
 
     obtain x where B: "B = [x]" using T0(2) unfolding T by (cases B) auto
     have C: "C = []" using T0(3) unfolding T by simp
     have D: "D = []" using T0(4) unfolding T by simp
     obtain l a where F: "F = [(l,a)]" using T0(5) unfolding T by fastforce
     obtain ts where ts: "a = send\<langle>ts\<rangle>" using T0(6) unfolding T F by (cases a) auto
     obtain k u where E: "E = [] \<or> E = [(k,u)]" using T0(6) unfolding T by (cases E) fastforce+
     have x: "Var x \<in> set ts" "fv\<^sub>s\<^sub>e\<^sub>t (set ts) = {x}" using T0(6) unfolding T B F ts by auto
 
     from E show ?thesis
     proof
       assume E': "E = [(k,u)]"
       obtain t t' where u: "u = insert\<langle>t,t'\<rangle>" using T0(6) unfolding T E' by (cases u) auto
       have t: "t = Var x" using T0(6) unfolding T B E' u Let_def by simp
       obtain s where t': "t' = \<langle>s\<rangle>\<^sub>s" and s: "f s" using T0(6) unfolding T B E' u Let_def by auto
       show ?thesis using that[OF T[unfolded B C D F ts E' u t t'] x] s by blast
     qed (use that[OF T[unfolded B C D F ts] x] in blast)
   qed
 
   note T_adm = bspec[OF P_adm T0(1)]
 
   have "x \<in> set (transaction_fresh T)" using T1(1) by fastforce
   hence x: "\<Gamma>\<^sub>v x = TAtom Value" using admissible_transactionE(2)[OF T_adm] by fast
 
   have "set ts \<subseteq> trms_transaction T" unfolding T1(1) trms_transaction_unfold by simp
   hence ts: "\<forall>n. \<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts)"
     using admissible_transactions_no_Value_consts[OF T_adm] by blast
 
   have "a \<noteq> select\<langle>t, \<langle>s\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> \<langle>t in \<langle>s\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> \<langle>t not in \<langle>s\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> delete\<langle>t, \<langle>s\<rangle>\<^sub>s\<rangle>"
     when upds: "upds = [(k, insert\<langle>Var x,\<langle>s\<rangle>\<^sub>s\<rangle>)]"
       and T': "T' \<in> set P" and la: "(l,a) \<in> set (transaction_strand T')"
     for T' l k a t
   proof -
     note T'_wf = admissible_transaction_is_wellformed_transaction(1)[OF bspec[OF P_adm T']]
 
     have "a \<in> set (unlabel (transaction_checks T'@transaction_updates T'))"
       when a': "is_Check_or_Assignment a \<or> is_Update a"
       using that wellformed_transaction_strand_unlabel_memberD[OF T'_wf unlabel_in[OF la]]
       by (cases a) auto
     note 0 = this T1(4) T'
 
     note 1 = upds f_def list_all_iff
 
     show ?thesis
     proof (cases a)
       case (Delete t' s') thus ?thesis using 0 unfolding 1 by fastforce
     next
       case (InSet ac t' s') thus ?thesis using 0 unfolding 1 by fastforce
     next
       case (NegChecks X F G) thus ?thesis using 0 unfolding 1 by fastforce
     qed auto
   qed
   hence s: "\<forall>T \<in> set P. \<forall>(l,a) \<in> set (transaction_strand T). \<forall>t.
         a \<noteq> select\<langle>t, \<langle>s\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> \<langle>t in \<langle>s\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> \<langle>t not in \<langle>s\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> delete\<langle>t, \<langle>s\<rangle>\<^sub>s\<rangle>"
     when upds: "upds = [(k, insert\<langle>Var x,\<langle>s\<rangle>\<^sub>s\<rangle>)]" for k
     using upds by force
 
   have h: "h = (\<lambda>(). [])"
   proof -
     have "transaction_decl T = h" using T1(1) by fastforce
     hence "h a = []" for a using admissible_transactionE(1)[OF T_adm] by simp
     thus ?thesis using ext[of h "\<lambda>(). []"] by (metis case_unit_Unity)
   qed
 
   show ?thesis using that[OF x T1(2,3) ts T0(1)] T1(1,4) s unfolding h by auto
 qed
 
 lemma has_initial_value_producing_transaction_update_send_ex_filter:
   fixes P::"('a,'b,'c,'d) prot"
   defines "f \<equiv> \<lambda>T. transaction_fresh T = [] \<longrightarrow>
                       list_ex (\<lambda>a. is_Update (snd a) \<or> is_Send (snd a)) (transaction_strand T)"
   assumes P: "has_initial_value_producing_transaction P"
   shows "has_initial_value_producing_transaction (filter f P)"
 proof -
   define g where "g \<equiv> \<lambda>P::('a,'b,'c,'d) prot. \<lambda>s.
       list_all (\<lambda>T. list_all (\<lambda>a. ((is_Delete a \<or> is_InSet a) \<longrightarrow> the_set_term a \<noteq> \<langle>s\<rangle>\<^sub>s) \<and>
                                   (is_NegChecks a \<longrightarrow> list_all (\<lambda>(_,t). t \<noteq> \<langle>s\<rangle>\<^sub>s) (the_ins a)))
                              (unlabel (transaction_checks T@transaction_updates T)))
                P"
 
   let ?Q = "\<lambda>P T.
      let x = hd (transaction_fresh T); a = hd (transaction_send T); u = transaction_updates T
      in is_Send (snd a) \<and> Var x \<in> set (the_msgs (snd a)) \<and>
         fv\<^sub>s\<^sub>e\<^sub>t (set (the_msgs (snd a))) = {x} \<and>
         (u \<noteq> [] \<longrightarrow> (
           let b = hd u; c = snd b
           in tl u = [] \<and> is_Insert c \<and> the_elem_term c = Var x \<and>
              is_Fun_Set (the_set_term c) \<and> g P (the_Set (the_Fun (the_set_term c)))))"
 
   have "set (filter f P) \<subseteq> set P" by simp
   hence "list_all h P \<Longrightarrow> list_all h (filter f P)" for h unfolding list_all_iff by blast
   hence g_f_subset: "g P s \<Longrightarrow> g (filter f P) s" for s unfolding g_def by blast
 
   obtain T where T:
     "T \<in> set P" "length (transaction_fresh T) = 1" "transaction_receive T = []"
     "transaction_checks T = []" "length (transaction_send T) = 1" "?Q P T"
     using P unfolding has_initial_value_producing_transaction_def Let_def list_ex_iff g_def by blast
 
   obtain x where x: "transaction_fresh T = [x]" using T(2) by blast
   obtain a where a: "transaction_send T = [a]" using T(5) by blast
   obtain l b where b: "a = (l,b)" by (cases a) auto
   obtain ts where ts: "b = send\<langle>ts\<rangle>" using T(6) unfolding Let_def a b by (cases b) auto
 
   have "T \<in> set (filter f P)" using T(1) x a unfolding b ts f_def by auto
   moreover have "?Q (filter f P) T" using T(6) g_f_subset by meson
   ultimately show ?thesis
     using T(2-5)
     unfolding has_initial_value_producing_transaction_def Let_def list_ex_iff g_def
     by blast
 qed
 
 
 subsection \<open>Lemmata: Renaming, Declaration, and Fresh Substitutions\<close>
 lemma transaction_decl_subst_empty_inv:
   assumes "transaction_decl_subst Var T"
   shows "transaction_decl T () = []"
 using assms unfolding transaction_decl_subst_def subst_domain_Var by blast
 
 lemma transaction_decl_subst_domain:
   fixes \<xi>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_decl_subst \<xi> T"
   shows "subst_domain \<xi> = fst ` set (transaction_decl T ())"
 using assms unfolding transaction_decl_subst_def by argo
 
 lemma transaction_decl_subst_grounds_domain:
   fixes \<xi>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_decl_subst \<xi> T"
     and "x \<in> fst ` set (transaction_decl T ())"
   shows "fv (\<xi> x) = {}"
 proof -
   obtain c where "\<xi> x = Fun c []"
     using assms unfolding transaction_decl_subst_def by moura
   thus ?thesis by simp
 qed
 
 lemma transaction_decl_subst_range_vars_empty:
   fixes \<xi>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_decl_subst \<xi> T"
   shows "range_vars \<xi> = {}"
 using assms unfolding transaction_decl_subst_def range_vars_def by auto
 
 lemma transaction_decl_subst_wt:
   fixes \<xi>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_decl_subst \<xi> T"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<xi>"
 using assms unfolding transaction_decl_subst_def by blast
 
 lemma transaction_decl_subst_is_wf_trm:
   fixes \<xi>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_decl_subst \<xi> P"
   shows "wf\<^sub>t\<^sub>r\<^sub>m (\<xi> v)"
 proof (cases "v \<in> subst_domain \<xi>")
   case True thus ?thesis using assms unfolding transaction_decl_subst_def by fastforce
 qed auto
 
 lemma transaction_decl_subst_range_wf_trms:
   fixes \<xi>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_decl_subst \<xi> P"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<xi>)"
 by (metis transaction_decl_subst_is_wf_trm[OF assms] wf_trm_subst_range_iff)
 
 lemma transaction_renaming_subst_is_renaming:
   fixes \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes \<alpha>: "transaction_renaming_subst \<alpha> P A"
   shows "\<exists>m. \<forall>\<tau> n. \<alpha> (\<tau>,n) = Var (\<tau>,n+Suc m)" (is ?A)
     and "\<exists>y. \<alpha> x = Var y" (is ?B)
     and "\<alpha> x \<noteq> Var x" (is ?C)
     and "subst_domain \<alpha> = UNIV" (is ?D)
     and "subst_range \<alpha> \<subseteq> range Var" (is ?E)
     and "fv (t \<cdot> \<alpha>) \<subseteq> range_vars \<alpha>" (is ?F)
 proof -
   show 0: ?A using \<alpha> unfolding transaction_renaming_subst_def var_rename_def by force
   show ?B using \<alpha> unfolding transaction_renaming_subst_def var_rename_def by blast
   show ?C using 0 by (cases x) auto
   show 1: ?D using 0 by fastforce
   show ?E using 0 by auto
   show ?F by (induct t) (auto simp add: 1 subst_dom_vars_in_subst subst_fv_imgI)
 qed
 
 lemma transaction_renaming_subst_is_injective:
   fixes \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_renaming_subst \<alpha> P A"
   shows "inj \<alpha>"
 proof (intro injI)
   fix x y::"('fun,'atom,'sets,'lbl) prot_var"
   obtain \<tau>x nx where x: "x = (\<tau>x,nx)" by (metis surj_pair)
   obtain \<tau>y ny where y: "y = (\<tau>y,ny)" by (metis surj_pair)
 
   obtain m where m: "\<forall>\<tau>. \<forall>n. \<alpha> (\<tau>, n) = Var (\<tau>, n + Suc m)"
     using transaction_renaming_subst_is_renaming(1)[OF assms] by blast
 
   assume "\<alpha> x = \<alpha> y"
   hence "\<tau>x = \<tau>y" "nx = ny" using x y m by simp_all
   thus "x = y" using x y by argo
 qed
 
 lemma transaction_renaming_subst_vars_disj:
   fixes \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
   shows "fv\<^sub>s\<^sub>e\<^sub>t (\<alpha> ` (\<Union>(vars_transaction ` set P))) \<inter> (\<Union>(vars_transaction ` set P)) = {}" (is ?A)
     and "fv\<^sub>s\<^sub>e\<^sub>t (\<alpha> ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<inter> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = {}" (is ?B)
     and "T \<in> set P \<Longrightarrow> vars_transaction T \<inter> range_vars \<alpha> = {}" (is "T \<in> set P \<Longrightarrow> ?C1")
     and "T \<in> set P \<Longrightarrow> bvars_transaction T \<inter> range_vars \<alpha> = {}" (is "T \<in> set P \<Longrightarrow> ?C2")
     and "T \<in> set P \<Longrightarrow> fv_transaction T \<inter> range_vars \<alpha> = {}" (is "T \<in> set P \<Longrightarrow> ?C3")
     and "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<inter> range_vars \<alpha> = {}" (is ?D1)
     and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<inter> range_vars \<alpha> = {}" (is ?D2)
     and "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<inter> range_vars \<alpha> = {}" (is ?D3)
 proof -
   define X where "X \<equiv> \<Union>(vars_transaction ` set P) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
 
   have 1: "finite X" by (simp add: X_def)
 
   obtain n where n: "n \<ge> max_var_set X" "\<alpha> = var_rename n"
     using assms unfolding transaction_renaming_subst_def X_def by moura
   hence 2: "\<forall>x \<in> X. snd x < Suc n"
     using less_Suc_max_var_set[OF _ 1] unfolding var_rename_def by fastforce
   
   have 3: "x \<notin> fv\<^sub>s\<^sub>e\<^sub>t (\<alpha> ` X)" "fv (\<alpha> x) \<inter> X = {}" "x \<notin> range_vars \<alpha>" when x: "x \<in> X" for x
     using 2 x n unfolding var_rename_def by force+
 
   show ?A ?B using 3(1,2) unfolding X_def by auto
 
   show ?C1 when T: "T \<in> set P" using T 3(3) unfolding X_def by blast
   thus ?C2 ?C3 when T: "T \<in> set P"
     using T by (simp_all add: disjoint_iff_not_equal vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t)
 
   show ?D1 using 3(3) unfolding X_def by auto
   thus ?D2 ?D3 by (simp_all add: disjoint_iff_not_equal vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t)
 qed
 
 lemma transaction_renaming_subst_wt:
   fixes \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_renaming_subst \<alpha> P X"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<alpha>"
 proof -
   { fix x::"('fun,'atom,'sets,'lbl) prot_var"
     obtain \<tau> n where x: "x = (\<tau>,n)" by moura
     then obtain m where m: "\<alpha> x = Var (\<tau>,m)"
       using assms transaction_renaming_subst_is_renaming(1) by moura
     hence "\<Gamma> (\<alpha> x) = \<Gamma>\<^sub>v x" using x by (simp add: \<Gamma>\<^sub>v_def)
   } thus ?thesis by (simp add: wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
 qed
 
 lemma transaction_renaming_subst_is_wf_trm:
   fixes \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_renaming_subst \<alpha> P X"
   shows "wf\<^sub>t\<^sub>r\<^sub>m (\<alpha> v)"
 proof -
   obtain \<tau> n where "v = (\<tau>, n)" by moura
   then obtain m where "\<alpha> v = Var (\<tau>, n + Suc m)"
     using transaction_renaming_subst_is_renaming(1)[OF assms]
     by moura
   thus ?thesis by (metis wf_trm_Var)
 qed
 
 lemma transaction_renaming_subst_range_wf_trms:
   fixes \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_renaming_subst \<alpha> P X"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<alpha>)"
 by (metis transaction_renaming_subst_is_wf_trm[OF assms] wf_trm_subst_range_iff)
 
 lemma transaction_renaming_subst_range_notin_vars:
   fixes \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
   shows "\<exists>y. \<alpha> x = Var y \<and> y \<notin> \<Union>(vars_transaction ` set P) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
 proof -
   obtain \<tau> n where x: "x = (\<tau>,n)" by (metis surj_pair)
 
   define y where "y \<equiv> \<lambda>m. (\<tau>,n+Suc m)"
 
   have "\<exists>m \<ge> max_var_set (\<Union>(vars_transaction ` set P) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A). \<alpha> x = Var (y m)"
     using assms x by (auto simp add: y_def transaction_renaming_subst_def var_rename_def)
   moreover have "finite (\<Union>(vars_transaction ` set P) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" by auto
   ultimately show ?thesis using x unfolding y_def by force
 qed
 
 lemma transaction_renaming_subst_var_obtain:
   fixes \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes \<alpha>: "transaction_renaming_subst \<alpha> P X"
   shows "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>) \<Longrightarrow> \<exists>y. \<alpha> y = Var x" (is "?A1 \<Longrightarrow> ?B1")
     and "x \<in> fv (t \<cdot> \<alpha>) \<Longrightarrow> \<exists>y \<in> fv t. \<alpha> y = Var x" (is "?A2 \<Longrightarrow> ?B2")
 proof -
   assume x: ?A1
   obtain y where y: "y \<in> fv\<^sub>s\<^sub>s\<^sub>t S" "x \<in> fv (\<alpha> y)" using fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var[OF x] by moura
   thus ?B1 using transaction_renaming_subst_is_renaming(2)[OF \<alpha>, of y] by fastforce
 next
   assume x: ?A2
   obtain y where y: "y \<in> fv t" "x \<in> fv (\<alpha> y)" using fv_subst_obtain_var[OF x] by moura
   thus ?B2 using transaction_renaming_subst_is_renaming(2)[OF \<alpha>, of y] by fastforce
 qed
 
 lemma transaction_renaming_subst_set_eq:
   assumes "set P1 = set P2"
   shows "transaction_renaming_subst \<alpha> P1 X = transaction_renaming_subst \<alpha> P2 X" (is "?A = ?B")
 using assms unfolding transaction_renaming_subst_def by presburger
 
 lemma transaction_renaming_subst_vars_transaction_neq:
   assumes T: "T \<in> set P"
     and \<alpha>: "transaction_renaming_subst \<alpha> P vars"
     and vars:"finite vars"
     and x: "x \<in> vars_transaction T"
   shows "\<alpha> y \<noteq> Var x"
 proof -
   have "\<exists>n. \<alpha> = var_rename n \<and> n \<ge> max_var_set (\<Union>(vars_transaction ` set P))"
     using T \<alpha> vars x unfolding transaction_renaming_subst_def by auto
   then obtain n where n_p: "\<alpha> = var_rename n" "n \<ge> max_var_set (\<Union>(vars_transaction ` set P))"
     by blast
   moreover
   have "\<Union>(vars_transaction ` set P) \<supseteq> vars_transaction T"
     using T by blast
   ultimately
   have n_gt: "n \<ge> max_var_set (vars_transaction T)"
     by auto
   obtain a b where ab: "x = (a,b)"
     by (cases x) auto
   obtain c d where cd: "y = (c,d)"
     by (cases y) auto
 
   have nb: "n \<ge> b"
     using n_gt x ab
     by auto
 
   have "\<alpha> y = \<alpha> (c, d)"
     using cd by auto
   moreover
   have "... = Var (c, Suc (d + n))"
     unfolding n_p(1) unfolding var_rename_def by simp 
   moreover
   have "... \<noteq> Var x"
     using nb ab by auto
   ultimately
   show ?thesis
     by auto
 qed
 
 lemma transaction_renaming_subst_fv_disj:
   fixes \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
   shows "fv\<^sub>s\<^sub>e\<^sub>t (\<alpha> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t  A = {}"
 proof -
   have "fv\<^sub>s\<^sub>e\<^sub>t (\<alpha> ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<inter> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t  A = {}"
     using assms transaction_renaming_subst_vars_disj(2) by blast
   moreover
   have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<subseteq> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
     by (simp add: vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t)
   ultimately
   show ?thesis
     by auto
 qed
 
 lemma transaction_fresh_subst_is_wf_trm:
   fixes \<sigma>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_fresh_subst \<sigma> T X"
   shows "wf\<^sub>t\<^sub>r\<^sub>m (\<sigma> v)"
 proof (cases "v \<in> subst_domain \<sigma>")
   case True
   then obtain c where "\<sigma> v = Fun c []" "arity c = 0"
     using assms unfolding transaction_fresh_subst_def
     by moura
   thus ?thesis by auto
 qed auto
 
 lemma transaction_fresh_subst_wt:
   fixes \<sigma>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_fresh_subst \<sigma> T X"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>"
 using assms unfolding transaction_fresh_subst_def by blast
 
 lemma transaction_fresh_subst_domain:
   fixes \<sigma>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_fresh_subst \<sigma> T X"
   shows "subst_domain \<sigma> = set (transaction_fresh T)"
 using assms unfolding transaction_fresh_subst_def by fast
 
 lemma transaction_fresh_subst_range_wf_trms:
   fixes \<sigma>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_fresh_subst \<sigma> T X"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
 by (metis transaction_fresh_subst_is_wf_trm[OF assms] wf_trm_subst_range_iff)
 
 lemma transaction_fresh_subst_range_fresh:
   fixes \<sigma>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_fresh_subst \<sigma> T M"
   shows "\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t M"
     and "\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"
 using assms unfolding transaction_fresh_subst_def by meson+
 
 lemma transaction_fresh_subst_sends_to_val:
   fixes \<sigma>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes \<sigma>: "transaction_fresh_subst \<sigma> T X"
     and y: "y \<in> set (transaction_fresh T)" "\<Gamma>\<^sub>v y = TAtom Value"
   obtains n where "\<sigma> y = Fun (Val n) []" "Fun (Val n) [] \<in> subst_range \<sigma>"
 proof -
   have "\<sigma> y \<in> subst_range \<sigma>" using assms unfolding transaction_fresh_subst_def by simp
 
   obtain c where c: "\<sigma> y = Fun c []" "\<not>public c" "arity c = 0"
     using \<sigma> y(1) unfolding transaction_fresh_subst_def by fastforce
 
   have "\<Gamma> (\<sigma> y) = TAtom Value"
     using \<sigma> y(2) \<Gamma>\<^sub>v_TAtom''(2)[of y] wt_subst_trm''[of \<sigma> "Var y"]
     unfolding transaction_fresh_subst_def by simp
   then obtain n where "c = Val n"
     using c by (cases c) (auto split: option.splits)
   thus ?thesis
     using c that unfolding transaction_fresh_subst_def
     by fastforce
 qed
 
 lemma transaction_fresh_subst_sends_to_val':
   fixes \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_fresh_subst \<sigma> T X"
     and "y \<in> set (transaction_fresh T)" "\<Gamma>\<^sub>v y = TAtom Value"
   obtains n where "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = Fun (Val n) []" "Fun (Val n) [] \<in> subst_range \<sigma>" 
 proof -
   obtain n where "\<sigma> y = Fun (Val n) []" "Fun (Val n) [] \<in> subst_range \<sigma>"
     using transaction_fresh_subst_sends_to_val[OF assms] by moura
   thus ?thesis using that by (fastforce simp add: subst_compose_def)
 qed
 
 lemma transaction_fresh_subst_grounds_domain:
   fixes \<sigma>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_fresh_subst \<sigma> T X"
     and "y \<in> set (transaction_fresh T)"
   shows "fv (\<sigma> y) = {}"
 proof -
   obtain c where "\<sigma> y = Fun c []"
     using assms unfolding transaction_fresh_subst_def by moura
   thus ?thesis by simp
 qed
 
 lemma transaction_fresh_subst_range_vars_empty:
   fixes \<sigma>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_fresh_subst \<sigma> T X"
   shows "range_vars \<sigma> = {}"
 proof -
   have "fv t = {}" when "t \<in> subst_range \<sigma>" for t
     using assms that unfolding transaction_fresh_subst_def by fastforce
   thus ?thesis unfolding range_vars_def by blast
 qed
 
 lemma transaction_decl_fresh_renaming_substs_range:
   fixes \<xi> \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T M"
     and \<alpha>: "transaction_renaming_subst \<alpha> P X"
   shows "x \<in> fst ` set (transaction_decl T ()) \<Longrightarrow>
           \<exists>c. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = Fun c [] \<and> arity c = 0"
     and "x \<notin> fst ` set (transaction_decl T ()) \<Longrightarrow>
           x \<in> set (transaction_fresh T) \<Longrightarrow>
             \<exists>c. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = Fun c [] \<and> \<not>public c \<and> arity c = 0"
     and "x \<notin> fst ` set (transaction_decl T ()) \<Longrightarrow>
           x \<in> set (transaction_fresh T) \<Longrightarrow>
           fst x = TAtom Value \<Longrightarrow>
             \<exists>n. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = Fun (Val n) []"
     and "x \<notin> fst ` set (transaction_decl T ()) \<Longrightarrow>
           x \<notin> set (transaction_fresh T) \<Longrightarrow>
             \<exists>y. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = Var y"
 proof -
   assume "x \<in> fst ` set (transaction_decl T ())"
   then obtain c where c: "\<xi> x = Fun c []" "arity c = 0"
     using \<xi> unfolding transaction_decl_subst_def by fastforce
   thus "\<exists>c. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = Fun c [] \<and> arity c = 0"
     using subst_compose[of "\<xi> \<circ>\<^sub>s \<sigma>" \<alpha> x] subst_compose[of \<xi> \<sigma> x] by simp
 next
   assume x: "x \<notin> fst ` set (transaction_decl T ())"
             "x \<in> set (transaction_fresh T)"
 
   have *: "(\<xi> \<circ>\<^sub>s \<sigma>) x = \<sigma> x"
     using x(1) \<xi> unfolding transaction_decl_subst_def
     by (metis (no_types, opaque_lifting) subst_comp_notin_dom_eq)
   then obtain c where c: "(\<xi> \<circ>\<^sub>s \<sigma>) x = Fun c []" "\<not>public c" "arity c = 0"
     using \<sigma> x(2) unfolding transaction_fresh_subst_def by fastforce
   thus "\<exists>c. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = Fun c [] \<and> \<not>public c \<and> arity c = 0"
     using subst_compose[of "\<xi> \<circ>\<^sub>s \<sigma>" \<alpha> x] subst_compose[of \<xi> \<sigma> x] by simp
 
   assume "fst x = TAtom Value"
   hence "\<Gamma> ((\<xi> \<circ>\<^sub>s \<sigma>) x) = TAtom Value"
     using * \<sigma> \<Gamma>\<^sub>v_TAtom''(2)[of x] wt_subst_trm''[of \<sigma> "Var x"]
     unfolding transaction_fresh_subst_def by simp
   then obtain n where "c = Val n"
     using c by (cases c) (auto split: option.splits)
   thus "\<exists>n. (\<xi> \<circ>\<^sub>s\<sigma> \<circ>\<^sub>s \<alpha>) x = Fun (Val n) []"
     using c subst_compose[of "\<xi> \<circ>\<^sub>s \<sigma>" \<alpha> x] subst_compose[of \<xi> \<sigma> x] by simp
 next
   assume "x \<notin> fst ` set (transaction_decl T ())"
          "x \<notin> set (transaction_fresh T)"
   hence "(\<xi> \<circ>\<^sub>s \<sigma>) x = Var x"
     using \<xi> \<sigma>
     unfolding transaction_decl_subst_def transaction_fresh_subst_def
     by (metis (no_types, opaque_lifting) subst_comp_notin_dom_eq subst_domI)
   thus "\<exists>y. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = Var y"
     using transaction_renaming_subst_is_renaming(1)[OF \<alpha>]
           subst_compose[of "\<xi> \<circ>\<^sub>s \<sigma>" \<alpha> x] subst_compose[of \<xi> \<sigma> x]
     by (cases x) force
 qed
 
 lemma transaction_decl_fresh_renaming_substs_range':
   fixes \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T M"
     and \<alpha>: "transaction_renaming_subst \<alpha> P X"
     and t: "t \<in> subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   shows "(\<exists>c. t = Fun c [] \<and> arity c = 0) \<or> (\<exists>x. t = Var x)"
     and "\<xi> = Var \<Longrightarrow> (\<exists>c. t = Fun c [] \<and> \<not>public c \<and> arity c = 0) \<or> (\<exists>x. t = Var x)"
     and "\<xi> = Var \<Longrightarrow> \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<Longrightarrow>
                       (\<exists>n. t = Fun (Val n) []) \<or> (\<exists>x. t = Var x)"
     and "\<xi> = Var \<Longrightarrow> is_Fun t \<Longrightarrow> t \<in> subst_range \<sigma>"
 proof -
   obtain x where x: "x \<in> subst_domain (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = t"
     using t by auto
 
   note 0 = x transaction_decl_fresh_renaming_substs_range[OF \<xi> \<sigma> \<alpha>, of x]
 
   show "(\<exists>c. t = Fun c [] \<and> arity c = 0) \<or> (\<exists>x. t = Var x)"
     using 0 unfolding \<Gamma>\<^sub>v_TAtom'' by auto
 
   assume 1: "\<xi> = Var"
 
   note 2 = transaction_decl_subst_empty_inv[OF \<xi>[unfolded 1]]
 
   show 3: "(\<exists>c. t = Fun c [] \<and> \<not>public c \<and> arity c = 0) \<or> (\<exists>x. t = Var x)"
     using 0 2 unfolding \<Gamma>\<^sub>v_TAtom'' by auto
 
   show "(\<exists>n. t = Fun (Val n) []) \<or> (\<exists>x. t = Var x)"
     when "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
     using 0 2 that unfolding \<Gamma>\<^sub>v_TAtom'' by auto
 
   show "t \<in> subst_range \<sigma>" when t': "is_Fun t"
   proof -
     obtain x where x: "(\<sigma> \<circ>\<^sub>s \<alpha>) x = t" using t 1 by auto
     
     show ?thesis
     proof (cases "x \<in> subst_domain \<sigma>")
       case True thus ?thesis
         by (metis subst_dom_vars_in_subst subst_ground_ident_compose(1) subst_imgI x
                   transaction_fresh_subst_grounds_domain[OF \<sigma>]
                   transaction_fresh_subst_domain[OF \<sigma>]) 
     next
       case False thus ?thesis
         by (metis (no_types, lifting) subst_compose_def subst_domI term.disc(1) that
                   transaction_renaming_subst_is_renaming(5)[OF \<alpha>] var_renaming_is_Fun_iff x)
     qed
   qed
 qed
 
 lemma transaction_decl_fresh_renaming_substs_range'':
   fixes \<xi> \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and y: "y \<in> fv ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x)"
   shows "\<xi> x = Var x"
     and "\<sigma> x = Var x"
     and "\<alpha> x = Var y"
     and "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = Var y"
 proof -
   have "\<exists>z. z \<in> fv (\<xi> x)" by (metis y subst_compose_fv')
   hence "x \<notin> subst_domain \<xi>"
     using y transaction_decl_subst_domain[OF \<xi>]
           transaction_decl_subst_grounds_domain[OF \<xi>, of x]
     by blast
   thus 0: "\<xi> x = Var x" by blast
   hence "y \<in> fv ((\<sigma> \<circ>\<^sub>s \<alpha>) x)" using y by (simp add: subst_compose)
   hence "\<exists>z. z \<in> fv (\<sigma> x)" by (metis subst_compose_fv')
   hence "x \<notin> subst_domain \<sigma>"
     using y transaction_fresh_subst_domain[OF \<sigma>]
           transaction_fresh_subst_grounds_domain[OF \<sigma>, of x]
     by blast
   thus 1: "\<sigma> x = Var x" by blast
   
   show "\<alpha> x = Var y" "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = Var y"
     using 0 1 y transaction_renaming_subst_is_renaming(2)[OF \<alpha>, of x]
     unfolding subst_compose_def by (fastforce,fastforce)
 qed
 
 lemma transaction_decl_fresh_renaming_substs_vars_subset:
   fixes \<xi> \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
   shows "\<Union>(fv_transaction ` set P) \<subseteq> subst_domain (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" (is ?A)
     and "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> subst_domain (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" (is ?B)
     and "T' \<in> set P \<Longrightarrow> fv_transaction T' \<subseteq> subst_domain (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" (is "T' \<in> set P \<Longrightarrow> ?C")
     and "T' \<in> set P \<Longrightarrow> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<subseteq> range_vars (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       (is "T' \<in> set P \<Longrightarrow> ?D")
 proof -
   have *: "x \<in> subst_domain (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" for x
   proof (cases "x \<in> subst_domain \<xi>")
     case True thus ?thesis
       using transaction_decl_subst_domain[OF \<xi>] transaction_decl_subst_grounds_domain[OF \<xi>]
       by (simp add: subst_domI subst_dom_vars_in_subst subst_ground_ident_compose(1))
   next
     case False
     hence \<xi>_x_eq: "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = (\<sigma> \<circ>\<^sub>s \<alpha>) x" by (auto simp add: subst_compose)
 
     show ?thesis
     proof (cases "x \<in> subst_domain \<sigma>")
       case True
       hence "x \<notin> {x. \<exists>y. \<sigma> x = Var y \<and> \<alpha> y = Var x}"
         using transaction_fresh_subst_domain[OF \<sigma>]
               transaction_fresh_subst_grounds_domain[OF \<sigma>, of x]
         by auto
       hence "x \<in> subst_domain (\<sigma> \<circ>\<^sub>s \<alpha>)" using subst_domain_subst_compose[of \<sigma> \<alpha>] by blast
       thus ?thesis using \<xi>_x_eq subst_dom_vars_in_subst by fastforce 
     next
       case False
       hence "(\<sigma> \<circ>\<^sub>s \<alpha>) x = \<alpha> x" unfolding subst_compose_def by fastforce
       moreover have "\<alpha> x \<noteq> Var x"
         using transaction_renaming_subst_is_renaming(1)[OF \<alpha>] by (cases x) auto
       ultimately show ?thesis using \<xi>_x_eq by fastforce
     qed
   qed
   
   show ?A ?B using * by blast+
 
   show ?C when T: "T' \<in> set P" using T * by blast
   hence "fv\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T') \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<subseteq> range_vars (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     when T: "T' \<in> set P"
     using T fv\<^sub>s\<^sub>s\<^sub>t_subst_subset_range_vars_if_subset_domain by blast
   thus ?D when T: "T' \<in> set P" by (metis T unlabel_subst)
 qed
 
 lemma transaction_decl_fresh_renaming_substs_vars_disj:
   fixes \<xi> \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
   shows "fv\<^sub>s\<^sub>e\<^sub>t ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` (\<Union>(vars_transaction ` set P))) \<inter> (\<Union>(vars_transaction ` set P)) = {}"
       (is ?A)
     and "x \<in> \<Union>(vars_transaction ` set P) \<Longrightarrow> fv ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x) \<inter> (\<Union>(vars_transaction ` set P)) = {}"
       (is "?B' \<Longrightarrow> ?B")
     and "T' \<in> set P \<Longrightarrow> vars_transaction T' \<inter> range_vars (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = {}" (is "T' \<in> set P \<Longrightarrow> ?C1")
     and "T' \<in> set P \<Longrightarrow> bvars_transaction T' \<inter> range_vars (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = {}" (is "T' \<in> set P \<Longrightarrow> ?C2")
     and "T' \<in> set P \<Longrightarrow> fv_transaction T' \<inter> range_vars (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = {}" (is "T' \<in> set P \<Longrightarrow> ?C3")
     and "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> range_vars (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = {}" (is ?D1)
     and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> range_vars (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = {}" (is ?D2)
     and "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> range_vars (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = {}" (is ?D3)
     and "range_vars \<xi> = {}" (is ?E1)
     and "range_vars \<sigma> = {}" (is ?E2)
     and "range_vars (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<subseteq> range_vars \<alpha>" (is ?E3)
 proof -
   note 0 = transaction_renaming_subst_vars_disj[OF \<alpha>]
 
   show ?A
   proof (cases "fv\<^sub>s\<^sub>e\<^sub>t ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` (\<Union>(vars_transaction ` set P))) = {}")
     case False
     hence "\<forall>x \<in> (\<Union>(vars_transaction ` set P)). (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = \<alpha> x \<or> fv ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x) = {}"
       using transaction_decl_fresh_renaming_substs_range''[OF \<xi> \<sigma> \<alpha>] by auto
     thus ?thesis using 0(1) by force
   qed blast
   thus "?B' \<Longrightarrow> ?B" by auto
 
   show ?E1 ?E2
     using transaction_fresh_subst_grounds_domain[OF \<sigma>]
           transaction_decl_subst_grounds_domain[OF \<xi>]
     unfolding transaction_fresh_subst_domain[OF \<sigma>, symmetric]
               transaction_decl_subst_domain[OF \<xi>, symmetric]
     by (fastforce, fastforce)
   thus 1: ?E3
     using range_vars_subst_compose_subset[of \<xi> \<sigma>]
           range_vars_subst_compose_subset[of "\<xi> \<circ>\<^sub>s \<sigma>" \<alpha>]
     by blast
   
   show ?C1 ?C2 ?C3 when T: "T' \<in> set P" using T 1 0(3,4,5)[of T'] by blast+
 
   show ?D1 ?D2 ?D3 using 1 0(6,7,8) by blast+
 qed
 
 lemma transaction_decl_fresh_renaming_substs_trms:
   fixes \<xi> \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<xi> = {}"
     and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<sigma> = {}"
     and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<alpha> = {}"
   shows "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))) = subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 proof -
   have 1: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S). (\<exists>f. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = Fun f []) \<or> (\<exists>y. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = Var y)"
     using transaction_decl_fresh_renaming_substs_range'[OF \<xi> \<sigma> \<alpha>] by blast
 
   have 2: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = {}"
     using assms(4-6) subst_domain_compose[of \<xi> \<sigma>] subst_domain_compose[of "\<xi> \<circ>\<^sub>s \<sigma>" \<alpha>] by blast
 
   show ?thesis using subterms_subst_lsst[OF 1 2] by simp
 qed
 
 lemma transaction_decl_fresh_renaming_substs_wt:
   fixes \<xi> \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_decl_subst \<xi> T" "transaction_fresh_subst \<sigma> T M"
           "transaction_renaming_subst \<alpha> P X"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 using transaction_renaming_subst_wt[OF assms(3)]
       transaction_fresh_subst_wt[OF assms(2)]
       transaction_decl_subst_wt[OF assms(1)]
 by (metis wt_subst_compose)
 
 lemma transaction_decl_fresh_renaming_substs_range_wf_trms:
   fixes \<xi> \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_decl_subst \<xi> T" "transaction_fresh_subst \<sigma> T M"
           "transaction_renaming_subst \<alpha> P X"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
 using transaction_renaming_subst_range_wf_trms[OF assms(3)]
       transaction_fresh_subst_range_wf_trms[OF assms(2)]
       transaction_decl_subst_range_wf_trms[OF assms(1)]
       wf_trms_subst_compose[of \<xi> \<sigma>]
       wf_trms_subst_compose[of "\<xi> \<circ>\<^sub>s \<sigma>" \<alpha>]
 by metis
 
 lemma transaction_decl_fresh_renaming_substs_fv:
   fixes \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T M"
     and \<alpha>: "transaction_renaming_subst \<alpha> P X"
     and x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
   shows "\<exists>y \<in> fv_transaction T - set (transaction_fresh T). (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y = Var x"
 proof -
   have "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     using x fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
           unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
     by argo
   then obtain y where "y \<in> fv_transaction T" "x \<in> fv ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y)"
     by (metis fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var)
   thus ?thesis
     using transaction_decl_fresh_renaming_substs_range[OF \<xi> \<sigma> \<alpha>, of y]
     by (cases "y \<in> set (transaction_fresh T)") force+
 qed
 
 lemma transaction_decl_fresh_renaming_substs_range_no_attack_const:
   fixes \<xi> \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T M"
     and \<alpha>: "transaction_renaming_subst \<alpha> P X"
     and T: "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
     and t: "t \<in> subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   shows "\<nexists>n. t = attack\<langle>n\<rangle>"
 proof -
   note \<xi>\<sigma>\<alpha>_wt = transaction_decl_fresh_renaming_substs_wt[OF \<xi> \<sigma> \<alpha>]
 
   obtain x where x: "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = t" using t by auto
 
   have x_type: "\<Gamma> (Var x) = \<Gamma> (Var x \<cdot> \<xi>)" "\<Gamma> (Var x) = \<Gamma> (Var x \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     using \<xi> wt_subst_trm''[of \<xi> "Var x"] wt_subst_trm''[OF \<xi>\<sigma>\<alpha>_wt, of "Var x"]
     unfolding transaction_decl_subst_def by (blast, blast)
 
   show ?thesis
   proof (cases t)
     case (Fun f S)
     hence "x \<in> set (transaction_fresh T) \<or> x \<in> fst ` set (transaction_decl T ())"
       using transaction_decl_fresh_renaming_substs_range[OF \<xi> \<sigma> \<alpha>, of x] x by force
     thus ?thesis
     proof
       assume "x \<in> set (transaction_fresh T)"
       hence "\<Gamma> t = TAtom Value \<or> (\<exists>a. \<Gamma> t = TAtom (Atom a))"
-        using T x_type(2) x by (metis \<Gamma>.simps(1) subst_apply_term.simps(1))
+        using T x_type(2) x by (metis \<Gamma>.simps(1) eval_term.simps(1))
       thus ?thesis by auto
     next
       assume "x \<in> fst ` set (transaction_decl T ())"
       then obtain c where c: "\<xi> x = Fun (Fu c) []" "arity\<^sub>f c = 0"
         using \<xi> unfolding transaction_decl_subst_def by auto
 
       have "\<Gamma> t = TAtom Bottom \<or> (\<exists>a. \<Gamma> t = TAtom (Atom a))"
         using c(1) \<Gamma>_consts_simps(1)[OF c(2)] x x_type
-              subst_apply_term.simps(1)[of x \<xi>] subst_apply_term.simps(1)[of x "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
+              eval_term.simps(1)[of _ x \<xi>] eval_term.simps(1)[of _ x "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
         by (cases "\<Gamma>\<^sub>f c") simp_all
       thus ?thesis by auto
     qed
   qed simp
 qed
 
 lemma transaction_decl_fresh_renaming_substs_occurs_fact_send_receive:
   fixes t::"('fun,'atom,'sets,'lbl) prot_term"
   assumes \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T M"
     and \<alpha>: "transaction_renaming_subst \<alpha> P X"
     and T: "admissible_transaction' T"
     and t: "occurs t \<in> set ts"
   shows "send\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))
           \<Longrightarrow> \<exists>ts' s. send\<langle>ts'\<rangle> \<in> set (unlabel (transaction_send T)) \<and>
                       occurs s \<in> set ts' \<and> t = s \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
       (is "?A \<Longrightarrow> ?A'")
     and "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))
           \<Longrightarrow> \<exists>ts' s. receive\<langle>ts'\<rangle> \<in> set (unlabel (transaction_receive T)) \<and>
                       occurs s \<in> set ts' \<and> t = s \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
       (is "?B \<Longrightarrow> ?B'")
 proof -
   assume ?A
   then obtain s ts' where s:
       "s \<in> set ts'" "send\<langle>ts'\<rangle> \<in> set (unlabel (transaction_strand T))" "occurs t = s \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
     using t stateful_strand_step_mem_substD(1)[
             of ts "unlabel (transaction_strand T)" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
           unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
     by auto
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T \<xi>]
 
   have T_decl_notin: "x \<notin> fst ` set (transaction_decl T ())" for x
     using transaction_decl_subst_empty_inv[OF \<xi>[unfolded \<xi>_empty]] by simp
 
   note 0 = s(3) transaction_decl_fresh_renaming_substs_range[OF \<xi> \<sigma> \<alpha>]
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T]
   note T_fresh = admissible_transactionE(14)[OF T]
 
   have "\<exists>u. s = occurs u"
   proof (cases s)
     case (Var x) 
     hence "(\<exists>c. s \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = Fun c []) \<or> (\<exists>y. s \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = Var y)"
       using 0(2-5)[of x] \<xi>_empty by (auto simp del: subst_subst_compose)
     thus ?thesis
       using 0(1) by simp
   next
     case (Fun f T)
     hence 1: "f = OccursFact" "length T = 2" "T ! 0 \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = Fun OccursSec []"
              "T ! 1 \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = t"
       using 0(1) by auto
     have "T ! 0 = Fun OccursSec []"
     proof (cases "T ! 0")
       case (Var x) thus ?thesis
         using 0(2-5)[of x] 1(3) T_fresh T_decl_notin
         unfolding list_all_iff by (auto simp del: subst_subst_compose)
     qed (use 1(3) in simp)
     thus ?thesis using Fun 1 0(1) by (auto simp del: subst_subst_compose)
   qed
   then obtain u where u: "s = occurs u" by moura
   hence "t = u \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" using s(3) by fastforce
   thus ?A' using s u wellformed_transaction_strand_unlabel_memberD(8)[OF T_wf] by metis
 next
   assume ?B
   then obtain s ts' where s:
       "s \<in> set ts'" "receive\<langle>ts'\<rangle> \<in> set (unlabel (transaction_strand T))" "occurs t = s \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
     using t stateful_strand_step_mem_substD(2)[
             of ts "unlabel (transaction_strand T)" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
           unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
     by auto
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T \<xi>]
 
   have T_decl_notin: "x \<notin> fst ` set (transaction_decl T ())" for x
     using transaction_decl_subst_empty_inv[OF \<xi>[unfolded \<xi>_empty]] by simp
 
   note 0 = s(3) transaction_decl_fresh_renaming_substs_range[OF \<xi> \<sigma> \<alpha>]
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T]
   note T_fresh = admissible_transactionE(14)[OF T]
 
   have "\<exists>u. s = occurs u"
   proof (cases s)
     case (Var x) 
     hence "(\<exists>c. s \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = Fun c []) \<or> (\<exists>y. s \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = Var y)"
       using 0(2-5)[of x] \<xi>_empty by (auto simp del: subst_subst_compose)
     thus ?thesis
       using 0(1) by simp
   next
     case (Fun f T)
     hence 1: "f = OccursFact" "length T = 2" "T ! 0 \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = Fun OccursSec []"
               "T ! 1 \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = t"
       using 0(1) by auto
     have "T ! 0 = Fun OccursSec []"
     proof (cases "T ! 0")
       case (Var x) thus ?thesis
         using 0(2-5)[of x] 1(3) T_fresh T_decl_notin
         unfolding list_all_iff by (auto simp del: subst_subst_compose)
     qed (use 1(3) in simp)
     thus ?thesis using Fun 1 0(1) by (auto simp del: subst_subst_compose)
   qed
   then obtain u where u: "s = occurs u" by moura
   hence "t = u \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" using s(3) by fastforce
   thus ?B' using s u wellformed_transaction_strand_unlabel_memberD(1)[OF T_wf] by metis
 qed
 
 lemma transaction_decl_subst_proj:
   assumes "transaction_decl_subst \<xi> T"
   shows "transaction_decl_subst \<xi> (transaction_proj n T)"
 using assms transaction_proj_decl_eq[of n T]
 unfolding transaction_decl_subst_def by presburger
 
 lemma transaction_fresh_subst_proj:
   assumes "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
   shows "transaction_fresh_subst \<sigma> (transaction_proj n T) (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A))"
 using assms transaction_proj_fresh_eq[of n T]
       contra_subsetD[OF subterms\<^sub>s\<^sub>e\<^sub>t_mono[OF transaction_proj_trms_subset[of n T]]]
       contra_subsetD[OF subterms\<^sub>s\<^sub>e\<^sub>t_mono[OF trms\<^sub>s\<^sub>s\<^sub>t_proj_subset(1)[of n A]]]
 unfolding transaction_fresh_subst_def by metis
   
 lemma transaction_renaming_subst_proj:
   assumes "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
   shows "transaction_renaming_subst \<alpha> (map (transaction_proj n) P) (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A))"
 proof -
   let ?X = "\<lambda>P A. \<Union>(vars_transaction ` set P) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
   define Y where "Y \<equiv> ?X (map (transaction_proj n) P) (proj n A)"
   define Z where "Z \<equiv> ?X P A"
 
   have "Y \<subseteq> Z"
     using sst_vars_proj_subset(3)[of n A] transaction_proj_vars_subset[of n]
     unfolding Y_def Z_def by fastforce
   hence "insert 0 (snd ` Y) \<subseteq> insert 0 (snd ` Z)" by blast
   moreover have "finite (insert 0 (snd ` Z))" "finite (insert 0 (snd ` Y))"
     unfolding Y_def Z_def by auto
   ultimately have 0: "max_var_set Y \<le> max_var_set Z" using Max_mono by blast
 
   have "\<exists>n\<ge>max_var_set Z. \<alpha> = var_rename n"
     using assms unfolding transaction_renaming_subst_def Z_def by blast
   hence "\<exists>n\<ge>max_var_set Y. \<alpha> = var_rename n" using 0 le_trans by fast
   thus ?thesis unfolding transaction_renaming_subst_def Y_def by blast
 qed
 
 lemma transaction_decl_fresh_renaming_substs_wf_sst:
   fixes \<xi> \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes T: "wf'\<^sub>s\<^sub>s\<^sub>t (fst ` set (transaction_decl T ()) \<union> set (transaction_fresh T))
                     (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
   shows "wf'\<^sub>s\<^sub>s\<^sub>t {} (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)))"
 proof -
   have 0: "range_vars \<xi> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) = {}"
           "range_vars \<sigma> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi>) = {}"
           "ground (\<xi> ` (fst ` set (transaction_decl T ())))"
           "ground (\<sigma> ` set (transaction_fresh T))"
           "ground (\<alpha> ` {})"
     using transaction_decl_subst_domain[OF \<xi>]
           transaction_decl_subst_grounds_domain[OF \<xi>]
           transaction_decl_subst_range_vars_empty[OF \<xi>]
           transaction_fresh_subst_range_vars_empty[OF \<sigma>]
           transaction_fresh_subst_domain[OF \<sigma>]
           transaction_fresh_subst_grounds_domain[OF \<sigma>]
     by (simp, simp, simp, simp, simp)
 
   have 1: "fv\<^sub>s\<^sub>e\<^sub>t (\<xi> ` set (transaction_fresh T)) \<subseteq> set (transaction_fresh T)" (is "?A \<subseteq> ?B")
   proof
     fix x assume x: "x \<in> ?A"
     then obtain y where y: "y \<in> set (transaction_fresh T)" "x \<in> fv (\<xi> y)" by auto
     hence "y \<notin> subst_domain \<xi>"
       using transaction_decl_subst_domain[OF \<xi>]
             transaction_decl_subst_grounds_domain[OF \<xi>]
       by fast
     thus "x \<in> ?B" using x y by auto
   qed
 
   let ?X = "fst ` set (transaction_decl T ()) \<union> set (transaction_fresh T)"
 
   have "fv\<^sub>s\<^sub>e\<^sub>t (\<alpha> ` fv\<^sub>s\<^sub>e\<^sub>t (\<sigma> ` fv\<^sub>s\<^sub>e\<^sub>t (\<xi> ` ?X))) = {}" using 0(3-5) 1 by auto
   hence "wf'\<^sub>s\<^sub>s\<^sub>t {} (((unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi>) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>)"
     by (metis wf\<^sub>s\<^sub>s\<^sub>t_subst_apply[OF wf\<^sub>s\<^sub>s\<^sub>t_subst_apply[OF wf\<^sub>s\<^sub>s\<^sub>t_subst_apply[OF T]]])
   thus ?thesis
     using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst
           labeled_stateful_strand_subst_comp[OF 0(1), of "\<sigma> \<circ>\<^sub>s \<alpha>"]
           labeled_stateful_strand_subst_comp[OF 0(2), of \<alpha>]
           subst_compose_assoc[of \<xi> \<sigma> \<alpha>]
     by metis
 qed
 
 lemma admissible_transaction_decl_fresh_renaming_subst_not_occurs:
   fixes \<xi> \<sigma> \<alpha>
   defines "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
   assumes T_adm: "admissible_transaction' T"
     and \<xi>\<sigma>\<alpha>:
       "transaction_decl_subst \<xi> T"
       "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
       "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
   shows "\<nexists>t. \<theta> x = occurs t"
     and "\<theta> x \<noteq> Fun OccursSec []"
 proof -
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T_adm \<xi>\<sigma>\<alpha>(1)]
   note T_fresh_val = admissible_transactionE(2)[OF T_adm]
 
   show "\<nexists>t. \<theta> x = occurs t" for x
     using transaction_decl_fresh_renaming_substs_range'(1)[OF \<xi>\<sigma>\<alpha>]
     unfolding \<theta>_def[symmetric] by (cases "x \<in> subst_domain \<theta>") (force,force)
 
   show "\<theta> x \<noteq> Fun OccursSec []" for x
     using transaction_decl_fresh_renaming_substs_range'(3)[
             OF \<xi>\<sigma>\<alpha> _ \<xi>_empty T_fresh_val, of "\<theta> x"]
     unfolding \<theta>_def[symmetric] by (cases "x \<in> subst_domain \<theta>") auto
 qed
 
 
 subsection \<open>Lemmata: Reachable Constraints\<close>
 lemma reachable_constraints_as_transaction_lists:
   fixes f
   defines "f \<equiv> \<lambda>(T,\<xi>,\<sigma>,\<alpha>). dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     and "g \<equiv> concat \<circ> map f"
   assumes A: "A \<in> reachable_constraints P"
   obtains Ts where "A = g Ts"
     and "\<forall>B. prefix B Ts \<longrightarrow> g B \<in> reachable_constraints P"
     and "\<forall>B T \<xi> \<sigma> \<alpha>. prefix (B@[(T,\<xi>,\<sigma>,\<alpha>)]) Ts \<longrightarrow>
                       T \<in> set P \<and> transaction_decl_subst \<xi> T \<and>
                       transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g B)) \<and>
                       transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g B))"
 proof -
   let ?P1 = "\<lambda>A Ts. A = g Ts"
   let ?P2 = "\<lambda>Ts. \<forall>B. prefix B Ts \<longrightarrow> g B \<in> reachable_constraints P"
   let ?P3 = "\<lambda>Ts. \<forall>B T \<xi> \<sigma> \<alpha>. prefix (B@[(T,\<xi>,\<sigma>,\<alpha>)]) Ts \<longrightarrow>
                       T \<in> set P \<and> transaction_decl_subst \<xi> T \<and>
                       transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g B)) \<and>
                       transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g B))"
 
   have "\<exists>Ts. ?P1 A Ts \<and> ?P2 Ts \<and> ?P3 Ts" using A
   proof (induction A rule: reachable_constraints.induct)
     case init
     have "?P1 [] []" "?P2 []" "?P3 []" unfolding g_def f_def by simp_all
     thus ?case by blast
   next
     case (step A T \<xi> \<sigma> \<alpha>)
     let ?A' = "A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     obtain Ts where Ts: "?P1 A Ts" "?P2 Ts" "?P3 Ts" using step.IH by blast
 
     have 1: "?P1 ?A' (Ts@[(T,\<xi>,\<sigma>,\<alpha>)])"
       using Ts(1) unfolding g_def f_def by simp
     
     have 2: "?P2 (Ts@[(T,\<xi>,\<sigma>,\<alpha>)])"
     proof (intro allI impI)
       fix B assume "prefix B (Ts@[(T,\<xi>,\<sigma>,\<alpha>)])"
       hence "prefix B Ts \<or> B = Ts@[(T,\<xi>,\<sigma>,\<alpha>)]" by fastforce
       thus "g B \<in> reachable_constraints P "
         using Ts(1,2) reachable_constraints.step[OF step.hyps]
         unfolding g_def f_def by auto
     qed
 
     have 3: "?P3 (Ts@[(T,\<xi>,\<sigma>,\<alpha>)])"
       using Ts(1,3) step.hyps(2-5) unfolding g_def f_def by auto 
 
     show ?case using 1 2 3 by blast
   qed
   thus thesis using that by blast
 qed
 
 lemma reachable_constraints_transaction_action_obtain:
   assumes A: "A \<in> reachable_constraints P"
     and a: "a \<in> set A"
   obtains T b B \<alpha> \<sigma> \<xi>
   where "prefix (B@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) A"
     and "T \<in> set P" "transaction_decl_subst \<xi> T" "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
         "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
     and "b \<in> set (transaction_strand T)" "a = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" "fst a = fst b"
 proof -
   define f where "f \<equiv> \<lambda>(T,\<xi>,\<sigma>::('fun,'atom,'sets,'lbl) prot_subst,\<alpha>).
                           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   define g where "g \<equiv> concat \<circ> map f"
 
   obtain Ts where Ts:
       "A = g Ts" "\<forall>B. prefix B Ts \<longrightarrow> g B \<in> reachable_constraints P"
       "\<forall>B T \<xi> \<sigma> \<alpha>. prefix (B@[(T,\<xi>,\<sigma>,\<alpha>)]) Ts \<longrightarrow>
             T \<in> set P \<and> transaction_decl_subst \<xi> T \<and>
             transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g B)) \<and>
             transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g B))"
     using reachable_constraints_as_transaction_lists[OF A] unfolding g_def f_def by blast
 
   obtain T \<alpha> \<xi> \<sigma> where T: "(T,\<xi>,\<sigma>,\<alpha>) \<in> set Ts" "a \<in> set (f (T,\<xi>,\<sigma>,\<alpha>))"
     using Ts(1) a unfolding g_def by auto
   
   obtain B where B: "prefix (B@[(T,\<xi>,\<sigma>,\<alpha>)]) Ts"
     using T(1) by (meson prefix_snoc_in_iff) 
 
   obtain b where b:
       "b \<in> set (transaction_strand T)" "a = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" "fst a = fst b"
     using T(2) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD'[of a "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" thesis]
     unfolding f_def by simp
 
   have 0: "prefix (g B@f (T, \<xi>, \<sigma>, \<alpha>)) A"
     using concat_map_mono_prefix[OF B, of f] unfolding g_def Ts(1) by simp
 
   have 1: "T \<in> set P" "transaction_decl_subst \<xi> T" "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g B))"
           "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g B))"
     using B Ts(3) by (blast,blast,blast,blast)
 
   show thesis using 0[unfolded f_def] that[OF _ 1 b] by fast
 qed
 
 lemma reachable_constraints_unlabel_eq:
   defines "transaction_unlabel_eq \<equiv> \<lambda>T1 T2.
              transaction_decl T1     =          transaction_decl T2 \<and>
              transaction_fresh T1    =          transaction_fresh T2 \<and>
     unlabel (transaction_receive T1) = unlabel (transaction_receive T2) \<and>
     unlabel (transaction_checks T1)  = unlabel (transaction_checks T2) \<and>
     unlabel (transaction_updates T1) = unlabel (transaction_updates T2) \<and>
     unlabel (transaction_send T1)    = unlabel (transaction_send T2)"
   assumes Peq: "list_all2 transaction_unlabel_eq P1 P2"
   shows "unlabel ` reachable_constraints P1 = unlabel ` reachable_constraints P2" (is "?A = ?B")
 proof (intro antisym subsetI)
   have "transaction_unlabel_eq T2 T1 = transaction_unlabel_eq T1 T2" for T1 T2
     unfolding transaction_unlabel_eq_def by argo
   hence Peq': "list_all2 transaction_unlabel_eq P2 P1"
     using Peq list_all2_sym by metis
 
   have 0: "unlabel (transaction_strand T1) = unlabel (transaction_strand T2)"
     when "transaction_unlabel_eq T1 T2" for T1 T2
     using that unfolding transaction_unlabel_eq_def transaction_strand_def by force
 
   have "vars_transaction T1 = vars_transaction T2" when "transaction_unlabel_eq T1 T2" for T1 T2
     using 0[OF that] by simp
   hence "vars_transaction (P1 ! i) = vars_transaction (P2 ! i)" when "i < length P1" for i
     using that Peq list_all2_conv_all_nth by blast
   moreover have "length P1 = length P2" using Peq unfolding list_all2_iff by argo
   ultimately have 1: "\<Union>(vars_transaction ` set P1) = \<Union>(vars_transaction ` set P2)"
     using in_set_conv_nth[of _ P1] in_set_conv_nth[of _ P2] by fastforce
 
   have 2:
       "transaction_decl_subst \<xi> T1 \<Longrightarrow> transaction_decl_subst \<xi> T2" (is "?A1 \<Longrightarrow> ?A2")
       "transaction_fresh_subst \<sigma> T1 (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<Longrightarrow> transaction_fresh_subst \<sigma> T2 (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)"
         (is "?B1 \<Longrightarrow> ?B2")
       "transaction_renaming_subst \<alpha> P1 (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<Longrightarrow> transaction_renaming_subst \<alpha> P2 (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)"
         (is "?C1 \<Longrightarrow> ?C2")
       "transaction_renaming_subst \<alpha> P2 (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<Longrightarrow> transaction_renaming_subst \<alpha> P1 (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)"
         (is "?D1 \<Longrightarrow> ?D2")
     when "transaction_unlabel_eq T1 T2" "unlabel \<A> = unlabel \<B>"
     for T1 T2::"('fun,'atom,'sets,'lbl) prot_transaction"
       and \<A> \<B>::"('fun,'atom,'sets,'lbl) prot_strand"
       and \<xi> \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   proof -
     have *: "transaction_decl T1 = transaction_decl T2"
             "transaction_fresh T1 = transaction_fresh T2"
             "trms_transaction T1 = trms_transaction T2"
       using that unfolding transaction_unlabel_eq_def transaction_strand_def by force+
 
     show "?A1 \<Longrightarrow> ?A2" using *(1) unfolding transaction_decl_subst_def by argo
     show "?B1 \<Longrightarrow> ?B2" using that(2) *(2,3) unfolding transaction_fresh_subst_def by force
     show "?C1 \<Longrightarrow> ?C2" using that(2) 1 unfolding transaction_renaming_subst_def by metis
     show "?D1 \<Longrightarrow> ?D2" using that(2) 1 unfolding transaction_renaming_subst_def by metis
   qed
 
   have 3: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T1 \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) =
            unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T2 \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
     when "transaction_unlabel_eq T1 T2" for T1 T2 \<theta>
     using 0[OF that] unlabel_subst[of _ \<theta>] dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_cong by metis
 
   have "\<exists>\<B> \<in> reachable_constraints P2. unlabel \<A> = unlabel \<B>"
     when "\<A> \<in> reachable_constraints P1" for \<A> using that
   proof (induction \<A> rule: reachable_constraints.induct)
     case (step \<A> T \<xi> \<sigma> \<alpha>)
     obtain \<B> where IH: "\<B> \<in> reachable_constraints P2" "unlabel \<A> = unlabel \<B>"
       by (meson step.IH)
     
     obtain T' where T': "T' \<in> set P2" "transaction_unlabel_eq T T'"
       using list_all2_in_set_ex[OF Peq step.hyps(2)] by auto
 
     show ?case
       using 3[OF T'(2), of "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] IH(2) reachable_constraints.step[OF IH(1) T'(1)]
             2[OF T'(2) IH(2)] step.hyps(3-5)
       by (metis unlabel_append[of \<A>] unlabel_append[of \<B>])
   qed (simp add: unlabel_def)
   thus "\<A> \<in> ?A \<Longrightarrow> \<A> \<in> ?B" for \<A> by fast
 
   have "\<exists>\<B> \<in> reachable_constraints P1. unlabel \<A> = unlabel \<B>"
     when "\<A> \<in> reachable_constraints P2" for \<A> using that
   proof (induction \<A> rule: reachable_constraints.induct)
     case (step \<A> T \<xi> \<sigma> \<alpha>)
     obtain \<B> where IH: "\<B> \<in> reachable_constraints P1" "unlabel \<A> = unlabel \<B>"
       by (meson step.IH)
     
     obtain T' where T': "T' \<in> set P1" "transaction_unlabel_eq T T'"
       using list_all2_in_set_ex[OF Peq' step.hyps(2)] by auto
 
     show ?case
       using 3[OF T'(2), of "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] IH(2) reachable_constraints.step[OF IH(1) T'(1)]
             2[OF T'(2) IH(2)] step.hyps(3-5)
       by (metis unlabel_append[of \<A>] unlabel_append[of \<B>])
   qed (simp add: unlabel_def)
   thus "\<A> \<in> ?B \<Longrightarrow> \<A> \<in> ?A" for \<A> by fast
 qed
 
 lemma reachable_constraints_set_eq:
   assumes "set P1 = set P2"
   shows "reachable_constraints P1 = reachable_constraints P2" (is "?A = ?B")
 proof (intro antisym subsetI)
   note 0 = assms transaction_renaming_subst_set_eq[OF assms]
   note 1 = reachable_constraints.intros
 
   show "\<A> \<in> ?A \<Longrightarrow> \<A> \<in> ?B" for \<A>
     by (induct \<A> rule: reachable_constraints.induct) (auto simp add: 0 intro: 1)
 
   show "\<A> \<in> ?B \<Longrightarrow> \<A> \<in> ?A" for \<A>
     by (induct \<A> rule: reachable_constraints.induct) (auto simp add: 0 intro: 1)
 qed
 
 lemma reachable_constraints_set_subst:
   assumes "set P1 = set P2"
     and "Q (reachable_constraints P1)"
   shows "Q (reachable_constraints P2)"
 by (rule subst[of _ _ Q, OF reachable_constraints_set_eq[OF assms(1)] assms(2)])
 
 lemma reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s:
   assumes "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)"
     and "\<A> \<in> reachable_constraints P"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
 using assms(2)
 proof (induction \<A> rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)"
     using assms(1) step.hyps(2) by blast
   hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     using transaction_decl_fresh_renaming_substs_range_wf_trms[OF step.hyps(3-5)]
     by (metis wf_trms_subst)
   hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     using wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_trms\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] by metis
   hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)))"
     using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq by blast
   thus ?case using step.IH unlabel_append[of \<A>] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] by auto
 qed simp
 
 lemma reachable_constraints_var_types_in_transactions:
   fixes \<A>::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>: "\<A> \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T).
               \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
   shows "\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` fv_transaction T)" (is "?A \<A>")
     and "\<Gamma>\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` bvars_transaction T)" (is "?B \<A>")
     and "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` vars_transaction T)" (is "?C \<A>")
 using \<A>
 proof (induction \<A> rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
   note 2 = transaction_decl_fresh_renaming_substs_wt[OF step.hyps(3-5)]
 
   have 3: "\<forall>t \<in> subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>). fv t = {} \<or> (\<exists>x. t = Var x)"
     using transaction_decl_fresh_renaming_substs_range'(1)[OF step.hyps(3-5)]
     by fastforce
 
   have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
        "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
        "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     unfolding T'_def
     by (metis fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq,
         metis bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq,
         metis vars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq)
   hence "\<Gamma> ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> \<Gamma> ` Var ` fv_transaction T"
         "\<Gamma> ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = \<Gamma> ` Var ` bvars_transaction T"
         "\<Gamma> ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> \<Gamma> ` Var ` vars_transaction T"
     using wt_subst_lsst_vars_type_subset[OF 2 3, of "transaction_strand T"]
     by argo+
   hence "\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> \<Gamma>\<^sub>v ` fv_transaction T"
         "\<Gamma>\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = \<Gamma>\<^sub>v ` bvars_transaction T"
         "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> \<Gamma>\<^sub>v ` vars_transaction T"
     by (metis \<Gamma>\<^sub>v_Var_image)+
   hence 4: "\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` fv_transaction T)"
            "\<Gamma>\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` bvars_transaction T)"
            "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` vars_transaction T)"
     using step.hyps(2) by fast+
 
   have 5: "\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> @ T') = (\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<union> (\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
           "\<Gamma>\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> @ T') = (\<Gamma>\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<union> (\<Gamma>\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
           "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> @ T') = (\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<union> (\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
     using unlabel_append[of \<A> T']
           fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel T'"]
           bvars\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel T'"]
           vars\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel T'"]
     by auto
 
   { case 1 thus ?case
       using step.IH(1) 4(1) 5(1)
       unfolding T'_def by (simp del: subst_subst_compose fv\<^sub>s\<^sub>s\<^sub>t_def)
   }
 
   { case 2 thus ?case
       using step.IH(2) 4(2) 5(2)
       unfolding T'_def by (simp del: subst_subst_compose bvars\<^sub>s\<^sub>s\<^sub>t_def)
   }
 
   { case 3 thus ?case
       using step.IH(3) 4(3) 5(3)
       unfolding T'_def by (simp del: subst_subst_compose)
   }
 qed simp_all
 
 lemma reachable_constraints_no_bvars:
   assumes \<A>: "\<A> \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = {}"
   shows "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
 using assms proof (induction)
   case init
   then show ?case 
     unfolding unlabel_def by auto
 next
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   then have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
     by metis
   moreover
   have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) = {}"
     using step by (metis bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq)
   ultimately 
   show ?case
     using bvars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append by (metis sup_bot.left_neutral)
 qed
 
 lemma reachable_constraints_fv_bvars_disj:
   fixes \<A>::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and P: "\<forall>S \<in> set P. admissible_transaction' S"
   shows "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
 proof -
   let ?X = "\<Union>T \<in> set P. bvars_transaction T"
 
   note 0 = admissible_transactions_fv_bvars_disj[OF P]
 
   have 1: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> ?X" using \<A>_reach
   proof (induction \<A> rule: reachable_constraints.induct)
     case (step \<A> T \<xi> \<sigma> \<alpha>)
     have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) = bvars_transaction T"
       using bvars\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel (transaction_strand T)" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
       by argo
     hence "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<subseteq> ?X"
       using step.hyps(2)
       by blast
     thus ?case
       using step.IH bvars\<^sub>s\<^sub>s\<^sub>t_append
       by auto
   qed (simp add: unlabel_def)
 
   have 2: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> ?X = {}" using \<A>_reach
   proof (induction \<A> rule: reachable_constraints.induct)
     case (step \<A> T \<xi> \<sigma> \<alpha>)
     have "x \<noteq> y" when x: "x \<in> ?X" and y: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" for x y
     proof -
       obtain y' where y': "y' \<in> fv_transaction T" "y \<in> fv ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y')"
         using y unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
         by (metis fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var)
 
       have "y \<notin> \<Union>(vars_transaction ` set P)"
         using transaction_decl_fresh_renaming_substs_range''[OF step.hyps(3-5) y'(2)]
               transaction_renaming_subst_range_notin_vars[OF step.hyps(5), of y']
         by auto
       thus ?thesis using x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t by fast
     qed
     hence "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<inter> ?X = {}"
       by blast
     thus ?case
       using step.IH
             fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"]
             unlabel_append[of \<A> "transaction_strand T"]
       by force
   qed (simp add: unlabel_def)
 
   show ?thesis using 0 1 2 by blast
 qed
 
 lemma reachable_constraints_vars_TAtom_typed:
   fixes \<A>::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and x: "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
   shows "\<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
 proof -
   have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P \<A>_reach)
 
   have T_adm: "admissible_transaction' T" when "T \<in> set P" for T
     by (meson that Ball_set P)
 
   have "\<forall>T\<in>set P. \<forall>x\<in>set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
     using protocol_transaction_vars_TAtom_typed(3) P by blast
   hence *: "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> (\<Union>T\<in>set P. \<Gamma>\<^sub>v ` vars_transaction T)"
     using reachable_constraints_var_types_in_transactions[of \<A> P, OF \<A>_reach] by auto
 
   have "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> TAtom ` insert Value (range Atom)"
   proof -
     have "\<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
       when "T \<in> set P" "x \<in> vars_transaction T" for T x
       using that protocol_transaction_vars_TAtom_typed(1)[of T] P
             admissible_transactionE(5)
       by blast
     hence "(\<Union>T\<in>set P. \<Gamma>\<^sub>v ` vars_transaction T) \<subseteq> TAtom ` insert Value (range Atom)"
       using P by blast
     thus "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> TAtom ` insert Value (range Atom)"
       using * by auto
   qed
   thus ?thesis using x by auto
 qed
 
 lemma reachable_constraints_vars_not_attack_typed:
   fixes \<A>::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T).
               \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
            "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T. \<not>TAtom AttackType \<sqsubseteq> \<Gamma>\<^sub>v x"
     and x: "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
   shows "\<not>TAtom AttackType \<sqsubseteq> \<Gamma>\<^sub>v x"
 using reachable_constraints_var_types_in_transactions(3)[OF \<A>_reach P(1)] P(2) x by fastforce
 
 lemma reachable_constraints_Value_vars_are_fv:
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and x: "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
     and "\<Gamma>\<^sub>v x = TAtom Value"
   shows "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
 proof -
   have "\<forall>T\<in>set P. bvars_transaction T = {}"
     using P admissible_transactionE(4) by metis
   hence \<A>_no_bvars: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
     using reachable_constraints_no_bvars[OF \<A>_reach] by metis
   thus ?thesis using x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"] by blast
 qed
 
 lemma reachable_constraints_subterms_subst:
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model \<I> \<A>"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
   shows "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>)) = (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
 proof -
   have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P \<A>_reach)
 
   from \<I> have \<I>': "welltyped_constraint_model \<I> \<A>"
     using welltyped_constraint_model_prefix by auto
 
   have 1: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). (\<exists>f. \<I> x = Fun f []) \<or> (\<exists>y. \<I> x = Var y)"
   proof
     fix x
     assume xa: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     have "\<exists>f T. \<I> x = Fun f T"
       using \<I> interpretation_grounds[of \<I> "Var x"]
       unfolding welltyped_constraint_model_def constraint_model_def
       by (cases "\<I> x") auto
     then obtain f T where fT_p: "\<I> x = Fun f T"
       by auto
     hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)"
       using \<I>
       unfolding welltyped_constraint_model_def constraint_model_def
       using wf_trm_subst_rangeD
       by metis
     moreover
     have "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
       using xa var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t[of x "unlabel \<A>"] vars_iff_subtermeq[of x]
       by auto
     hence "\<exists>a. \<Gamma>\<^sub>v x = TAtom a"
       using reachable_constraints_vars_TAtom_typed[OF \<A>_reach P] by blast
     hence "\<exists>a. \<Gamma> (Var x) = TAtom a"
       by simp
     hence "\<exists>a. \<Gamma> (Fun f T) = TAtom a"
       by (metis (no_types, opaque_lifting) \<I>' welltyped_constraint_model_def fT_p wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
     ultimately show "(\<exists>f. \<I> x = Fun f []) \<or> (\<exists>y. \<I> x = Var y)"
       using TAtom_term_cases fT_p by metis
   qed
 
   have "\<forall>T\<in>set P. bvars_transaction T = {}"
     using assms admissible_transactionE(4) by metis
   then have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
     using reachable_constraints_no_bvars assms by metis
   then have 2: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> subst_domain \<I> = {}"
     by auto
 
   show ?thesis
     using subterms_subst_lsst[OF _ 2] 1
     by simp
 qed
 
 lemma reachable_constraints_val_funs_private':
   fixes \<A>::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction_terms T"
            "\<forall>T \<in> set P. transaction_decl T () = []"
            "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
     and f: "f \<in> \<Union>(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
   shows "\<not>is_PubConstValue f"
     and "\<not>is_Abs f"
 proof -
   have "\<not>is_PubConstValue f \<and> \<not>is_Abs f" using \<A>_reach f
   proof (induction \<A> rule: reachable_constraints.induct)
     case (step \<A> T \<xi> \<sigma> \<alpha>)
     let ?T' = "unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
     let ?T'' = "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
     note \<xi>_empty =
       admissible_transaction_decl_subst_empty'[OF bspec[OF P(2) step.hyps(2)] step.hyps(3)]
 
     have T: "admissible_transaction_terms T"
       using P(1) step.hyps(2) by metis
 
     have T_fresh: "\<forall>x \<in> set (transaction_fresh T). fst x = TAtom Value" when "T \<in> set P" for T
       using P that admissible_transactionE(14) unfolding list_all_iff \<Gamma>\<^sub>v_TAtom'' by fast
 
     show ?thesis using step
     proof (cases "f \<in> \<Union>(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)")
       case False
       then obtain t where t: "t \<in> trms\<^sub>s\<^sub>s\<^sub>t ?T'" "f \<in> funs_term t"
         using step.prems trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of ?T'']
               trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T'')"]
               unlabel_append[of \<A> "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T''"] unlabel_subst[of "transaction_strand T"]
         by fastforce
       show ?thesis using trms\<^sub>s\<^sub>s\<^sub>t_funs_term_cases[OF t]
       proof
         assume "\<exists>u \<in> trms_transaction T. f \<in> funs_term u"
         thus ?thesis
           using conjunct1[OF conjunct2[OF T[unfolded admissible_transaction_terms_def]]]
           unfolding is_PubConstValue_def by blast
       next
         assume "\<exists>x \<in> fv_transaction T. f \<in> funs_term ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x)"
         then obtain x where "x \<in> fv_transaction T" "f \<in> funs_term ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x)" by moura
         thus ?thesis
           using transaction_decl_fresh_renaming_substs_range'(3)[
                   OF step.hyps(3-5) _ \<xi>_empty T_fresh[OF step.hyps(2), unfolded \<Gamma>\<^sub>v_TAtom''(2)]]
           unfolding is_PubConstValue_def
           by (metis (no_types, lifting) funs_term_Fun_subterm prot_fun.disc(30,48) subst_imgI
                 subtermeq_Var_const(2) term.distinct(1) term.inject(2) term.set_cases(1))
       qed
     qed simp
   qed simp
   thus "\<not>is_PubConstValue f" "\<not>is_Abs f" by simp_all
 qed
 
 lemma reachable_constraints_val_funs_private:
   fixes \<A>::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and f: "f \<in> \<Union>(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
   shows "\<not>is_PubConstValue f"
     and "\<not>is_Abs f"
 using P reachable_constraints_val_funs_private'[OF \<A>_reach _ _ _ f]
       admissible_transaction_is_wellformed_transaction(4)
       admissible_transactionE(1,14)
 unfolding list_all_iff \<Gamma>\<^sub>v_TAtom''
 by (blast,fast)
 
 lemma reachable_constraints_occurs_fact_ik_case:
   fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>_reach: "A \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and occ: "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
   shows "\<exists>n. t = Fun (Val n) []"
 using \<A>_reach occ
 proof (induction A rule: reachable_constraints.induct)
   case (step A T \<xi> \<sigma> \<alpha>)
   define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   have T_adm: "admissible_transaction' T" using P step.hyps(2) by blast
   hence T: "wellformed_transaction T" "admissible_transaction_occurs_checks T"
     using admissible_transaction_is_wellformed_transaction(1) P_occ step.hyps(2) by (blast,blast)
 
   have T_fresh: "\<forall>x \<in> set (transaction_fresh T). fst x = TAtom Value"
     using admissible_transactionE(14)[OF T_adm] unfolding list_all_iff by fast
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T_adm step.hyps(3)]
 
   have \<xi>_dom_empty: "z \<notin> fst ` set (transaction_decl T ())" for z
     using transaction_decl_subst_empty_inv[OF step.hyps(3)[unfolded \<xi>_empty]] by simp
 
   show ?case
   proof (cases "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A")
     case False
     hence "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
       using step.prems unfolding \<theta>_def by simp
     hence "\<exists>ts. occurs t \<in> set ts \<and>
                 receive\<langle>ts\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
       unfolding ik\<^sub>s\<^sub>s\<^sub>t_def by force
     hence "\<exists>ts. occurs t \<in> set ts \<and>
                 send\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
       using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(1) by blast
     then obtain ts s where s:
         "s \<in> set ts" "send\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T))" "s \<cdot> \<theta> = occurs t"
       using stateful_strand_step_mem_substD(1)[of _ "unlabel (transaction_strand T)" \<theta>]
             unlabel_subst[of "transaction_strand T" \<theta>]
       by force
 
     note 0 = transaction_decl_fresh_renaming_substs_range[OF step.hyps(3-5)]
 
     have 1: "send\<langle>ts\<rangle> \<in> set (unlabel (transaction_send T))"
       using s(2) wellformed_transaction_strand_unlabel_memberD(8)[OF T(1)] by blast
 
     have 2: "is_Send (send\<langle>ts\<rangle>)"
       unfolding is_Send_def by simp
 
     have 3: "\<exists>u. s = occurs u"
     proof -
       { fix z
         have "(\<exists>n. \<theta> z = Fun (Val n) []) \<or> (\<exists>y. \<theta> z = Var y)"
           using 0(3,4) T_fresh \<xi>_dom_empty unfolding \<theta>_def by blast
         hence "\<nexists>u. \<theta> z = occurs u" "\<theta> z \<noteq> Fun OccursSec []" by auto
       } note * = this
 
       obtain u u' where T: "s = Fun OccursFact [u,u']"
         using *(1) s(3) by (cases s) auto
       thus ?thesis using *(2) s(3) by (cases u) auto
     qed
 
     obtain x where x: "x \<in> set (transaction_fresh T)" "s = occurs (Var x)"
       using 3 s(1) admissible_transaction_occurs_checksE4[OF T(2) 1] by metis
     
     have "t = \<theta> x"
       using s(3) x(2) by auto
     thus ?thesis
       using 0(3)[OF \<xi>_dom_empty x(1)] x(1) T_fresh unfolding \<theta>_def by fast
   qed (simp add: step.IH)
 qed simp
 
 lemma reachable_constraints_occurs_fact_send_ex:
   fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>_reach: "A \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and x: "\<Gamma>\<^sub>v x = TAtom Value" "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
   shows "\<exists>ts. occurs (Var x) \<in> set ts \<and> send\<langle>ts\<rangle> \<in> set (unlabel A)"
 using \<A>_reach x(2)
 proof (induction A rule: reachable_constraints.induct)
   case (step A T \<xi> \<sigma> \<alpha>)
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF bspec[OF P step.hyps(2)] step.hyps(3)]
   note T = bspec[OF P_occ step.hyps(2)]
   
   show ?case
   proof (cases "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A")
     case True
     show ?thesis
       using step.IH[OF True] unlabel_append[of A]
       by auto
   next
     case False
     then obtain y where y:
         "y \<in> fv_transaction T - set (transaction_fresh T)" "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y = Var x"
       using transaction_decl_fresh_renaming_substs_fv[OF step.hyps(3-5), of x]
             step.prems(1) fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A"] unlabel_append[of A]
       by auto
     
     have "\<sigma> y = Var y" using y(1) step.hyps(4) unfolding transaction_fresh_subst_def by auto
     hence "\<alpha> y = Var x" using y(2) unfolding subst_compose_def \<xi>_empty by simp
     hence y_val: "fst y = TAtom Value" "\<Gamma>\<^sub>v y = TAtom Value"
       using x(1) \<Gamma>\<^sub>v_TAtom''[of x] \<Gamma>\<^sub>v_TAtom''[of y]
             wt_subst_trm''[OF transaction_renaming_subst_wt[OF step.hyps(5)], of "Var y"]
       by force+
 
     obtain ts where ts:
         "occurs (Var y) \<in> set ts" "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_receive T))"
       using admissible_transaction_occurs_checksE1[OF T y(1) y_val(2)]
       by (metis list.set_intros(1) unlabel_Cons(1)) 
     hence "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T))" 
       using transaction_strand_subsets(5) by blast
     hence *: "receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>\<rangle> \<in> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
       using unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             stateful_strand_step_subst_inI(2)[of _ _ "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] 
       by force
 
     have "occurs (Var y) \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = occurs (Var x)"
       using y(2) by (auto simp del: subst_subst_compose)
     hence **: "occurs (Var x) \<in> set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" using ts(1) by force
 
     have "send\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)))"
       using * dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) by blast
     thus ?thesis using ** unlabel_append[of A] by force
   qed
 qed simp
 
 lemma reachable_constraints_db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_args_empty:
   assumes \<A>: "\<A> \<in> reachable_constraints P"
     and PP: "list_all wellformed_transaction P"
     and admissible_transaction_updates:
       "let f = (\<lambda>T. \<forall>x \<in> set (unlabel (transaction_updates T)).
                       is_Update x \<and> is_Var (the_elem_term x) \<and> is_Fun_Set (the_set_term x) \<and>
                       fst (the_Var (the_elem_term x)) = TAtom Value)
       in list_all f P"
     and d: "(t, s) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
   shows "\<exists>ss. s = Fun (Set ss) []"
   using \<A> d
 proof (induction)
   case (step \<A> TT \<xi> \<sigma> \<alpha>)
   let ?TT = "transaction_strand TT \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
   let ?TTu = "unlabel ?TT"
   let ?TTd = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?TT"
   let ?TTdu = "unlabel ?TTd"
 
   from step(6) have "(t, s) \<in> set (db'\<^sub>s\<^sub>s\<^sub>t ?TTdu \<I> (db'\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> []))"
     by (metis db\<^sub>s\<^sub>s\<^sub>t_append db\<^sub>s\<^sub>s\<^sub>t_def step.prems unlabel_append)
   hence "(t, s) \<in> set (db'\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> []) \<or>
     (\<exists>t' s'. insert\<langle>t',s'\<rangle> \<in> set ?TTdu \<and> t = t' \<cdot> \<I> \<and> s = s' \<cdot> \<I>)"
     using db\<^sub>s\<^sub>s\<^sub>t_in_cases[of t "s" ?TTdu \<I>] by metis 
   thus ?case
   proof
     assume "\<exists>t' s'. insert\<langle>t',s'\<rangle> \<in> set ?TTdu \<and> t = t' \<cdot> \<I> \<and> s = s' \<cdot> \<I>"
     then obtain t' s' where t's'_p: "insert\<langle>t',s'\<rangle> \<in> set ?TTdu" "t = t' \<cdot> \<I>" "s = s' \<cdot> \<I>" by metis
     then obtain lll where "(lll, insert\<langle>t',s'\<rangle>) \<in> set ?TTd" by (meson unlabel_mem_has_label)
     hence "(lll, insert\<langle>t',s'\<rangle>) \<in> set (transaction_strand TT \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(4) by blast
     hence "insert\<langle>t',s'\<rangle> \<in> set ?TTu" by (meson unlabel_in)
     hence "insert\<langle>t',s'\<rangle> \<in> set ((unlabel (transaction_strand TT)) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       by (simp add: subst_lsst_unlabel)
     hence "insert\<langle>t',s'\<rangle> \<in> (\<lambda>x. x \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` set (unlabel (transaction_strand TT))"
       unfolding subst_apply_stateful_strand_def by auto
     then obtain u where
         "u \<in> set (unlabel (transaction_strand TT)) \<and> u \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = insert\<langle>t',s'\<rangle>"
       by auto
     hence "\<exists>t'' s''. insert\<langle>t'',s''\<rangle> \<in> set (unlabel (transaction_strand TT)) \<and>
                    t' = t'' \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<and> s' = s'' \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
       by  (cases u) auto
     then obtain t'' s'' where t''s''_p:
         "insert\<langle>t'',s''\<rangle> \<in> set (unlabel (transaction_strand TT)) \<and>
           t' = t'' \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<and> s' = s'' \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
       by auto
     hence "insert\<langle>t'',s''\<rangle> \<in> set (unlabel (transaction_updates TT))"
       using is_Update_in_transaction_updates[of "insert\<langle>t'',s''\<rangle>" TT]
       using PP step(2) unfolding list_all_iff by auto
     moreover have "\<forall>x\<in>set (unlabel (transaction_updates TT)). is_Fun_Set (the_set_term x)"
       using step(2) admissible_transaction_updates unfolding is_Fun_Set_def list_all_iff by auto
     ultimately have "is_Fun_Set (the_set_term (insert\<langle>t'',s''\<rangle>))" by auto
     moreover have "s' = s'' \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" using t''s''_p by blast
     ultimately have "is_Fun_Set (the_set_term (insert\<langle>t',s'\<rangle>))" by (auto simp add: is_Fun_Set_subst)
     hence "is_Fun_Set s" by (simp add: t's'_p(3) is_Fun_Set_subst)
     thus ?case using is_Fun_Set_exi by auto
   qed (auto simp add: step db\<^sub>s\<^sub>s\<^sub>t_def)
 qed auto
 
 lemma reachable_constraints_occurs_fact_ik_ground:
   fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>_reach: "A \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and t: "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
   shows "fv (occurs t) = {}"
 proof -
   have 0: "admissible_transaction' T"
     when "T \<in> set P" for T
     using P that unfolding list_all_iff by simp
 
   note 1 = admissible_transaction_is_wellformed_transaction(1)[OF 0] bspec[OF P_occ]
 
   have 2: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) =
            (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<union> (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
     when "T \<in> set P" for T \<theta> and A::"('fun,'atom,'sets,'lbl) prot_constr"
     using dual_transaction_ik_is_transaction_send'[OF 1(1)[OF that]] by fastforce
 
   show ?thesis using \<A>_reach t
   proof (induction A rule: reachable_constraints.induct)
     case (step A T \<xi> \<sigma> \<alpha>)
     note \<xi>_empty = admissible_transaction_decl_subst_empty[OF 0[OF step.hyps(2)] step.hyps(3)]
 
     from step show ?case
     proof (cases "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A")
       case False
       hence "occurs t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
         using 2[OF step.hyps(2)] step.prems \<xi>_empty by blast
       then obtain ts where ts:
           "occurs t \<in> set ts" "send\<langle>ts\<rangle> \<in> set (unlabel (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
         using wellformed_transaction_send_receive_subst_trm_cases(2)[OF 1(1)[OF step.hyps(2)]]
         by blast
       then obtain ts' s where s:
           "occurs s \<in> set ts'" "send\<langle>ts'\<rangle> \<in> set (unlabel (transaction_send T))" "t = s \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
         using transaction_decl_fresh_renaming_substs_occurs_fact_send_receive(1)[
                 OF step.hyps(3-5) 0[OF step.hyps(2)] ts(1)]
               transaction_strand_subst_subsets(8)[of T "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
         by blast
 
       obtain x where x: "x \<in> set (transaction_fresh T)" "s = Var x"
         using admissible_transaction_occurs_checksE4[OF 1(2)[OF step.hyps(2)] s(2,1)] by metis
 
       have "fv t = {}"
         using transaction_decl_fresh_renaming_substs_range(2)[OF step.hyps(3-5) _ x(1)]
               s(3) x(2) transaction_decl_subst_empty_inv[OF step.hyps(3)[unfolded \<xi>_empty]]
         by (auto simp del: subst_subst_compose)
       thus ?thesis by simp
     qed simp
   qed simp
 qed
 
 lemma reachable_constraints_occurs_fact_ik_funs_terms:
   fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>_reach: "A \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model I A"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
   shows "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I). OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana s)))" (is "?A A")
     and "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I). OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana s)))" (is "?B A")
     and "Fun OccursSec [] \<notin> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I" (is "?C A")
     and "\<forall>x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. I x \<noteq> Fun OccursSec []" (is "?D A")
 proof -
   have T_adm: "admissible_transaction' T" when "T \<in> set P" for T
     using P that unfolding list_all_iff by simp
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
 
   note T_occ = bspec[OF P_occ]
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T_adm]
 
   have \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" by (metis \<I> welltyped_constraint_model_def)
 
   have \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
     by (metis \<I> welltyped_constraint_model_def constraint_model_def)
 
   have \<I>_grounds: "fv (I x) = {}" "\<exists>f T. I x = Fun f T" for x
     using \<I> interpretation_grounds[of I, of "Var x"] empty_fv_exists_fun[of "I x"]
     unfolding welltyped_constraint_model_def constraint_model_def by auto
 
   have 00: "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<subseteq> vars_transaction T"
            "fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))) = fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))"
     for T::"('fun,'atom,'sets,'lbl) prot_transaction"
     using fv_trms\<^sub>s\<^sub>s\<^sub>t_subset(1)[of "unlabel (transaction_send T)"] vars_transaction_unfold
           fv_subterms_set[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"]
     by blast+
 
   have 0: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). \<exists>a. \<Gamma> (Var x) = TAtom a"
           "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). \<Gamma> (Var x) \<noteq> TAtom OccursSecType"
           "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))). \<exists>a. \<Gamma> (Var x) = TAtom a"
           "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))). \<Gamma> (Var x) \<noteq> TAtom OccursSecType"
           "\<forall>x \<in> vars_transaction T. \<exists>a. \<Gamma> (Var x) = TAtom a"
           "\<forall>x \<in> vars_transaction T. \<Gamma> (Var x) \<noteq> TAtom OccursSecType"
     when "T \<in> set P" for T
     using admissible_transaction_occurs_fv_types[OF T_adm[OF that]] 00
     by blast+
 
   note T_fresh_type = admissible_transactionE(2)[OF T_adm]
 
   have 1: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<cdot>\<^sub>s\<^sub>e\<^sub>t I =
            (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<union> (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<cdot>\<^sub>s\<^sub>e\<^sub>t I)"
     when "T \<in> set P" for T \<theta> and A::"('fun,'atom,'sets,'lbl) prot_constr"
     using dual_transaction_ik_is_transaction_send'[OF T_wf[OF that]]
     by fastforce
 
   have 2: "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<cdot>\<^sub>s\<^sub>e\<^sub>t I) =
            subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
     when "T \<in> set P" 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>)" for T \<theta>
     using wt_subst_TAtom_subterms_set_subst[OF wt_subst_compose[OF \<theta>(1) \<I>_wt] 0(1)[OF that(1)]]
           wf_trm_subst_rangeD[OF wf_trms_subst_compose[OF \<theta>(2) \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s]]
     by auto
 
   have 3: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     when "T \<in> set P" "transaction_decl_subst \<xi> T"
          "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
     for \<xi> \<sigma> \<alpha> and T::"('fun,'atom,'sets,'lbl) prot_transaction"
       and A::"('fun,'atom,'sets,'lbl) prot_constr"
     using protocol_transaction_vars_TAtom_typed(3)[of T] P that(1)
           transaction_decl_fresh_renaming_substs_wt[OF that(2-4)]
           transaction_decl_fresh_renaming_substs_range_wf_trms[OF that(2-4)]
           wf_trms_subst_compose
     by simp_all
 
   have 4: "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)).
               OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana s))) \<and>
               OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
     when T: "T \<in> set P" for T
   proof
     fix t assume t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))"
     then obtain ts s where s:
         "send\<langle>ts\<rangle> \<in> set (unlabel (transaction_send T))" "s \<in> set ts" "t \<in> subterms s"
       using wellformed_transaction_unlabel_cases(4)[OF T_wf[OF T]]
       by fastforce
 
     have s_occ: "\<exists>x. s = occurs (Var x)" when "OccursFact \<in> funs_term t \<or> OccursSec \<in> funs_term t"
       using that s(1) subtermeq_imp_funs_term_subset[OF s(3)]
             admissible_transaction_occurs_checksE3[OF T_occ[OF T] _ s(2)]
       by blast
 
     obtain K T' where K: "Ana t = (K,T')" by moura
 
     show "OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana t))) \<and>
           OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana t)))"
     proof (rule ccontr)
       assume "\<not>(OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana t))) \<and>
                 OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana t))))"
       hence a: "OccursFact \<in> \<Union>(funs_term ` set (snd (Ana t))) \<or>
                 OccursSec \<in> \<Union>(funs_term ` set (snd (Ana t)))"
         by simp
       hence "OccursFact \<in> \<Union>(funs_term ` set T') \<or> OccursSec \<in> \<Union>(funs_term ` set T')"
         using K by simp
       hence "OccursFact \<in> funs_term t \<or> OccursSec \<in> funs_term t"
         using Ana_subterm[OF K] funs_term_subterms_eq(1)[of t] by blast
       then obtain x where x: "t \<in> subterms (occurs (Var x))"
         using s(3) s_occ by blast
       thus False using a by fastforce
     qed
   qed
 
   have 5: "OccursFact \<notin> \<Union>(funs_term ` subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
           "OccursSec \<notin> \<Union>(funs_term ` subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
       when \<xi>\<sigma>\<alpha>: "transaction_decl_subst \<xi> T" "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
                 "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
       and T: "T \<in> set P"
     for \<xi> \<sigma> \<alpha> and T::"('fun,'atom,'sets,'lbl) prot_transaction"
       and A::"('fun,'atom,'sets,'lbl) prot_constr"
   proof -
     have "OccursFact \<notin> funs_term t" "OccursSec \<notin> funs_term t"
       when "t \<in> subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" for t 
       using transaction_decl_fresh_renaming_substs_range'(3)[
               OF \<xi>\<sigma>\<alpha> that \<xi>_empty[OF T \<xi>\<sigma>\<alpha>(1)] T_fresh_type[OF T]]
       by auto
     thus "OccursFact \<notin> \<Union>(funs_term ` subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
          "OccursSec \<notin> \<Union>(funs_term ` subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
       by blast+
   qed
 
   have 6: "I x \<noteq> Fun OccursSec []" "\<nexists>t. I x = occurs t" "\<exists>a. \<Gamma> (I x) = TAtom a \<and> a \<noteq> OccursSecType"
     when T: "T \<in> set P"
       and \<xi>\<sigma>\<alpha>: "transaction_decl_subst \<xi> T" "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
                "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
       and x: "Var x \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
     for x \<xi> \<sigma> \<alpha> and T::"('fun,'atom,'sets,'lbl) prot_transaction"
       and A::"('fun,'atom,'sets,'lbl) prot_constr"
   proof -
     obtain t where t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "t \<cdot> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = Var x"
       using x by moura
     then obtain y where y: "t = Var y" by (cases t) auto
 
     have "\<exists>a. \<Gamma> t = TAtom a \<and> a \<noteq> OccursSecType"
       using 0(1,2)[OF T] t(1) y
       by force
     thus "\<exists>a. \<Gamma> (I x) = TAtom a \<and> a \<noteq> OccursSecType"
       using wt_subst_trm''[OF 3(1)[OF T \<xi>\<sigma>\<alpha>]] wt_subst_trm''[OF \<I>_wt] t(2) 
-      by (metis subst_apply_term.simps(1))
+      by (metis eval_term.simps(1))
     thus "I x \<noteq> Fun OccursSec []" "\<nexists>t. I x = occurs t"
       by auto
   qed
 
   have 7: "I x \<noteq> Fun OccursSec []" "\<nexists>t. I x = occurs t" "\<exists>a. \<Gamma> (I x) = TAtom a \<and> a \<noteq> OccursSecType"
     when T: "T \<in> set P"
       and \<xi>\<sigma>\<alpha>: "transaction_decl_subst \<xi> T" "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
                "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
       and x: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` vars_transaction T)"
     for x \<xi> \<sigma> \<alpha> and T::"('fun,'atom,'sets,'lbl) prot_transaction"
       and A::"('fun,'atom,'sets,'lbl) prot_constr"
   proof -
     obtain y where y: "y \<in> vars_transaction T" "x \<in> fv ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y)"
       using x by auto
     hence y': "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y = Var x"
       using transaction_decl_fresh_renaming_substs_range'(3)[
               OF \<xi>\<sigma>\<alpha> _ \<xi>_empty[OF T \<xi>\<sigma>\<alpha>(1)] T_fresh_type[OF T]]
       by (cases "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<in> subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)") force+
 
     have "\<exists>a. \<Gamma> (Var y) = TAtom a \<and> a \<noteq> OccursSecType"
       using 0(5,6)[OF T] y
       by force
     thus "\<exists>a. \<Gamma> (I x) = TAtom a \<and> a \<noteq> OccursSecType"
       using wt_subst_trm''[OF 3(1)[OF T \<xi>\<sigma>\<alpha>]] wt_subst_trm''[OF \<I>_wt] y'
-      by (metis subst_apply_term.simps(1))
+      by (metis eval_term.simps(1))
     thus "I x \<noteq> Fun OccursSec []" "\<nexists>t. I x = occurs t"
       by auto
   qed
 
   have 8: "I x \<noteq> Fun OccursSec []" "\<nexists>t. I x = occurs t" "\<exists>a. \<Gamma> (I x) = TAtom a \<and> a \<noteq> OccursSecType"
     when T: "T \<in> set P"
       and \<xi>\<sigma>\<alpha>: "transaction_decl_subst \<xi> T" "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
                "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
       and x: "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
     for x \<xi> \<sigma> \<alpha> and T::"('fun,'atom,'sets,'lbl) prot_transaction"
       and A::"('fun,'atom,'sets,'lbl) prot_constr"
   proof -
     obtain t where t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" "t \<cdot> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = Var x"
       using x by moura
     then obtain y where y: "t = Var y" by (cases t) auto
 
     have "\<exists>a. \<Gamma> t = TAtom a \<and> a \<noteq> OccursSecType"
       using 0(3,4)[OF T] t(1) y
       by force
     thus "\<exists>a. \<Gamma> (I x) = TAtom a \<and> a \<noteq> OccursSecType"
       using wt_subst_trm''[OF 3(1)[OF T \<xi>\<sigma>\<alpha>]] wt_subst_trm''[OF \<I>_wt] t(2) 
-      by (metis subst_apply_term.simps(1))
+      by (metis eval_term.simps(1))
     thus "I x \<noteq> Fun OccursSec []" "\<nexists>t. I x = occurs t"
       by auto
   qed
 
   have s_fv: "fv s \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` vars_transaction T)"
     when s: "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
       and T: "T \<in> set P"
     for s and \<xi> \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
       and T::"('fun,'atom,'sets,'lbl) prot_transaction"
   proof
     fix x assume "x \<in> fv s"
     hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       using s by auto
     hence *: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       using fv_subterms_set_subst' by fast
     have **: "list_all is_Send (unlabel (transaction_send T))"
       using T_wf[OF T] unfolding wellformed_transaction_def by blast
     have "x \<in> fv\<^sub>s\<^sub>e\<^sub>t ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))"
     proof -
       obtain t where t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "x \<in> fv (t \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
         using * by fastforce
       hence "fv t \<subseteq> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
         using fv_trms\<^sub>s\<^sub>s\<^sub>t_subset(1)[of "unlabel (transaction_send T)"]
         by auto
       thus ?thesis using t(2) subst_apply_fv_subset by fast
     qed
     thus "x \<in> fv\<^sub>s\<^sub>e\<^sub>t ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` vars_transaction T)"
       using vars_transaction_unfold[of T] by fastforce
   qed
 
   show "?A A" using \<A>_reach
   proof (induction A rule: reachable_constraints.induct)
     case (step A T \<xi> \<sigma> \<alpha>)
     have *: "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)).
               OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
       using 4[OF step.hyps(2)] by blast
 
     have "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<cdot>\<^sub>s\<^sub>e\<^sub>t I.
             OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
     proof
       fix t assume t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
       then obtain s u where su:
           "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" "s \<cdot> I = t"
           "u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" "u \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = s"
         by force
 
       obtain Ku Tu where KTu: "Ana u = (Ku,Tu)" by moura
       
       have *: "OccursFact \<notin> \<Union>(funs_term ` set Tu)"
               "OccursFact \<notin> \<Union>(funs_term ` subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
               "OccursFact \<notin> \<Union>(funs_term ` \<Union>(((set \<circ> snd \<circ> Ana) ` subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))))"
         using transaction_decl_fresh_renaming_substs_range'(3)[
                 OF step.hyps(3-5) _ \<xi>_empty[OF step.hyps(2,3)] T_fresh_type[OF step.hyps(2)]]
               4[OF step.hyps(2)] su(3) KTu
         by (fastforce,fastforce,fastforce)
 
       have "OccursFact \<notin> \<Union>(funs_term ` set (Tu \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
       proof -
         { fix f assume f: "f \<in> \<Union>(funs_term ` set (Tu \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
           then obtain tf where tf: "tf \<in> set Tu" "f \<in> funs_term (tf \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" by moura
           hence "f \<in> funs_term tf \<or> f \<in> \<Union>(funs_term ` subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
             using funs_term_subst[of tf "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] by force
           hence "f \<noteq> OccursFact" using *(1,2) tf(1) by blast
         } thus ?thesis by metis
       qed
       hence **: "OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
       proof (cases u)
         case (Var xu)
-        hence "s = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) xu" using su(4) by (metis subst_apply_term.simps(1))
+        hence "s = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) xu" using su(4) by (metis eval_term.simps(1))
         thus ?thesis using *(3) by fastforce
       qed (use su(4) KTu Ana_subst'[of _ _ Ku Tu "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] in simp)
       
       show "OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana t)))"
       proof (cases s)
         case (Var sx)
         then obtain a where a: "\<Gamma> (I sx) = Var a"
           using su(1) 8(3)[OF step.hyps(2-5), of sx] by fast
         hence "Ana (I sx) = ([],[])" by (metis \<I>_grounds(2) const_type_inv[THEN Ana_const])
         thus ?thesis using Var su(2) by simp
       next
         case (Fun f S)
         hence snd_Ana_t: "snd (Ana t) = snd (Ana s) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t I"
           using su(2) Ana_subst'[of f S _ "snd (Ana s)" I] by (cases "Ana s") simp_all
 
         { fix g assume "g \<in> \<Union>(funs_term ` set (snd (Ana t)))"
           hence "g \<in> \<Union>(funs_term ` set (snd (Ana s))) \<or>
                  (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s))). g \<in> funs_term (I x))"
             using snd_Ana_t funs_term_subst[of _ I] by auto
           hence "g \<noteq> OccursFact"
           proof
             assume "\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s))). g \<in> funs_term (I x)"
             then obtain x where x: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s)))" "g \<in> funs_term (I x)" by moura
             have "x \<in> fv s" using x(1) Ana_vars(2)[of s] by (cases "Ana s") auto
             hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` vars_transaction T)"
               using s_fv[OF su(1) step.hyps(2)] by blast
             then obtain a h U where h:
                 "I x = Fun h U" "\<Gamma> (I x) = Var a" "a \<noteq> OccursSecType" "arity h = 0"
               using \<I>_grounds(2) 7(3)[OF step.hyps(2-5)] const_type_inv
               by metis
             hence "h \<noteq> OccursFact" by auto
             moreover have "U = []" using h(1,2,4) const_type_inv_wf[of h U a] \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s by fastforce
             ultimately show ?thesis using h(1) x(2) by auto
           qed (use ** in blast)
         } thus ?thesis by blast
       qed
     qed
     thus ?case
       using step.IH step.prems 1[OF step.hyps(2), of A "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             2[OF step.hyps(2) 3[OF step.hyps(2-5)]]
       by auto
   qed simp
 
   show "?B A" using \<A>_reach
   proof (induction A rule: reachable_constraints.induct)
     case (step A T \<xi> \<sigma> \<alpha>)
     have "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<cdot>\<^sub>s\<^sub>e\<^sub>t I.
             OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
     proof
       fix t assume t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
       then obtain s u where su:
           "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" "s \<cdot> I = t"
           "u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" "u \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = s"
         by force
 
       obtain Ku Tu where KTu: "Ana u = (Ku,Tu)" by moura
       
       have *: "OccursSec \<notin> \<Union>(funs_term ` set Tu)"
               "OccursSec \<notin> \<Union>(funs_term ` subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
               "OccursSec \<notin> \<Union>(funs_term ` \<Union>(((set \<circ> snd \<circ> Ana) ` subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))))"
         using transaction_decl_fresh_renaming_substs_range'(3)[
                 OF step.hyps(3-5) _ \<xi>_empty[OF step.hyps(2,3)] T_fresh_type[OF step.hyps(2)]] 
               4[OF step.hyps(2)] su(3) KTu
         by (fastforce,fastforce,fastforce)
 
       have "OccursSec \<notin> \<Union>(funs_term ` set (Tu \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
       proof -
         { fix f assume f: "f \<in> \<Union>(funs_term ` set (Tu \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
           then obtain tf where tf: "tf \<in> set Tu" "f \<in> funs_term (tf \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" by moura
           hence "f \<in> funs_term tf \<or> f \<in> \<Union>(funs_term ` subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
             using funs_term_subst[of tf "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] by force
           hence "f \<noteq> OccursSec" using *(1,2) tf(1) by blast
         } thus ?thesis by metis
       qed
       hence **: "OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
       proof (cases u)
         case (Var xu)
-        hence "s = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) xu" using su(4) by (metis subst_apply_term.simps(1))
+        hence "s = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) xu" using su(4) by (metis eval_term.simps(1))
         thus ?thesis using *(3) by fastforce
       qed (use su(4) KTu Ana_subst'[of _ _ Ku Tu "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] in simp)
       
       show "OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana t)))"
       proof (cases s)
         case (Var sx)
         then obtain a where a: "\<Gamma> (I sx) = Var a"
           using su(1) 8(3)[OF step.hyps(2-5), of sx] by fast
         hence "Ana (I sx) = ([],[])" by (metis \<I>_grounds(2) const_type_inv[THEN Ana_const])
         thus ?thesis using Var su(2) by simp
       next
         case (Fun f S)
         hence snd_Ana_t: "snd (Ana t) = snd (Ana s) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t I"
           using su(2) Ana_subst'[of f S _ "snd (Ana s)" I] by (cases "Ana s") simp_all
 
         { fix g assume "g \<in> \<Union>(funs_term ` set (snd (Ana t)))"
           hence "g \<in> \<Union>(funs_term ` set (snd (Ana s))) \<or>
                  (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s))). g \<in> funs_term (I x))"
             using snd_Ana_t funs_term_subst[of _ I] by auto
           hence "g \<noteq> OccursSec"
           proof
             assume "\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s))). g \<in> funs_term (I x)"
             then obtain x where x: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s)))" "g \<in> funs_term (I x)" by moura
             have "x \<in> fv s" using x(1) Ana_vars(2)[of s] by (cases "Ana s") auto
             hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` vars_transaction T)"
               using s_fv[OF su(1) step.hyps(2)] by blast
             then obtain a h U where h:
                 "I x = Fun h U" "\<Gamma> (I x) = Var a" "a \<noteq> OccursSecType" "arity h = 0"
               using \<I>_grounds(2) 7(3)[OF step.hyps(2-5)] const_type_inv
               by metis
             hence "h \<noteq> OccursSec" by auto
             moreover have "U = []" using h(1,2,4) const_type_inv_wf[of h U a] \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s by fastforce
             ultimately show ?thesis using h(1) x(2) by auto
           qed (use ** in blast)
         } thus ?thesis by blast
       qed
     qed
     thus ?case
       using step.IH step.prems 1[OF step.hyps(2), of A "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             2[OF step.hyps(2) 3[OF step.hyps(2-5)]]
       by auto
   qed simp
 
   show "?C A" using \<A>_reach
   proof (induction A rule: reachable_constraints.induct)
     case (step A T \<xi> \<sigma> \<alpha>)
     have *: "Fun OccursSec [] \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
       using admissible_transaction_occurs_checksE5[OF T_occ[OF step.hyps(2)]] by blast
 
     have **: "Fun OccursSec [] \<notin> subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       using transaction_decl_fresh_renaming_substs_range'(3)[
               OF step.hyps(3-5) _ \<xi>_empty[OF step.hyps(2,3)] T_fresh_type[OF step.hyps(2)]]
       by auto
 
     have "Fun OccursSec [] \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
     proof
       assume "Fun OccursSec [] \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
       then obtain s where "s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" "s \<cdot> I = Fun OccursSec []"
         by moura
       moreover have "Fun OccursSec [] \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
       proof
         assume "Fun OccursSec [] \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
         then obtain u where "u \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "u \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = Fun OccursSec []"
           by moura
         thus False using * ** by (cases u) (force simp del: subst_subst_compose)+
       qed
       ultimately show False using 6[OF step.hyps(2-5)] by (cases s) auto
     qed
     thus ?case using step.IH step.prems 1[OF step.hyps(2), of A "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] by fast
   qed simp
 
   show "?D A" using \<A>_reach
   proof (induction A rule: reachable_constraints.induct)
     case (step A T \<xi> \<sigma> \<alpha>)
     { fix x assume x: "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
       hence x': "x \<in> vars\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
         by (metis vars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unlabel_subst)
       hence "x \<in> vars_transaction T \<or> x \<in> fv\<^sub>s\<^sub>e\<^sub>t ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` vars_transaction T)"
         using vars\<^sub>s\<^sub>s\<^sub>t_subst_cases[OF x'] by metis
       moreover have "I x \<noteq> Fun OccursSec []" when "x \<in> vars_transaction T"
         using that 0(5,6)[OF step.hyps(2)] wt_subst_trm''[OF \<I>_wt, of "Var x"]
         by fastforce
       ultimately have "I x \<noteq> Fun OccursSec []"
         using 7(1)[OF step.hyps(2-5), of x]
         by blast
     } thus ?case using step.IH by auto
   qed simp
 qed
 
 lemma reachable_constraints_occurs_fact_ik_subst_aux:
   assumes \<A>_reach: "A \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model I A"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and t: "t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "t \<cdot> I = occurs s"
   shows "\<exists>u. t = occurs u"
 proof -
   have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I"
     using \<I> unfolding welltyped_constraint_model_def constraint_model_def by metis
   hence 0: "\<Gamma> t = \<Gamma> (occurs s)"
     using t(2) wt_subst_trm'' by metis
 
   have 1: "\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` fv_transaction T)"
           "\<forall>T \<in> set P. \<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
     using reachable_constraints_var_types_in_transactions(1)[OF \<A>_reach]
           protocol_transaction_vars_TAtom_typed(2,3) P
     by fast+
 
   show ?thesis
   proof (cases t)
     case (Var x)
     thus ?thesis
       using 0 1 t(1) var_subterm_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of x "unlabel A"]
       by fastforce
   next
     case (Fun f T)
     hence 2: "f = OccursFact" "length T = Suc (Suc 0)" "T ! 0 \<cdot> I = Fun OccursSec []"
       using t(2) by auto
 
     have "T ! 0 = Fun OccursSec []"
     proof (cases "T ! 0")
       case (Var y)
       hence "I y = Fun OccursSec []" using Fun 2(3) by simp
       moreover have "Var y \<in> set T" using Var 2(2) length_Suc_conv[of T 1] by auto
       hence "y \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" using Fun t(1) by force
       hence "y \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
         using fv_ik_subset_fv_sst'[of "unlabel A"] vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel A"]
         by blast
       ultimately have False
         using reachable_constraints_occurs_fact_ik_funs_terms(4)[OF \<A>_reach \<I> P P_occ]
         by blast
       thus ?thesis by simp
     qed (use 2(3) in simp)
     moreover have "\<exists>u u'. T = [u,u']"
       using iffD1[OF length_Suc_conv 2(2)] iffD1[OF length_Suc_conv[of _ 0]] length_0_conv by fast
     ultimately show ?thesis using Fun 2(1,2) by force
   qed
 qed
 
 lemma reachable_constraints_occurs_fact_ik_subst:
   assumes \<A>_reach: "A \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model I A"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and t: "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
   shows "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
 proof -
   have \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I"
     using \<I> unfolding welltyped_constraint_model_def constraint_model_def by metis
 
   obtain s where s: "s \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "s \<cdot> I = occurs t"
     using t by auto
   hence u: "\<exists>u. s = occurs u"
     using \<I>_wt reachable_constraints_occurs_fact_ik_subst_aux[OF \<A>_reach \<I> P P_occ]
     by blast
   hence "fv s = {}"
     using reachable_constraints_occurs_fact_ik_ground[OF \<A>_reach P P_occ] s
     by fast
   thus ?thesis
     using s u subst_ground_ident[of s I] 
     by argo
 qed
 
 lemma reachable_constraints_occurs_fact_send_in_ik:
   assumes \<A>_reach: "A \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model I A"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and x: "occurs (Var x) \<in> set ts" "send\<langle>ts\<rangle> \<in> set (unlabel A)"
   shows "occurs (I x) \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
 using \<A>_reach \<I> x
 proof (induction A rule: reachable_constraints.induct)
   case (step A T \<xi> \<sigma> \<alpha>)
   define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
   define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 
   have T_adm: "admissible_transaction' T"
     using P step.hyps(2) unfolding list_all_iff by blast
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
   note T_adm_occ = bspec[OF P_occ]
 
   have \<I>_is_T_model: "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) (set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I)) (unlabel T') I"
     using step.prems unlabel_append[of A T'] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel A" I "[]"]
           strand_sem_append_stateful[of "{}" "{}" "unlabel A" "unlabel T'" I]
     by (simp add: T'_def \<theta>_def welltyped_constraint_model_def constraint_model_def db\<^sub>s\<^sub>s\<^sub>t_def)
 
   show ?case
   proof (cases "send\<langle>ts\<rangle> \<in> set (unlabel A)")
     case False
     hence "send\<langle>ts\<rangle> \<in> set (unlabel T')"
       using step.prems(3) unfolding T'_def \<theta>_def by simp
     hence "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
       using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) unfolding T'_def by blast
     then obtain y ts' where y:
         "receive\<langle>ts'\<rangle> \<in> set (unlabel (transaction_receive T))"
         "\<theta> y = Var x" "occurs (Var y) \<in> set ts'"
       using transaction_decl_fresh_renaming_substs_occurs_fact_send_receive(2)[
               OF step.hyps(3-5) T_adm]
             subst_to_var_is_var[of _ \<theta> x] step.prems(2)
-      unfolding \<theta>_def by (metis subst_apply_term.simps(1))
+      unfolding \<theta>_def by (metis eval_term.simps(1))
     hence "occurs (Var y) \<cdot> \<theta> \<in> set ts' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
           "receive\<langle>ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
       using subst_lsst_unlabel_member[of "receive\<langle>ts'\<rangle>" "transaction_receive T" \<theta>]
       by fastforce+
     hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> occurs (Var y) \<cdot> \<theta> \<cdot> I"
       using wellformed_transaction_sem_receives[
               OF T_wf, of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I" "set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I)" \<theta> I "ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>"]
             \<I>_is_T_model
       unfolding T'_def list_all_iff by fastforce
     hence *: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> occurs (\<theta> y \<cdot> I)"
       by auto
 
     have "occurs (\<theta> y \<cdot> I) \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
       using deduct_occurs_in_ik[OF *]
             reachable_constraints_occurs_fact_ik_subst[
               OF step.hyps(1) welltyped_constraint_model_prefix[OF step.prems(1)] P P_occ,
               of "\<theta> y \<cdot> I"]
             reachable_constraints_occurs_fact_ik_funs_terms[
               OF step.hyps(1) welltyped_constraint_model_prefix[OF step.prems(1)] P P_occ]
       by blast
     thus ?thesis using y(2) by simp
   qed (simp add: step.IH[OF welltyped_constraint_model_prefix[OF step.prems(1)]] step.prems(2))
 qed simp
 
 lemma reachable_constraints_occurs_fact_deduct_in_ik:
   assumes \<A>_reach: "A \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model I A"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and k: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> occurs k"
   shows "occurs k \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
     and "occurs k \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
 using reachable_constraints_occurs_fact_ik_funs_terms(1-3)[OF \<A>_reach \<I> P P_occ]
       reachable_constraints_occurs_fact_ik_subst[OF \<A>_reach \<I> P P_occ]
       deduct_occurs_in_ik[OF k]
 by (presburger, presburger)
 
 lemma reachable_constraints_fv_bvars_subset:
   assumes A: "A \<in> reachable_constraints P"
   shows "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<subseteq> (\<Union>T \<in> set P. bvars_transaction T)"
 using assms
 proof (induction A rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   let ?T' = "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   show ?case
     using step.IH step.hyps(2)
           bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of ?T']
           bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
           bvars\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T')"]
           unlabel_append[of \<A> "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T'"]
     by (metis (no_types, lifting) SUP_upper Un_subset_iff)
 qed simp
 
 lemma reachable_constraints_fv_disj:
   fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes A: "A \<in> reachable_constraints P"
   shows "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<inter> (\<Union>T \<in> set P. bvars_transaction T) = {}"
 using A
 proof (induction A rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   define T' where "T' \<equiv> transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" 
   define X where "X \<equiv> \<Union>T \<in> set P. bvars_transaction T"
   have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<inter> X = {}"
     using transaction_decl_fresh_renaming_substs_vars_disj(4)[OF step.hyps(3-5)]
           transaction_decl_fresh_renaming_substs_vars_subset(4)[OF step.hyps(3-5,2)]
     unfolding T'_def X_def by blast
   hence "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<inter> X = {}"
     using step.IH[unfolded X_def[symmetric]] fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of T'] by auto
   thus ?case unfolding T'_def X_def by blast
 qed simp
 
 (* TODO: this lemma subsumes reachable_constraints_fv_bvars_disj *)
 lemma reachable_constraints_fv_bvars_disj':
   fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes P: "\<forall>T \<in> set P. wellformed_transaction T"
     and A: "A \<in> reachable_constraints P"
   shows "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = {}"
 using A
 proof (induction A rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
   note 0 = transaction_decl_fresh_renaming_substs_vars_disj[OF step.hyps(3-5)]
   note 1 = transaction_decl_fresh_renaming_substs_vars_subset[OF step.hyps(3-5)]
 
   have 2: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = {}" 
     using 0(7) 1(4)[OF step.hyps(2)] fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq
     unfolding T'_def by (metis (no_types) disjoint_iff_not_equal subset_iff)
 
   have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> \<Union>(bvars_transaction ` set P)"
        "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> \<Union>(bvars_transaction ` set P) = {}"
     using reachable_constraints_fv_bvars_subset[OF reachable_constraints.step[OF step.hyps]]
           reachable_constraints_fv_disj[OF reachable_constraints.step[OF step.hyps]]
     unfolding T'_def by auto
   hence 3: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = {}" by blast
   
   have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<inter> bvars_transaction T = {}"
     using 0(4)[OF step.hyps(2)] 1(4)[OF step.hyps(2)] by blast
   hence 4: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = {}"
     by (metis (no_types) T'_def fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq
               unlabel_subst bvars\<^sub>s\<^sub>s\<^sub>t_subst)
 
   have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') = {}"
     using 2 3 4 step.IH
     unfolding unlabel_append[of \<A> T']
               fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel T'"]
               bvars\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel T'"]
     by fast
   thus ?case unfolding T'_def by blast
 qed simp
 
 lemma reachable_constraints_wf:
   assumes P:
       "\<forall>T \<in> set P. wellformed_transaction T"
       "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
     and A: "A \<in> reachable_constraints P"
   shows "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)"
 proof -
   let ?X = "\<lambda>T. fst ` set (transaction_decl T ()) \<union> set (transaction_fresh T)"
 
   have "wellformed_transaction T"
     when "T \<in> set P" for T
     using P(1) that by fast+
   hence 0: "wf'\<^sub>s\<^sub>s\<^sub>t (?X T) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))"
            "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) = {}"
            "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)"
     when T: "T \<in> set P" for T
     unfolding admissible_transaction_terms_def
     by (metis T wellformed_transaction_wf\<^sub>s\<^sub>s\<^sub>t(1),
         metis T wellformed_transaction_wf\<^sub>s\<^sub>s\<^sub>t(2) fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq,
         metis T wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code P(2))
 
   from A have "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)"
   proof (induction A rule: reachable_constraints.induct)
     case (step A T \<xi> \<sigma> \<alpha>)
     let ?T' = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
     have IH: "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 = {}" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
       using step.IH by metis+
 
     have 1: "wf'\<^sub>s\<^sub>s\<^sub>t {} (unlabel (A@?T'))"
       using transaction_decl_fresh_renaming_substs_wf_sst[OF 0(1)[OF step.hyps(2)] step.hyps(3-5)]
             wf\<^sub>s\<^sub>s\<^sub>t_vars_mono[of "{}"] wf\<^sub>s\<^sub>s\<^sub>t_append[OF IH(1)]
       by simp
 
     have 2: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@?T') \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@?T') = {}"
       using reachable_constraints_fv_bvars_disj'[OF P(1)]
             reachable_constraints.step[OF step.hyps]
       by blast
 
     have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T')"
       using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unlabel_subst
             wf_trms_subst[
               OF transaction_decl_fresh_renaming_substs_range_wf_trms[OF step.hyps(3-5)],
               THEN wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_trms\<^sub>s\<^sub>s\<^sub>t_subst,
               OF 0(3)[OF step.hyps(2)]]
       by metis
     hence 3: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@?T'))"
       using IH(3) by auto
 
     show ?case using 1 2 3 by force
   qed simp
   thus "wf\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" by metis+
 qed
 
 lemma reachable_constraints_no_Ana_attack:
   assumes \<A>: "\<A> \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. wellformed_transaction T"
            "\<forall>T \<in> set P. admissible_transaction_terms T"
            "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T).
               \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
     and t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
   shows "attack\<langle>n\<rangle> \<notin> set (snd (Ana t))"
 proof -
   have T_adm_term: "admissible_transaction_terms T" when "T \<in> set P" for T
     using P that by blast
 
   have T_wf: "wellformed_transaction T" when "T \<in> set P" for T
     using P that by blast
 
   have T_fresh: "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
     when "T \<in> set P" for T
     using P(3) that by fast
 
   show ?thesis
   using \<A> t
   proof (induction \<A> rule: reachable_constraints.induct)
     case (step A T \<xi> \<sigma> \<alpha>) thus ?case
     proof (cases "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)")
       case False
       hence "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)))"
         using step.prems by simp
       hence "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
         using dual_transaction_ik_is_transaction_send'[OF T_wf[OF step.hyps(2)]]
         by metis
       hence "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
         using transaction_decl_fresh_renaming_substs_trms[
                 OF step.hyps(3-5), of "transaction_send T"]
               wellformed_transaction_unlabel_cases(4)[OF T_wf[OF step.hyps(2)]]
         by fastforce
       then obtain s where s: "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" "t = s \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
         by moura
       hence s': "attack\<langle>n\<rangle> \<notin> set (snd (Ana s))"
         using admissible_transaction_no_Ana_Attack[OF T_adm_term[OF step.hyps(2)]]
               trms_transaction_unfold[of T]
         by blast
 
       note * = transaction_decl_fresh_renaming_substs_range'(1-3)[OF step.hyps(3-5)]
                transaction_decl_fresh_renaming_substs_range_no_attack_const[
                  OF step.hyps(3-5) T_fresh[OF step.hyps(2)]]
 
       show ?thesis
       proof
         assume n: "attack\<langle>n\<rangle> \<in> set (snd (Ana t))"
         thus False
         proof (cases s)
           case (Var x)
           hence "(\<exists>c. t = Fun c []) \<or> (\<exists>y. t = Var y)"
             using *(1)[of t] n s(2) by (force simp del: subst_subst_compose)
           thus ?thesis using n Ana_subterm' by fastforce
         next
           case (Fun f S)
           hence "attack\<langle>n\<rangle> \<in> set (snd (Ana s)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
             using Ana_subst'[of f S _ "snd (Ana s)" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] s(2) s' n
             by (cases "Ana s") auto
           hence "attack\<langle>n\<rangle> \<in> set (snd (Ana s)) \<or> attack\<langle>n\<rangle> \<in> subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
             using const_mem_subst_cases' by fast
           thus ?thesis using *(4) s' by fast
         qed
       qed
     qed simp
   qed simp
 qed
 
 lemma reachable_constraints_receive_attack_if_attack:
   assumes \<A>: "\<A> \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. wellformed_transaction T"
            "\<forall>T \<in> set P. admissible_transaction_terms T"
            "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T).
               \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
            "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T. \<not>TAtom AttackType \<sqsubseteq> \<Gamma>\<^sub>v x"
     and \<I>: "welltyped_constraint_model \<I> \<A>"
     and l: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> attack\<langle>l\<rangle>"
   shows "attack\<langle>l\<rangle> \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     and "receive\<langle>[attack\<langle>l\<rangle>]\<rangle> \<in> set (unlabel \<A>)"
     and "\<forall>T \<in> set P. \<forall>s \<in> set (transaction_strand T).
               is_Send (snd s) \<and> length (the_msgs (snd s)) = 1 \<and>
               is_Fun_Attack (hd (the_msgs (snd s)))
               \<longrightarrow> the_Attack_label (the_Fun (hd (the_msgs (snd s)))) = fst s
          \<Longrightarrow> (l,receive\<langle>[attack\<langle>l\<rangle>]\<rangle>) \<in> set \<A>" (is "?Q \<Longrightarrow> (l,receive\<langle>[attack\<langle>l\<rangle>]\<rangle>) \<in> set \<A>")
 proof -
   have \<I>': "constr_sem_stateful \<I> (unlabel \<A>)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
            "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     using \<I> unfolding welltyped_constraint_model_def constraint_model_def by metis+
 
   have 0: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)"
     when \<A>: "\<A> \<in> reachable_constraints P" for \<A>
     using reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s[OF _ \<A>] admissible_transaction_terms_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(2)
           ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel \<A>"] wf_trms_subst[OF \<I>'(3)]
     by fast
 
   have 1: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). \<not>TAtom AttackType \<sqsubseteq> \<Gamma>\<^sub>v x"
     when \<A>: "\<A> \<in> reachable_constraints P" for \<A>
     using reachable_constraints_vars_not_attack_typed[OF \<A> P(3,4)]
           fv_ik_subset_vars_sst'[of "unlabel \<A>"]
     by fast
 
   have 2: "attack\<langle>l\<rangle> \<notin> set (snd (Ana t)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" when t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" for t
   proof
     assume "attack\<langle>l\<rangle> \<in> set (snd (Ana t)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     then obtain s where s: "s \<in> set (snd (Ana t))" "s \<cdot> \<I> = attack\<langle>l\<rangle>" by moura
 
     obtain x where x: "s = Var x"
       by (cases s) (use s reachable_constraints_no_Ana_attack[OF \<A> P(1-3) t] in auto)
 
     have "x \<in> fv t" using x Ana_subterm'[OF s(1)] vars_iff_subtermeq by force
     hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" using t fv_subterms by fastforce
     hence "\<Gamma>\<^sub>v x \<noteq> TAtom AttackType" using 1[OF \<A>] by fastforce
     thus False using s(2) x wt_subst_trm''[OF \<I>'(4), of "Var x"] by fastforce
   qed
 
   have 3: "attack\<langle>l\<rangle> \<notin> set (snd (Ana t))" when t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)" for t
   proof
     assume "attack\<langle>l\<rangle> \<in> set (snd (Ana t))"
     then obtain s where s:
         "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<I> ` fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))" "attack\<langle>l\<rangle> \<in> set (snd (Ana s))"
       using Ana_subst_subterms_cases[OF t] 2 by fast
     then obtain x where x: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" "s \<sqsubseteq> \<I> x" by moura
     hence "\<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)"
       using var_is_subterm[of x] subterms_subst_subset'[of \<I> "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"]
       by force
     hence *: "wf\<^sub>t\<^sub>r\<^sub>m (\<I> x)" "wf\<^sub>t\<^sub>r\<^sub>m s"
       using wf_trms_subterms[OF 0[OF \<A>]] wf_trm_subtermeq[OF _ x(2)]
       by auto
 
     show False
       using term.order_trans[
               OF subtermeq_imp_subtermtypeeq[OF *(2) Ana_subterm'[OF s(2)]]
                  subtermeq_imp_subtermtypeeq[OF *(1) x(2)]]
             1[OF \<A>] x(1) wt_subst_trm''[OF \<I>'(4), of "Var x"]
       by force
   qed
 
   have 4: "t = attack\<langle>n\<rangle>"
     when t: "t \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = attack\<langle>n\<rangle>"
       and hyps: "transaction_decl_subst \<xi> T"
                 "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
                 "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
       and T: "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
     for t n
       and T::"('fun, 'atom, 'sets, 'lbl) prot_transaction"
       and \<xi> \<sigma> \<alpha>::"('fun, 'atom, 'sets, 'lbl) prot_subst"
       and \<A>::"('fun, 'atom, 'sets, 'lbl) prot_strand"
   proof (cases t)
     case (Var x)
     hence "attack\<langle>n\<rangle> \<in> subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
-      by (metis (no_types, lifting) t subst_apply_term.simps(1) subst_imgI term.distinct(1))  
+      by (metis (no_types, lifting) t eval_term.simps(1) subst_imgI term.distinct(1))  
     thus ?thesis
       using transaction_decl_fresh_renaming_substs_range_no_attack_const[OF hyps T]
       by blast
   qed (use t in simp)
 
   have 5: "\<exists>ts'. ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta> \<and> (l,send\<langle>ts'\<rangle>) \<in> set (transaction_strand T)"
     when ts: "(l,receive\<langle>ts\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
     for l ts \<theta> and T::"('fun, 'atom, 'sets, 'lbl) prot_transaction"
     using subst_lsst_memD(2)[OF ts[unfolded dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(1)[symmetric]]]
     by auto
 
   have 6: "l' = l" when "(l',receive\<langle>[attack\<langle>l\<rangle>]\<rangle>) \<in> set \<A>" and Q: "?Q" for l'
     using \<A> that(1)
   proof (induction \<A> rule: reachable_constraints.induct)
     case (step \<A> T \<xi> \<sigma> \<alpha>) show ?case
     proof (cases "(l',receive\<langle>[attack\<langle>l\<rangle>]\<rangle>) \<in> set \<A>")
       case False
       hence *: "(l',receive\<langle>[attack\<langle>l\<rangle>]\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
         using step.prems by simp
       have "(l',send\<langle>[attack\<langle>l\<rangle>]\<rangle>) \<in> set (transaction_strand T)"
         using 4[OF _ step.hyps(3-5)] P(3) step.hyps(2) 5[OF *] by force
       thus ?thesis using Q step.hyps(2) unfolding is_Fun_Attack_def by fastforce
     qed (use step.IH in simp)
   qed simp
 
   have 7: "\<exists>t. ts = [t] \<and> t = attack\<langle>l\<rangle>"
     when ts: "receive\<langle>ts\<rangle> \<in> set (unlabel \<A>)" "attack\<langle>l\<rangle> \<in> set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" for ts
     using \<A> ts(1)
   proof (induction \<A> rule: reachable_constraints.induct)
     case (step \<A> T \<xi> \<sigma> \<alpha>)
     obtain t where t: "t \<in> set ts" "attack\<langle>l\<rangle> = t \<cdot> \<I>" using ts(2) by blast
     hence t_in_ik: "t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> @ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
       using step.prems(1) in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of t] by blast
 
     have t_attack_eq: "t = attack\<langle>l\<rangle>"
     proof (cases t)
       case (Var x) 
       hence "TAtom AttackType \<notin> subterms (\<Gamma> t)"
         using t_in_ik 1[OF reachable_constraints.step[OF step.hyps]] by fastforce
       thus ?thesis using t(2) wt_subst_trm''[OF \<I>'(4), of t] by force
     qed (use t(2) in simp)
 
     show ?case
     proof (cases "receive\<langle>ts\<rangle> \<in> set (unlabel \<A>)")
       case False
       then obtain l' where l':
           "(l', receive\<langle>ts\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
         using step.prems(1) unfolding unlabel_def by force
       then obtain ts' where ts':
           "ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" "(l', send\<langle>ts'\<rangle>) \<in> set (transaction_strand T)"
         using 5 by meson
       then obtain t' where t': "t' \<in> set ts'" "t' \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = attack\<langle>l\<rangle>"
         using t(1) t_attack_eq by force
 
       note * = t'(1) 4[OF t'(2) step.hyps(3-5)]
 
       have "send\<langle>ts'\<rangle> \<in> set (unlabel (transaction_strand T))"
         using ts'(2) step.hyps(2) P(2) unfolding unlabel_def by force
       hence "length ts' = 1"
         using step.hyps(2) P(2,3) * unfolding admissible_transaction_terms_def by fastforce
       hence "ts' = [attack\<langle>l\<rangle>]" using * P(3) step.hyps(2) by (cases ts') auto
       thus ?thesis by (simp add: ts'(1))
     qed (use step.IH in simp)
   qed simp
 
   show "attack\<langle>l\<rangle> \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     using private_const_deduct[OF _ l] 3 by simp
   then obtain ts where ts: "receive\<langle>ts\<rangle> \<in> set (unlabel \<A>)" "attack\<langle>l\<rangle> \<in> set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     using in_ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t_iff[of _ \<A>] unfolding unlabel_def by force
   then obtain t where "ts = [t]" "t = attack\<langle>l\<rangle>"
     using 7 by blast
   thus "receive\<langle>[attack\<langle>l\<rangle>]\<rangle> \<in> set (unlabel \<A>)"
     using ts(1) by blast
   hence "\<exists>l'. (l', receive\<langle>[attack\<langle>l\<rangle>]\<rangle>) \<in> set \<A>"
     unfolding unlabel_def by fastforce
   thus "(l,receive\<langle>[attack\<langle>l\<rangle>]\<rangle>) \<in> set \<A>" when ?Q
     using that 6 by fast
 qed
 
 lemma reachable_constraints_receive_attack_if_attack':
   assumes \<A>: "\<A> \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and \<I>: "welltyped_constraint_model \<I> \<A>"
     and n: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> attack\<langle>n\<rangle>"
   shows "attack\<langle>n\<rangle> \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     and "receive\<langle>[attack\<langle>n\<rangle>]\<rangle> \<in> set (unlabel \<A>)"
 proof -
   have P': "\<forall>T \<in> set P. wellformed_transaction T"
            "\<forall>T \<in> set P. admissible_transaction_terms T"
            "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
            "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T. \<not>TAtom AttackType \<sqsubseteq> \<Gamma>\<^sub>v x"
     using admissible_transaction_is_wellformed_transaction(1,4)[OF bspec[OF P]]
           admissible_transactionE(2,15)[OF bspec[OF P]]
     by (blast, blast, blast, blast)
 
   show "attack\<langle>n\<rangle> \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "receive\<langle>[attack\<langle>n\<rangle>]\<rangle> \<in> set (unlabel \<A>)"
     using reachable_constraints_receive_attack_if_attack(1,2)[OF \<A> P'(1,2) _ P'(4) \<I> n] P'(3)
     by (metis, metis)
 qed
 
 lemma constraint_model_Value_term_is_Val:
   assumes \<A>_reach: "A \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model I A"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and x: "\<Gamma>\<^sub>v x = TAtom Value" "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
   shows "\<exists>n. I x = Fun (Val n) []"
 using reachable_constraints_occurs_fact_send_ex[OF \<A>_reach P P_occ x]
       reachable_constraints_occurs_fact_send_in_ik[OF \<A>_reach \<I> P P_occ]
       reachable_constraints_occurs_fact_ik_case[OF \<A>_reach P P_occ]
 by fast
 
 lemma constraint_model_Value_term_is_Val':
   assumes \<A>_reach: "A \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model I A"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and x: "(TAtom Value, m) \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
   shows "\<exists>n. I (TAtom Value, m) = Fun (Val n) []"
 using constraint_model_Value_term_is_Val[OF \<A>_reach \<I> P P_occ _ x] by simp
 
 (* We use this lemma to show that fresh constants first occur in \<I>(\<A>) at the point where they were generated *)
 lemma constraint_model_Value_var_in_constr_prefix:
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model \<I> \<A>"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
   shows "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow> (\<exists>B. prefix B \<A> \<and> x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> \<I> x \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
     (is "\<forall>x \<in> ?X \<A>. ?R x \<longrightarrow> ?Q x \<A>")
 using \<A>_reach \<I>
 proof (induction \<A> rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   let ?P = "\<lambda>\<A>. \<forall>x \<in> ?X \<A>. ?R x \<longrightarrow> ?Q x \<A>"
 
   define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
   have IH: "?P \<A>" using step welltyped_constraint_model_prefix by fast
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF bspec[OF P step.hyps(2)] step.hyps(3)]
 
   have T_adm: "admissible_transaction' T" by (metis P step.hyps(2))
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
 
   have \<I>_is_T_model: "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) (set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)) (unlabel T') \<I>"
     using step.prems unlabel_append[of \<A> T'] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>" \<I> "[]"]
           strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" "unlabel T'" \<I>]
     by (simp add: T'_def welltyped_constraint_model_def constraint_model_def db\<^sub>s\<^sub>s\<^sub>t_def)
 
   have \<I>_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     and \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     and \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
     by (metis \<I> welltyped_constraint_model_def constraint_model_def,
         metis \<I> welltyped_constraint_model_def,
         metis \<I> welltyped_constraint_model_def constraint_model_def)
 
   have 1: "?Q x \<A>" when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "\<Gamma>\<^sub>v x = TAtom Value" for x
   proof -
     obtain n where n: "\<I> x = Fun n []" "is_Val n" "\<not>public n"
       using constraint_model_Value_term_is_Val[
               OF reachable_constraints.step[OF step.hyps] step.prems P P_occ x(2)]
             x(1) fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel T'"] unlabel_append[of \<A> T']
       unfolding T'_def by moura
 
     have "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       using x(1) fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unfolding T'_def by fastforce
     then obtain y where y: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" "x \<in> fv ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y)"
       using fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var[of x "unlabel (transaction_strand T)" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
       by auto
 
     have y_x: "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y = Var x" and y_not_fresh: "y \<notin> set (transaction_fresh T)"
       using y(2) transaction_decl_fresh_renaming_substs_range[OF step.hyps(3-5), of y]
       by (force, fastforce)
 
     have "\<Gamma> ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y) = TAtom Value" using x(2) y_x by simp
     moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       by (rule transaction_decl_fresh_renaming_substs_wt[OF step.hyps(3-5)])
     ultimately have y_val: "\<Gamma>\<^sub>v y = TAtom Value"
       by (metis wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def \<Gamma>.simps(1))
 
     have "Fun n [] = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>" using n y_x by simp
     hence y_n: "Fun n [] = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>) y"
-      by (metis subst_subst_compose[of "Var y" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" \<I>] subst_apply_term.simps(1))
+      by (metis subst_subst_compose[of "Var y" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" \<I>] eval_term.simps(1))
 
     have \<A>_ik_\<I>_vals: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). \<exists>f. \<I> x = Fun f []"
     proof -
       have "\<exists>a. \<Gamma> (\<I> x) = Var a" when "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" for x
         using that reachable_constraints_vars_TAtom_typed[OF step.hyps(1) P, of x]
               vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"] wt_subst_trm''[OF \<I>_wt, of "Var x"]
         by force
       hence "\<exists>f. \<I> x = Fun f []" when "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" for x
         using that wf_trm_subst[OF \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s, of "Var x"] wf_trm_Var[of x] const_type_inv_wf
               empty_fv_exists_fun[OF interpretation_grounds[OF \<I>_interp], of "Var x"] 
-        by (metis subst_apply_term.simps(1)[of x \<I>])
+        by (metis eval_term.simps(1)[of _ x \<I>])
       thus ?thesis
         using fv_ik_subset_fv_sst'[of "unlabel \<A>"] vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"]
         by blast
     qed
     hence \<A>_subterms_subst_cong: "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) = subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
       by (metis ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel \<A>" \<I>] unlabel_subst[of \<A> \<I>] subterms_subst_lsst_ik[of \<A> \<I>])
 
     have x_nin_\<A>: "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
     proof -
       have "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
         using x(1) fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unfolding T'_def by fast
       hence "x \<in> fv\<^sub>s\<^sub>s\<^sub>t ((unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>)"
         using transaction_fresh_subst_grounds_domain[OF step.hyps(4)] step.hyps(4)
               labeled_stateful_strand_subst_comp[of \<sigma> "transaction_strand T" \<alpha>]
               unlabel_subst[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>" \<alpha>]
               unlabel_subst[of "transaction_strand T" \<sigma>]
         by (simp add: \<xi>_empty transaction_fresh_subst_def range_vars_alt_def)
       then obtain y where "\<alpha> y = Var x"
         using transaction_renaming_subst_var_obtain(1)[OF step.hyps(5)] by blast
       thus ?thesis
         using transaction_renaming_subst_range_notin_vars[OF step.hyps(5), of y]
               vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"]
         by auto
     qed
 
     from admissible_transaction_fv_in_receives_or_selects[OF T_adm y(1) y_not_fresh]
     have n_cases: "Fun n [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<or> (\<exists>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<Gamma>\<^sub>v z = TAtom Value \<and> \<I> z = Fun n [])"
     proof
       assume y_in: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
       then obtain ts where ts:
           "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_receive T))" "y \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
         using admissible_transaction_strand_step_cases(1)[OF T_adm]
         by force
       hence ts_deduct: "list_all (\<lambda>t. ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I>) ts"
         using wellformed_transaction_sem_receives[
                 OF T_wf, of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" \<I> "ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
               \<I>_is_T_model
               subst_lsst_unlabel_member[of "receive\<langle>ts\<rangle>" "transaction_receive T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
         unfolding T'_def list_all_iff by force
 
       obtain ty where ty: "ty \<in> set ts" "y \<in> fv ty" using ts(2) by fastforce
       
       have "Fun n [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<or> (\<exists>z \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). \<Gamma>\<^sub>v z = TAtom Value \<and> \<I> z = Fun n [])"
       proof -
         have "Fun n [] \<sqsubseteq> ty \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I>"
           using imageI[of "Var y" "subterms ty" "\<lambda>x. x \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>"]
                 var_is_subterm[OF ty(2)] subterms_subst_subset[of "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>" ty]
                 subst_subst_compose[of ty "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" \<I>] y_n
           by (auto simp del: subst_subst_compose)
         hence "Fun n [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
           using ty(1) private_fun_deduct_in_ik[of _ _ n "[]"] n(2,3) ts_deduct
           unfolding is_Val_def is_Abs_def list_all_iff by fast
         hence "Fun n [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<or> (\<exists>z \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). \<I> z = Fun n [])"
           using const_subterm_subst_cases[of n _ \<I>] \<A>_ik_\<I>_vals by fastforce
         thus ?thesis
           using \<I>_wt n(2) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def is_Val_def is_Abs_def by force
       qed
       thus ?thesis
         using fv_ik_subset_fv_sst' ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel \<A>"] \<A>_subterms_subst_cong
         by fast
     next
       assume y_in: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<and>
                     (\<exists>t s. select\<langle>t,s\<rangle> \<in> set (unlabel (transaction_checks T)) \<and> y \<in> fv t \<union> fv s)"
       then obtain s where s: "select\<langle>Var y,Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))"
         using admissible_transaction_strand_step_cases(2)[OF T_adm] by force
       hence "select\<langle>(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y, Fun (Set s) []\<rangle> \<in>
               set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
         using subst_lsst_unlabel_member
         by fastforce
       hence n_in_db: "(Fun n [], Fun (Set s) []) \<in> set (db'\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> [])"
         using wellformed_transaction_sem_pos_checks(1)[
                 OF T_wf, of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" \<I>
                                assign "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y" "Fun (Set s) []"]
               \<I>_is_T_model n y_x
         unfolding T'_def db\<^sub>s\<^sub>s\<^sub>t_def
         by fastforce
 
       obtain tn sn where tsn: "insert\<langle>tn,sn\<rangle> \<in> set (unlabel \<A>)" "Fun n [] = tn \<cdot> \<I>"
         using db\<^sub>s\<^sub>s\<^sub>t_in_cases[OF n_in_db] by force
 
       have "Fun n [] = tn \<or> (\<exists>z. \<Gamma>\<^sub>v z = TAtom Value \<and> tn = Var z)"
         using \<I>_wt tsn(2) n(2) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def is_Val_def is_Abs_def by (cases tn) auto
       moreover have "tn \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" "fv tn \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
         using tsn(1) in_subterms_Union by force+
       ultimately show ?thesis using tsn(2) by auto
     qed
 
     from n_cases show ?thesis
     proof
       assume "\<exists>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<Gamma>\<^sub>v z = TAtom Value \<and> \<I> z = Fun n []"
       then obtain B where B: "prefix B \<A>" "Fun n [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
         by (metis IH n(1))
       thus ?thesis
         using n x_nin_\<A> trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)[of B]
         by (metis (no_types, opaque_lifting) self_append_conv subset_iff subterms\<^sub>s\<^sub>e\<^sub>t_mono prefix_def)
     qed (use n x_nin_\<A> in fastforce)
   qed
 
   have "?P (\<A>@T')"
   proof (intro ballI impI)
     fix x assume x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T')" "\<Gamma>\<^sub>v x = TAtom Value"
     show "?Q x (\<A>@T')"
     proof (cases "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>")
       case False
       hence "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" using x(1) unlabel_append[of \<A>] fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] by simp
       then obtain B where B: "prefix B \<A>" "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B" "\<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
         using x(2) 1 by moura
       thus ?thesis using prefix_prefix by fast
     qed (use x(2) IH prefix_prefix in fast)
   qed
   thus ?case unfolding T'_def by blast
 qed simp
 
 lemma constraint_model_Val_const_in_constr_prefix:
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model \<I> \<A>"
     and P: "\<forall>T \<in> set P. wellformed_transaction T"
            "\<forall>T \<in> set P. admissible_transaction_terms T"
     and n: "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
   shows "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
 proof -
   have *: "wf\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
           "constr_sem_stateful \<I> (unlabel \<A>)"
           "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
           "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
           "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     using reachable_constraints_wf(1)[OF P(1) _ \<A>_reach]
           admissible_transaction_terms_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s \<I> P(2) n
     unfolding welltyped_constraint_model_def constraint_model_def wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code by fast+
 
   show ?thesis
     using constraint_model_priv_const_in_constr_prefix[OF * _ _ n]
     by simp
 qed
 
 lemma constraint_model_Val_const_in_constr_prefix':
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model \<I> \<A>"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and n: "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
   shows "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
 using constraint_model_Val_const_in_constr_prefix[OF \<A>_reach \<I> _ _ n]
       P admissible_transaction_is_wellformed_transaction(1,4)
 by fast
 
 lemma constraint_model_Value_in_constr_prefix_fresh_action':
   fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list"
   assumes A: "A \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction_terms T"
            "\<forall>T \<in> set P. transaction_decl T () = []"
            "\<forall>T \<in> set P. bvars_transaction T = {}"
     and n: "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
   obtains B T \<xi> \<sigma> \<alpha> where "prefix (B@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) A"
     and "B \<in> reachable_constraints P" "T \<in> set P" "transaction_decl_subst \<xi> T"
         "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
     and "Fun (Val n) [] \<in> subst_range \<sigma>"
 proof -
   define f where "f \<equiv>
     \<lambda>(T::('fun, 'atom, 'sets, 'lbl) prot_transaction,
       \<xi>::('fun, 'atom, 'sets, 'lbl) prot_subst,
       \<sigma>::('fun, 'atom, 'sets, 'lbl) prot_subst,
       \<alpha>::('fun, 'atom, 'sets, 'lbl) prot_subst).
         dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
   define g where "g \<equiv> concat \<circ> map f"
 
   obtain Ts where Ts:
       "A = g Ts" "\<forall>B. prefix B Ts \<longrightarrow> g B \<in> reachable_constraints P"
       "\<forall>B T \<xi> \<sigma> \<alpha>. prefix (B@[(T,\<xi>,\<sigma>,\<alpha>)]) Ts \<longrightarrow>
                         T \<in> set P \<and> transaction_decl_subst \<xi> T \<and>
                         transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g B)) \<and>
                         transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g B))"
     using reachable_constraints_as_transaction_lists[OF A] unfolding g_def f_def by blast
 
   obtain T \<xi> \<sigma> \<alpha> where T:
       "(T, \<xi>, \<sigma>, \<alpha>) \<in> set Ts" "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     using n trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unlabel_subst
     unfolding Ts(1) g_def f_def unlabel_def trms\<^sub>s\<^sub>s\<^sub>t_def
     by fastforce
   
   obtain B where B:
       "prefix (B@[(T, \<xi>, \<sigma>, \<alpha>)]) Ts" "g B \<in> reachable_constraints P" "T \<in> set P"
       "transaction_decl_subst \<xi> T" "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g B))"
       "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g B))"
   proof -
     obtain B where "\<exists>C. B@(T, \<xi>, \<sigma>, \<alpha>)#C = Ts" by (metis T(1) split_list)
     thus ?thesis using Ts(2-) that[of B] by auto
   qed
 
   note T_adm_terms = bspec[OF P(1) B(3)]
   note T_decl_empty = bspec[OF P(2) B(3)]
   note T_no_bvars = bspec[OF P(3) B(3)]
   note \<xi>_empty = admissible_transaction_decl_subst_empty'[OF T_decl_empty B(4)]
 
   have "trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = trms_transaction T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
     using trms\<^sub>s\<^sub>s\<^sub>t_subst[of _ "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] T_no_bvars by blast
   hence "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms_transaction T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
     by (metis T(2) unlabel_subst)
   hence "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     using admissible_transaction_terms_no_Value_consts(1)[OF T_adm_terms]
           const_subterms_subst_cases'[of "Val n" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" "trms_transaction T"]
     by blast
   then obtain tn where tn: "tn \<in> subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" "Fun (Val n) [] \<sqsubseteq> tn" "is_Fun tn"
     by fastforce
 
   have "Fun (Val n) [] \<in> subst_range \<sigma>"
     using tn(1-) transaction_decl_fresh_renaming_substs_range'(2,4)[OF B(4-6) tn(1) \<xi>_empty]
     by fastforce
   moreover have "prefix (g B@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) A"
     using Ts(1) B(1) unfolding g_def f_def prefix_def by fastforce
   ultimately show thesis using that B(2-) by blast
 qed
 
 lemma constraint_model_Value_in_constr_prefix_fresh_action:
   fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list"
   assumes A: "A \<in> reachable_constraints P"
     and P_adm: "\<forall>T \<in> set P. admissible_transaction' T"
     and n: "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
   obtains B T \<xi> \<sigma> \<alpha> where "prefix (B@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) A"
     and "B \<in> reachable_constraints P" "T \<in> set P" "transaction_decl_subst \<xi> T"
         "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
     and "Fun (Val n) [] \<in> subst_range \<sigma>"
 proof -
   have P: "\<forall>T \<in> set P. admissible_transaction_terms T"
           "\<forall>T \<in> set P. transaction_decl T () = []"
           "\<forall>T \<in> set P. bvars_transaction T = {}"
   using P_adm admissible_transactionE(1) admissible_transaction_no_bvars(2)
         admissible_transaction_is_wellformed_transaction(4)
   by (blast,blast,blast)
 
   show ?thesis using that constraint_model_Value_in_constr_prefix_fresh_action'[OF A P n] by blast
 qed
 
 lemma reachable_constraints_occurs_fact_ik_case':
   fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>_reach: "A \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and val: "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
   shows "occurs (Fun (Val n) []) \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
 proof -
   obtain B T \<xi> \<sigma> \<alpha> where B:
       "prefix (B@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) A"
       "B \<in> reachable_constraints P"
       "T \<in> set P"
       "transaction_decl_subst \<xi> T"
       "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
       "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
       "Fun (Val n) [] \<in> subst_range \<sigma>"
     using constraint_model_Value_in_constr_prefix_fresh_action[OF \<A>_reach P val]
     by blast
 
   define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   have T_adm: "admissible_transaction' T" using P B(3) by blast
   hence T_wf: "wellformed_transaction T" "admissible_transaction_occurs_checks T"
     using admissible_transaction_is_wellformed_transaction(1) bspec[OF P_occ B(3)] by (blast,blast)
 
   obtain x where x: "x \<in> set (transaction_fresh T)" "\<theta> x = Fun (Val n) []"
     using transaction_fresh_subst_domain[OF B(5)] B(7)
           admissible_transaction_decl_subst_empty[OF T_adm B(4)]
     by (force simp add: subst_compose \<theta>_def)
 
   obtain ts where ts: "send\<langle>ts\<rangle> \<in> set (unlabel (transaction_send T))" "occurs (Var x) \<in> set ts"
     using admissible_transaction_occurs_checksE2[OF T_wf(2) x(1)]
     by (metis (mono_tags, lifting) list.set_intros(1) unlabel_Cons(1))
 
   have "occurs (Var x) \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
     using ts by force
   hence "occurs (Var x) \<cdot> \<theta> \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
     using dual_transaction_ik_is_transaction_send'[OF T_wf(1), of \<theta>] by fast
   hence "occurs (Fun (Val n) []) \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
     using x(2) by simp
   thus ?thesis
     using B(1)[unfolded \<theta>_def[symmetric]]
           unlabel_append[of B "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"]
           ik\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel B" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"]
     unfolding prefix_def by force
 qed
 
 lemma reachable_constraints_occurs_fact_ik_case'':
   fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>_reach: "A \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model \<I> A"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and val: "Fun (Val n) [] \<sqsubseteq> t" "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t"
   shows "occurs (Fun (Val n) []) \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
 proof -
   obtain f ts where t: "t = Fun f ts" using val(1) by (cases t) simp_all
 
   show ?thesis
     using private_fun_deduct_in_ik[OF val(2,1)[unfolded t]]
           constraint_model_Val_const_in_constr_prefix'[OF \<A>_reach \<I> P, of n]
           reachable_constraints_occurs_fact_ik_case'[OF \<A>_reach P P_occ, of n]
     by fastforce
 qed
 
 lemma admissible_transaction_occurs_checks_prop:
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model \<I> \<A>"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and f: "f \<in> \<Union>(funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
   shows "\<not>is_PubConstValue f"
     and "\<not>is_Abs f"
 proof -
   obtain x where x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" "f \<in> funs_term (\<I> x)" using f by moura
   obtain T where T: "Fun f T \<sqsubseteq> \<I> x" using funs_term_Fun_subterm[OF x(2)] by moura
 
   have \<I>_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     and \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     and \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
     by (metis \<I> welltyped_constraint_model_def constraint_model_def,
         metis \<I> welltyped_constraint_model_def,
         metis \<I> welltyped_constraint_model_def constraint_model_def)
 
   note 0 = x(1) reachable_constraints_vars_TAtom_typed[OF \<A>_reach P, of x] 
            vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"]
 
   have 1: "\<Gamma> (Var x) = \<Gamma> (\<I> x)" using wt_subst_trm''[OF \<I>_wt, of "Var x"] by simp
   hence "\<exists>a. \<Gamma> (\<I> x) = Var a" using 0 by force
   hence "\<exists>f. \<I> x = Fun f []"
     using x(1) wf_trm_subst[OF \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s, of "Var x"] wf_trm_Var[of x] const_type_inv_wf
           empty_fv_exists_fun[OF interpretation_grounds[OF \<I>_interp], of "Var x"] 
-    by (metis subst_apply_term.simps(1)[of x \<I>])
+    by (metis eval_term.simps(1)[of _ x \<I>])
   hence 2: "\<I> x = Fun f []" using x(2) by force
 
   have 3: "\<Gamma>\<^sub>v x \<noteq> TAtom AbsValue" using 0 by force
 
   have "\<not>is_PubConstValue f \<and> \<not>is_Abs f"
   proof (cases "\<Gamma>\<^sub>v x = TAtom Value")
     case True
     then obtain B where B: "prefix B \<A>" "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B" "\<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
       using constraint_model_Value_var_in_constr_prefix[OF \<A>_reach \<I> P P_occ] x(1)
       by fast
   
     have "\<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
       using B(1,3) trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel B"] unlabel_append[of B]
       unfolding prefix_def by auto
     hence "f \<in> \<Union>(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
       using x(2) funs_term_subterms_eq(2)[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"] by blast
     thus ?thesis
       using reachable_constraints_val_funs_private[OF \<A>_reach P]
       by blast+
   next
     case False thus ?thesis using x 1 2 3 unfolding is_PubConstValue_def by (cases f) auto
   qed
   thus "\<not>is_PubConstValue f" "\<not>is_Abs f" by metis+
 qed
 
 lemma admissible_transaction_occurs_checks_prop':
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model \<I> \<A>"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and f: "f \<in> \<Union>(funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
   shows "\<nexists>n. f = PubConst Value n"
     and "\<nexists>n. f = Abs n"
 using admissible_transaction_occurs_checks_prop[OF \<A>_reach \<I> P P_occ f]
 unfolding is_PubConstValue_def by auto
 
 lemma transaction_var_becomes_Val:
   assumes \<A>_reach: "\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and T: "T \<in> set P"
     and x: "x \<in> fv_transaction T" "fst x = TAtom Value"
   shows "\<exists>n. Fun (Val n) [] = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I>"
 proof -
   obtain m where m: "x = (TAtom Value, m)" by (metis x(2) eq_fst_iff)
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF bspec[OF P T] \<xi>]
 
   have x_not_bvar: "x \<notin> bvars_transaction T" "fv ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x) \<inter> bvars_transaction T = {}"
     using x(1) admissible_transactions_fv_bvars_disj[OF P] T
           transaction_decl_fresh_renaming_substs_vars_disj(2)[OF \<xi> \<sigma> \<alpha>, of x]
           vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
     by (blast, blast)
 
   have \<sigma>x_type: "\<Gamma> (\<sigma> x) = TAtom Value"
     using \<sigma> x \<Gamma>\<^sub>v_TAtom''(2)[of x] wt_subst_trm''[of \<sigma> "Var x"]
     unfolding transaction_fresh_subst_def by simp
 
   show ?thesis
   proof (cases "x \<in> subst_domain \<sigma>")
     case True
     then obtain c where c: "\<sigma> x = Fun c []" "\<not>public c" "arity c = 0"
       using \<sigma> unfolding transaction_fresh_subst_def by fastforce
     then obtain n where n: "c = Val n" using \<sigma>x_type by (cases c) (auto split: option.splits)
     show ?thesis using c n subst_compose[of \<sigma> \<alpha> x] \<xi>_empty by simp
   next
     case False
     hence "\<sigma> x = Var x" by auto
     then obtain n where n: "(\<sigma> \<circ>\<^sub>s \<alpha>) x = Var (TAtom Value, n)"
       using m transaction_renaming_subst_is_renaming(1)[OF \<alpha>] subst_compose[of \<sigma> \<alpha> x]
       by force
     hence "(TAtom Value, n) \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       using x_not_bvar fv\<^sub>s\<^sub>s\<^sub>t_subst_fv_subset[OF x(1), of "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] \<xi>_empty
       by force
     hence "\<exists>n'. \<I> (TAtom Value, n) = Fun (Val n') []"
       using constraint_model_Value_term_is_Val'[OF \<A>_reach \<I> P P_occ, of n] x
             fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] unlabel_append[of \<A>]
       by fastforce
     thus ?thesis using n \<xi>_empty by simp
   qed
 qed
 
 lemma reachable_constraints_SMP_subset:
   assumes \<A>: "\<A> \<in> reachable_constraints P"
   shows "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<subseteq> SMP (\<Union>T \<in> set P. trms_transaction T)" (is "?A \<A>")
     and "SMP (pair`setops\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)) \<subseteq> SMP (\<Union>T\<in>set P. pair`setops_transaction T)" (is "?B \<A>")
 proof -
   have "?A \<A> \<and> ?B \<A>" using \<A>
   proof (induction \<A> rule: reachable_constraints.induct)
     case (step A T \<xi> \<sigma> \<alpha>)
     define T' where "T' \<equiv> transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
     define M where "M \<equiv> \<Union>T \<in> set P. trms_transaction T"
     define N where "N \<equiv> \<Union>T \<in> set P. pair ` setops_transaction T"
   
     let ?P = "\<lambda>t. \<exists>s \<delta>. s \<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> t = s \<cdot> \<delta>"
     let ?Q = "\<lambda>t. \<exists>s \<delta>. s \<in> N \<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> t = s \<cdot> \<delta>"
   
     have IH: "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<subseteq> SMP M" "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)) \<subseteq> SMP N"
       using step.IH by (metis M_def, metis N_def)
   
     note \<xi>\<sigma>\<alpha>_wt = transaction_decl_fresh_renaming_substs_wt[OF step.hyps(3-5)]
     note \<xi>\<sigma>\<alpha>_wf = transaction_decl_fresh_renaming_substs_range_wf_trms[OF step.hyps(3-5)]
 
     have 0: "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')) = SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<union> SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
             "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'))) =
               SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)) \<union> SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel T'))"
       using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of T']
             setops\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of T']
             trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"]
             setops\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"]
             unlabel_append[of A "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"]
             image_Un[of pair "setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "setops\<^sub>s\<^sub>s\<^sub>t (unlabel T')"]
             SMP_union[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"]
             SMP_union[of "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel T')"]
       by argo+
   
     have 1: "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<subseteq> SMP M"
     proof (intro SMP_subset_I ballI)
       fix t show "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<Longrightarrow> ?P t"
         using trms\<^sub>s\<^sub>s\<^sub>t_wt_subst_ex[OF \<xi>\<sigma>\<alpha>_wt \<xi>\<sigma>\<alpha>_wf, of t "unlabel (transaction_strand T)"]
               unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] step.hyps(2)
         unfolding T'_def M_def by auto
     qed
   
     have 2: "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel T')) \<subseteq> SMP N"
     proof (intro SMP_subset_I ballI)
       fix t show "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel T') \<Longrightarrow> ?Q t"
         using setops\<^sub>s\<^sub>s\<^sub>t_wt_subst_ex[OF \<xi>\<sigma>\<alpha>_wt \<xi>\<sigma>\<alpha>_wf, of t "unlabel (transaction_strand T)"]
               unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] step.hyps(2)
         unfolding T'_def N_def by auto
     qed
   
     have "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')) \<subseteq> SMP M"
          "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'))) \<subseteq> SMP N"
       using 0 1 2 IH by blast+
     thus ?case unfolding T'_def M_def N_def by blast
   qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
   thus "?A \<A>" "?B \<A>" by metis+
 qed
 
 lemma reachable_constraints_no_Pair_fun':
   assumes A: "A \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
            "\<forall>T \<in> set P. transaction_decl T () = []"
            "\<forall>T \<in> set P. admissible_transaction_terms T"
            "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = \<langle>a\<rangle>\<^sub>\<tau>\<^sub>a)"
   shows "Pair \<notin> \<Union>(funs_term ` SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
 using A
 proof (induction A rule: reachable_constraints.induct)
   case (step A T \<xi> \<sigma> \<alpha>)
   define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
   note T_fresh_type = bspec[OF P(1) step.hyps(2)]
 
   note \<xi>_empty =
     admissible_transaction_decl_subst_empty'[OF bspec[OF P(2) step.hyps(2)] step.hyps(3)]
 
   note T_adm_terms = bspec[OF P(3) step.hyps(2)]
 
   note \<xi>\<sigma>\<alpha>_wt = transaction_decl_fresh_renaming_substs_wt[OF step.hyps(3-5)]
   note \<xi>\<sigma>\<alpha>_wf = transaction_decl_fresh_renaming_substs_range_wf_trms[OF step.hyps(3-5)]
 
   have 0: "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T')) = SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<union> SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
     using SMP_union[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"]
           unlabel_append[of A T'] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" "unlabel T'"]
     by simp
 
   have 1: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
     using reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s[OF _ reachable_constraints.step[OF step.hyps]]
           admissible_transaction_terms_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(3)
           trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A"] unlabel_append[of A]
     unfolding T'_def by force
 
   have 2: "Pair \<notin> \<Union>(funs_term ` (subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)))"
     using transaction_decl_fresh_renaming_substs_range'(3)[
             OF step.hyps(3-5) _ \<xi>_empty T_fresh_type]
     by force
 
   have "Pair \<notin> \<Union>(funs_term ` (trms_transaction T))"
     using T_adm_terms unfolding admissible_transaction_terms_def by blast
   hence "Pair \<notin> funs_term t"
     when t: "t \<in> trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" for t
     using 2 trms\<^sub>s\<^sub>s\<^sub>t_funs_term_cases[OF t]
     by force
   hence 3: "Pair \<notin> funs_term t" when t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for t
     using t unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
           trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
     unfolding T'_def by metis
 
   have "\<exists>a. \<Gamma>\<^sub>v x = TAtom a" when "x \<in> vars_transaction T" for x
     using that protocol_transaction_vars_TAtom_typed(1) bspec[OF P(4) step.hyps(2)]
     by fast
   hence "\<exists>a. \<Gamma>\<^sub>v x = TAtom a" when "x \<in> vars\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" for x
     using wt_subst_fv\<^sub>s\<^sub>e\<^sub>t_termtype_subterm[OF _ \<xi>\<sigma>\<alpha>_wt \<xi>\<sigma>\<alpha>_wf, of x "vars_transaction T"]
           vars\<^sub>s\<^sub>s\<^sub>t_subst_cases[OF that]
     by fastforce
   hence "\<exists>a. \<Gamma>\<^sub>v x = TAtom a" when "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for x
     using that unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
           vars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
     unfolding T'_def
     by simp
   hence "\<exists>a. \<Gamma>\<^sub>v x = TAtom a" when "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" for x
     using that fv_trms\<^sub>s\<^sub>s\<^sub>t_subset(1) by fast
   hence "Pair \<notin> funs_term (\<Gamma> (Var x))" when "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" for x
     using that by fastforce
   moreover have "Pair \<in> funs_term s"
     when s: "Ana s = (K, M)" "Pair \<in> \<Union>(funs_term ` set K)"
     for s::"('fun,'atom,'sets,'lbl) prot_term" and K M
   proof (cases s)
     case (Fun f S) thus ?thesis using s Ana_Fu_keys_not_pairs[of _ S K M] by (cases f) force+
   qed (use s in simp)
   ultimately have "Pair \<notin> funs_term t" when t: "t \<in> SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" for t
     using t 3 SMP_funs_term[OF t _ _ 1, of Pair] funs_term_type_iff by fastforce
   thus ?case using 0 step.IH(1) unfolding T'_def by blast
 qed simp
 
 lemma reachable_constraints_no_Pair_fun:
   assumes A: "A \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
   shows "Pair \<notin> \<Union>(funs_term ` SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
 using reachable_constraints_no_Pair_fun'[OF A]
       P admissible_transactionE(1,2,3)
       admissible_transaction_is_wellformed_transaction(4)
 by blast
 
 lemma reachable_constraints_setops_form:
   assumes A: "A \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and t: "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
   shows "\<exists>c s. t = pair (c, Fun (Set s) []) \<and> \<Gamma> c = TAtom Value"
 using A t
 proof (induction A rule: reachable_constraints.induct)
   case (step A T \<xi> \<sigma> \<alpha>) 
 
   have T_adm: "admissible_transaction' T" when "T \<in> set P" for T
     using P that unfolding list_all_iff by simp
 
   note T_adm' = admissible_transaction_is_wellformed_transaction(2,3)[OF T_adm]
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
 
   note \<xi>\<sigma>\<alpha>_wt = transaction_decl_fresh_renaming_substs_wt[OF step.hyps(3-5)]
   note \<xi>\<sigma>\<alpha>_wf = transaction_decl_fresh_renaming_substs_range_wf_trms[OF step.hyps(3-5)]
   
   show ?case using step.IH
   proof (cases "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)")
     case False
     hence "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       using step.prems setops\<^sub>s\<^sub>s\<^sub>t_append unlabel_append
             setops\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
             unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
       by fastforce
     then obtain t' \<delta> where t':
         "t' \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand 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>)" "t = t' \<cdot> \<delta>"
       using setops\<^sub>s\<^sub>s\<^sub>t_wt_subst_ex[OF \<xi>\<sigma>\<alpha>_wt \<xi>\<sigma>\<alpha>_wf] by blast
     then obtain s s' where s: "t' = pair (s,s')"
       using setops\<^sub>s\<^sub>s\<^sub>t_are_pairs by fastforce
     moreover have "InSet ac s s' = InSet Assign s s' \<or> InSet ac s s' = InSet Check s s'" for ac
       by (cases ac) simp_all
     ultimately have "\<exists>n. s = Var (Var Value, n)" "\<exists>u. s' = Fun (Set u) []"
       using t'(1) setops\<^sub>s\<^sub>s\<^sub>t_member_iff[of s s' "unlabel (transaction_strand T)"]
             pair_in_pair_image_iff[of s s']
             transaction_inserts_are_Value_vars[
               OF T_wf[OF step.hyps(2)] T_adm'(2)[OF step.hyps(2)], of s s']
             transaction_deletes_are_Value_vars[
               OF T_wf[OF step.hyps(2)] T_adm'(2)[OF step.hyps(2)], of s s']
             transaction_selects_are_Value_vars[
               OF T_wf[OF step.hyps(2)] T_adm'(1)[OF step.hyps(2)], of s s']
             transaction_inset_checks_are_Value_vars[
               OF T_adm[OF step.hyps(2)], of s s']
             transaction_notinset_checks_are_Value_vars[
               OF T_adm[OF step.hyps(2)], of _ _ _ s s']
       by metis+
     then obtain ss n where ss: "t = pair (\<delta> (Var Value, n), Fun (Set ss) [])"
       using t'(4) s unfolding pair_def by force
 
     have "\<Gamma> (\<delta> (Var Value, n)) = TAtom Value" "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> (Var Value, n))"
       using t'(2) wt_subst_trm''[OF t'(2), of "Var (Var Value, n)"] apply simp
       using t'(3) by (cases "(Var Value, n) \<in> subst_domain \<delta>") auto
     thus ?thesis using ss by blast
   qed simp
 qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma reachable_constraints_insert_delete_form:
   assumes A: "A \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and t: "insert\<langle>t,s\<rangle> \<in> set (unlabel A) \<or> delete\<langle>t,s\<rangle> \<in> set (unlabel A)" (is "?Q t s A")
   shows "\<exists>k. s = Fun (Set k) []" (is ?A)
     and "\<Gamma> t = TAtom Value" (is ?B)
     and "(\<exists>x. t = Var x) \<or> (\<exists>n. t = Fun (Val n) [])" (is ?C)
 proof -
   have 0: "pair (t,s) \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" using t unfolding setops\<^sub>s\<^sub>s\<^sub>t_def by force
 
   show 1: ?A ?B using reachable_constraints_setops_form[OF A P 0] by (fast,fast)
 
   show ?C using A t
   proof (induction A rule: reachable_constraints.induct)
     case (step \<A> T \<xi> \<sigma> \<alpha>)
     let ?T' = "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
     note T_adm = bspec[OF P step.hyps(2)]
     note T_wf = admissible_transaction_is_wellformed_transaction(1,3)[OF T_adm]
 
     have "?Q t s \<A> \<or> ?Q t s ?T'"
       using step.prems dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(4,5)[of t s ?T']
       unfolding unlabel_append by auto
     thus ?case
     proof
       assume "?Q t s ?T'"
       then obtain u v where u: "?Q u v (transaction_strand T)" "t = u \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
         by (metis (no_types, lifting) stateful_strand_step_mem_substD(4,5) unlabel_subst)
 
       obtain x where x: "u = Var x"
         using u(1) transaction_inserts_are_Value_vars(1)[OF T_wf, of u v]
               transaction_deletes_are_Value_vars(1)[OF T_wf, of u v]
         by fastforce
 
       show ?case
         using u(2) x
               transaction_decl_fresh_renaming_substs_range'(3)[
                 OF step.hyps(3,4,5) _
                    admissible_transaction_decl_subst_empty[OF T_adm step.hyps(3)]
                    admissible_transactionE(2)[OF T_adm],
                 of t]
         by (cases "t \<in> subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)")
-           (blast, metis subst_apply_term.simps(1) subst_imgI)
+           (blast, metis eval_term.simps(1) subst_imgI)
     qed (use step.IH in fastforce)
   qed simp
 qed
 
 lemma reachable_constraints_setops_type:
   fixes t::"('fun,'atom,'sets,'lbl) prot_term"
   assumes A: "A \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and t: "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
   shows "\<Gamma> t = TComp Pair [TAtom Value, TAtom SetType]"
 proof -
   obtain s c where s: "t = pair (c, Fun (Set s) [])" "\<Gamma> c = TAtom Value"
     using reachable_constraints_setops_form[OF A P t] by moura
   hence "(Fun (Set s) []::('fun,'atom,'sets,'lbl) prot_term) \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
     using t setops\<^sub>s\<^sub>s\<^sub>t_member_iff[of c "Fun (Set s) []" "unlabel A"]
     by force
   hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun (Set s) []::('fun,'atom,'sets,'lbl) prot_term)"
     using reachable_constraints_wf(2) P A admissible_transaction_is_wellformed_transaction(1,4)
     unfolding admissible_transaction_terms_def by blast
   hence "arity (Set s) = 0" unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by simp
   thus ?thesis using s unfolding pair_def by fastforce
 qed
 
 lemma reachable_constraints_setops_same_type_if_unifiable:
   assumes A: "A \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
   shows "\<forall>s \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A). \<forall>t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A).
           (\<exists>\<delta>. Unifier \<delta> s t) \<longrightarrow> \<Gamma> s = \<Gamma> t"
     (is "?P A")
 using reachable_constraints_setops_type[OF A P] by simp
 
 lemma reachable_constraints_setops_unifiable_if_wt_instance_unifiable:
   assumes A: "A \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
   shows "\<forall>s \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A). \<forall>t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A).
           (\<exists>\<sigma> \<theta> \<rho>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>) \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>) \<and>
                    Unifier \<rho> (s \<cdot> \<sigma>) (t \<cdot> \<theta>))
           \<longrightarrow> (\<exists>\<delta>. Unifier \<delta> s t)"
 proof (intro ballI impI)
   fix s t assume st: "s \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" and
     "\<exists>\<sigma> \<theta> \<rho>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>) \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>) \<and>
              Unifier \<rho> (s \<cdot> \<sigma>) (t \<cdot> \<theta>)"
   then obtain \<sigma> \<theta> \<rho> where \<sigma>:
       "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
       "Unifier \<rho> (s \<cdot> \<sigma>) (t \<cdot> \<theta>)"
     by moura
 
   obtain fs ft cs ct where c:
       "s = pair (cs, Fun (Set fs) [])" "t = pair (ct, Fun (Set ft) [])"
       "\<Gamma> cs = TAtom Value" "\<Gamma> ct = TAtom Value" 
     using reachable_constraints_setops_form[OF A P st(1)]
           reachable_constraints_setops_form[OF A P st(2)]
     by moura
 
   have "cs \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" "ct \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
     using c(1,2) setops_subterm_trms[OF st(1), of cs] setops_subterm_trms[OF st(2), of ct]
           Fun_param_is_subterm[of cs "args s"] Fun_param_is_subterm[of ct "args t"]
     unfolding pair_def by simp_all
   moreover have
       "\<forall>T \<in> set P. wellformed_transaction T"
       "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
     using P admissible_transaction_is_wellformed_transaction(1,4)
     unfolding admissible_transaction_terms_def by fast+
   ultimately have *: "wf\<^sub>t\<^sub>r\<^sub>m cs" "wf\<^sub>t\<^sub>r\<^sub>m ct"
     using reachable_constraints_wf(2)[OF _ _ A] wf_trms_subterms by blast+
 
   have "(\<exists>x. cs = Var x) \<or> (\<exists>c d. cs = Fun c [])"
     using const_type_inv_wf c(3) *(1) by (cases cs) auto
   moreover have "(\<exists>x. ct = Var x) \<or> (\<exists>c d. ct = Fun c [])"
     using const_type_inv_wf c(4) *(2) by (cases ct) auto
   ultimately show "\<exists>\<delta>. Unifier \<delta> s t"
     using reachable_constraints_setops_form[OF A P] reachable_constraints_setops_type[OF A P] st \<sigma> c
     unfolding pair_def by auto
 qed
 
 lemma reachable_constraints_tfr:
   assumes M:
       "M \<equiv> \<Union>T \<in> set P. trms_transaction T"
       "has_all_wt_instances_of \<Gamma> M N"
       "finite N"
       "tfr\<^sub>s\<^sub>e\<^sub>t N"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and P:
       "\<forall>T \<in> set P. admissible_transaction T"
       "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
     and \<A>: "\<A> \<in> reachable_constraints P"
   shows "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
 using \<A>
 proof (induction \<A> rule: reachable_constraints.induct)
   case (step A T \<xi> \<sigma> \<alpha>)
   define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
   have P': "\<forall>T \<in> set P. admissible_transaction' T" using P(1) admissible_transactionE'(1) by blast
 
   have AT'_reach: "A@T' \<in> reachable_constraints P"
     using reachable_constraints.step[OF step.hyps] unfolding T'_def by metis
 
   note T_adm = bspec[OF P(1) step.hyps(2)]
   note T_adm' = bspec[OF P'(1) step.hyps(2)]
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T_adm' step.hyps(3)]
 
   note \<xi>\<sigma>\<alpha>_wt = transaction_decl_fresh_renaming_substs_wt[OF step.hyps(3-5)]
   note \<xi>\<sigma>\<alpha>_wf = transaction_decl_fresh_renaming_substs_range_wf_trms[OF step.hyps(3-5)]
 
   have \<xi>\<sigma>\<alpha>_bvars_disj: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<inter> range_vars (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = {}"
     using transaction_decl_fresh_renaming_substs_vars_disj(4)[OF step.hyps(3,4,5,2)] \<xi>_empty
     by simp
 
   have wf_trms_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     using admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P'(1) unfolding M(1) by blast
 
   have "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T'))"
     using reachable_constraints_SMP_subset(1)[OF AT'_reach]
           tfr_subset(3)[OF M(4), of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T')"]
           SMP_SMP_subset[of M N] SMP_I'[OF wf_trms_M M(5,2)]
     unfolding M(1) by blast
   moreover have "\<forall>p. Ana (pair p) = ([],[])" unfolding pair_def by auto
   ultimately have 1: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T') \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T')))"
     using tfr_setops_if_tfr_trms[of "unlabel (A@T')"]
           reachable_constraints_no_Pair_fun[OF AT'_reach P']
           reachable_constraints_setops_same_type_if_unifiable[OF AT'_reach P']
           reachable_constraints_setops_unifiable_if_wt_instance_unifiable[OF AT'_reach P']
     by blast
 
   have "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
     using step.hyps(2) P(2) tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p
     unfolding comp_tfr\<^sub>s\<^sub>s\<^sub>t_def tfr\<^sub>s\<^sub>s\<^sub>t_def by fastforce
   hence "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel T')"
     using tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_all_wt_subst_apply[OF _ \<xi>\<sigma>\<alpha>_wt \<xi>\<sigma>\<alpha>_wf \<xi>\<sigma>\<alpha>_bvars_disj]
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
           unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
     unfolding T'_def by argo
   hence 2: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (A@T'))"
     using step.IH unlabel_append
     unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by auto
 
   have "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))" using 1 2 by (metis tfr\<^sub>s\<^sub>s\<^sub>t_def)
   thus ?case by (metis T'_def)
 qed simp
 
 lemma reachable_constraints_tfr':
   assumes M:
       "M \<equiv> \<Union>T \<in> set P. trms_transaction T \<union> pair' Pair ` setops_transaction T"
       "has_all_wt_instances_of \<Gamma> M N"
       "finite N"
       "tfr\<^sub>s\<^sub>e\<^sub>t N"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and P:
       "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
       "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
     and \<A>: "\<A> \<in> reachable_constraints P"
   shows "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
 using \<A>
 proof (induction \<A> rule: reachable_constraints.induct)
   case (step A T \<xi> \<sigma> \<alpha>)
   define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
   have AT'_reach: "A@T' \<in> reachable_constraints P"
     using reachable_constraints.step[OF step.hyps] unfolding T'_def by metis
 
   note \<xi>\<sigma>\<alpha>_wt = transaction_decl_fresh_renaming_substs_wt[OF step.hyps(3-5)]
   note \<xi>\<sigma>\<alpha>_wf = transaction_decl_fresh_renaming_substs_range_wf_trms[OF step.hyps(3-5)]
 
   have \<xi>\<sigma>\<alpha>_bvars_disj: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<inter> range_vars (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = {}"
     by (rule transaction_decl_fresh_renaming_substs_vars_disj(4)[OF step.hyps(3,4,5,2)])
 
   have wf_trms_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     using P(1) setops\<^sub>s\<^sub>s\<^sub>t_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s(2) unfolding M(1) pair_code wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric] by fast
 
   have "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T')) \<subseteq> SMP M" "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))) \<subseteq> SMP M"
     using reachable_constraints_SMP_subset[OF AT'_reach]
           SMP_mono[of "\<Union>T \<in> set P. trms_transaction T" M]
           SMP_mono[of "\<Union>T \<in> set P. pair ` setops_transaction T" M]
     unfolding M(1) pair_code[symmetric] by blast+
   hence 1: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T') \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T')))"
     using tfr_subset(3)[OF M(4), of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T') \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))"]
           SMP_union[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T')" "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))"]
           SMP_SMP_subset[of M N] SMP_I'[OF wf_trms_M M(5,2)]
     by blast
 
   have "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
     using step.hyps(2) P(2) tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p
     unfolding comp_tfr\<^sub>s\<^sub>s\<^sub>t_def tfr\<^sub>s\<^sub>s\<^sub>t_def by fastforce
   hence "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel T')"
     using tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_all_wt_subst_apply[OF _ \<xi>\<sigma>\<alpha>_wt \<xi>\<sigma>\<alpha>_wf \<xi>\<sigma>\<alpha>_bvars_disj]
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
           unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
     unfolding T'_def by argo
   hence 2: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (A@T'))"
     using step.IH unlabel_append
     unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by auto
 
   have "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))" using 1 2 by (metis tfr\<^sub>s\<^sub>s\<^sub>t_def)
   thus ?case by (metis T'_def)
 qed simp
 
 lemma reachable_constraints_typing_cond\<^sub>s\<^sub>s\<^sub>t:
   assumes M:
       "M \<equiv> \<Union>T \<in> set P. trms_transaction T \<union> pair' Pair ` setops_transaction T"
       "has_all_wt_instances_of \<Gamma> M N"
       "finite N"
       "tfr\<^sub>s\<^sub>e\<^sub>t N"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and P:
       "\<forall>T \<in> set P. wellformed_transaction T"
       "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
       "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
     and \<A>: "\<A> \<in> reachable_constraints P"
   shows "typing_cond\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
 using reachable_constraints_wf[OF P(1,2) \<A>] reachable_constraints_tfr'[OF M P(2,3) \<A>]
 unfolding typing_cond\<^sub>s\<^sub>s\<^sub>t_def by blast
 
 context
 begin
 private lemma reachable_constraints_typing_result_aux:
   assumes 0: "wf\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)" "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
   shows "wf\<^sub>s\<^sub>s\<^sub>t (unlabel (\<A>@[(l,send\<langle>[attack\<langle>n\<rangle>]\<rangle>)]))" "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel (\<A>@[(l,send\<langle>[attack\<langle>n\<rangle>]\<rangle>)]))"
         "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@[(l,send\<langle>[attack\<langle>n\<rangle>]\<rangle>)]))"
 proof -
   let ?n = "[(l,send\<langle>[attack\<langle>n\<rangle>]\<rangle>)]"
   let ?A = "\<A>@?n"
 
   show "wf\<^sub>s\<^sub>s\<^sub>t (unlabel ?A)"
     using 0(1) wf\<^sub>s\<^sub>s\<^sub>t_append_suffix'[of "{}" "unlabel \<A>" "unlabel ?n"] unlabel_append[of \<A> ?n]
     by simp
 
   show "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?A)"
     using 0(3) trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel ?n"] unlabel_append[of \<A> ?n]
     by fastforce
 
   have "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?n \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ?n). \<exists>c. t = Fun c []"
        "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?n \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ?n). Ana t = ([],[])"
     by (simp_all add: setops\<^sub>s\<^sub>s\<^sub>t_def)
   hence "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>) \<union>
                 (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?n \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ?n)))"
     using 0(2) tfr_consts_mono unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by blast
   hence "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@?n) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (\<A>@?n)))"
     using unlabel_append[of \<A> ?n] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel ?n"]
           setops\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel ?n"]
     by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
   thus "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel ?A)"
     using 0(2) unlabel_append[of ?A ?n]
     unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by auto
 qed
 
 lemma reachable_constraints_typing_result:
   fixes P
   assumes M:
       "has_all_wt_instances_of \<Gamma> (\<Union>T \<in> set P. trms_transaction T) N"
       "finite N"
       "tfr\<^sub>s\<^sub>e\<^sub>t N"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and P:
       "\<forall>T \<in> set P. admissible_transaction T"
       "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
     and A: "\<A> \<in> reachable_constraints P"
     and \<I>: "constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
   shows "\<exists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
 proof -
   have I:
       "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
       "constr_sem_stateful \<I> (unlabel (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)]))"
     using \<I> unfolding constraint_model_def by metis+
 
   note 0 = admissible_transaction_is_wellformed_transaction(1,4)[OF admissible_transactionE'(1)]
 
   have 1: "\<forall>T \<in> set P. wellformed_transaction T"
     using P(1) 0(1) by blast
   
   have 2: "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
     using P(1) 0(2) unfolding admissible_transaction_terms_def by blast
   
   have 3: "wf\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)" "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     using reachable_constraints_tfr[OF _ M P A] reachable_constraints_wf[OF 1(1) 2 A] by metis+
 
   show ?thesis
     using stateful_typing_result[OF reachable_constraints_typing_result_aux[OF 3] I(1,3)]
     by (metis welltyped_constraint_model_def constraint_model_def)
 qed
 
 lemma reachable_constraints_typing_result':
   fixes P
   assumes M:
       "M \<equiv> \<Union>T \<in> set P. trms_transaction T \<union> pair' Pair ` setops_transaction T"
       "has_all_wt_instances_of \<Gamma> M N"
       "finite N"
       "tfr\<^sub>s\<^sub>e\<^sub>t N"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and P:
       "\<forall>T \<in> set P. wellformed_transaction T"
       "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
       "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
     and A: "\<A> \<in> reachable_constraints P"
     and \<I>: "constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
   shows "\<exists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
 proof -
   have I:
       "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
       "constr_sem_stateful \<I> (unlabel (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)]))"
     using \<I> unfolding constraint_model_def by metis+
 
   have 0: "wf\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)" "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     using reachable_constraints_tfr'[OF M P(2-3) A]
           reachable_constraints_wf[OF P(1,2) A]
     by metis+
 
   show ?thesis
     using stateful_typing_result[OF reachable_constraints_typing_result_aux[OF 0] I(1,3)]
     by (metis welltyped_constraint_model_def constraint_model_def)
 qed
 end
 
 lemma reachable_constraints_transaction_proj:
   assumes "\<A> \<in> reachable_constraints P"
   shows "proj n \<A> \<in> reachable_constraints (map (transaction_proj n) P)"
 using assms
 proof (induction \<A> rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>) show ?case
     using step.hyps(2) reachable_constraints.step[OF
             step.IH _ transaction_decl_subst_proj[OF step.hyps(3)]
             transaction_fresh_subst_proj[OF step.hyps(4)]
             transaction_renaming_subst_proj[OF step.hyps(5)]]
     by (simp add: proj_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t proj_subst transaction_strand_proj)
 qed (simp add: reachable_constraints.init)
 
 context
 begin
 private lemma reachable_constraints_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_aux:
   fixes P
   defines "Ts \<equiv> concat (map transaction_strand P)"
   assumes A: "A \<in> reachable_constraints P"
   shows "\<forall>b \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A). \<exists>a \<in> set Ts. \<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>) \<and>
       (\<forall>t \<in> subst_range \<delta>. (\<exists>x. t = Var x) \<or> (\<exists>c. t = Fun c []))"
     (is "\<forall>b \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A). \<exists>a \<in> set Ts. ?P b a")
 using A
 proof (induction A rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   define Q where "Q \<equiv> ?P"
   define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   let ?R = "\<lambda>A Ts. \<forall>b \<in> set A. \<exists>a \<in> set Ts. Q b a"
 
   have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
        "\<forall>t \<in> subst_range \<theta>. (\<exists>x. t = Var x) \<or> (\<exists>c. t = Fun c [])"
     using transaction_decl_fresh_renaming_substs_wt[OF step.hyps(3-5)]
           transaction_decl_fresh_renaming_substs_range_wf_trms[OF step.hyps(3-5)]
           transaction_decl_fresh_renaming_substs_range'(1)[OF step.hyps(3-5)]
     unfolding \<theta>_def by (metis,metis,fastforce)
   hence "?R (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) (transaction_strand T)"
     using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_self_inverse[of "transaction_strand T"]
     by (auto simp add: Q_def subst_apply_labeled_stateful_strand_def)
   hence "?R (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) (transaction_strand T)"
     by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst)
   hence "?R (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) Ts"
     using step.hyps(2) unfolding Ts_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by fastforce
   thus ?case using step.IH unfolding Q_def \<theta>_def by auto
 qed simp
 
 lemma reachable_constraints_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t:
   fixes P
   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>) = {}}"
     and "Ts \<equiv> concat (map transaction_strand P)"
   assumes P_pc: "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> Pair Ts M S"
     and A: "A \<in> reachable_constraints P"
   shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A ((f S) - {m. intruder_synth {} m})"
 using par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_if_comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t'[OF P_pc, of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A", THEN par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t]
       reachable_constraints_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_aux[OF A, unfolded Ts_def[symmetric]]
 unfolding f_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_self_inverse by fast
 end
 
 lemma reachable_constraints_par_comp_constr:
   fixes P f S
   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>) = {}}"
     and "Ts \<equiv> concat (map transaction_strand P)"
     and "Sec \<equiv> f S - {m. intruder_synth {} m}"
     and "M \<equiv> \<Union>T \<in> set P. trms_transaction T \<union> pair' Pair ` setops_transaction T"
   assumes M:
       "has_all_wt_instances_of \<Gamma> M N"
       "finite N"
       "tfr\<^sub>s\<^sub>e\<^sub>t N"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and P:
       "\<forall>T \<in> set P. wellformed_transaction T"
       "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
       "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
       "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> Pair Ts M_fun S"   
     and \<A>: "\<A> \<in> reachable_constraints P"
     and \<I>: "constraint_model \<I> \<A>"
   shows "\<exists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> \<A> \<and>
               ((\<forall>n. welltyped_constraint_model \<I>\<^sub>\<tau> (proj n \<A>)) \<or>
                (\<exists>\<A>' l t. prefix \<A>' \<A> \<and> suffix [(l, receive\<langle>t\<rangle>)] \<A>' \<and> strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' Sec \<I>\<^sub>\<tau>))"
 proof -
   have \<I>': "constr_sem_stateful \<I> (unlabel \<A>)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     using \<I> unfolding constraint_model_def by blast+
 
   show ?thesis
     using reachable_constraints_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t[OF P(4)[unfolded Ts_def] \<A>]
           reachable_constraints_typing_cond\<^sub>s\<^sub>s\<^sub>t[OF M_def M P(1-3) \<A>]
           par_comp_constr_stateful[OF _ _ \<I>', of Sec]
     unfolding f_def Sec_def welltyped_constraint_model_def constraint_model_def by blast
 qed
 
 lemma reachable_constraints_component_leaks_if_composed_leaks:
   fixes Sec Q
   defines "leaks \<equiv> \<lambda>\<A>. \<exists>\<I>\<^sub>\<tau> \<A>'.
     Q \<I>\<^sub>\<tau> \<and> prefix \<A>' \<A> \<and> (\<exists>l' t. suffix [(l', receive\<langle>t\<rangle>)] \<A>') \<and> strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' Sec \<I>\<^sub>\<tau>"
   assumes Sec: "\<forall>s \<in> Sec. \<not>{} \<turnstile>\<^sub>c s" "ground Sec"
     and composed_leaks: "\<exists>\<A> \<in> reachable_constraints Ps. leaks \<A>"
   shows "\<exists>l. \<exists>\<A> \<in> reachable_constraints (map (transaction_proj l) Ps). leaks \<A>"
 proof -
   from composed_leaks obtain \<A> \<I>\<^sub>\<tau> \<A>' s n where
       \<A>: "\<A> \<in> reachable_constraints Ps" and
       \<A>': "prefix \<A>' \<A>" "constr_sem_stateful \<I>\<^sub>\<tau> (proj_unl n \<A>'@[send\<langle>[s]\<rangle>])" and
       \<I>\<^sub>\<tau>: "Q \<I>\<^sub>\<tau>" and
       s: "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>"
     unfolding leaks_def strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by fast
 
   have "\<not>{} \<turnstile>\<^sub>c s" "s \<cdot> \<I>\<^sub>\<tau> = s" using s Sec by auto
   then obtain B k' u where
       "constr_sem_stateful \<I>\<^sub>\<tau> (proj_unl n B@[send\<langle>[s]\<rangle>])"
       "prefix (proj n B) (proj n \<A>)" "suffix [(k', receive\<langle>u\<rangle>)] (proj n B)"
       "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n B) \<I>\<^sub>\<tau>"
     using constr_sem_stateful_proj_priv_term_prefix_obtain[OF \<A>' s]
     unfolding welltyped_constraint_model_def constraint_model_def by metis
   thus ?thesis
     using \<I>\<^sub>\<tau> reachable_constraints_transaction_proj[OF \<A>, of n] proj_idem[of n B]
     unfolding leaks_def strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def
     by metis
 qed
 
 lemma reachable_constraints_preserves_labels:
   assumes \<A>: "\<A> \<in> reachable_constraints P"
   shows "\<forall>a \<in> set \<A>. \<exists>T \<in> set P. \<exists>b \<in> set (transaction_strand T). fst b = fst a"
     (is "\<forall>a \<in> set \<A>. \<exists>T \<in> set P. ?P T a")
 using \<A>
 proof (induction \<A> rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   have "\<forall>a \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)). ?P T a"
   proof
     fix a assume a: "a \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     then obtain b where b: "b \<in> set (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" "a = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p b"
       unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
     then obtain c where c: "c \<in> set (transaction_strand T)" "b = c \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
       unfolding subst_apply_labeled_stateful_strand_def by auto
 
     have "?P T c" using c(1) by blast
     hence "?P T b" using c(2) by (simp add: subst_lsstp_fst_eq)
     thus "?P T a" using b(2) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_fst_eq[of b] by presburger
   qed
   thus ?case using step.IH step.hyps(2) by (metis Un_iff set_append)
 qed simp
 
 lemma reachable_constraints_preserves_labels':
   assumes P: "\<forall>T \<in> set P. \<forall>a \<in> set (transaction_strand T). has_LabelN l a \<or> has_LabelS a"
     and \<A>: "\<A> \<in> reachable_constraints P"
   shows "\<forall>a \<in> set \<A>. has_LabelN l a \<or> has_LabelS a"
 using reachable_constraints_preserves_labels[OF \<A>] P by fastforce
 
 lemma reachable_constraints_transaction_proj_proj_eq:
   assumes \<A>: "\<A> \<in> reachable_constraints (map (transaction_proj l) P)"
   shows "proj l \<A> = \<A>"
     and "prefix \<A>' \<A> \<Longrightarrow> proj l \<A>' = \<A>'"
 using \<A>
 proof (induction \<A> rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   let ?T = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   note A = reachable_constraints.step[OF step.hyps]
 
   have P: "\<forall>T \<in> set (map (transaction_proj l) P).
             \<forall>a \<in> set (transaction_strand T). has_LabelN l a \<or> has_LabelS a"
     using transaction_proj_labels[of l] unfolding list_all_iff by auto
 
   note * = reachable_constraints_preserves_labels'[OF P A]
 
   have **: "\<forall>a \<in> set \<A>'. has_LabelN l a \<or> has_LabelS a"
     when "\<forall>a \<in> set B. has_LabelN l a \<or> has_LabelS a" "prefix \<A>' B" for B
     using that assms unfolding prefix_def by auto
 
   note *** = proj_ident[unfolded list_all_iff]
 
   { case 1 thus ?case using *[THEN ***] by blast }
   { case 2 thus ?case using *[THEN **, THEN ***] by blast }
 qed (simp_all add: reachable_constraints.init)
 
 lemma reachable_constraints_transaction_proj_star_proj:
   assumes \<A>: "\<A> \<in> reachable_constraints (map (transaction_proj l) P)"
     and k_neq_l: "k \<noteq> l"
   shows "proj k \<A> \<in> reachable_constraints (map transaction_star_proj P)"
 using \<A>
 proof (induction \<A> rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   have "map (transaction_proj k) (map (transaction_proj l) P) = map transaction_star_proj P"
     using transaction_star_proj_negates_transaction_proj(2)[OF k_neq_l]
     by fastforce
   thus ?case
     using reachable_constraints_transaction_proj[OF reachable_constraints.step[OF step.hyps], of k]
     by argo
 qed (simp add: reachable_constraints.init)
 
 lemma reachable_constraints_aligned_prefix_ex:
   fixes P
   defines "f \<equiv> \<lambda>T.
     list_all is_Receive (unlabel (transaction_receive T)) \<and>
     list_all is_Check_or_Assignment (unlabel (transaction_checks T)) \<and>
     list_all is_Update (unlabel (transaction_updates T)) \<and>
     list_all is_Send (unlabel (transaction_send T))"
   assumes P: "list_all f P" "list_all ((list_all (Not \<circ> has_LabelS)) \<circ> tl \<circ> transaction_send) P"
     and s: "\<not>{} \<turnstile>\<^sub>c s" "fv s = {}"
     and A: "A \<in> reachable_constraints P" "prefix B A"
     and B: "\<exists>l ts. suffix [(l, receive\<langle>ts\<rangle>)] B"
            "constr_sem_stateful \<I> (unlabel B@[send\<langle>[s]\<rangle>])"
   shows "\<exists>C \<in> reachable_constraints P.
           prefix C A \<and> (\<exists>l ts. suffix [(l, receive\<langle>ts\<rangle>)] C) \<and>
           declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<I> = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t C \<I> \<and>
           constr_sem_stateful \<I> (unlabel C@[send\<langle>[s]\<rangle>])"
 using A
 proof (induction A rule: reachable_constraints.induct)
   case (step A T \<xi> \<sigma> \<alpha>)
   define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   let ?T = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
   note AT_reach = reachable_constraints.step[OF step.hyps]
 
   obtain lb tsb B' where B': "B = B'@[(lb, receive\<langle>tsb\<rangle>)]" using B(1) unfolding suffix_def by blast
 
   define decl_ik where "decl_ik \<equiv> \<lambda>S::('fun,'atom,'sets,'lbl) prot_strand.
     \<Union>{set ts |ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set S} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
 
   have decl_ik_append: "decl_ik (M@N) = decl_ik M \<union> decl_ik N" for M N
     unfolding decl_ik_def by fastforce
 
   have "\<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<notin> set N"
     when "\<star> \<notin> fst ` set N" for ts and N::"('fun, 'atom, 'sets, 'lbl) prot_strand"
     using that by force
   hence decl_ik_star: "decl_ik M = decl_ik (M@N)" when "\<star> \<notin> fst ` set N" for M N
     using that unfolding decl_ik_def by simp 
 
   have decl_decl_ik: "declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<I> = {t. decl_ik S \<turnstile> t}" for S
     unfolding declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_alt_def decl_ik_def by blast
 
   have "f T" using P(1) step.hyps(2) by (simp add: list_all_iff)
   hence "list_all is_Send (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
         "list_all is_Check_or_Assignment (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
         "list_all is_Update (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
         "list_all is_Receive (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
     using subst_sst_list_all(2)[of "unlabel (transaction_receive T)" \<theta>]
           subst_sst_list_all(11)[of "unlabel (transaction_checks T)" \<theta>]
           subst_sst_list_all(10)[of "unlabel (transaction_updates T)" \<theta>]
           subst_sst_list_all(1)[of "unlabel (transaction_send T)" \<theta>]
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(1)[of "transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(11)[of "transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(10)[of "transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(2)[of "transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
     unfolding f_def by (metis unlabel_subst[of _ \<theta>])+
   hence "\<not>list_ex is_Receive (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
         "\<not>list_ex is_Receive (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
         "\<not>list_ex is_Receive (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
         "list_all is_Receive (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
     unfolding list_ex_iff list_all_iff by blast+
   then obtain TA TB where T:
       "?T = TA@TB" "\<not>list_ex is_Receive (unlabel TA)" "list_all is_Receive (unlabel TB)"
       "TB = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
     using transaction_dual_subst_unfold[of T \<theta>] unfolding \<theta>_def by fastforce
 
   have 0: "prefix B (A@TA@TB)" using step.prems B' T by argo
 
   have 1: "prefix B A" when "prefix B (A@TA)"
     using that T(2) B' prefix_prefix_inv
     unfolding list_ex_iff unlabel_def by fastforce
   
   have 2: "\<star> \<notin> fst ` set TB2" when "TB = TB1@(l,x)#TB2" for TB1 l x TB2
   proof -
     have "k \<noteq> \<star>" when "k \<in> set (map fst (tl (transaction_send T)))" for k
       using that P(2) step.hyps(2) unfolding list_all_iff by auto
     hence "k \<noteq> \<star>" when "k \<in> set (map fst (tl TB))" for k
       using that subst_lsst_map_fst_eq[of "tl (transaction_send T)" \<theta>]
             dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_map_fst_eq[of "tl (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"]
       unfolding T(4) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_tl subst_lsst_tl by simp
     moreover have "set TB2 \<subseteq> set (tl TB)"
       using that
       by (metis (no_types, lifting) append_eq_append_conv2 order.eq_iff list.sel(3) self_append_conv
                 set_mono_suffix suffix_appendI suffix_tl tl_append2)
     ultimately show ?thesis by auto
   qed
 
   have 3: "declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t TB \<I> = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t (TB1@[(l,x)]) \<I>"
     when "TB = TB1@(l,x)#TB2" for TB1 l x TB2
     using decl_ik_star[OF 2[OF that], of "TB1@[(l,x)]"] unfolding that decl_decl_ik by simp
 
   show ?case
   proof (cases "prefix B A")
     case False
     hence 4: "\<not>prefix B (A@TA)" using 1 by blast
 
     have 5: "\<exists>l ts. suffix [(l, receive\<langle>ts\<rangle>)] (A@?T)"
     proof -
       have "(lb, receive\<langle>tsb\<rangle>) \<in> set TB"
         using 0 4 prefix_prefix_inv[OF _ suffixI[OF B'], of "A@TA" TB] by (metis append_assoc)
       hence "receive\<langle>tsb\<rangle> \<in> set (unlabel TB)"
         unfolding unlabel_def by force
       hence "\<exists>ts. suffix [receive\<langle>ts\<rangle>] (unlabel TB)"
         using T(3) unfolding list_all_iff is_Receive_def suffix_def
         by (metis in_set_conv_decomp list.distinct(1) list.set_cases rev_exhaust)
       then obtain TB' ts where "unlabel TB = TB'@[receive\<langle>ts\<rangle>]" unfolding suffix_def by blast
       then obtain TB'' x where "TB = TB''@[x]" "snd x = receive\<langle>ts\<rangle>"
         by (metis (no_types, opaque_lifting) append1_eq_conv list.distinct(1) rev_exhaust
               rotate1.simps(2) rotate1_is_Nil_conv unlabel_Cons(2) unlabel_append unlabel_nil)
       then obtain l where "suffix [(l, receive\<langle>ts\<rangle>)] TB"
         by (metis surj_pair prod.sel(2) suffix_def)
       thus ?thesis
         using T(4) transaction_dual_subst_unfold[of T \<theta>]
               suffix_append[of "[(l, receive\<langle>ts\<rangle>)]"]
         unfolding \<theta>_def by metis
     qed
 
     obtain TB1 where TB:
         "B = A@TA@TB1@[(lb, receive\<langle>tsb\<rangle>)]" "prefix (TB1@[(lb, receive\<langle>tsb\<rangle>)]) TB"
       using 0 4 B' prefix_snoc_obtain[of B' "(lb, receive\<langle>tsb\<rangle>)" "A@TA" TB thesis]
       by (metis append_assoc)
     then obtain TB2 where TB2: "TB = TB1@(lb, receive\<langle>tsb\<rangle>)#TB2"
       unfolding prefix_def by fastforce
     hence TB2': "list_all is_Receive (unlabel TB2)"
       using T(3) unfolding list_all_iff is_Receive_def proj_def unlabel_def by auto
 
     have 6: "constr_sem_stateful \<I> (unlabel B)" "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> s \<cdot> \<I>"
       using B(2) strand_sem_append_stateful[of "{}" "{}" "unlabel B" "[send\<langle>[s]\<rangle>]" \<I>]
       by auto
 
     have "constr_sem_stateful \<I> (unlabel (A@TA@TB1@[(lb, receive\<langle>tsb\<rangle>)]))"
       using 6(1) TB(1) by blast
     hence "constr_sem_stateful \<I> (unlabel (A@?T))"
       using T(1) TB2 strand_sem_receive_prepend_stateful[
               of "{}" "{}" "unlabel (A@TA@TB1@[(lb, receive\<langle>tsb\<rangle>)])" \<I>,
               OF _ TB2']
       by auto
     moreover have "set (unlabel B) \<subseteq> set (unlabel (A@?T))"
       using step.prems(1) unfolding prefix_def by force
     hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@?T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> s \<cdot> \<I>"
       using ideduct_mono[OF 6(2)] subst_all_mono[of _ _ \<I>]
             ik\<^sub>s\<^sub>s\<^sub>t_set_subset[of "unlabel B" "unlabel (A@?T)"]
       by meson
     ultimately have 7: "constr_sem_stateful \<I> (unlabel (A@?T)@[send\<langle>[s]\<rangle>])"
       using strand_sem_append_stateful[of "{}" "{}" "unlabel (A@?T)" "[send\<langle>[s]\<rangle>]" \<I>]
       by auto
 
     have "declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<I> = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@?T) \<I>"
     proof -
       have "declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t TB \<I> = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t (TB1@[(lb, receive\<langle>tsb\<rangle>)]) \<I>"
         using 3[of _ lb "receive\<langle>tsb\<rangle>"] TB(2) unfolding prefix_def by auto
       hence "(decl_ik TB \<turnstile> t) \<longleftrightarrow> decl_ik (TB1@[(lb,receive\<langle>tsb\<rangle>)]) \<turnstile> t" for t
         unfolding TB(1) T(1) decl_decl_ik by blast
       hence "(decl_ik (A@TA@TB) \<turnstile> t) \<longleftrightarrow> decl_ik (A@TA@TB1@[(lb,receive\<langle>tsb\<rangle>)]) \<turnstile> t" for t
         using ideduct_mono_eq[of "decl_ik TB" "decl_ik (TB1@[(lb,receive\<langle>tsb\<rangle>)])" "decl_ik (A@TA)"]
         by (metis decl_ik_append[of "A@TA"] Un_commute[of _ "decl_ik (A@TA)"] append_assoc)
       thus ?thesis unfolding TB(1) T(1) decl_decl_ik by blast
     qed
     thus ?thesis using step.prems AT_reach B(1) 5 7 by force
   qed (use step.IH prefix_append in blast)
 qed (use B(1) suffix_def in simp)
 
 lemma reachable_constraints_secure_if_filter_secure_case:
   fixes f l n
     and P::"('fun,'atom,'sets,'lbl) prot_transaction list"
   defines "has_attack \<equiv> \<lambda>P.
       \<exists>\<A> \<in> reachable_constraints P. \<exists>\<I>. constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
     and "f \<equiv> \<lambda>T. list_ex (\<lambda>a. is_Update (snd a) \<or> is_Send (snd a)) (transaction_strand T)"
     and "g \<equiv> \<lambda>T. transaction_fresh T = [] \<longrightarrow> f T"
   assumes att: "has_attack P"
   shows "has_attack (filter g P)"
 proof -
   let ?attack = "\<lambda>A I. constraint_model I (A@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
 
   define constr' where "constr' \<equiv>
     \<lambda>(T::('fun,'atom,'sets,'lbl) prot_transaction,\<xi>::('fun,'atom,'sets,'lbl) prot_subst,
       \<sigma>::('fun,'atom,'sets,'lbl) prot_subst,\<alpha>::('fun,'atom,'sets,'lbl) prot_subst).
       dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
   define constr where "constr \<equiv> \<lambda>Ts. concat (map constr' Ts)"
 
   define h where "h \<equiv>
     \<lambda>(T::('fun,'atom,'sets,'lbl) prot_transaction,_::('fun,'atom,'sets,'lbl) prot_subst,
       _::('fun,'atom,'sets,'lbl) prot_subst,_::('fun,'atom,'sets,'lbl) prot_subst).
       g T"
 
   obtain A I where A: "A \<in> reachable_constraints P" "?attack A I"
     using att unfolding has_attack_def by blast
 
   obtain Ts where Ts:
       "A = constr Ts"
       "\<forall>B. prefix B Ts \<longrightarrow> constr B \<in> reachable_constraints P"
       "\<forall>B T \<xi> \<sigma> \<alpha>. prefix (B@[(T,\<xi>,\<sigma>,\<alpha>)]) Ts \<longrightarrow>
           T \<in> set P \<and> transaction_decl_subst \<xi> T \<and>
           transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr B)) \<and>
           transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr B))"
     using reachable_constraints_as_transaction_lists[OF A(1)] constr_def constr'_def by auto
 
   define B where "B \<equiv> constr (filter h Ts)"
 
   have Ts': "T \<in> set P" when "(T,\<xi>,\<sigma>,\<alpha>) \<in> set Ts" for T \<xi> \<sigma> \<alpha>
     using that Ts(3) by (meson prefix_snoc_in_iff) 
 
   have constr_Cons: "constr (p#Ts) = constr' p@constr Ts" for p Ts unfolding constr_def by simp
 
   have constr_snoc: "constr (Ts@[p]) = constr Ts@constr' p" for p Ts unfolding constr_def by simp
 
   have 0: "?attack B I" when A_att: "?attack A I"
   proof -
     have not_f_T_case: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr' p) = {}" "\<And>D. dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (constr' p)) I D = D"
       when not_f_T: "\<not>(f T)" and p: "p = (T,\<xi>,\<sigma>,\<alpha>)" for p T \<xi> \<sigma> \<alpha>
     proof -
       have constr_p: "constr' p = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
         unfolding p constr'_def by fast
 
       have "\<not>is_Receive a" when a: "(l,a) \<in> set (constr' p)" for l a
       proof
         assume "is_Receive a"
         then obtain ts where ts: "a = receive\<langle>ts\<rangle>" by (cases a) auto
         then obtain ts' where ts':
           "(l,send\<langle>ts'\<rangle>) \<in> set (transaction_strand T)" "ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
           using a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(1)[of l ts] subst_lsst_memD(2)[of l _ "transaction_strand T"]
           unfolding constr_p by blast
         thus False using not_f_T unfolding f_def list_ex_iff by fastforce
       qed
       thus "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr' p) = {}" using in_ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t_iff by fastforce
 
       have "\<not>is_Update a" when a: "(l,a) \<in> set (constr' p)" for l a
       proof
         assume "is_Update a"
         then obtain t s where ts: "a = insert\<langle>t,s\<rangle> \<or> a = delete\<langle>t,s\<rangle>" by (cases a) auto
         then obtain t' s' where ts':
           "(l,insert\<langle>t',s'\<rangle>) \<in> set (transaction_strand T) \<or>
                (l,delete\<langle>t',s'\<rangle>) \<in> set (transaction_strand T)"
           "t = t' \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" "s = s' \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
           using a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(4,5)[of l]
             subst_lsst_memD(4,5)[of l _ _ "transaction_strand T"]
           unfolding constr_p by blast
         thus False using not_f_T unfolding f_def list_ex_iff by fastforce
       qed
       thus "\<And>D. dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (constr' p)) I D = D"
         using dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd[of "unlabel (constr' p)" I] by (meson unlabel_mem_has_label) 
     qed
 
     have *: "strand_sem_stateful M D (unlabel B) I"
       when "strand_sem_stateful M D (unlabel A) I" for M D
       using that Ts' unfolding Ts(1) B_def
     proof (induction Ts arbitrary: M D)
       case (Cons p Ts)
       obtain T \<xi> \<sigma> \<alpha> where p: "p = (T,\<xi>,\<sigma>,\<alpha>)" by (cases p) simp
       have T_in: "T \<in> set P" using Cons.prems(2) unfolding p by fastforce
 
       let ?M' = "M \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr' p) \<cdot>\<^sub>s\<^sub>e\<^sub>t I)"
       let ?D' = "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (constr' p)) I D"
 
       have p_sem: "strand_sem_stateful M D (unlabel (constr' p)) I"
         and IH: "strand_sem_stateful ?M' ?D' (unlabel (constr (filter h Ts))) I"
         using Cons.IH[of ?M' ?D'] Cons.prems
               strand_sem_append_stateful[of M D "unlabel (constr' p)" "unlabel (constr Ts)" I]
         unfolding constr_Cons unlabel_append by fastforce+
 
       show ?case
       proof (cases "T \<in> set (filter g P)")
         case True
         hence h_p: "filter h (p#Ts) = p#filter h Ts" unfolding h_def p by simp
         show ?thesis
           using p_sem IH strand_sem_append_stateful[of M D "unlabel (constr' p)" _ I]
           unfolding h_p constr_Cons unlabel_append by blast
       next
         case False
         hence not_f: "\<not>(f T)"
           and not_h: "\<not>(h p)"
           using T_in unfolding g_def h_def p by auto
 
         show ?thesis
           using not_h not_f_T_case[OF not_f p] IH
           unfolding constr_Cons unlabel_append by auto
       qed
     qed simp
 
     have **: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t B = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
     proof
       show "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<subseteq> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
         unfolding Ts(1) B_def constr_def by (induct Ts) (auto simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
 
       show "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<subseteq> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t B" using Ts' unfolding Ts(1) B_def
       proof (induction Ts)
         case (Cons p Ts)
         obtain T \<xi> \<sigma> \<alpha> where p: "p = (T,\<xi>,\<sigma>,\<alpha>)" by (cases p) simp
         have T_in: "T \<in> set P" using Cons.prems unfolding p by fastforce
 
         have IH: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr Ts) \<subseteq> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr (filter h Ts))"
           using Cons.IH Cons.prems by auto
 
         show ?case
         proof (cases "T \<in> set (filter g P)")
           case True
           hence h_p: "filter h (p#Ts) = p#filter h Ts" unfolding h_def p by simp
           show ?thesis
             using IH unfolding h_p constr_Cons unlabel_append ik\<^sub>s\<^sub>s\<^sub>t_append by blast
         next
           case False
           hence not_f: "\<not>(f T)"
             and not_h: "\<not>(h p)"
             using T_in unfolding g_def h_def p by auto
 
           show ?thesis
             using not_h not_f_T_case[OF not_f p] IH
             unfolding constr_Cons unlabel_append by auto
         qed
       qed simp
     qed
 
     show ?thesis
       using A_att *[of "{}" "{}"] ** strand_sem_stateful_if_sends_deduct
             strand_sem_append_stateful[of "{}" "{}" _ "unlabel [(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)]" I]
       unfolding constraint_model_def unlabel_append by force
   qed
 
   have 1: "B \<in> reachable_constraints (filter g P)"
     using A(1) Ts(2,3) unfolding Ts(1) B_def
   proof (induction Ts rule: List.rev_induct)
     case (snoc p Ts)
     obtain T \<xi> \<sigma> \<alpha> where p: "p = (T,\<xi>,\<sigma>,\<alpha>)" by (cases p) simp
 
     have constr_p: "constr' p = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       unfolding constr'_def p by fastforce
 
     have T_in: "T \<in> set P"
       and \<xi>: "transaction_decl_subst \<xi> T"
       and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr Ts))"
       and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr Ts))"
       using snoc.prems(3) unfolding p by fast+
 
     have "transaction_fresh_subst s t bb"
       when "transaction_fresh_subst s t aa" "bb \<subseteq> aa"
       for s t bb aa using that unfolding transaction_fresh_subst_def by fast
           
     have "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr (filter h Ts)) \<subseteq> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr Ts)"
       unfolding constr_def unlabel_def by fastforce
     hence \<sigma>': "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr (filter h Ts)))"
       using \<sigma> unfolding transaction_fresh_subst_def by fast
 
     have "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr (filter h Ts)) \<subseteq> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr Ts)"
       unfolding constr_def unlabel_def vars\<^sub>s\<^sub>s\<^sub>t_def by auto
     hence \<alpha>': "transaction_renaming_subst \<alpha> (filter g P) (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (constr (filter h Ts)))"
       using \<alpha> unfolding transaction_renaming_subst_def by auto
 
     have IH: "constr (filter h Ts) \<in> reachable_constraints (filter g P)"
       using snoc.prems snoc.IH by simp
 
     show ?case
     proof (cases "h p")
       case True
       hence h_p: "filter h (Ts@[p]) = filter h Ts@[p]" by fastforce
       have T_in': "T \<in> set (filter g P)" using T_in True unfolding h_def p by fastforce
       show ?thesis
         using IH reachable_constraints.step[OF IH T_in' \<xi> \<sigma>' \<alpha>']
         unfolding h_p constr_snoc constr_p by fast
     next
       case False thus ?thesis using IH by fastforce
     qed
   qed (simp add: constr_def)
 
   show ?thesis using 0 1 A(2) unfolding has_attack_def by blast
 qed
 
 lemma reachable_constraints_fv_Value_typed:
   assumes P: "\<forall>T \<in> set P. admissible_transaction' T"
     and A: "\<A> \<in> reachable_constraints P"
     and x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
   shows "\<Gamma>\<^sub>v x = TAtom Value"
 proof -
   obtain T where T: "T \<in> set P" "\<Gamma>\<^sub>v x \<in> \<Gamma>\<^sub>v ` fv_transaction T"
     using x P(1) reachable_constraints_var_types_in_transactions(1)[OF A(1)]
           admissible_transactionE(2) 
     by blast
 
   show ?thesis
     using T(2) admissible_transactionE(3)[OF bspec[OF P(1) T(1)]]
           vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
     by force
 qed
 
 lemma reachable_constraints_fv_Value_const_cases:
   assumes P: "\<forall>T \<in> set P. admissible_transaction' T"
     and A: "\<A> \<in> reachable_constraints P"
     and I: "welltyped_constraint_model \<I> \<A>"
     and x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
   shows "(\<exists>n. \<I> x = Fun (Val n) []) \<or> (\<exists>n. \<I> x = Fun (PubConst Value n) [])"
 proof -
   have x': "\<Gamma> (\<I> x) = TAtom Value" "fv (\<I> x) = {}" "wf\<^sub>t\<^sub>r\<^sub>m (\<I> x)"
     using reachable_constraints_fv_Value_typed[OF P A x] I wt_subst_trm''[of \<I> "Var x"]
     unfolding welltyped_constraint_model_def constraint_model_def by auto
 
   obtain f where f: "arity f = 0" "\<I> x = Fun f []"
     using TAtom_term_cases[OF x'(3,1)] x' const_type_inv_wf[of _ _ Value] by (cases "\<I> x") force+
 
   show ?thesis
   proof (cases f)
     case (Fu g) thus ?thesis by (metis f(2) x'(1) \<Gamma>_Fu_simps(4)[of g "[]"])
   qed (use f x'(1) in auto)
 qed
 
 lemma reachable_constraints_receive_attack_if_attack'':
   assumes P: "\<forall>T \<in> set P. admissible_transaction' T"
     and A: "\<A> \<in> reachable_constraints P"
     and wt_attack: "welltyped_constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
   shows "receive\<langle>[attack\<langle>n\<rangle>]\<rangle> \<in> set (unlabel \<A>)"
 proof -
   have I: "welltyped_constraint_model \<I> \<A>"
     using welltyped_constraint_model_prefix wt_attack by blast
 
   show ?thesis
     using wt_attack strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" "[send\<langle>[attack\<langle>n\<rangle>]\<rangle>]" \<I>]
           reachable_constraints_receive_attack_if_attack'(2)[OF A(1) P I]
     unfolding welltyped_constraint_model_def constraint_model_def by simp
 qed
 
 context
 begin
 
 private lemma reachable_constraints_initial_value_transaction_aux:
   fixes P::"('fun,'atom,'sets,'lbl) prot" and N::"nat set"
   assumes P: "\<forall>T \<in> set P. admissible_transaction' T"
     and A: "A \<in> reachable_constraints P"
     and P':
       "\<forall>T \<in> set P. \<forall>(l,a) \<in> set (transaction_strand T). \<forall>t.
         a \<noteq> select\<langle>t,\<langle>k\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> \<langle>t in \<langle>k\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> \<langle>t not in \<langle>k\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> delete\<langle>t,\<langle>k\<rangle>\<^sub>s\<rangle>"
     shows "(l,\<langle>ac: t \<in> s\<rangle>) \<in> set A \<Longrightarrow> (\<exists>u. s = \<langle>u\<rangle>\<^sub>s \<and> u \<noteq> k)" (is "?A A \<Longrightarrow> ?Q A")
       and "(l,\<langle>t not in s\<rangle>) \<in> set A \<Longrightarrow> (\<exists>u. s = \<langle>u\<rangle>\<^sub>s \<and> u \<noteq> k)" (is "?B A \<Longrightarrow> ?Q A")
       and "(l,delete\<langle>t,s\<rangle>) \<in> set A \<Longrightarrow> (\<exists>u. s = \<langle>u\<rangle>\<^sub>s \<and> u \<noteq> k)" (is "?C A \<Longrightarrow> ?Q A")
 proof -
   have "(?A A \<longrightarrow> ?Q A) \<and> (?B A \<longrightarrow> ?Q A) \<and> (?C A \<longrightarrow> ?Q A)" (is "?D A") using A
   proof (induction A rule: reachable_constraints.induct)
     case (step \<A> T \<xi> \<sigma> \<alpha>)
     define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
     let ?T' = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 
     note T_adm = bspec[OF P step.hyps(2)]
     note T_wf = admissible_transaction_is_wellformed_transaction[OF T_adm]
     note T_P' = bspec[OF P' step.hyps(2)]
 
     have 0: "?Q ?T'" when A: "?A ?T'"
     proof -
       obtain t' s' where t:
           "(l, \<langle>ac: t' \<in> s'\<rangle>) \<in> set (transaction_strand T)" "t = t' \<cdot> \<theta>" "s = s' \<cdot> \<theta>"
         using A dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(6) subst_lsst_memD(6) by blast
       obtain u where u: "s' = \<langle>u\<rangle>\<^sub>s"
         using transaction_selects_are_Value_vars[OF T_wf(1,2), of t' s']
               transaction_inset_checks_are_Value_vars[OF T_adm, of t' s']
               unlabel_in[OF t(1)]
         by (cases ac) auto
       show ?thesis using T_P' t(1,3) unfolding u by (cases ac) auto
     qed
 
     have 1: "?Q ?T'" when B: "?B ?T'"
     proof -
       obtain t' s' where t:
           "(l, \<langle>t' not in s'\<rangle>) \<in> set (transaction_strand T)" "t = t' \<cdot> \<theta>" "s = s' \<cdot> \<theta>"
         using B dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(7) subst_lsst_memD(9) by blast
       obtain u where u: "s' = \<langle>u\<rangle>\<^sub>s"
         using transaction_notinset_checks_are_Value_vars(2)[OF T_adm unlabel_in[OF t(1)]]
         by fastforce
       show ?thesis using T_P' t(1,3) unfolding u by auto
     qed
 
     have 2: "?Q ?T'" when C: "?C ?T'"
     proof -
       obtain t' s' where t:
           "(l, delete\<langle>t', s'\<rangle>) \<in> set (transaction_strand T)" "t = t' \<cdot> \<theta>" "s = s' \<cdot> \<theta>"
         using C dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(5) subst_lsst_memD(5) by blast
       obtain u where u: "s' = \<langle>u\<rangle>\<^sub>s"
         using transaction_deletes_are_Value_vars(2)[OF T_wf(1,3) unlabel_in[OF t(1)]] by blast
       show ?thesis using T_P' t(1,3) unfolding u by auto
     qed
 
     show ?case using 0 1 2 step.IH unfolding \<theta>_def by auto
   qed simp
   thus "?A A \<Longrightarrow> ?Q A" "?B A \<Longrightarrow> ?Q A" "?C A \<Longrightarrow> ?Q A" by fast+
 qed
 
 lemma reachable_constraints_initial_value_transaction:
   fixes P::"('fun,'atom,'sets,'lbl) prot" and N::"nat set" and k A T_upds
   defines "checks_not_k \<equiv> \<lambda>B.
             T_upds \<noteq> [] \<longrightarrow> (
              (\<forall>l t s. (l,\<langle>t in s\<rangle>) \<in> set (A@B) \<longrightarrow> (\<exists>u. s = \<langle>u\<rangle>\<^sub>s \<and> u \<noteq> k)) \<and>
              (\<forall>l t s. (l,\<langle>t not in s\<rangle>) \<in> set (A@B) \<longrightarrow> (\<exists>u. s = \<langle>u\<rangle>\<^sub>s \<and> u \<noteq> k)) \<and>
              (\<forall>l t s. (l,delete\<langle>t,s\<rangle>) \<in> set (A@B) \<longrightarrow> (\<exists>u. s = \<langle>u\<rangle>\<^sub>s \<and> u \<noteq> k)))"
   assumes P: "\<forall>T \<in> set P. admissible_transaction' T"
     and A: "A \<in> reachable_constraints P"
     and N: "finite N" "\<forall>n \<in> N. \<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
     and T:
       "T \<in> set P" "Var x \<in> set T_ts" "\<Gamma>\<^sub>v x = TAtom Value" "fv\<^sub>s\<^sub>e\<^sub>t (set T_ts) = {x}"
       "\<forall>n. \<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set T_ts)"
       "T = Transaction (\<lambda>(). []) [x] [] [] T_upds [(l1,send\<langle>T_ts\<rangle>)]"
       "T_upds = [] \<or>
        (T_upds = [(l2,insert\<langle>Var x, \<langle>k\<rangle>\<^sub>s\<rangle>)] \<and>
         (\<forall>T \<in> set P. \<forall>(l,a) \<in> set (transaction_strand T). \<forall>t.
           a \<noteq> select\<langle>t,\<langle>k\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> \<langle>t in \<langle>k\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> \<langle>t not in \<langle>k\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> delete\<langle>t,\<langle>k\<rangle>\<^sub>s\<rangle>))"
   shows "\<exists>B. A@B \<in> reachable_constraints P \<and> B \<in> reachable_constraints P \<and> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t B = {} \<and>
              (T_upds = [] \<longrightarrow> list_all is_Receive (unlabel B)) \<and> 
              (T_upds \<noteq> [] \<longrightarrow> list_all (\<lambda>a. is_Insert a \<or> is_Receive a) (unlabel B)) \<and>
              (\<forall>n. Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<longrightarrow> Fun (Val n) [] \<notin> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t B) \<and>
              (\<forall>n. Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<longrightarrow> Fun (Val n) [] \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t B) \<and>
              N = {n. Fun (Val n) [] \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t B} \<and>
              checks_not_k B \<and>
              (\<forall>l a. (l,a) \<in> set B \<and> is_Insert a \<longrightarrow>
                       (l = l2 \<and> (\<exists>n. a = insert\<langle>Fun (Val n) [],\<langle>k\<rangle>\<^sub>s\<rangle>)))"
     (is "\<exists>B. A@B \<in> ?reach P \<and> B \<in> ?reach P \<and> ?Q1 B \<and> ?Q2 B \<and> ?Q3 B \<and> ?Q4 B \<and> ?Q5 B \<and> ?Q6 N B \<and>
              checks_not_k B \<and> ?Q7 B")
 using N
 proof (induction N rule: finite_induct)
   case empty
   define B where "B \<equiv> []::('fun,'atom,'sets,'lbl) prot_constr"
 
   have 0: "A@B \<in> ?reach P" "B \<in> ?reach P"
     using A unfolding B_def by auto
 
   have 1: "?Q1 B" "?Q2 B" "?Q3 B" "?Q4 B" "?Q6 {} B"
     unfolding B_def by auto
   
   have 2: "checks_not_k B"
     using reachable_constraints_initial_value_transaction_aux[OF P 0(1)] T(7)
     unfolding checks_not_k_def by presburger
 
   have 3: "?Q5 B" "?Q7 B"
     unfolding B_def by simp_all
 
   show ?case using 0 1 2 3 by blast
 next
   case (insert n N)
   obtain B where B:
       "A@B \<in> reachable_constraints P" "B \<in> reachable_constraints P"
       "?Q1 B" "?Q2 B" "?Q3 B" "?Q4 B" "?Q5 B" "?Q6 N B" "checks_not_k B" "?Q7 B"
     using insert.IH insert.prems by blast
 
   define \<xi> where "\<xi> \<equiv> Var::('fun,'atom,'sets,'lbl) prot_subst"
 
   define \<sigma> where "\<sigma> \<equiv> Var(x := Fun (Val n) [])::('fun,'atom,'sets,'lbl) prot_subst"
 
   have \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B))"
   proof (unfold transaction_fresh_subst_def; intro conjI)
     have "subst_range \<sigma> = {Fun (Val n) []}" unfolding \<sigma>_def by simp
     moreover have "Fun (Val n) [] \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B))"
       using insert.prems insert.hyps(2) B(7,8) ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel B"]
       unfolding unlabel_append trms\<^sub>s\<^sub>s\<^sub>t_append by blast
     ultimately show "\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B))" by fastforce
   next
     show "subst_domain \<sigma> = set (transaction_fresh T)" using T(6) unfolding \<sigma>_def by auto
   next
     show "\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)"
       using T(5,7) unfolding \<sigma>_def T(6) by fastforce
   qed (force simp add: T(3) \<sigma>_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)+
   hence \<sigma>': "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
     unfolding transaction_fresh_subst_def by fastforce
 
   have \<xi>: "transaction_decl_subst \<xi> T"
     using T(6) unfolding \<xi>_def transaction_decl_subst_def by fastforce
 
   obtain \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst" where \<alpha>:
       "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B))"
     unfolding transaction_renaming_subst_def by blast
   hence \<alpha>': "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
     unfolding transaction_renaming_subst_def by auto
 
   define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   define C where "C \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 
   have \<theta>x: "\<theta> x = Fun (Val n) []" unfolding \<theta>_def \<xi>_def \<sigma>_def subst_compose by force
 
   have "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = []" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = []"
     using T(6) unfolding \<theta>_def \<xi>_def \<sigma>_def by auto
   moreover have
       "(T_upds = [] \<and> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = []) \<or>
        (T_upds \<noteq> [] \<and> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = [(l2,insert\<langle>\<theta> x, \<langle>k\<rangle>\<^sub>s\<rangle>)])"
     using subst_lsst_cons[of "(l2,insert\<langle>Var x,\<langle>k\<rangle>\<^sub>s\<rangle>)" "[]" \<theta>] T(6,7) unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst by auto
   hence "(T_upds = [] \<and> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = []) \<or>
          (T_upds \<noteq> [] \<and> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = [(l2,insert\<langle>Fun (Val n) [],\<langle>k\<rangle>\<^sub>s\<rangle>)])"
-    using subst_apply_term.simps(1)[of x \<theta>] unfolding \<theta>_def \<xi>_def \<sigma>_def by auto
+    unfolding \<theta>_def \<xi>_def \<sigma>_def by (auto simp: subst_compose)
   moreover have "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = [(l1, receive\<langle>T_ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>)]"
     using subst_lsst_cons[of "(l1, receive\<langle>T_ts\<rangle>)" "[]" \<theta>] T(6) unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst by auto
   hence "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = [(l1, receive\<langle>T_ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>)]"
-    using subst_apply_term.simps(1)[of x \<theta>] by auto
+    by auto
   ultimately have C:
       "(T_upds = [] \<and> C = [(l1, receive\<langle>T_ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>)]) \<or>
        (T_upds \<noteq> [] \<and> C = [(l2, insert\<langle>Fun (Val n) [],\<langle>k\<rangle>\<^sub>s\<rangle>), (l1, receive\<langle>T_ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>)])"
     unfolding C_def transaction_dual_subst_unfold by force
 
   have C': "Fun (Val n) [] \<in> set (T_ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)" "Fun (Val n) [] \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t C"
     using T(2) in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of _ "unlabel C"] C
     unfolding \<theta>_def \<xi>_def \<sigma>_def by (force, force)
 
   have "fv (t \<cdot> \<theta>) = {}" when t: "t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set T_ts" for t
   proof -
     have  "fv t \<subseteq> {x}" using t T(4) fv_subset_subterms by blast
     hence "fv (t \<cdot> \<xi> \<circ>\<^sub>s \<sigma>) = {}" unfolding \<xi>_def \<sigma>_def by (induct t) auto
     thus ?thesis unfolding \<theta>_def by (metis subst_ground_ident_compose(2))
   qed
   hence 1: "ground (set (T_ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>))" by auto
 
   have 2: "m = n" when m: "Fun (Val m) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t C" for m
   proof -
     have "Fun (Val m) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set (T_ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)"
       using m C in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of _ "unlabel C"] by fastforce
     hence *: "Fun (Val m) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set T_ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>" by simp
     show ?thesis using const_subterms_subst_cases[OF *] T(4,5) \<theta>x by fastforce
   qed
 
   have C_trms: "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t C \<subseteq> {Fun (Val n) [],\<langle>k\<rangle>\<^sub>s} \<union> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t C"
     using C in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of _ "unlabel C"] by fastforce
 
   have 3: "m = n" when m: "Fun (Val m) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t C" for m
     using m 2[of m] C_trms by fastforce
 
   have Q1: "?Q1 (B@C)" using B(3) C 1 by auto
   have Q2: "?Q2 (B@C)" using B(4) C by force
   have Q3: "?Q3 (B@C)" using B(5) C by force
   have Q4: "?Q4 (B@C)" using B(6) insert.prems C 2 unfolding unlabel_append ik\<^sub>s\<^sub>s\<^sub>t_append by blast
   have Q5: "?Q5 (B@C)" using B(7) C' 3 unfolding unlabel_append ik\<^sub>s\<^sub>s\<^sub>t_append trms\<^sub>s\<^sub>s\<^sub>t_append by blast
   have Q6: "?Q6 (insert n N) (B@C)" using B(8) C' 2 unfolding unlabel_append ik\<^sub>s\<^sub>s\<^sub>t_append by blast
   have Q7: "?Q7 (B@C)" using B(10) C by fastforce
   have Q8: "checks_not_k (B@C)" using B(9) C unfolding checks_not_k_def by force
 
   have "B@C \<in> reachable_constraints P" "A@B@C \<in> reachable_constraints P"
     using reachable_constraints.step[OF B(1) T(1) \<xi> \<sigma> \<alpha>]
           reachable_constraints.step[OF B(2) T(1) \<xi> \<sigma>' \<alpha>']
     unfolding \<theta>_def[symmetric] C_def[symmetric] by simp_all
   thus ?case using Q1 Q2 Q3 Q4 Q5 Q6 Q7 Q8 by blast
 qed
 
 end
 
 
 subsection \<open>Equivalence Between the Symbolic Protocol Model and a Ground Protocol Model\<close>
 
 context
 begin
 
 subsubsection \<open>Intermediate Step: Equivalence to a Ground Protocol Model with Renaming\<close>
 
 private definition "consts_of X = {t. t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t X \<and> (\<exists>c. t = Fun c [])}"
 
 private fun mk_symb where
   "mk_symb (\<xi>, \<sigma>, I, T, \<alpha>) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t((transaction_strand T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
 private fun T_symb :: " _ \<Rightarrow> ('fun,'atom,'sets,'lbl) prot_constr" where
   "T_symb w = concat (map mk_symb w)"
 
 
 private definition "narrow \<sigma> S = (\<lambda>x. if x \<in> S then \<sigma> x else Var x)"
 
 private fun mk_inv\<alpha>I where
   "mk_inv\<alpha>I n (\<xi>, \<sigma>, I, T) =
     narrow ((var_rename_inv n) \<circ>\<^sub>s I) (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s var_rename n))"
 
 private fun inv\<alpha>I where
   "inv\<alpha>I ns w = foldl (\<circ>\<^sub>s) Var (map2 mk_inv\<alpha>I ns w)"
 
 private fun mk_I where
   "mk_I (\<xi>, \<sigma>, I, T, \<alpha>) = narrow I (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
 
 private fun comb_I where
   "comb_I w = fold (\<circ>\<^sub>s) (map mk_I w) (\<lambda>x. Fun OccursSec [])"
 
 private abbreviation "ground_term t \<equiv> ground {t}"
 
 private lemma ground_term_def2: "ground_term t \<longleftrightarrow> (fv t = {})"
   by auto
 
 private definition "ground_strand s \<equiv> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t s = {}"
 
 private fun ground_step :: "(_, _) stateful_strand_step \<Rightarrow> bool" where
   "ground_step s \<longleftrightarrow> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s = {}"
 
 private fun ground_lstep :: "_ strand_label \<times> (_, _) stateful_strand_step \<Rightarrow> bool" where
   "ground_lstep (l,s) \<longleftrightarrow> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s = {}"
 
 
 private inductive_set ground_protocol_states_aux::
   "('fun,'atom,'sets,'lbl) prot \<Rightarrow>
    (('fun,'atom,'sets,'lbl) prot_terms \<times>
     (('fun,'atom,'sets,'lbl) prot_term \<times> ('fun,'atom,'sets,'lbl) prot_term) set
     \<times> _ set \<times> _ set \<times> _ list) set"
   for P::"('fun,'atom,'sets,'lbl) prot"
 where
   init:
   "({},{},{},{},[]) \<in> ground_protocol_states_aux P"
 | step:
   "\<lbrakk>(IK,DB,trms,vars,w) \<in> ground_protocol_states_aux P;
     T \<in> set P;
     transaction_decl_subst \<xi> T;
     transaction_fresh_subst \<sigma> T trms;
     transaction_renaming_subst \<alpha> P vars;
     A = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>);
     strand_sem_stateful IK DB (unlabel A) I;
     interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I;
     wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)
    \<rbrakk> \<Longrightarrow> (IK \<union> ((ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t I), dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I DB,
           trms \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A, vars \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A,
           w@[(\<xi>, \<sigma>, I, T, \<alpha>)]) \<in> ground_protocol_states_aux P"
 
 private lemma T_symb_append':
   " T_symb (w@w') = T_symb w @ T_symb w'"
 proof (induction w arbitrary: w')
   case Nil
   then show ?case
     by auto
 next
   case (Cons a w)
   then show ?case
     by auto
 qed
 
 private lemma T_symb_append:
   "T_symb (w@[(\<xi>, \<sigma>, I, T, \<alpha>)]) = T_symb w @ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t((transaction_strand T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 using T_symb_append'[of w "[(\<xi>, \<sigma>, I, T,\<alpha>)]"] by auto
 
 private lemma ground_step_subst:
   assumes "ground_step a"
   shows "a = a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma>"
 using assms 
 proof (induction a)
   case (NegChecks Y F F')
   then have FY: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set Y = {}"
     unfolding ground_step.simps
     unfolding fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps by auto
   {  
     have "\<forall>t s. (t,s) \<in> set F \<longrightarrow> t \<cdot> (rm_vars (set Y) \<sigma>) = t"
     proof (rule, rule, rule)
       fix t s 
       assume "(t, s) \<in> set F"
       then show "t \<cdot> rm_vars (set Y) \<sigma> = t"
         using FY by fastforce                      
     qed
     moreover
     have "\<forall>t s. (t,s) \<in> set F \<longrightarrow> s \<cdot> (rm_vars (set Y) \<sigma>) = s"
     proof (rule, rule, rule)
       fix t s 
       assume "(t, s) \<in> set F"
       then show "s \<cdot> rm_vars (set Y) \<sigma> = s"
         using FY by fastforce                      
     qed
     ultimately
     have "\<forall>f \<in> set F. f \<cdot>\<^sub>p (rm_vars (set Y) \<sigma>) = f"
       by auto
     then have "F = F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set Y) \<sigma>"
       by (metis (no_types, lifting) map_idI split_cong subst_apply_pairs_def)
   }
   moreover
   from NegChecks have F'Y: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' - set Y = {}"
     unfolding ground_step.simps
     unfolding fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps by auto
   {  
     have "\<forall>t s. (t,s) \<in> set F' \<longrightarrow> t \<cdot> (rm_vars (set Y) \<sigma>) = t"
     proof (rule, rule, rule)
       fix t s 
       assume "(t, s) \<in> set F'"
       then show "t \<cdot> rm_vars (set Y) \<sigma> = t"
         using F'Y by fastforce                      
     qed
     moreover
     have "\<forall>t s. (t,s) \<in> set F' \<longrightarrow> s \<cdot> (rm_vars (set Y) \<sigma>) = s"
     proof (rule, rule, rule)
       fix t s 
       assume "(t, s) \<in> set F'"
       then show "s \<cdot> rm_vars (set Y) \<sigma> = s"
         using F'Y by fastforce                      
     qed
     ultimately
     have "\<forall>f \<in> set F'. f \<cdot>\<^sub>p (rm_vars (set Y) \<sigma>) = f"
       by auto
     then have "F' = F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set Y) \<sigma>"
       by (simp add: map_idI subst_apply_pairs_def)
   }
   ultimately
   show ?case 
     by simp
 qed (auto simp add: map_idI subst_ground_ident)
 
 private lemma ground_lstep_subst:
   assumes "ground_lstep a"
   shows "a = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma>"
 using assms by (cases a) (auto simp add: ground_step_subst)
 
 private lemma subst_apply_term_rm_vars_swap:
   assumes "\<forall>x\<in>fv t - set X. I x = I' x"
   shows "t \<cdot> rm_vars (set X) I = t \<cdot> rm_vars (set X) I'"
 using assms by (induction t) auto
 
 private lemma subst_apply_pairs_rm_vars_swap:
   assumes "\<forall>x\<in>\<Union> (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r ` set ps) - set X. I x = I' x"
   shows "ps \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) I = ps \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) I'"
 proof -
   have "\<forall>p \<in> set ps. p \<cdot>\<^sub>p rm_vars (set X) I = p  \<cdot>\<^sub>p rm_vars (set X) I'"
   proof
     fix p
     assume "p \<in> set ps"
     obtain t s where "p = (t,s)"
       by (cases p) auto
     have "\<forall>x\<in>fv t - set X. I x = I' x"
       by (metis DiffD1 DiffD2 DiffI \<open>p = (t, s)\<close> \<open>p \<in> set ps\<close> assms fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.elims fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_inI(4))
     then have "t \<cdot> rm_vars (set X) I = t \<cdot> rm_vars (set X) I'"
       using subst_apply_term_rm_vars_swap by blast
     have "\<forall>x\<in>fv s - set X. I x = I' x"
       by (metis DiffD1 DiffD2 DiffI \<open>p = (t, s)\<close> \<open>p \<in> set ps\<close> assms fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.elims fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_inI(5))
     then have "s \<cdot> rm_vars (set X) I = s \<cdot> rm_vars (set X) I'"
       using subst_apply_term_rm_vars_swap by blast
     show "p \<cdot>\<^sub>p rm_vars (set X) I = p \<cdot>\<^sub>p rm_vars (set X) I'"
       using \<open>p = (t, s)\<close> \<open>s \<cdot> rm_vars (set X) I = s \<cdot> rm_vars (set X) I'\<close>
             \<open>t \<cdot> rm_vars (set X) I = t \<cdot> rm_vars (set X) I'\<close>
       by fastforce
   qed
   then show ?thesis
     unfolding subst_apply_pairs_def by auto
 qed
 
 private lemma subst_apply_stateful_strand_step_swap:
   assumes "\<forall>x\<in>fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p T. I x = I' x"
   shows "T \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p I = T  \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p I'"
   using assms
 proof (induction T)
   case (Send ts)
   then show ?case
     using term_subst_eq by fastforce
 next
   case (NegChecks X F G)
   then have "\<forall>x \<in> \<Union>(fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r ` set F) \<union> \<Union>(fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r ` set G) - set X. I x = I' x"
     by auto
   then show ?case
     using subst_apply_pairs_rm_vars_swap[of F]
           subst_apply_pairs_rm_vars_swap[of G]
     by auto
 qed (simp_all add: term_subst_eq_conv)
 
 private lemma subst_apply_labeled_stateful_strand_step_swap:
   assumes "\<forall>x \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd T). I x = I' x"
   shows "T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p I = T  \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p I'"
 using assms subst_apply_stateful_strand_step_swap
 by (metis prod.exhaust_sel subst_apply_labeled_stateful_strand_step.simps) 
 
 private lemma subst_apply_labeled_stateful_strand_swap:
   assumes "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T. I x = I' x"
   shows "T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I = T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I'"
   using assms
 proof (induction T)
   case Nil
   then show ?case
     by auto
 next
   case (Cons a T)
   then show ?case
     using subst_apply_labeled_stateful_strand_step_swap
     by (metis UnCI fv\<^sub>s\<^sub>s\<^sub>t_Cons subst_lsst_cons unlabel_Cons(2))
 qed
 
 private lemma transaction_renaming_subst_not_in_fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t:
   fixes \<xi> \<sigma> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
     and A::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
   assumes "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
   shows "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 proof -
   have 0: "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<alpha>)"
     when x: "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
       and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
     for x
       and A::"('fun,'atom,'sets,'lbl) prot_constr"
       and \<xi> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst" 
   proof -
     have "x \<notin> range_vars \<alpha>"
       using x \<alpha> transaction_renaming_subst_vars_disj(6) by blast
     moreover
     have "subst_domain \<alpha> = UNIV"
       using \<alpha> transaction_renaming_subst_is_renaming(4) by blast
     ultimately
     show ?thesis
       using subst_fv_dom_img_subset[of _ \<alpha>] fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var subst_compose unlabel_subst
       by (metis (no_types, opaque_lifting) subset_iff top_greatest)
   qed
 
   have 1: "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<alpha>)"
     when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
       and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
     for x
       and A::"('fun,'atom,'sets,'lbl) prot_constr"
       and \<xi> \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
     using \<alpha> x 0 by (metis Un_iff vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t)
 
   show ?thesis using 1 assms by metis
 qed
 
 private lemma wf_comb_I_Nil: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (comb_I []))"
   by auto
 
 private lemma comb_I_append:
   "comb_I (w @ [(\<xi>, \<sigma>, I, T, \<alpha>)]) = (mk_I (\<xi>, \<sigma>, I, T, \<alpha>) \<circ>\<^sub>s (comb_I w))"
 by auto
 
 private lemma reachable_constraints_if_ground_protocol_states_aux:
   assumes "(IK, DB, trms, vars, w) \<in> ground_protocol_states_aux P"
   shows "T_symb w \<in> reachable_constraints P
          \<and> constr_sem_stateful (comb_I w) (unlabel (T_symb w))
          \<and> IK = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((T_symb w) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t (comb_I w))
          \<and> DB = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel ((T_symb w))) (comb_I w) {}
          \<and> trms = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w)
          \<and> vars = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w)
          \<and> interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (comb_I w)
          \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (comb_I w))"
   using assms
 proof (induction rule: ground_protocol_states_aux.induct)
   case init
   show ?case
     using wf_comb_I_Nil by auto
 next
   case (step IK DB trms vars w T \<xi> \<sigma> \<alpha> A I)
   then have step': "T_symb w \<in> reachable_constraints P"
     "strand_sem_stateful {} {} (unlabel (T_symb w)) (comb_I w)"
     "IK = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t comb_I w)"
     "DB = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w) {}"
     "trms = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w)"
     "vars = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w)"
     "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (comb_I w)"
     "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (comb_I w))"
     by auto
 
   define w' where "w' = w @ [(\<xi>, \<sigma>, I, T, \<alpha>)]"
 
   have interps_w: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w). (comb_I w) x = (comb_I w') x"
   proof 
     fix x
     assume "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w)"
     then have "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       using step(5) transaction_renaming_subst_not_in_fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t unfolding step'(6) by blast
     then have "mk_I (\<xi>, \<sigma>, I, T, \<alpha>) x = Var x"
       unfolding mk_I.simps narrow_def by metis
     then have "comb_I w x = (mk_I (\<xi>, \<sigma>, I, T, \<alpha>) \<circ>\<^sub>s (comb_I (w))) x"
       by (simp add: subst_compose)
     then show "comb_I w x = comb_I w' x"
       unfolding w'_def by auto
   qed
 
   have interps_T: "\<forall>x \<in> fv\<^sub>s\<^sub>s\<^sub>t (unlabel (mk_symb (\<xi>, \<sigma>, I, T, \<alpha>))). I x = (comb_I w') x"
   proof 
     fix x
     assume "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (unlabel (mk_symb (\<xi>, \<sigma>, I, T, \<alpha>)))"
     then have a: "x \<in> (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
       by (metis fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq mk_symb.simps)
     have "(comb_I w') x = (mk_I (\<xi>, \<sigma>, I, T, \<alpha>) \<circ>\<^sub>s (comb_I (w))) x"
       unfolding w'_def by auto
     also
     have "... = ((mk_I (\<xi>, \<sigma>, I, T, \<alpha>)) x) \<cdot> comb_I w"
       unfolding subst_compose by auto
     also
     have "... = (narrow I (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) x) \<cdot> comb_I w"
       using a by auto
     also
     have "... = (I x) \<cdot> comb_I w"
       by (metis a narrow_def)
     also
     have "... = I x"
       by (metis UNIV_I ground_subst_range_empty_fv step.hyps(8) subst_compose
                 subst_ground_ident_compose(1))
     finally
     show "I x = (comb_I w') x"
       by auto
   qed
 
   have "T_symb w' \<in> reachable_constraints P"
   proof -
     have "T_symb w \<in> reachable_constraints P"
       using step'(1) .
     moreover
     have "T \<in> set P"
       using step(2) by auto
     moreover
     have "transaction_decl_subst \<xi> T"
       using step(3) by auto
     moreover
     have "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w))"
       using step(4) step'(5) by auto
     moreover
     have "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w))"
       using step(5) step'(6) by auto
     ultimately
     have "(T_symb w) @ mk_symb (\<xi>, \<sigma>, I, T, \<alpha>) \<in> reachable_constraints P"
       using reachable_constraints.step[of "T_symb w" P T \<xi> \<sigma> \<alpha>] by auto
     then show "T_symb w' \<in> reachable_constraints P"
       unfolding w'_def by auto
   qed
   moreover
   have "strand_sem_stateful {} {} (unlabel (T_symb w')) (comb_I w')"
   proof -
     have "strand_sem_stateful {} {} (unlabel (T_symb w)) (comb_I w')"
     proof -
       have "strand_sem_stateful {} {} (unlabel (T_symb w)) (comb_I w)"
         using step'(2) by auto
       then show "strand_sem_stateful {} {} (unlabel (T_symb w)) (comb_I w')"
         using interps_w strand_sem_model_swap by blast
     qed
     moreover
     have "strand_sem_stateful
             (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w) \<cdot>\<^sub>s\<^sub>e\<^sub>t comb_I w')
             (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w') {})
             (unlabel (mk_symb (\<xi>, \<sigma>, I, T, \<alpha>)))
             (comb_I w')"
     proof -
       have "A = (mk_symb (\<xi>, \<sigma>, I, T, \<alpha>))"
         unfolding step(6) by auto
       moreover
       have "strand_sem_stateful
               (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t comb_I w))
               (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w) {})
               (unlabel A)
               I"
         using step'(3) step'(4) step.hyps(7) by force
       moreover
       {
         have "\<forall>x\<in>fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w)). comb_I w x = comb_I w' x"
           using interps_w by (metis fv_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t)
         then have "\<forall>x\<in>fv t. comb_I w x = comb_I w' x" when t: "t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w)" for t
           using t by auto
         then have "t \<cdot> comb_I w' = t \<cdot> comb_I w" when t: "t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w)" for t
           using t term_subst_eq[of t "comb_I w'" "comb_I w"] by metis
         then have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w) \<cdot>\<^sub>s\<^sub>e\<^sub>t comb_I w' = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w) \<cdot>\<^sub>s\<^sub>e\<^sub>t comb_I w"
           by auto
         also
         have "... = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t comb_I w)"
           by (metis ik\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst)
         finally
         have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w) \<cdot>\<^sub>s\<^sub>e\<^sub>t comb_I w' = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t comb_I w)"
           by auto
       }
       moreover
       {
         have "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w) {} =
               dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w') {}"
           by (metis db\<^sub>s\<^sub>s\<^sub>t_subst_swap[OF interps_w] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t empty_set)
       }
       ultimately
       have "strand_sem_stateful
               (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w) \<cdot>\<^sub>s\<^sub>e\<^sub>t comb_I w')
               (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w') {})
               (unlabel (mk_symb (\<xi>, \<sigma>, I, T, \<alpha>)))
               I"
         by force
       then show "strand_sem_stateful
                   (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w) \<cdot>\<^sub>s\<^sub>e\<^sub>t comb_I w')
                   (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w') {})
                   (unlabel (mk_symb (\<xi>, \<sigma>, I, T, \<alpha>)))
                   (comb_I w')"
         using interps_T strand_sem_model_swap[of "unlabel (mk_symb (\<xi>, \<sigma>, I, T, \<alpha>))" I "comb_I w'"]
         by force 
     qed
     ultimately
     show "strand_sem_stateful {} {} (unlabel (T_symb w')) (comb_I w')"
       using strand_sem_append_stateful[
               of "{}" "{}" "unlabel (T_symb w)" "unlabel (mk_symb (\<xi>, \<sigma>, I, T, \<alpha>))" "(comb_I w')"]
       unfolding w'_def by auto
   qed
   moreover
   have "IK \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t comb_I w')"
   proof -
     have AI: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I) = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
       by (metis ik\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst)
 
     have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t comb_I w') = 
            ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t comb_I w') \<union> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb [(\<xi>, \<sigma>, I, T, \<alpha>)] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t comb_I w')"
       unfolding w'_def by (simp add: subst_lsst_append)
     also 
     have "... = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t comb_I w') \<union> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb [(\<xi>, \<sigma>, I, T, \<alpha>)] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)"
       by (metis T_symb_append T_symb_append' interps_T mk_symb.simps self_append_conv2
                 subst_apply_labeled_stateful_strand_swap)
     also
     have "... = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t comb_I w) \<union> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb [(\<xi>, \<sigma>, I, T, \<alpha>)] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)"
       by (metis interps_w subst_apply_labeled_stateful_strand_swap)
     also 
     have "... = IK \<union> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)"
       using step'(3) step.hyps(6) by auto
     also
     have "... = IK \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A  \<cdot>\<^sub>s\<^sub>e\<^sub>t I)"
       unfolding AI by auto
     finally
     show "IK \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t comb_I w')"
       using step'(3) step(6) T_symb.simps mk_symb.simps by auto
   qed
   moreover
   have "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I DB = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w')) (comb_I w') {}"
   proof -
     have "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I DB =
           dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w) {})"
       using step'(4) by auto
     moreover
     have "... = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))) I
                         (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w) {})"
       using step(6) by auto
     moreover
     have "... = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (mk_symb (\<xi>, \<sigma>, I, T, \<alpha>))) I
                         (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w) {})"
       by auto
     moreover
     have "... = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (mk_symb (\<xi>, \<sigma>, I, T, \<alpha>))) (comb_I w')
                         (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w) {})"
       by (metis (no_types, lifting) db\<^sub>s\<^sub>s\<^sub>t_subst_swap[OF interps_T] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t empty_set)
     moreover
     have "... = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (mk_symb (\<xi>, \<sigma>, I, T, \<alpha>))) (comb_I w')
                         (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w') {})"
       by (metis (no_types, lifting) db\<^sub>s\<^sub>s\<^sub>t_subst_swap[OF interps_w] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t empty_set)
     moreover
     have "... = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w) @ unlabel (mk_symb (\<xi>, \<sigma>, I, T, \<alpha>))) (comb_I w') {}"
       using dbupd\<^sub>s\<^sub>s\<^sub>t_append by metis
     moreover
     have "... = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel ((T_symb w) @ mk_symb (\<xi>, \<sigma>, I, T, \<alpha>))) (comb_I w') {}"
       by auto
     moreover
     have "... = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w')) (comb_I w') {}"
       unfolding w'_def by auto
     ultimately
     show "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I DB = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w')) (comb_I w') {}"
       by auto
   qed
   moreover
   have "trms \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w')"
   proof -
     have "trms \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
       using step'(5) by auto
     moreover
     have "... = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
       using step(6) by auto
     moreover 
     have "... = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb [(\<xi>, \<sigma>, I, T, \<alpha>)])"
       by auto
     moreover
     have "... = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w @ T_symb [(\<xi>, \<sigma>, I, T, \<alpha>)])"
       by auto
     moreover
     have "... = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w')"
       unfolding w'_def by auto
     ultimately
     show "trms \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w')"
       by auto
   qed
   moreover
   have "vars \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w')"
   proof -
     have "vars \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
       using step'(6) by fastforce
     moreover
     have "... = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
       using step(6) by auto
     moreover 
     have "... = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb [(\<xi>, \<sigma>, I, T, \<alpha>)])"
       by auto
     moreover
     have "... = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w @ T_symb [(\<xi>, \<sigma>, I, T, \<alpha>)])"
       by auto
     moreover
     have "... = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w')"
       unfolding w'_def by auto
     ultimately
     show "vars \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w')"
       using step(6) by auto
   qed
   moreover
   have interp_comb_I_w': "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (comb_I w')"
     using interpretation_comp(1) step'(7) unfolding w'_def by auto
   moreover
   have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (comb_I w'))"
   proof 
     fix t
     assume "t \<in> subst_range (comb_I w')"
     then have "\<exists>x. x \<in> subst_domain (comb_I w') \<and> t = comb_I w' x"
       by auto
     then obtain x where "x \<in> subst_domain (comb_I w')" "t = comb_I w' x"
       by auto
     then show "wf\<^sub>t\<^sub>r\<^sub>m t"
       by (metis (no_types, lifting) w'_def interp_comb_I_w' comb_I_append ground_subst_dom_iff_img
                   mk_I.simps narrow_def step'(8) step.hyps(8) step.hyps(9) subst_compose_def
                   wf_trm_Var wf_trm_subst)
   qed
   ultimately
   show ?case
     unfolding w'_def by auto
 qed
 
 private lemma ground_protocol_states_aux_if_reachable_constraints:
   assumes "A \<in> reachable_constraints P"
   assumes "constr_sem_stateful I (unlabel A)"
   assumes "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I"
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
   shows "\<exists>w. (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I, dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I {}, trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A, vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A, w)
               \<in> ground_protocol_states_aux P"
 using assms
 proof (induction rule: reachable_constraints.induct)
   case init
   then show ?case
     using ground_protocol_states_aux.init by auto 
 next
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   have "\<exists>w. (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t I, dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) I {}, trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>, vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>, w)
               \<in> ground_protocol_states_aux P"
     by (metis local.step(6,7,8,9) step.IH strand_sem_append_stateful unlabel_append)
   then obtain w where w_p:
       "(ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t I, dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) I {}, trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>, vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>, w)
         \<in> ground_protocol_states_aux P"
     by auto
 
   define w' where "w' = w@[(\<xi>, \<sigma>, I, T, \<alpha>)]"
   define \<A>' where "\<A>' = \<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
   let ?T = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
 
   have "T \<in> set P"
     using step.hyps(2) .
   moreover
   have "transaction_decl_subst \<xi> T"
     using step.hyps(3) .
   moreover
   have "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     using step.hyps(4) .
   moreover
   have "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     using step.hyps(5) .
   moreover
   have "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t I) (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) I {}) ?T I"
     using step(7) strand_sem_append_stateful[of "{}"  "{}" "unlabel \<A>" ?T I]
     by auto
   moreover
   have "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I"
     using assms(3) .
   moreover
   have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
     using step.prems(3) by fastforce
   ultimately
   have "((ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<union> (ik\<^sub>s\<^sub>s\<^sub>t ?T \<cdot>\<^sub>s\<^sub>e\<^sub>t I),
          dbupd\<^sub>s\<^sub>s\<^sub>t ?T I (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) I {}),
          trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> trms\<^sub>s\<^sub>s\<^sub>t ?T,
          vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> vars\<^sub>s\<^sub>s\<^sub>t ?T,
          w@[(\<xi>, \<sigma>, I, T, \<alpha>)])
       \<in> ground_protocol_states_aux P"
     using ground_protocol_states_aux.step[
             OF w_p,
             of T \<xi> \<sigma> \<alpha> "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" I]
     by metis
   moreover
   have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<cdot>\<^sub>s\<^sub>e\<^sub>t I = (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<union> (ik\<^sub>s\<^sub>s\<^sub>t ?T \<cdot>\<^sub>s\<^sub>e\<^sub>t I)"
     unfolding \<A>'_def by auto
   moreover
   have "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>') I {} = dbupd\<^sub>s\<^sub>s\<^sub>t ?T I (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) I {})"
     unfolding \<A>'_def by (simp add: dbupd\<^sub>s\<^sub>s\<^sub>t_append) 
   moreover
   have "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> trms\<^sub>s\<^sub>s\<^sub>t ?T"
     unfolding \<A>'_def by auto
   moreover
   have "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> vars\<^sub>s\<^sub>s\<^sub>t ?T"
     unfolding \<A>'_def by auto
   ultimately
   have "(ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<cdot>\<^sub>s\<^sub>e\<^sub>t I, dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>') I {}, trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>', vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>', w')
           \<in> ground_protocol_states_aux P"
     using w'_def by auto
   then show ?case 
     unfolding \<A>'_def w'_def by auto
 qed
 
 private lemma protocol_model_equivalence_aux1:
   "{(IK, DB) | IK DB. \<exists>w trms vars. (IK, DB, trms, vars, w) \<in> ground_protocol_states_aux P} = 
    {(ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I), dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I {}) | A I.
       A \<in> reachable_constraints P \<and> strand_sem_stateful {} {} (unlabel A) I \<and>
       interpretation\<^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 (rule; rule; rule)
   fix IK DB
   assume "(IK, DB) \<in>
             {(IK, DB) | IK DB. \<exists>w trms vars. (IK, DB, trms, vars, w) \<in> ground_protocol_states_aux P}"
   then have "\<exists>w trms vars. (IK, DB, trms, vars, w) \<in> ground_protocol_states_aux P"
     by auto
   then obtain w trms vars where "(IK, DB, trms, vars, w) \<in> ground_protocol_states_aux P"
     by auto
   then have reachable:
       "T_symb w \<in> reachable_constraints P"
       "strand_sem_stateful {} {} (unlabel (T_symb w)) (comb_I w)"
       "IK = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t comb_I w)"
       "DB = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w) {}"
       "trms = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w)"
       "vars = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w)" 
       "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (comb_I w)"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (comb_I w))"
     using reachable_constraints_if_ground_protocol_states_aux[of IK DB trms vars w P] by auto
   then have
       "IK = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t (comb_I w))"
       "DB = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (T_symb w)) (comb_I w) {}"
       "T_symb w \<in> reachable_constraints P"
       "strand_sem_stateful {} {} (unlabel (T_symb w)) (comb_I w)"
       "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (comb_I w) \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (comb_I w))"
     by auto
   then show "\<exists>A I. (IK, DB) = (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I), dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I {}) \<and>
                    A \<in> reachable_constraints P \<and> strand_sem_stateful {} {} (unlabel A) I \<and>
                    interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
     by blast
 next
   fix IK DB
   assume "(IK, DB) \<in>
             {(ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I), dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I {}) | A I.
               A \<in> reachable_constraints P \<and> strand_sem_stateful {} {} (unlabel A) I \<and>
               interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)}"
   then obtain A I where A_I_p:
      "IK = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)"
      "DB = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I {}"
      "A \<in> reachable_constraints P"
      "strand_sem_stateful {} {} (unlabel A) I"
      "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I"
      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)" 
     by auto
   then have "\<exists>w. (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I, dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I {}, trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A, vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A, w)
                   \<in> ground_protocol_states_aux P"
     using ground_protocol_states_aux_if_reachable_constraints[of A P I] by auto
   then have "\<exists>w. (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I, DB, trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A, vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A, w) \<in> ground_protocol_states_aux P"
     using A_I_p by blast
   then have "\<exists>w. (ik\<^sub>s\<^sub>s\<^sub>t (unlabel A \<cdot>\<^sub>s\<^sub>s\<^sub>t I), DB, trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A, vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A, w) \<in> ground_protocol_states_aux P"
     by (simp add: ik\<^sub>s\<^sub>s\<^sub>t_subst)
   then have "(\<exists>w trms vars. (IK, DB, trms, vars, w) \<in> ground_protocol_states_aux P)"
     by (metis (no_types) A_I_p(1) unlabel_subst)
   then show "\<exists>IK' DB'. (IK, DB) = (IK', DB') \<and>
                        (\<exists>w trms vars. (IK', DB', trms, vars, w) \<in> ground_protocol_states_aux P)"
     by auto
 qed
 
 subsubsection \<open>The Protocol Model Equivalence Proof\<close>
 
 private lemma subst_ground_term_ident:
   assumes "ground_term t"
   shows "t \<cdot> I = t"
 using assms by (simp add: subst_ground_ident)
 
 private lemma subst_comp_rm_vars_eq:
   fixes \<delta> :: "('fun,'atom,'sets,'lbl) prot_subst"
   fixes \<alpha> :: "('fun,'atom,'sets,'lbl) prot_subst"
   fixes I :: "('fun,'atom,'sets,'lbl) prot_subst"
   assumes "subst_domain \<delta> = set X \<and> ground (subst_range \<delta>)"
   shows "(\<delta> \<circ>\<^sub>s \<alpha>) = (\<delta> \<circ>\<^sub>s (rm_vars (set X) \<alpha>))"
 proof (rule ext)
   fix x
   show "(\<delta> \<circ>\<^sub>s \<alpha>) x = (\<delta> \<circ>\<^sub>s rm_vars (set X) \<alpha>) x"
   proof (cases "x \<in> set X")
     case True
     have gt: "ground_term (\<delta> x)"
       using True assms by auto
 
     have "(\<delta> \<circ>\<^sub>s \<alpha>) x = (\<delta> x) \<cdot> \<alpha>"
       using subst_compose by metis
     also
     have "... = \<delta> x"
       using gt subst_ground_term_ident by blast
     also
     have "... = (\<delta> x) \<cdot> (rm_vars (set X) \<alpha>)"
       using gt subst_ground_term_ident by fastforce 
     also
     have "... = (\<delta> \<circ>\<^sub>s (rm_vars (set X) \<alpha>)) x"
       using subst_compose by metis
     ultimately
     show ?thesis
       by auto
   next
     case False
     have delta_x: "\<delta> x = Var x"
       using False assms by blast
     have "(rm_vars (set X) \<alpha>) x = \<alpha> x"
       using False by auto
 
     have "(\<delta> \<circ>\<^sub>s \<alpha>) x = (\<delta> x) \<cdot> \<alpha>"
       using subst_compose by metis
     also
     have "... = (Var x) \<cdot> \<alpha>"
       using delta_x by presburger
     also
     have "... = (Var x) \<cdot> (rm_vars (set X) \<alpha>)"
       using False by force
     also
     have "... = (\<delta> x) \<cdot> (rm_vars (set X) \<alpha>)"
       using delta_x by presburger
     also
     have "... = (\<delta> \<circ>\<^sub>s (rm_vars (set X) \<alpha>)) x"
       using subst_compose by metis
     finally
     show ?thesis 
       by auto
   qed
 qed
 
 private lemma subst_comp_rm_vars_commute:
   assumes "\<forall>x\<in>set X. \<forall>y. \<alpha> y \<noteq> Var x"
   assumes "subst_range \<alpha> \<subseteq> range Var"
   assumes "subst_domain \<delta> = set X"
   assumes "ground (subst_range \<delta>)"
   shows "(\<delta> \<circ>\<^sub>s (rm_vars (set X) \<alpha>)) = (rm_vars (set X) \<alpha> \<circ>\<^sub>s \<delta>)"
 proof (rule ext)
   fix x
   show "(\<delta> \<circ>\<^sub>s rm_vars (set X) \<alpha>) x = (rm_vars (set X) \<alpha> \<circ>\<^sub>s \<delta>) x"
   proof (cases "x \<in> set X")
     case True
     then have gt: "ground_term (\<delta> x)"
       using True assms(3,4) by auto
 
     have "(\<delta> \<circ>\<^sub>s (rm_vars (set X) \<alpha>)) x = \<delta> x \<cdot> rm_vars (set X) \<alpha>"
       by (simp add: subst_compose)
     also
     have "... = \<delta> x"
       using gt by auto
     also
     have "... = ((rm_vars (set X) \<alpha>) x) \<cdot> \<delta>"
       by (simp add: True)
     also
     have "... = (rm_vars (set X) \<alpha> \<circ>\<^sub>s \<delta>) x"
       by (simp add: subst_compose)
     finally 
     show ?thesis .
   next
     case False
     have \<delta>_x: "\<delta> x = Var x"
       using False assms(3) by blast
     obtain y where y_p: "\<alpha> x = Var y"
       by (meson assms(2) image_iff subsetD subst_imgI)
     then have "y \<notin> set X"
       using assms(1) by blast
     then show ?thesis
       using assms(3,4) subst_domI False \<delta>_x y_p
       by (metis (mono_tags, lifting) subst_comp_notin_dom_eq subst_compose)
   qed
 qed
 
 private lemma negchecks_model_substitution_lemma_1:
   fixes \<alpha> :: "('fun,'atom,'sets,'lbl) prot_subst"
   fixes I :: "('fun,'atom,'sets,'lbl) prot_subst"
   assumes "negchecks_model (\<alpha> \<circ>\<^sub>s I) DB X F F'"
   assumes "subst_range \<alpha> \<subseteq> range Var"
   assumes "\<forall>x\<in>set X. \<forall>y. \<alpha> y \<noteq> Var x"
   shows  "negchecks_model I DB X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>) (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>)"
   unfolding negchecks_model_def
 proof (rule, rule)
   fix \<delta> :: "('fun,'atom,'sets,'lbl) prot_subst"
   assume a: "subst_domain \<delta> = set X \<and> ground (subst_range \<delta>)"
 
   have "(\<exists>(t, s)\<in>set F. t \<cdot> \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I) \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I)) \<or>
           (\<exists>(t, s)\<in>set F'. (t, s) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I) \<notin> DB)"
     using a assms(1) unfolding negchecks_model_def by auto
   then show "(\<exists>(t, s)\<in>set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>). t \<cdot> \<delta> \<circ>\<^sub>s I \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s I) \<or> 
                (\<exists>(t, s)\<in>set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>). (t, s) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s I \<notin> DB)"
   proof
     assume "\<exists>(t, s)\<in>set F. t \<cdot> \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I) \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I)"
     then obtain t s where t_s_p: "(t, s)\<in>set F" "t \<cdot> \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I) \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I)"
       by auto
     from this(2) have "t \<cdot> \<delta> \<circ>\<^sub>s ((rm_vars (set X) \<alpha>) \<circ>\<^sub>s I) \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s ((rm_vars (set X) \<alpha>) \<circ>\<^sub>s I)"
       using assms(3) a using subst_comp_rm_vars_eq[of \<delta> X \<alpha>] subst_compose_assoc
       by (metis (no_types, lifting)) 
     then have "t \<cdot> (rm_vars (set X) \<alpha>) \<circ>\<^sub>s  ( \<delta> \<circ>\<^sub>s I) \<noteq> s \<cdot> (rm_vars (set X) \<alpha>) \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s I)"
       using subst_comp_rm_vars_commute[of X \<alpha> \<delta>, OF assms(3) assms(2)] a
       by (metis (no_types, lifting) subst_compose_assoc[symmetric])
     then have "t \<cdot> (rm_vars (set X) \<alpha>) \<cdot> ( \<delta> \<circ>\<^sub>s I) \<noteq> s \<cdot> (rm_vars (set X) \<alpha>) \<cdot> (\<delta> \<circ>\<^sub>s I)"
       by auto
     moreover
     have "(t \<cdot> rm_vars (set X) \<alpha>, s \<cdot> rm_vars (set X) \<alpha>) \<in> set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>)"
       using subst_apply_pairs_pset_subst t_s_p(1) by fastforce
     ultimately
     have "\<exists>(t, s)\<in>set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>). t \<cdot> \<delta> \<circ>\<^sub>s I \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s I"
       by auto
     then show ?thesis
       by auto
   next
     assume "\<exists>(t, s)\<in>set F'. (t, s) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I) \<notin> DB"
     then obtain t s where t_s_p: "(t, s) \<in> set F'" "(t, s) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I) \<notin> DB"
       by auto
     from this(2) have "(t, s) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s (rm_vars (set X) \<alpha> \<circ>\<^sub>s I) \<notin> DB"
       using assms(3) a subst_comp_rm_vars_eq[OF a]
       by (metis (no_types, lifting) case_prod_conv subst_subst_compose)
     then have "(t, s) \<cdot>\<^sub>p rm_vars (set X) \<alpha> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s I) \<notin> DB"
       using a subst_comp_rm_vars_commute[of X \<alpha> \<delta>, OF assms(3) assms(2)]
       by (metis (no_types, lifting) case_prod_conv subst_compose_assoc) 
     then have "(t \<cdot> rm_vars (set X) \<alpha>, s \<cdot> rm_vars (set X) \<alpha>) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s I \<notin> DB"
       by auto
     moreover
     have "(t \<cdot> rm_vars (set X) \<alpha>, s \<cdot> rm_vars (set X) \<alpha>) \<in> set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>)"
       using t_s_p(1) subst_apply_pairs_pset_subst by fastforce
     ultimately
     have "(\<exists>(t, s) \<in> set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>). (t, s) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s I \<notin> DB)"
       by auto
     then show ?thesis
       by auto
   qed
 qed
 
 private lemma negchecks_model_substitution_lemma_2:
   fixes \<alpha> :: "('fun,'atom,'sets,'lbl) prot_subst"
   fixes I :: "('fun,'atom,'sets,'lbl) prot_subst"
   assumes "negchecks_model I DB X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>) (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>)"
   assumes "subst_range \<alpha> \<subseteq> range Var"
   assumes "\<forall>x\<in>set X. \<forall>y. \<alpha> y \<noteq> Var x"
   shows "negchecks_model (\<alpha> \<circ>\<^sub>s I) DB X F F'"
   unfolding negchecks_model_def
 proof (rule, rule)
   fix \<delta> :: "('fun,'atom,'sets,'lbl) prot_subst"
   assume a: "subst_domain \<delta> = set X \<and> ground (subst_range \<delta>)"
 
   have "(\<exists>(t, s)\<in>set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>). t \<cdot> \<delta> \<circ>\<^sub>s  I \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s (I)) \<or>
           (\<exists>(t, s)\<in>set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>). (t, s) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s I \<notin> DB)"
     using a assms(1)unfolding negchecks_model_def by auto
   then show "(\<exists>(t, s)\<in>set F. t \<cdot> \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I) \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I)) \<or>
                (\<exists>(t, s)\<in>set F'. (t, s) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I) \<notin> DB)"
   proof
     assume "\<exists>(t, s)\<in>set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>). t \<cdot> \<delta> \<circ>\<^sub>s  I \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s (I)"
     then obtain t s where t_s_p: "(t, s) \<in> set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>)" "t \<cdot> \<delta> \<circ>\<^sub>s I \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s I"
       by auto
     then have "\<exists>t' s'. t = t' \<cdot> rm_vars (set X) \<alpha> \<and> s = s' \<cdot> rm_vars (set X) \<alpha> \<and> (t',s') \<in> set F"
       unfolding subst_apply_pairs_def by auto
     then obtain t' s' where t'_s'_p: 
       "t = t' \<cdot> rm_vars (set X) \<alpha>" 
       "s = s' \<cdot> rm_vars (set X) \<alpha>" 
       "(t',s') \<in> set F"
       by auto
     then have "t' \<cdot> rm_vars (set X) \<alpha> \<cdot> \<delta> \<circ>\<^sub>s I \<noteq> s' \<cdot> rm_vars (set X) \<alpha> \<cdot> \<delta> \<circ>\<^sub>s I"
       using t_s_p by auto
     then have "t' \<cdot>  \<delta> \<cdot> rm_vars (set X) \<alpha> \<circ>\<^sub>s I \<noteq> s' \<cdot> \<delta> \<cdot> rm_vars (set X) \<alpha>  \<circ>\<^sub>s I"
       using a subst_comp_rm_vars_commute[OF assms(3,2)] by (metis (no_types, lifting) subst_subst)
     then have "t' \<cdot>  \<delta> \<cdot> \<alpha> \<circ>\<^sub>s I \<noteq> s' \<cdot> \<delta> \<cdot> \<alpha>  \<circ>\<^sub>s I"
       using subst_comp_rm_vars_eq[OF a] by (metis (no_types, lifting) subst_subst)
     moreover
     from t_s_p(1) have "(t', s') \<in> set F"
       using subst_apply_pairs_pset_subst t'_s'_p by fastforce
     ultimately
     have "\<exists>(t, s)\<in>set F. t \<cdot> \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I) \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I)"
       by auto
     then show ?thesis
       by auto
   next
     assume "\<exists>(t, s)\<in>set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>). (t, s) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s I \<notin> DB"
     then obtain t s where t_s_p: 
       "(t, s) \<in> set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>)" 
       "(t \<cdot> \<delta> \<circ>\<^sub>s I, s \<cdot> \<delta> \<circ>\<^sub>s I) \<notin> DB"
       by auto
     then have "\<exists>t' s'. t = t' \<cdot> rm_vars (set X) \<alpha> \<and> s = s' \<cdot> rm_vars (set X) \<alpha> \<and> (t',s') \<in> set F'"
       unfolding subst_apply_pairs_def by auto
     then obtain t' s' where t'_s'_p: 
       "t = t' \<cdot> rm_vars (set X) \<alpha>" 
       "s = s' \<cdot> rm_vars (set X) \<alpha>" 
       "(t',s') \<in> set F'"
       by auto
     then have "(t' \<cdot> rm_vars (set X) \<alpha> \<cdot> \<delta> \<circ>\<^sub>s I, s' \<cdot> rm_vars (set X) \<alpha> \<cdot> \<delta> \<circ>\<^sub>s I) \<notin> DB"
       using t_s_p by auto
     then have "(t' \<cdot>  \<delta> \<cdot> rm_vars (set X) \<alpha> \<circ>\<^sub>s I, s' \<cdot> \<delta> \<cdot> rm_vars (set X) \<alpha>  \<circ>\<^sub>s I) \<notin> DB"
       using a subst_comp_rm_vars_commute[OF assms(3,2)]
       by (metis (no_types, lifting) subst_subst)
     then have "(t' \<cdot>  \<delta> \<cdot> \<alpha> \<circ>\<^sub>s I , s' \<cdot> \<delta> \<cdot> \<alpha>  \<circ>\<^sub>s I) \<notin> DB"
       using subst_comp_rm_vars_eq[OF a] by (metis (no_types, lifting) subst_subst)
     moreover
     from t_s_p(1) have "(t', s') \<in> set F'"
       using subst_apply_pairs_pset_subst t'_s'_p by fastforce
     ultimately
     have "\<exists>(t, s)\<in>set F'. (t, s) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s (\<alpha> \<circ>\<^sub>s I) \<notin> DB"
       by auto
     then show ?thesis
       by auto
   qed
 qed
 
 private lemma negchecks_model_substitution_lemma:
   fixes \<alpha> :: "('fun,'atom,'sets,'lbl) prot_subst"
   fixes I :: "('fun,'atom,'sets,'lbl) prot_subst"
   assumes "subst_range \<alpha> \<subseteq> range Var"
   assumes "\<forall>x\<in>set X. \<forall>y. \<alpha> y \<noteq> Var x"
   shows "negchecks_model (\<alpha> \<circ>\<^sub>s I) DB X F F' \<longleftrightarrow>
            negchecks_model I DB X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>) (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>)"
 using assms negchecks_model_substitution_lemma_1[of \<alpha> I DB X F F'] 
       negchecks_model_substitution_lemma_2[of I DB X F \<alpha> F'] assms
 by auto
 
 private lemma strand_sem_stateful_substitution_lemma:
   fixes \<alpha> :: "('fun,'atom,'sets,'lbl) prot_subst"
   fixes I :: "('fun,'atom,'sets,'lbl) prot_subst"
   assumes "subst_range \<alpha> \<subseteq> range Var"
   assumes "\<forall>x \<in> bvars\<^sub>s\<^sub>s\<^sub>t T. \<forall>y. \<alpha> y \<noteq> Var x"
   shows "strand_sem_stateful IK DB (T \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>) I = strand_sem_stateful IK DB T (\<alpha> \<circ>\<^sub>s I)"
 using assms
 proof (induction T arbitrary: IK DB)
   case Nil
   then show ?case by auto
 next
   case (Cons a T)
   then show ?case
   proof (induction a)
     case (Receive ts)
     have "((\<lambda>x. x \<cdot> \<alpha> \<cdot> I) ` (set ts)) \<union> IK = ((\<lambda>t. t \<cdot> \<alpha>) ` set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<union> IK"
       by blast
     then show ?case
       using Receive by (force simp add: subst_sst_cons)
   next
     case (NegChecks X F F')
 
     have bounds: "\<forall>x\<in>bvars\<^sub>s\<^sub>s\<^sub>t T. \<forall>y. \<alpha> y \<noteq> Var x"
       using NegChecks by auto
 
     have "\<forall>x\<in>bvars\<^sub>s\<^sub>s\<^sub>t ([\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle>]). \<forall>y. \<alpha> y \<noteq> Var x"
       using NegChecks by auto
     then have bounds2: "\<forall>x\<in>set X. \<forall>y. \<alpha> y \<noteq> Var x"
       by simp
 
     have "negchecks_model I DB X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>) (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>) \<longleftrightarrow>
             negchecks_model (\<alpha> \<circ>\<^sub>s I) DB X F F'"
       using NegChecks.prems(2) bounds2 negchecks_model_substitution_lemma by blast
     moreover
     have "strand_sem_stateful IK DB (T \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>) I \<longleftrightarrow> strand_sem_stateful IK DB T (\<alpha> \<circ>\<^sub>s I)"
       using Cons NegChecks(2) bounds by blast
     ultimately
     show ?case
       by (simp add: subst_sst_cons)
   qed (force simp add: subst_sst_cons)+
 qed
 
 private lemma ground_subst_rm_vars_subst_compose_dist:
   assumes "ground (subst_range \<xi>\<sigma>)"
   shows "(rm_vars (set X) (\<xi>\<sigma> \<circ>\<^sub>s \<alpha>)) = (rm_vars (set X) \<xi>\<sigma> \<circ>\<^sub>s rm_vars (set X) \<alpha>)"
 proof (rule ext)
   fix x
   show "rm_vars (set X) (\<xi>\<sigma> \<circ>\<^sub>s \<alpha>) x = (rm_vars (set X) \<xi>\<sigma> \<circ>\<^sub>s rm_vars (set X) \<alpha>) x"
   proof (cases "x \<in> set X")
     case True
     then show ?thesis
       by (simp add: subst_compose)
   next
     case False
     note False_outer = False
     show ?thesis
     proof (cases "x \<in> subst_domain \<xi>\<sigma>")
       case True
       then show ?thesis
         by (metis (mono_tags, lifting) False assms ground_subst_range_empty_fv 
               subst_ground_ident_compose(1))
     next
       case False
       have "\<xi>\<sigma> x = Var x"
         using False by blast
       then show ?thesis 
         using False_outer by (simp add: subst_compose)
     qed
   qed
 qed
 
 private lemma stateful_strand_ground_subst_comp:
   assumes "ground (subst_range \<xi>\<sigma>)"
   shows "T \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi>\<sigma> \<circ>\<^sub>s \<alpha> = (T \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi>\<sigma>) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>"
 using assms by (meson disjoint_iff ground_subst_no_var stateful_strand_subst_comp)
 
 private lemma labelled_stateful_strand_ground_subst_comp:
   assumes "ground (subst_range \<xi>\<sigma>)"
   shows "T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi>\<sigma> \<circ>\<^sub>s \<alpha> = (T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi>\<sigma>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<alpha>"
 using assms by (metis Int_empty_left ground_range_vars labeled_stateful_strand_subst_comp)
 
 private lemma transaction_fresh_subst_ground_subst_range:
   assumes "transaction_fresh_subst \<sigma> T trms"
   shows "ground (subst_range \<sigma>)"
 using assms by (metis range_vars_alt_def transaction_fresh_subst_range_vars_empty)
 
 private lemma transaction_decl_subst_ground_subst_range:
   assumes "transaction_decl_subst \<xi> T"
   shows "ground (subst_range \<xi>)"
 proof -
   have \<xi>_ground: "\<forall>x \<in> subst_domain \<xi>. ground_term (\<xi> x)"
     using assms transaction_decl_subst_domain transaction_decl_subst_grounds_domain by force
   show ?thesis
   proof (rule ccontr)
     assume "fv\<^sub>s\<^sub>e\<^sub>t (subst_range \<xi>) \<noteq> {}"
     then have "\<exists>x \<in> subst_domain \<xi>. fv (\<xi> x) \<noteq> {}"
       by auto
     then obtain x where x_p: "x \<in> subst_domain \<xi> \<and> fv (\<xi> x) \<noteq> {}"
       by meson
     moreover 
     have "ground_term (\<xi> x)"
       using \<xi>_ground x_p by auto
     ultimately
     show "False"
       by auto
   qed
 qed
 
 private lemma fresh_transaction_decl_subst_ground_subst_range:
   assumes "transaction_fresh_subst \<sigma> T trms"
   assumes "transaction_decl_subst \<xi> T"
   shows "ground (subst_range (\<xi> \<circ>\<^sub>s \<sigma>))"
 proof -
   have "ground (subst_range \<xi>)"
     using assms transaction_decl_subst_ground_subst_range by blast
   moreover
   have "ground (subst_range \<sigma>)"
     using assms
     using transaction_fresh_subst_ground_subst_range by blast 
   ultimately
   show "ground (subst_range (\<xi> \<circ>\<^sub>s \<sigma>))"
     by (metis (no_types, opaque_lifting) Diff_iff all_not_in_conv empty_iff empty_subsetI 
           range_vars_alt_def range_vars_subst_compose_subset subset_antisym sup_bot.right_neutral)
 qed
 
 private lemma strand_sem_stateful_substitution_lemma':
   assumes "transaction_renaming_subst \<alpha> P vars"
   assumes "transaction_fresh_subst \<sigma> T trms"
   assumes "transaction_decl_subst \<xi> T"
   assumes "finite vars"
   assumes "T \<in> set P"
   shows "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))) I
     \<longleftrightarrow> strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma>))) (\<alpha> \<circ>\<^sub>s I)"
 proof -
   have \<alpha>_Var: "subst_range \<alpha> \<subseteq> range Var"
     using assms(1) transaction_renaming_subst_is_renaming(5) by blast
   have "(\<forall>x\<in>vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T). \<forall>y. \<alpha> y \<noteq> Var x)"
     using assms(4,2) transaction_renaming_subst_vars_transaction_neq assms(1) assms(5) by blast 
   then have "(\<forall>x\<in>bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T). \<forall>y. \<alpha> y \<noteq> Var x)"
     by (metis UnCI vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t)
   then have T_Vars: "(\<forall>x\<in>bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma>)). \<forall>y. \<alpha> y \<noteq> Var x)"
     by (metis bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq)
 
   have ground_\<xi>_\<sigma>: "ground (subst_range (\<xi> \<circ>\<^sub>s \<sigma>))"
     using fresh_transaction_decl_subst_ground_subst_range
     using assms(2) assms(3) by blast
  
   from assms(1) ground_\<xi>_\<sigma> have 
     "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) =
     unlabel ((dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<alpha>)"
     using stateful_strand_ground_subst_comp[of _ "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"]
     by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst) 
   then show ?thesis
     using strand_sem_stateful_substitution_lemma \<alpha>_Var T_Vars
     by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst subst_lsst_unlabel)
 qed
 
 inductive_set ground_protocol_states::
   "('fun,'atom,'sets,'lbl) prot \<Rightarrow>
    (('fun,'atom,'sets,'lbl) prot_terms \<times>
     (('fun,'atom,'sets,'lbl) prot_term \<times> ('fun,'atom,'sets,'lbl) prot_term) set
     \<times>
    _ set
    ) set" (* TODO: write up the type nicer *)
   for P::"('fun,'atom,'sets,'lbl) prot"
 where
   init:
   "({},{},{}) \<in> ground_protocol_states P"
 | step:
   "\<lbrakk>(IK,DB,consts) \<in> ground_protocol_states P;
     T \<in> set P;
     transaction_decl_subst \<xi> T;
     transaction_fresh_subst \<sigma> T consts;
     A = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma>);
     strand_sem_stateful IK DB (unlabel A) I;
     interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I;
     wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)
    \<rbrakk> \<Longrightarrow> (IK \<union> ((ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t I), dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I DB,
           consts \<union> {t. t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<and> (\<exists>c. t = Fun c [])}) \<in> ground_protocol_states P"
 
 
 private lemma transaction_fresh_subst_consts_of_iff:
   "transaction_fresh_subst \<sigma> T (consts_of trms) \<longleftrightarrow> transaction_fresh_subst \<sigma> T trms"
 proof (cases "transaction_fresh_subst \<sigma> T (consts_of trms) \<or> transaction_fresh_subst \<sigma> T trms")
   case True
   then have "\<forall>t \<in> subst_range \<sigma>. \<exists>c. t = Fun c []"
     unfolding transaction_fresh_subst_def by auto
   have "(\<forall>t \<in> subst_range \<sigma>. t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (consts_of trms) \<longleftrightarrow> t \<in> subterms\<^sub>s\<^sub>e\<^sub>t trms)"
   proof 
     fix t
     assume "t \<in> subst_range \<sigma>"
     then obtain c where c_p: "t = Fun c []"
       using \<open>\<forall>t\<in>subst_range \<sigma>. \<exists>c. t = Fun c []\<close> by blast
     have "Fun c [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (consts_of trms) \<longleftrightarrow> Fun c [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t trms"
       unfolding consts_of_def by auto
     then show "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (consts_of trms) \<longleftrightarrow> t \<in> subterms\<^sub>s\<^sub>e\<^sub>t trms"
       using c_p by auto
   qed
   then show ?thesis
     using transaction_fresh_subst_def by force
 next
   case False
   then show ?thesis by auto
 qed
 
 private lemma transaction_renaming_subst_inv:
   assumes "transaction_renaming_subst \<alpha> P X "
   shows "\<exists>\<alpha>inv. \<alpha> \<circ>\<^sub>s \<alpha>inv = Var \<and>  wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<alpha>inv)"
 using var_rename_inv_comp transaction_renaming_subst_def assms subst_apply_term_empty subst_term_eqI
 by (metis var_rename_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_range(2))  
 
 private lemma consts_of_union_distr: 
   "consts_of (trms1 \<union> trms2) = consts_of trms1 \<union> consts_of trms2"
 unfolding consts_of_def by auto
 
 private lemma ground_protocol_states_aux_finite_vars:
   assumes "(IK,DB,trms,vars,w) \<in> ground_protocol_states_aux P"
   shows "finite vars"
 using assms by (induction rule: ground_protocol_states_aux.induct) auto
 
 private lemma dbupd\<^sub>s\<^sub>s\<^sub>t_substitution_lemma:
   "dbupd\<^sub>s\<^sub>s\<^sub>t T (\<alpha> \<circ>\<^sub>s I) DB = dbupd\<^sub>s\<^sub>s\<^sub>t (T \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>) I DB"
 proof (induction T arbitrary: DB)
   case Nil
   then show ?case
     by auto 
 next
   case (Cons a T)
   then show ?case
     by (induction a) (simp_all add: subst_apply_stateful_strand_def)
 qed
 
 private lemma subst_Var_const_subterm_subst:
   assumes "subst_range \<alpha> \<subseteq> range Var"
   shows "Fun c [] \<sqsubseteq> t \<longleftrightarrow> Fun c [] \<sqsubseteq> t \<cdot> \<alpha>"
   using assms
 proof (induction t)
   case (Var x)
   then show ?case
     by (metis is_Var_def subtermeq_Var_const(1) term.discI(2) var_renaming_is_Fun_iff)
 next
   case (Fun f ts)
   then show ?case
     by auto
 qed
 
 private lemma subst_Var_consts_of:
   assumes "subst_range \<alpha> \<subseteq> range Var"
   shows "consts_of T = consts_of (T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<alpha>)"
 proof (rule antisym; rule subsetI)
   fix x
   assume "x \<in> consts_of T"
   then obtain t c where t_c_p: "t \<in> T \<and> x \<sqsubseteq> t \<and> x = Fun c []"
     unfolding consts_of_def by auto
   moreover
   have "x \<sqsubseteq> t \<cdot> \<alpha>"
     using t_c_p by (meson assms subst_Var_const_subterm_subst)
   ultimately
   show "x \<in> consts_of (T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<alpha>)"
     unfolding consts_of_def by auto 
 next
   fix x
   assume "x \<in> consts_of (T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<alpha>)"
   then obtain t c where t_c_p: "t \<in> T \<and> x \<sqsubseteq> t \<cdot> \<alpha> \<and> x = Fun c []"
     unfolding consts_of_def by auto
   moreover
   have "x \<sqsubseteq> t"
     using t_c_p by (meson assms subst_Var_const_subterm_subst)
   ultimately
   show "x \<in> consts_of T"
     unfolding consts_of_def by auto
 qed
 
 private lemma fst_set_subst_apply_set:
   "fst ` set F \<cdot>\<^sub>s\<^sub>e\<^sub>t \<alpha> = fst ` (set F \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<alpha>)"
 by (induction F) auto
 
 private lemma snd_set_subst_apply_set:
   "snd ` set F \<cdot>\<^sub>s\<^sub>e\<^sub>t \<alpha> = snd ` (set F \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<alpha>)"
 by (induction F) auto
 
 private lemma trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fst_snd: 
   "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = fst ` set F \<union> snd ` set F"
 by (auto simp add: rev_image_eqI)
 
 private lemma consts_of_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_range_Var:
   assumes "subst_range \<alpha> \<subseteq> range Var"
   shows "consts_of (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) = consts_of (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<alpha>))"
   using assms
 proof (induction a)
   case (NegChecks X F F')
   have \<alpha>_subs_rng_Var: "subst_range (rm_vars (set X) \<alpha>) \<subseteq> range Var"
     using assms by auto
 
   have "consts_of (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) = consts_of (fst ` set F \<union> snd ` set F)"
     using trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fst_snd by metis
   also
   have "... = consts_of (fst ` set F) \<union> consts_of (snd ` set F)"
     using consts_of_union_distr by blast
   also
   have "... = consts_of ((fst ` set F) \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \<alpha>) \<union>
                 consts_of ((snd ` set F) \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \<alpha>)"
     using \<alpha>_subs_rng_Var subst_Var_consts_of[of "rm_vars (set X) \<alpha>" "fst ` set F"] 
             subst_Var_consts_of[of "rm_vars (set X) \<alpha>" "snd ` set F"] 
     by auto
   also
   have "... = consts_of (((fst ` set F) \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \<alpha>) \<union>
                 ((snd ` set F) \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \<alpha>))"
     using consts_of_union_distr by auto
   also
   have "... = consts_of (fst ` set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>) \<union>
                 snd ` set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>))"
     unfolding subst_apply_pairs_def fst_set_subst_apply_set snd_set_subst_apply_set by simp 
   also
   have "... = consts_of (trms\<^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) \<alpha>))"
     using trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fst_snd[of "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>"] 
     by metis
   finally 
   have 1: "consts_of (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) = consts_of (trms\<^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) \<alpha>))"
     by auto
 
   have "consts_of (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F') = consts_of (fst ` set F' \<union> snd ` set F')"
     using trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fst_snd by metis
   also
   have "... = consts_of (fst ` set F') \<union> consts_of (snd ` set F')"
     using consts_of_union_distr by blast
   also
   have "... = consts_of ((fst ` set F') \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \<alpha>) \<union>
                 consts_of ((snd ` set F') \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \<alpha>)"
     using subst_Var_consts_of[of "rm_vars (set X) \<alpha>" "fst ` set F'"] \<alpha>_subs_rng_Var
             subst_Var_consts_of[of "rm_vars (set X) \<alpha>" "snd ` set F'"]
     by auto
   also
   have "... = consts_of ((fst ` set F' \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \<alpha>) \<union>
                 (snd ` set F' \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \<alpha>))"
     using consts_of_union_distr by auto
   also
   have "... = consts_of (fst ` set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>) \<union> 
                 snd ` set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>))"
     unfolding subst_apply_pairs_def fst_set_subst_apply_set snd_set_subst_apply_set by simp 
   also
   have "... = consts_of (trms\<^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) \<alpha>))"
     using trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fst_snd[of "F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<alpha>"] 
     by metis
   finally have 2: "consts_of (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F') = consts_of (trms\<^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) \<alpha>))"
     by auto
 
   show ?case 
     using 1 2 by (simp add: consts_of_union_distr)
 qed (use subst_Var_consts_of[of _ "{_, _}", OF assms] subst_Var_consts_of[OF assms] in auto)
 
 private lemma consts_of_trms\<^sub>s\<^sub>s\<^sub>t_range_Var:
   assumes "subst_range \<alpha> \<subseteq> range Var"
   shows "consts_of (trms\<^sub>s\<^sub>s\<^sub>t T) = consts_of (trms\<^sub>s\<^sub>s\<^sub>t (T \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>))"
 proof (induction T)
   case Nil
   then show ?case by auto
 next
   case (Cons a T)
   have "consts_of (trms\<^sub>s\<^sub>s\<^sub>t (a # T)) = consts_of (trms\<^sub>s\<^sub>s\<^sub>t [a] \<union> trms\<^sub>s\<^sub>s\<^sub>t T)"
     by simp
   also
   have "... = consts_of (trms\<^sub>s\<^sub>s\<^sub>t [a]) \<union> consts_of (trms\<^sub>s\<^sub>s\<^sub>t T)"
     using consts_of_union_distr by simp
   also 
   have "... = consts_of (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) \<union> consts_of (trms\<^sub>s\<^sub>s\<^sub>t T)"
     by simp
   also
   have "... = consts_of (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<alpha>)) \<union> consts_of (trms\<^sub>s\<^sub>s\<^sub>t T)"
     using consts_of_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_range_Var[OF assms] by simp
   also 
   have "... = consts_of (trms\<^sub>s\<^sub>s\<^sub>t ([a] \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>)) \<union> consts_of (trms\<^sub>s\<^sub>s\<^sub>t T)"
     by (simp add: subst_apply_stateful_strand_def)
   also
   have "... = consts_of (trms\<^sub>s\<^sub>s\<^sub>t ([a] \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>)) \<union> consts_of (trms\<^sub>s\<^sub>s\<^sub>t (T \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>))"
     using local.Cons by simp
   also
   have "... = consts_of (trms\<^sub>s\<^sub>s\<^sub>t (a # T \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>))"
     by (simp add: consts_of_union_distr subst_sst_cons)
   finally
   show ?case
     by simp
 qed
 
 private lemma consts_of_trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t_range_Var:
   assumes "subst_range \<alpha> \<subseteq> range Var"
   shows "consts_of (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T) = consts_of (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<alpha>))"
 using consts_of_trms\<^sub>s\<^sub>s\<^sub>t_range_Var[of \<alpha> "unlabel T"]
 by (metis assms unlabel_subst)
 
 private lemma transaction_renaming_subst_range:
   assumes "transaction_renaming_subst \<alpha> P vars"
   shows "subst_range \<alpha> \<subseteq> range Var"
 using assms unfolding transaction_renaming_subst_def var_rename_def by auto
 
 private lemma protocol_models_equiv3':
   assumes "(IK,DB,trms,vars,w) \<in> ground_protocol_states_aux P"
   shows "(IK,DB, consts_of trms) \<in> ground_protocol_states P"
   using assms 
 proof (induction rule: ground_protocol_states_aux.induct)
   case init
   then show ?case
     using ground_protocol_states.init unfolding consts_of_def by force
 next
   case (step IK DB trms vars w T \<xi> \<sigma> \<alpha> A I)
 
   have fin_vars: "finite vars"
     using ground_protocol_states_aux_finite_vars step by auto
 
   have ground_\<xi>\<sigma>: "ground (subst_range (\<xi> \<circ>\<^sub>s \<sigma>))"
     using fresh_transaction_decl_subst_ground_subst_range using step.hyps(3) step.hyps(4) by blast
 
   have \<alpha>_Var: "subst_range \<alpha> \<subseteq> range Var"
     using step(5) transaction_renaming_subst_range by metis
 
   define I' where "I' = \<alpha> \<circ>\<^sub>s I"
   define A' where "A' = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma>)"
 
   have "(IK, DB, consts_of trms) \<in> ground_protocol_states P"
     using step by force
   moreover
   have T_in_P: "T \<in> set P"
      using step by force
   moreover
   have "transaction_decl_subst \<xi> T"
      using step by force
   moreover
   have "transaction_fresh_subst \<sigma> T (consts_of trms)"
      using step transaction_fresh_subst_consts_of_iff by force
   moreover
   have "A' = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma>)"
     using A'_def .
   moreover
   have "strand_sem_stateful IK DB (unlabel A') I'"
     using step(7) step(4) step(5) step(3) T_in_P fin_vars unfolding A'_def I'_def step(6)
     using strand_sem_stateful_substitution_lemma'
     by auto
   moreover
   have "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I'"
     using step(8) unfolding I'_def
     by (meson interpretation_comp(1)) 
   moreover
   have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I')"
    using step(9) unfolding I'_def
    using step.hyps(5) transaction_renaming_subst_range_wf_trms wf_trms_subst_compose by blast 
   ultimately
   have "(IK \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A' \<cdot>\<^sub>s\<^sub>e\<^sub>t I'), dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A') I' DB, 
            consts_of trms \<union> consts_of (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A')) \<in> ground_protocol_states P"
     using ground_protocol_states.step[of IK DB "consts_of trms" P T \<xi> \<sigma> A' I']
     unfolding consts_of_def by blast
   moreover
   have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A' \<cdot>\<^sub>s\<^sub>e\<^sub>t I' = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
   proof - 
     have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A' \<cdot>\<^sub>s\<^sub>e\<^sub>t I' = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<alpha> \<circ>\<^sub>s I"
       unfolding A'_def I'_def step(6) by auto
     also
     have "... = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((A' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<alpha>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)"
       unfolding unlabel_subst[symmetric] ik\<^sub>s\<^sub>s\<^sub>t_subst by auto
     also
     have "... = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)"
       unfolding A'_def step(6)
       using labelled_stateful_strand_ground_subst_comp[of _ "transaction_strand T", OF ground_\<xi>\<sigma>]
       by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst)
     also
     have "... = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
       by (metis ik\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst)
     finally 
     show "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A' \<cdot>\<^sub>s\<^sub>e\<^sub>t I' = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
       by auto
   qed
   moreover
   have "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A') I' DB = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I DB"
   proof -
     have "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A') I' DB = 
             dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A') (\<alpha> \<circ>\<^sub>s I) DB"
       unfolding A'_def I'_def step(6) using step by auto
     also
     have "... = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A' \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>) I DB"
       using dbupd\<^sub>s\<^sub>s\<^sub>t_substitution_lemma by metis
     also
     have "... = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I DB"
       unfolding A'_def step(6)
       using stateful_strand_ground_subst_comp[of _ "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"] 
         ground_\<xi>\<sigma> by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_unlabel)
     finally
     show "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A') I' DB = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I DB"
       by auto
   qed
   moreover
   have "consts_of (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A') = consts_of (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
     by (metis (no_types, lifting) A'_def \<alpha>_Var consts_of_trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t_range_Var ground_\<xi>\<sigma> 
          labelled_stateful_strand_ground_subst_comp step.hyps(6) trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq)
   ultimately
   show ?case
     using consts_of_union_distr by metis
 qed
 
 private lemma protocol_models_equiv4':
   assumes "(IK, DB, csts) \<in> ground_protocol_states P"
   shows "\<exists>trms w vars. (IK,DB,trms,vars,w) \<in> ground_protocol_states_aux P 
                   \<and> csts = consts_of trms
                   \<and> vars = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w)"
   using assms 
 proof (induction rule: ground_protocol_states.induct)
   case init
   have "({}, {}, {}, {}, []) \<in> ground_protocol_states_aux P"
     using ground_protocol_states_aux.init by blast
   moreover
   have "{} = consts_of {}"
     unfolding consts_of_def by auto
   moreover
   have "{} = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb [])"
     by auto
   ultimately
   show ?case
     by metis
 next
   case (step IK DB "consts" T \<xi> \<sigma> A I)
   then obtain trms w vars where trms_w_vars_p:
     "(IK, DB, trms, vars, w) \<in> ground_protocol_states_aux P"
     "consts = consts_of trms"
     "vars = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w)"
     by auto
 
   have "\<exists>\<alpha>. transaction_renaming_subst \<alpha> P vars"
     unfolding transaction_renaming_subst_def by blast
 
   then obtain \<alpha> :: "('fun,'atom,'sets,'lbl) prot_subst"
     where \<alpha>_p: "transaction_renaming_subst \<alpha> P vars"
     by blast
   then obtain \<alpha>inv where \<alpha>inv_p: "\<alpha> \<circ>\<^sub>s \<alpha>inv = Var \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<alpha>inv)"
     using transaction_renaming_subst_inv[of \<alpha> P vars] by auto
 
   define A' where "A' = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   define I' where "I' = \<alpha>inv \<circ>\<^sub>s I"
   define trms' where "trms' = trms \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A'"
   define vars' where "vars' = vars \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A'"
   define w' where "w' = w @ [(\<xi>, \<sigma>, I', T, \<alpha>)]"
   define IK' where "IK' = IK \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I)"
   define DB' where "DB' = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I DB"
 
   have P_state: "(IK', DB' , trms', vars', w') \<in> ground_protocol_states_aux P"
   proof -
     have 1: "(IK, DB, trms, vars, w) \<in> ground_protocol_states_aux P"
       using \<open>(IK, DB, trms, vars, w) \<in> ground_protocol_states_aux P\<close> by blast
     moreover
     have "T \<in> set P"
       using step(2) .
     moreover
     have "transaction_decl_subst \<xi> T"
       using step(3) .
     moreover
     have fresh_\<sigma>: "transaction_fresh_subst \<sigma> T trms"
       using step(4) trms_w_vars_p(2)
       using transaction_fresh_subst_consts_of_iff by auto
     moreover
     have "transaction_renaming_subst \<alpha> P vars"
       using \<alpha>_p .
     moreover
     have "A' = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       unfolding A'_def by auto
     moreover
     have "strand_sem_stateful IK DB (unlabel A') I'"
     proof -
       have fin_vars: "finite vars"
         using 1 ground_protocol_states_aux_finite_vars by blast
       show "strand_sem_stateful IK DB (unlabel A') I'"
         using step(6) strand_sem_stateful_substitution_lemma'[OF \<alpha>_p fresh_\<sigma> step(3) fin_vars]
           step(2) unfolding A'_def step(5)
         by (metis (no_types, lifting) I'_def \<alpha>inv_p subst_compose_assoc var_comp(2))
     qed
     moreover
     have "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I'"
       using step(7) by (simp add: I'_def interpretation_substI subst_compose)
     moreover
     have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I')"
       using I'_def \<alpha>inv_p step.hyps(8) wf_trms_subst_compose by blast
     moreover
     have "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I DB = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A') I' DB"
     proof -
       have "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I DB = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) (\<alpha> \<circ>\<^sub>s \<alpha>inv \<circ>\<^sub>s I) DB"
         by (simp add: \<alpha>inv_p)
       also
       have "... = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A') (\<alpha>inv \<circ>\<^sub>s I) DB"
         unfolding A'_def step(5)
         by (metis (no_types, lifting) dbupd\<^sub>s\<^sub>s\<^sub>t_substitution_lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_unlabel 
              subst_compose_assoc)
       also
       have "... = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A') I' DB"
         unfolding A'_def I'_def by auto
       finally
       show ?thesis
         by auto
     qed
     moreover
     have "IK \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) = IK \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A' \<cdot>\<^sub>s\<^sub>e\<^sub>t I')"
     proof -
       have "IK \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) = IK \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<alpha>  \<circ>\<^sub>s \<alpha>inv) \<circ>\<^sub>s I)"
         using \<alpha>inv_p by auto
       also
       have "... = IK \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A' \<cdot>\<^sub>s\<^sub>e\<^sub>t I')"
         unfolding A'_def step(5) unlabel_subst[symmetric] ik\<^sub>s\<^sub>s\<^sub>t_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst I'_def by auto
       finally
       show ?thesis
         by auto
     qed
     ultimately
     show "(IK', DB' , trms', vars', w') \<in> ground_protocol_states_aux P"
       using ground_protocol_states_aux.step[of IK DB trms vars w P T \<xi> \<sigma> \<alpha> A' I']
       unfolding trms'_def vars'_def w'_def IK'_def DB'_def by auto
   qed
   moreover
   have "consts \<union> consts_of (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = consts_of trms'"
   proof -
     have \<alpha>_Var: "subst_range \<alpha> \<subseteq> range Var"
       using \<alpha>_p transaction_renaming_subst_range by blast
 
     have ground_\<xi>\<sigma>: "ground (subst_range (\<xi> \<circ>\<^sub>s \<sigma>))"
       using fresh_transaction_decl_subst_ground_subst_range using step.hyps(3) step.hyps(4) by blast
 
     have "consts \<union> consts_of (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = (consts_of trms) \<union> consts_of (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
       using trms_w_vars_p(2) by blast
     also
     have "... = (consts_of trms) \<union> consts_of (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<alpha>))"
       using consts_of_trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t_range_Var[of \<alpha>, OF \<alpha>_Var, of A] by auto
     also
     have "... = (consts_of trms) \<union> consts_of (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A')"
       using step(5) A'_def ground_\<xi>\<sigma>
       using labelled_stateful_strand_ground_subst_comp[of _ "(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"]
       by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst)
     also
     have "... = consts_of (trms \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A')"
       using consts_of_union_distr by blast
     also
     have "... = consts_of trms'"
       unfolding trms'_def by auto
     finally
     show "?thesis"
       by auto
   qed
   moreover
   have "vars' = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T_symb w')"
     using P_state reachable_constraints_if_ground_protocol_states_aux by auto
   ultimately
   show ?case
     unfolding DB'_def IK'_def consts_of_def[symmetric] by metis
 qed
 
 private lemma protocol_model_equivalence_aux2:
   "{(IK, DB) | IK DB. \<exists>csts. (IK, DB, csts) \<in> ground_protocol_states P} = 
    {(IK, DB) | IK DB. \<exists>w trms vars. (IK, DB, trms, vars, w) \<in> ground_protocol_states_aux P}"
 using protocol_models_equiv4' protocol_models_equiv3' by meson
 
 theorem protocol_model_equivalence:
   "{(IK, DB) | IK DB. \<exists>csts. (IK, DB, csts) \<in> ground_protocol_states P} = 
    {(ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I), dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I {}) | A I.
       A \<in> reachable_constraints P \<and> strand_sem_stateful {} {} (unlabel A) I \<and>
       interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)}"
 using protocol_model_equivalence_aux2 protocol_model_equivalence_aux1 by auto
 
 end
 
 end
 
 end
diff --git a/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy b/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy
--- a/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy
+++ b/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy
@@ -1,11393 +1,11391 @@
 (*  Title:      Stateful_Protocol_Verification.thy
     Author:     Andreas Viktor Hess, DTU
     Author:     Sebastian A. Mödersheim, DTU
     Author:     Achim D. Brucker, University of Exeter
     Author:     Anders Schlichtkrull, DTU
     SPDX-License-Identifier: BSD-3-Clause
 *)
 
 section\<open>Stateful Protocol Verification\<close>
 theory Stateful_Protocol_Verification
 imports Stateful_Protocol_Model Term_Implication
 begin
 
 subsection \<open>Fixed-Point Intruder Deduction Lemma\<close>
 context stateful_protocol_model
 begin
 
 abbreviation pubval_terms::"('fun,'atom,'sets,'lbl) prot_terms" where
   "pubval_terms \<equiv> {t. \<exists>f \<in> funs_term t. is_PubConstValue f}"
 
 abbreviation abs_terms::"('fun,'atom,'sets,'lbl) prot_terms" where
   "abs_terms \<equiv> {t. \<exists>f \<in> funs_term t. is_Abs f}"
 
 definition intruder_deduct_GSMP::
   "[('fun,'atom,'sets,'lbl) prot_terms,
     ('fun,'atom,'sets,'lbl) prot_terms,
     ('fun,'atom,'sets,'lbl) prot_term]
     \<Rightarrow> bool" ("\<langle>_;_\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P _" 50)
 where
   "\<langle>M; T\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P t \<equiv> intruder_deduct_restricted M (\<lambda>t. t \<in> GSMP T - (pubval_terms \<union> abs_terms)) t"
 
 lemma intruder_deduct_GSMP_induct[consumes 1, case_names AxiomH ComposeH DecomposeH]:
   assumes "\<langle>M; T\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P t" "\<And>t. t \<in> M \<Longrightarrow> P M t"
           "\<And>S f. \<lbrakk>length S = arity f; public f;
                   \<And>s. s \<in> set S \<Longrightarrow> \<langle>M; T\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P s;
                   \<And>s. s \<in> set S \<Longrightarrow> P M s;
                   Fun f S \<in> GSMP T - (pubval_terms \<union> abs_terms)
                   \<rbrakk> \<Longrightarrow> P M (Fun f S)"
           "\<And>t K T' t\<^sub>i. \<lbrakk>\<langle>M; T\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P t; P M t; Ana t = (K, T'); \<And>k. k \<in> set K \<Longrightarrow> \<langle>M; T\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P k;
                         \<And>k. k \<in> set K \<Longrightarrow> P M k; t\<^sub>i \<in> set T'\<rbrakk> \<Longrightarrow> P M t\<^sub>i"
   shows "P M t"
 proof -
   let ?Q = "\<lambda>t. t \<in> GSMP T - (pubval_terms \<union> abs_terms)"
   show ?thesis
     using intruder_deduct_restricted_induct[of M ?Q t "\<lambda>M Q t. P M t"] assms
     unfolding intruder_deduct_GSMP_def
     by blast
 qed
 
 lemma pubval_terms_subst:
   assumes "t \<cdot> \<theta> \<in> pubval_terms" "\<theta> ` fv t \<inter> pubval_terms = {}"
   shows "t \<in> pubval_terms"
 using assms(1,2)
 proof (induction t)
   case (Fun f T)
   let ?P = "\<lambda>f. is_PubConstValue f"
   from Fun show ?case
   proof (cases "?P f")
     case False
     then obtain t where t: "t \<in> set T" "t \<cdot> \<theta> \<in> pubval_terms"
       using Fun.prems by auto
     hence "\<theta> ` fv t \<inter> pubval_terms = {}" using Fun.prems(2) by auto
     thus ?thesis using Fun.IH[OF t] t(1) by auto
   qed force
 qed simp
 
 lemma abs_terms_subst:
   assumes "t \<cdot> \<theta> \<in> abs_terms" "\<theta> ` fv t \<inter> abs_terms = {}"
   shows "t \<in> abs_terms"
 using assms(1,2)
 proof (induction t)
   case (Fun f T)
   let ?P = "\<lambda>f. is_Abs f"
   from Fun show ?case
   proof (cases "?P f")
     case False
     then obtain t where t: "t \<in> set T" "t \<cdot> \<theta> \<in> abs_terms"
       using Fun.prems by auto
     hence "\<theta> ` fv t \<inter> abs_terms = {}" using Fun.prems(2) by auto
     thus ?thesis using Fun.IH[OF t] t(1) by auto
   qed force
 qed simp
 
 lemma pubval_terms_subst':
   assumes "t \<cdot> \<theta> \<in> pubval_terms" "\<forall>n. PubConst Value n \<notin> \<Union>(funs_term ` (\<theta> ` fv t))"
   shows "t \<in> pubval_terms"
 proof -
   have False
     when fs: "f \<in> funs_term s" "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv t)" "is_PubConstValue f"
     for f s
   proof -
     obtain T where T: "Fun f T \<in> subterms s" using funs_term_Fun_subterm[OF fs(1)] by moura
     hence "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv t)" using fs(2) in_subterms_subset_Union by blast
     thus ?thesis
       using assms(2) funs_term_Fun_subterm'[of f T] fs(3)
       unfolding is_PubConstValue_def
       by (cases f) force+
   qed
   thus ?thesis using pubval_terms_subst[OF assms(1)] by auto
 qed
 
 lemma abs_terms_subst':
   assumes "t \<cdot> \<theta> \<in> abs_terms" "\<forall>n. Abs n \<notin> \<Union>(funs_term ` (\<theta> ` fv t))"
   shows "t \<in> abs_terms"
 proof -
   have "\<not>is_Abs f" when fs: "f \<in> funs_term s" "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv t)" for f s
   proof -
     obtain T where T: "Fun f T \<in> subterms s" using funs_term_Fun_subterm[OF fs(1)] by moura  
     hence "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv t)" using fs(2) in_subterms_subset_Union by blast
     thus ?thesis using assms(2) funs_term_Fun_subterm'[of f T] by (cases f) auto
   qed
   thus ?thesis using abs_terms_subst[OF assms(1)] by force
 qed
 
 lemma pubval_terms_subst_range_disj:
   "subst_range \<theta> \<inter> pubval_terms = {} \<Longrightarrow> \<theta> ` fv t \<inter> pubval_terms = {}"
 proof (induction t)
   case (Var x) thus ?case by (cases "x \<in> subst_domain \<theta>") auto
 qed auto
 
 lemma abs_terms_subst_range_disj:
   "subst_range \<theta> \<inter> abs_terms = {} \<Longrightarrow> \<theta> ` fv t \<inter> abs_terms = {}"
 proof (induction t)
   case (Var x) thus ?case by (cases "x \<in> subst_domain \<theta>") auto
 qed auto
 
 lemma pubval_terms_subst_range_comp:
   assumes "subst_range \<theta> \<inter> pubval_terms = {}" "subst_range \<delta> \<inter> pubval_terms = {}"
   shows "subst_range (\<theta> \<circ>\<^sub>s \<delta>) \<inter> pubval_terms = {}"
 proof -
   { fix t f assume t:
       "t \<in> subst_range (\<theta> \<circ>\<^sub>s \<delta>)" "f \<in> funs_term t" "is_PubConstValue f"
     then obtain x where x: "(\<theta> \<circ>\<^sub>s \<delta>) x = t" by auto
     have "\<theta> x \<notin> pubval_terms" using assms(1) by (cases "\<theta> x \<in> subst_range \<theta>") force+
     hence "(\<theta> \<circ>\<^sub>s \<delta>) x \<notin> pubval_terms"
       using assms(2) pubval_terms_subst[of "\<theta> x" \<delta>] pubval_terms_subst_range_disj
       by (metis (mono_tags, lifting) subst_compose_def)
     hence False using t(2,3) x by blast
   } thus ?thesis by fast
 qed
 
 lemma pubval_terms_subst_range_comp':
   assumes "(\<theta> ` X) \<inter> pubval_terms = {}" "(\<delta> ` fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` X)) \<inter> pubval_terms = {}"
   shows "((\<theta> \<circ>\<^sub>s \<delta>) ` X) \<inter> pubval_terms = {}"
 proof -
   { fix t f assume t:
       "t \<in> (\<theta> \<circ>\<^sub>s \<delta>) ` X" "f \<in> funs_term t" "is_PubConstValue f"
     then obtain x where x: "(\<theta> \<circ>\<^sub>s \<delta>) x = t" "x \<in> X" by auto
     have "\<theta> x \<notin> pubval_terms" using assms(1) x(2) by force
     moreover have "fv (\<theta> x) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` X)" using x(2) by (auto simp add: fv_subset)
     hence "\<delta> ` fv (\<theta> x) \<inter> pubval_terms = {}" using assms(2) by auto
     ultimately have "(\<theta> \<circ>\<^sub>s \<delta>) x \<notin> pubval_terms"
       using pubval_terms_subst[of "\<theta> x" \<delta>]
       by (metis (mono_tags, lifting) subst_compose_def)
     hence False using t(2,3) x by blast
   } thus ?thesis by fast
 qed
 
 lemma abs_terms_subst_range_comp:
   assumes "subst_range \<theta> \<inter> abs_terms = {}" "subst_range \<delta> \<inter> abs_terms = {}"
   shows "subst_range (\<theta> \<circ>\<^sub>s \<delta>) \<inter> abs_terms = {}"
 proof -
   { fix t f assume t: "t \<in> subst_range (\<theta> \<circ>\<^sub>s \<delta>)" "f \<in> funs_term t" "is_Abs f"
     then obtain x where x: "(\<theta> \<circ>\<^sub>s \<delta>) x = t" by auto
     have "\<theta> x \<notin> abs_terms" using assms(1) by (cases "\<theta> x \<in> subst_range \<theta>") force+
     hence "(\<theta> \<circ>\<^sub>s \<delta>) x \<notin> abs_terms"
       using assms(2) abs_terms_subst[of "\<theta> x" \<delta>] abs_terms_subst_range_disj
       by (metis (mono_tags, lifting) subst_compose_def)
     hence False using t(2,3) x by blast
   } thus ?thesis by fast
 qed
 
 lemma abs_terms_subst_range_comp':
   assumes "(\<theta> ` X) \<inter> abs_terms = {}" "(\<delta> ` fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` X)) \<inter> abs_terms = {}"
   shows "((\<theta> \<circ>\<^sub>s \<delta>) ` X) \<inter> abs_terms = {}"
 proof -
   { fix t f assume t:
       "t \<in> (\<theta> \<circ>\<^sub>s \<delta>) ` X" "f \<in> funs_term t" "is_Abs f"
     then obtain x where x: "(\<theta> \<circ>\<^sub>s \<delta>) x = t" "x \<in> X" by auto
     have "\<theta> x \<notin> abs_terms" using assms(1) x(2) by force
     moreover have "fv (\<theta> x) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` X)" using x(2) by (auto simp add: fv_subset)
     hence "\<delta> ` fv (\<theta> x) \<inter> abs_terms = {}" using assms(2) by auto
     ultimately have "(\<theta> \<circ>\<^sub>s \<delta>) x \<notin> abs_terms"
       using abs_terms_subst[of "\<theta> x" \<delta>]
       by (metis (mono_tags, lifting) subst_compose_def)
     hence False using t(2,3) x by blast
   } thus ?thesis by fast
 qed
 
 context
 begin
 private lemma Ana_abs_aux1:
   fixes \<delta>::"(('fun,'atom,'sets,'lbl) prot_fun, nat, ('fun,'atom,'sets,'lbl) prot_var) gsubst"
     and \<alpha>::"nat \<Rightarrow> 'sets set"
   assumes "Ana\<^sub>f f = (K,T)"
   shows "(K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> = K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (\<lambda>n. \<delta> n \<cdot>\<^sub>\<alpha> \<alpha>)"
 proof -
   { fix k assume "k \<in> set K"
     hence "k \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)" by force
     hence "k \<cdot> \<delta> \<cdot>\<^sub>\<alpha> \<alpha> = k \<cdot> (\<lambda>n. \<delta> n \<cdot>\<^sub>\<alpha> \<alpha>)"
     proof (induction k)
       case (Fun g S)
       have "\<And>s. s \<in> set S \<Longrightarrow> s \<cdot> \<delta> \<cdot>\<^sub>\<alpha> \<alpha> = s \<cdot> (\<lambda>n. \<delta> n \<cdot>\<^sub>\<alpha> \<alpha>)"
         using Fun.IH in_subterms_subset_Union[OF Fun.prems] Fun_param_in_subterms[of _ S g]
         by (meson contra_subsetD)
       thus ?case using Ana\<^sub>f_assm1_alt[OF assms Fun.prems] by (cases g) auto
     qed simp
   } thus ?thesis unfolding abs_apply_list_def by force
 qed
 
 private lemma Ana_abs_aux2:
   fixes \<alpha>::"nat \<Rightarrow> 'sets set"
     and K::"(('fun,'atom,'sets,'lbl) prot_fun, nat) term list"
     and M::"nat list"
     and T::"('fun,'atom,'sets,'lbl) prot_term list"
   assumes "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K) \<union> set M. i < length T"
     and "(K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T) \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> = K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (\<lambda>n. T ! n \<cdot>\<^sub>\<alpha> \<alpha>)"
   shows "(K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T) \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> = K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T)" (is "?A1 = ?A2")
     and "(map ((!) T) M) \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> = map ((!) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T)) M" (is "?B1 = ?B2")
 proof -
   have "T ! i \<cdot>\<^sub>\<alpha> \<alpha> = (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ! i" when "i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K)" for i
     using that assms(1) by auto
   hence "k \<cdot> (\<lambda>i. T ! i \<cdot>\<^sub>\<alpha> \<alpha>) = k \<cdot> (\<lambda>i. (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ! i)" when "k \<in> set K" for k
     using that term_subst_eq_conv[of k "\<lambda>i. T ! i \<cdot>\<^sub>\<alpha> \<alpha>" "\<lambda>i. (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ! i"]
     by auto
   thus "?A1 = ?A2" using assms(2) by (force simp add: abs_apply_terms_def)
 
   have "T ! i \<cdot>\<^sub>\<alpha> \<alpha> = map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T ! i" when "i \<in> set M" for i
     using that assms(1) by auto
   thus "?B1 = ?B2" by (force simp add: abs_apply_list_def)
 qed
 
 private lemma Ana_abs_aux1_set:
   fixes \<delta>::"(('fun,'atom,'sets,'lbl) prot_fun, nat, ('fun,'atom,'sets,'lbl) prot_var) gsubst"
     and \<alpha>::"nat \<Rightarrow> 'sets set"
   assumes "Ana\<^sub>f f = (K,T)"
   shows "(set K \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> = set K \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<lambda>n. \<delta> n \<cdot>\<^sub>\<alpha> \<alpha>)"
 proof -
   { fix k assume "k \<in> set K"
     hence "k \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)" by force
     hence "k \<cdot> \<delta> \<cdot>\<^sub>\<alpha> \<alpha> = k \<cdot> (\<lambda>n. \<delta> n \<cdot>\<^sub>\<alpha> \<alpha>)"
     proof (induction k)
       case (Fun g S)
       have "\<And>s. s \<in> set S \<Longrightarrow> s \<cdot> \<delta> \<cdot>\<^sub>\<alpha> \<alpha> = s \<cdot> (\<lambda>n. \<delta> n \<cdot>\<^sub>\<alpha> \<alpha>)"
         using Fun.IH in_subterms_subset_Union[OF Fun.prems] Fun_param_in_subterms[of _ S g]
         by (meson contra_subsetD)
       thus ?case using Ana\<^sub>f_assm1_alt[OF assms Fun.prems] by (cases g) auto
     qed simp
   } thus ?thesis unfolding abs_apply_terms_def by force
 qed
 
 private lemma Ana_abs_aux2_set:
   fixes \<alpha>::"nat \<Rightarrow> 'sets set"
     and K::"(('fun,'atom,'sets,'lbl) prot_fun, nat) terms"
     and M::"nat set"
     and T::"('fun,'atom,'sets,'lbl) prot_term list"
   assumes "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t K \<union> M. i < length T"
     and "(K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) T) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> = K \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<lambda>n. T ! n \<cdot>\<^sub>\<alpha> \<alpha>)"
   shows "(K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) T) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> = K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T)" (is "?A1 = ?A2")
     and "((!) T ` M) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> = (!) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ` M" (is "?B1 = ?B2")
 proof -
   have "T ! i \<cdot>\<^sub>\<alpha> \<alpha> = (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ! i" when "i \<in> fv\<^sub>s\<^sub>e\<^sub>t K" for i
     using that assms(1) by auto
   hence "k \<cdot> (\<lambda>i. T ! i \<cdot>\<^sub>\<alpha> \<alpha>) = k \<cdot> (\<lambda>i. (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ! i)" when "k \<in> K" for k
     using that term_subst_eq_conv[of k "\<lambda>i. T ! i \<cdot>\<^sub>\<alpha> \<alpha>" "\<lambda>i. (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ! i"]
     by auto
   thus "?A1 = ?A2" using assms(2) by (force simp add: abs_apply_terms_def)
 
   have "T ! i \<cdot>\<^sub>\<alpha> \<alpha> = map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T ! i" when "i \<in> M" for i
     using that assms(1) by auto
   thus "?B1 = ?B2" by (force simp add: abs_apply_terms_def)
 qed
 
 lemma Ana_abs:
   fixes t::"('fun,'atom,'sets,'lbl) prot_term"
   assumes "Ana t = (K, T)"
   shows "Ana (t \<cdot>\<^sub>\<alpha> \<alpha>) = (K \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>, T \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>)"
   using assms
 proof (induction t rule: Ana.induct)
   case (1 f S)
   obtain K' T' where *: "Ana\<^sub>f f = (K',T')" by moura
   show ?case using 1
   proof (cases "arity\<^sub>f f = length S \<and> arity\<^sub>f f > 0")
     case True
     hence "K = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) S" "T = map ((!) S) T'"
         and **: "arity\<^sub>f f = length (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) S)" "arity\<^sub>f f > 0"
       using 1 * by auto
     hence "K \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) S)"
           "T \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> = map ((!) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) S)) T'"
       using Ana\<^sub>f_assm2_alt[OF *] Ana_abs_aux2[OF _ Ana_abs_aux1[OF *], of T' S \<alpha>]
       unfolding abs_apply_list_def
       by auto
     moreover have "Fun (Fu f) S \<cdot>\<^sub>\<alpha> \<alpha> = Fun (Fu f) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) S)" by simp
     ultimately show ?thesis using Ana_Fu_intro[OF ** *] by metis
   qed (auto simp add: abs_apply_list_def)
 qed (simp_all add: abs_apply_list_def)
 end
 
 lemma deduct_FP_if_deduct:
   fixes M IK FP::"('fun,'atom,'sets,'lbl) prot_terms"
   assumes IK: "IK \<subseteq> GSMP M - (pubval_terms \<union> abs_terms)" "\<forall>t \<in> IK \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>. FP \<turnstile>\<^sub>c t"
     and t: "IK \<turnstile> t" "t \<in> GSMP M - (pubval_terms \<union> abs_terms)"
   shows "FP \<turnstile> t \<cdot>\<^sub>\<alpha> \<alpha>"
 proof -
   let ?P = "\<lambda>f. \<not>is_PubConstValue f"
   let ?GSMP = "GSMP M - (pubval_terms \<union> abs_terms)"
 
   have 1: "\<forall>m \<in> IK. m \<in> ?GSMP"
     using IK(1) by blast
 
   have 2: "\<forall>t t'. t \<in> ?GSMP \<longrightarrow> t' \<sqsubseteq> t \<longrightarrow> t' \<in> ?GSMP"
   proof (intro allI impI)
     fix t t' assume t: "t \<in> ?GSMP" "t' \<sqsubseteq> t"
     hence "t' \<in> GSMP M" using ground_subterm unfolding GSMP_def by auto
     moreover have "\<not>is_PubConstValue f"
       when "f \<in> funs_term t" for f
       using t(1) that by auto
     hence "\<not>is_PubConstValue f"
       when "f \<in> funs_term t'" for f
       using that subtermeq_imp_funs_term_subset[OF t(2)] by auto
     moreover have "\<not>is_Abs f" when "f \<in> funs_term t" for f using t(1) that by auto
     hence "\<not>is_Abs f" when "f \<in> funs_term t'" for f
       using that subtermeq_imp_funs_term_subset[OF t(2)] by auto
     ultimately show "t' \<in> ?GSMP" by simp
   qed
 
   have 3: "\<forall>t K T k. t \<in> ?GSMP \<longrightarrow> Ana t = (K, T) \<longrightarrow> k \<in> set K \<longrightarrow> k \<in> ?GSMP"
   proof (intro allI impI)
     fix t K T k assume t: "t \<in> ?GSMP" "Ana t = (K, T)" "k \<in> set K"
     hence "k \<in> GSMP M" using GSMP_Ana_key by blast
     moreover have "\<forall>f \<in> funs_term t. ?P f" using t(1) by auto
     with t(2,3) have "\<forall>f \<in> funs_term k. ?P f"
     proof (induction t arbitrary: k rule: Ana.induct)
       case 1 thus ?case by (metis Ana_Fu_keys_not_pubval_terms surj_pair)
     qed auto
     moreover have "\<forall>f \<in> funs_term t. \<not>is_Abs f" using t(1) by auto
     with t(2,3) have "\<forall>f \<in> funs_term k. \<not>is_Abs f"
     proof (induction t arbitrary: k rule: Ana.induct)
       case 1 thus ?case by (metis Ana_Fu_keys_not_abs_terms surj_pair)
     qed auto
     ultimately show "k \<in> ?GSMP" by simp
   qed
 
   have "\<langle>IK; M\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P t"
     unfolding intruder_deduct_GSMP_def
     by (rule restricted_deduct_if_deduct'[OF 1 2 3 t])
   thus ?thesis
   proof (induction t rule: intruder_deduct_GSMP_induct)
     case (AxiomH t)
     show ?case using IK(2) abs_in[OF AxiomH.hyps] by force
   next
     case (ComposeH T f)
     have *: "Fun f T \<cdot>\<^sub>\<alpha> \<alpha> = Fun f (map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) T)"
       using ComposeH.hyps(2,4)
       by (cases f) auto
 
     have **: "length (map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) T) = arity f"
       using ComposeH.hyps(1)
       by auto
 
     show ?case
       using intruder_deduct.Compose[OF ** ComposeH.hyps(2)] ComposeH.IH(1) *
       by auto
   next
     case (DecomposeH t K T' t\<^sub>i)
     have *: "Ana (t \<cdot>\<^sub>\<alpha> \<alpha>) = (K \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>, T' \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>)"
       using Ana_abs[OF DecomposeH.hyps(2)]
       by metis
 
     have **: "t\<^sub>i \<cdot>\<^sub>\<alpha> \<alpha> \<in> set (T' \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>)"
       using DecomposeH.hyps(4) abs_in abs_list_set_is_set_abs_set[of T']
       by auto
 
     have ***: "FP \<turnstile> k"
       when k: "k \<in> set (K \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>)" for k
     proof -
       obtain k' where k': "k' \<in> set K" "k = k' \<cdot>\<^sub>\<alpha> \<alpha>"
         by (metis (no_types) k abs_apply_terms_def imageE abs_list_set_is_set_abs_set)
 
       show "FP \<turnstile> k"
         using DecomposeH.IH k' by blast
     qed
 
     show ?case
       using intruder_deduct.Decompose[OF _ * _ **]
             DecomposeH.IH(1) ***(1)
       by blast
   qed
 qed
 
 end
 
 
 subsection \<open>Computing and Checking Term Implications and Messages\<close>
 context stateful_protocol_model
 begin
 
 abbreviation (input) "absc s \<equiv> (Fun (Abs s) []::('fun,'atom,'sets,'lbl) prot_term)"
 
 fun absdbupd where
   "absdbupd [] _ a = a"
 | "absdbupd (insert\<langle>Var y, Fun (Set s) T\<rangle>#D) x a = (
     if x = y then absdbupd D x (insert s a) else absdbupd D x a)"
 | "absdbupd (delete\<langle>Var y, Fun (Set s) T\<rangle>#D) x a = (
     if x = y then absdbupd D x (a - {s}) else absdbupd D x a)"
 | "absdbupd (_#D) x a = absdbupd D x a"
 
 lemma absdbupd_cons_cases:
   "absdbupd (insert\<langle>Var x, Fun (Set s) T\<rangle>#D) x d = absdbupd D x (insert s d)"
   "absdbupd (delete\<langle>Var x, Fun (Set s) T\<rangle>#D) x d = absdbupd D x (d - {s})"
   "t \<noteq> Var x \<or> (\<nexists>s T. u = Fun (Set s) T) \<Longrightarrow> absdbupd (insert\<langle>t,u\<rangle>#D) x d = absdbupd D x d"
   "t \<noteq> Var x \<or> (\<nexists>s T. u = Fun (Set s) T) \<Longrightarrow> absdbupd (delete\<langle>t,u\<rangle>#D) x d = absdbupd D x d"
 proof -
   assume *: "t \<noteq> Var x \<or> (\<nexists>s T. u = Fun (Set s) T)"
   let ?P = "absdbupd (insert\<langle>t,u\<rangle>#D) x d = absdbupd D x d"
   let ?Q = "absdbupd (delete\<langle>t,u\<rangle>#D) x d = absdbupd D x d"
   { fix y f T assume "t = Fun f T \<or> u = Var y" hence ?P ?Q by auto
   } moreover {
     fix y f T assume "t = Var y" "u = Fun f T" hence ?P using * by (cases f) auto
   } moreover {
     fix y f T assume "t = Var y" "u = Fun f T" hence ?Q using * by (cases f) auto
   } ultimately show ?P ?Q by (metis term.exhaust)+
 qed simp_all
 
 lemma absdbupd_filter: "absdbupd S x d = absdbupd (filter is_Update S) x d"
 by (induction S x d rule: absdbupd.induct) simp_all
 
 lemma absdbupd_append:
   "absdbupd (A@B) x d = absdbupd B x (absdbupd A x d)"
 proof (induction A arbitrary: d)
   case (Cons a A) thus ?case
   proof (cases a)
     case (Insert t u) thus ?thesis
     proof (cases "t \<noteq> Var x \<or> (\<nexists>s T. u = Fun (Set s) T)")
       case False
       then obtain s T where "t = Var x" "u = Fun (Set s) T" by moura
       thus ?thesis by (simp add: Insert Cons.IH absdbupd_cons_cases(1))
     qed (simp_all add: Cons.IH absdbupd_cons_cases(3))
   next
     case (Delete t u) thus ?thesis
     proof (cases "t \<noteq> Var x \<or> (\<nexists>s T. u = Fun (Set s) T)")
       case False
       then obtain s T where "t = Var x" "u = Fun (Set s) T" by moura
       thus ?thesis by (simp add: Delete Cons.IH absdbupd_cons_cases(2))
     qed (simp_all add: Cons.IH absdbupd_cons_cases(4))
   qed simp_all
 qed simp
 
 lemma absdbupd_wellformed_transaction:
   assumes T: "wellformed_transaction T"
   shows "absdbupd (unlabel (transaction_strand T)) = absdbupd (unlabel (transaction_updates T))"
 proof -
   define S0 where "S0 \<equiv> unlabel (transaction_strand T)"
   define S1 where "S1 \<equiv> unlabel (transaction_receive T)"
   define S2 where "S2 \<equiv> unlabel (transaction_checks T)"
   define S3 where "S3 \<equiv> unlabel (transaction_updates T)"
   define S4 where "S4 \<equiv> unlabel (transaction_send T)"
 
   note S_defs = S0_def S1_def S2_def S3_def S4_def
 
   have 0: "list_all is_Receive S1"
           "list_all is_Check_or_Assignment S2"
           "list_all is_Update S3"
           "list_all is_Send S4"
     using T unfolding wellformed_transaction_def S_defs by metis+
 
   have "filter is_Update S1 = []"
        "filter is_Update S2 = []"
        "filter is_Update S3 = S3"
        "filter is_Update S4 = []"
     using list_all_filter_nil[OF 0(1), of is_Update]
           list_all_filter_nil[OF 0(2), of is_Update]
           list_all_filter_eq[OF 0(3)]
           list_all_filter_nil[OF 0(4), of is_Update]
     by blast+
   moreover have "S0 = S1@S2@S3@S4"
     unfolding S_defs transaction_strand_def unlabel_def by auto
   ultimately have "filter is_Update S0 = S3"
     using filter_append[of is_Update] list_all_append[of is_Update]
     by simp
   thus ?thesis
     using absdbupd_filter[of S0]
     unfolding S_defs by presburger
 qed
 
 fun abs_substs_set::
   "[('fun,'atom,'sets,'lbl) prot_var list,
     'sets set list,
     ('fun,'atom,'sets,'lbl) prot_var \<Rightarrow> 'sets set,
     ('fun,'atom,'sets,'lbl) prot_var \<Rightarrow> 'sets set,
     ('fun,'atom,'sets,'lbl) prot_var \<Rightarrow> 'sets set \<Rightarrow> bool]
   \<Rightarrow> ((('fun,'atom,'sets,'lbl) prot_var \<times> 'sets set) list) list"
 where
   "abs_substs_set [] _ _ _ _ = [[]]"
 | "abs_substs_set (x#xs) as posconstrs negconstrs msgconstrs = (
     let bs = filter (\<lambda>a. posconstrs x \<subseteq> a \<and> a \<inter> negconstrs x = {} \<and> msgconstrs x a) as;
         \<Delta> = abs_substs_set xs as posconstrs negconstrs msgconstrs
     in concat (map (\<lambda>b. map (\<lambda>\<delta>. (x, b)#\<delta>) \<Delta>) bs))"
 
 definition abs_substs_fun::
   "[(('fun,'atom,'sets,'lbl) prot_var \<times> 'sets set) list,
     ('fun,'atom,'sets,'lbl) prot_var]
   \<Rightarrow> 'sets set"
 where
   "abs_substs_fun \<delta> x = (case find (\<lambda>b. fst b = x) \<delta> of Some (_,a) \<Rightarrow> a | None \<Rightarrow> {})"
 
 lemmas abs_substs_set_induct = abs_substs_set.induct[case_names Nil Cons]
 
 fun transaction_poschecks_comp::
   "(('fun,'atom,'sets,'lbl) prot_fun, ('fun,'atom,'sets,'lbl) prot_var) stateful_strand
   \<Rightarrow> (('fun,'atom,'sets,'lbl) prot_var \<Rightarrow> 'sets set)"
 where
   "transaction_poschecks_comp [] = (\<lambda>_. {})"
 | "transaction_poschecks_comp (\<langle>_: Var x \<in> Fun (Set s) []\<rangle>#T) = (
     let f = transaction_poschecks_comp T in f(x := insert s (f x)))"
 | "transaction_poschecks_comp (_#T) = transaction_poschecks_comp T"
 
 fun transaction_negchecks_comp::
   "(('fun,'atom,'sets,'lbl) prot_fun, ('fun,'atom,'sets,'lbl) prot_var) stateful_strand
   \<Rightarrow> (('fun,'atom,'sets,'lbl) prot_var \<Rightarrow> 'sets set)"
 where
   "transaction_negchecks_comp [] = (\<lambda>_. {})"
 | "transaction_negchecks_comp (\<langle>Var x not in Fun (Set s) []\<rangle>#T) = (
     let f = transaction_negchecks_comp T in f(x := insert s (f x)))"
 | "transaction_negchecks_comp (_#T) = transaction_negchecks_comp T"
 
 definition transaction_check_pre where
   "transaction_check_pre FPT T \<delta> \<equiv>
     let (FP, _, TI) = FPT;
         C = set (unlabel (transaction_checks T));
         xs = fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T));
         \<theta> = \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x
     in (\<forall>x \<in> set (transaction_fresh T). \<delta> x = {}) \<and>
        (\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<delta>)) \<and>
        (\<forall>u \<in> C.
           (is_InSet u \<longrightarrow> (
             let x = the_elem_term u; s = the_set_term u
             in (is_Var x \<and> is_Fun_Set s) \<longrightarrow> the_Set (the_Fun s) \<in> \<delta> (the_Var x))) \<and>
           ((is_NegChecks u \<and> bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p u = [] \<and> the_eqs u = [] \<and> length (the_ins u) = 1) \<longrightarrow> (
             let x = fst (hd (the_ins u)); s = snd (hd (the_ins u))
             in (is_Var x \<and> is_Fun_Set s) \<longrightarrow> the_Set (the_Fun s) \<notin> \<delta> (the_Var x))))"
 
 definition transaction_check_post where
   "transaction_check_post FPT T \<delta> \<equiv>
     let (FP, _, TI) = FPT;
         xs = fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T));
         \<theta> = \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x;
         u = \<lambda>\<delta> x. absdbupd (unlabel (transaction_updates T)) x (\<delta> x)
     in (\<forall>x \<in> set xs - set (transaction_fresh T). \<delta> x \<noteq> u \<delta> x \<longrightarrow> List.member TI (\<delta> x, u \<delta> x)) \<and>
        (\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> (u \<delta>)))"
 
 definition fun_point_inter where "fun_point_inter f g \<equiv> \<lambda>x. f x \<inter> g x"
 definition fun_point_union where "fun_point_union f g \<equiv> \<lambda>x. f x \<union> g x"
 definition fun_point_Inter where "fun_point_Inter fs \<equiv> \<lambda>x. \<Inter>f \<in> fs. f x"
 definition fun_point_Union where "fun_point_Union fs \<equiv> \<lambda>x. \<Union>f \<in> fs. f x"
 definition fun_point_Inter_list where "fun_point_Inter_list fs \<equiv> \<lambda>x. \<Inter>(set (map (\<lambda>f. f x) fs))"
 definition fun_point_Union_list where "fun_point_Union_list fs \<equiv> \<lambda>x. \<Union>(set (map (\<lambda>f. f x) fs))"
 definition ticl_abs where "ticl_abs TI a \<equiv> set (a#map snd (filter (\<lambda>p. fst p = a) TI))"
 definition ticl_abss where "ticl_abss TI as \<equiv> \<Union>a \<in> as. ticl_abs TI a"
 
 lemma fun_point_Inter_set_eq:
   "fun_point_Inter (set fs) = fun_point_Inter_list fs"
 unfolding fun_point_Inter_def fun_point_Inter_list_def by simp
 
 lemma fun_point_Union_set_eq:
   "fun_point_Union (set fs) = fun_point_Union_list fs"
 unfolding fun_point_Union_def fun_point_Union_list_def by simp
 
 lemma ticl_abs_refl_in: "x \<in> ticl_abs TI x"
 unfolding ticl_abs_def by simp
 
 lemma ticl_abs_iff:
   assumes TI: "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
   shows "ticl_abs TI a = {b. (a,b) \<in> (set TI)\<^sup>*}"  
 proof (intro order_antisym subsetI)
   fix x assume x: "x \<in> {b. (a, b) \<in> (set TI)\<^sup>*}"
   hence "x = a \<or> (x \<noteq> a \<and> (a,x) \<in> (set TI)\<^sup>+)" by (metis mem_Collect_eq rtranclD)
   moreover have "ticl_abs TI a = {a} \<union> {b. (a,b) \<in> set TI}" unfolding ticl_abs_def by force
   ultimately show "x \<in> ticl_abs TI a" using TI by blast
 qed (fastforce simp add: ticl_abs_def)
 
 lemma ticl_abs_Inter:
   assumes xs: "\<Inter>(ticl_abs TI ` xs) \<noteq> {}"
     and TI: "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
   shows "\<Inter>(ticl_abs TI ` \<Inter>(ticl_abs TI ` xs)) \<subseteq> \<Inter>(ticl_abs TI ` xs)"
 proof
   fix x assume x: "x \<in> \<Inter>(ticl_abs TI ` \<Inter>(ticl_abs TI ` xs))"
   have *: "\<Inter>(ticl_abs TI ` xs) = {b. \<forall>a \<in> xs. (a,b) \<in> (set TI)\<^sup>*}"
     unfolding ticl_abs_iff[OF TI] by blast
 
   have "(b,x) \<in> (set TI)\<^sup>*" when b: "\<forall>a \<in> xs. (a,b) \<in> (set TI)\<^sup>*" for b
     using x b unfolding ticl_abs_iff[OF TI] by blast
   hence "(a,x) \<in> (set TI)\<^sup>*" when "a \<in> xs" for a
     using that xs rtrancl.rtrancl_into_rtrancl[of a _ "(set TI)\<^sup>*" x]
     unfolding * rtrancl_idemp[of "set TI"] by blast
   thus "x \<in> \<Inter>(ticl_abs TI ` xs)" unfolding * by blast
 qed
 
 function (sequential) match_abss'
 ::"(('a,'b,'c,'d) prot_fun, 'e) term \<Rightarrow>
    (('a,'b,'c,'d) prot_fun, 'e) term \<Rightarrow>
    ('e \<Rightarrow> 'c set set) option"
 where
   "match_abss' (Var x) (Fun (Abs a) _) = Some ((\<lambda>_. {})(x := {a}))"
 | "match_abss' (Fun f ts) (Fun g ss) = (
     if f = g \<and> length ts = length ss
     then map_option fun_point_Union_list (those (map2 match_abss' ts ss))
     else None)"
 | "match_abss' _ _ = None"
 by pat_completeness auto
 termination
 proof -
   let ?m = "measures [size \<circ> fst]"
 
   have 0: "wf ?m" by simp
 
   show ?thesis
     apply (standard, use 0 in fast)
     by (metis (no_types) comp_def fst_conv measures_less Fun_zip_size_lt(1))
 qed
 
 definition match_abss where
   "match_abss OCC TI t s \<equiv> (
     let xs = fv t;
         OCC' = set OCC;
         f = \<lambda>\<delta> x. if x \<in> xs then \<delta> x else OCC';
         g = \<lambda>\<delta> x. \<Inter>(ticl_abs TI ` \<delta> x)
     in case match_abss' t s of
       Some \<delta> \<Rightarrow>
         let \<delta>' = g \<delta>
         in if \<forall>x \<in> xs. \<delta>' x \<noteq> {} then Some (f \<delta>') else None
     | None \<Rightarrow> None)"
 
 lemma match_abss'_Var_inv:
   assumes \<delta>: "match_abss' (Var x) t = Some \<delta>"
   shows "\<exists>a ts. t = Fun (Abs a) ts \<and> \<delta> = (\<lambda>_. {})(x := {a})"
 proof -
   obtain f ts where t: "t = Fun f ts" using \<delta> by (cases t) auto
   then obtain a where a: "f = Abs a" using \<delta> by (cases f) auto
   show ?thesis using \<delta> unfolding t a by simp 
 qed
 
 lemma match_abss'_Fun_inv:
   assumes "match_abss' (Fun f ts) (Fun g ss) = Some \<delta>"
   shows "f = g" (is ?A)
     and "length ts = length ss" (is ?B)
     and "\<exists>\<theta>. Some \<theta> = those (map2 match_abss' ts ss) \<and> \<delta> = fun_point_Union_list \<theta>" (is ?C)
     and "\<forall>(t,s) \<in> set (zip ts ss). \<exists>\<sigma>. match_abss' t s = Some \<sigma>" (is ?D)
 proof -
   note 0 = assms match_abss'.simps(2)[of f ts g ss] option.distinct(1)
   show ?A by (metis 0)
   show ?B by (metis 0)
   show ?C by (metis (no_types, opaque_lifting) 0 map_option_eq_Some)
   thus ?D using map2_those_Some_case[of match_abss' ts ss] by fastforce
 qed
 
 lemma match_abss'_FunI:
   assumes \<Delta>: "\<And>i. i < length T \<Longrightarrow> match_abss' (U ! i) (T ! i) = Some (\<Delta> i)"
     and T: "length T = length U"
   shows "match_abss' (Fun f U) (Fun f T) = Some (fun_point_Union_list (map \<Delta> [0..<length T]))"
 proof -
   have "match_abss' (Fun f U) (Fun f T) =
           map_option fun_point_Union_list (those (map2 match_abss' U T))"
     using T match_abss'.simps(2)[of f U f T] by presburger
   moreover have "those (map2 match_abss' U T) = Some (map \<Delta> [0..<length T])"
     using \<Delta> T those_map2_SomeI by metis
   ultimately show ?thesis by simp
 qed
 
 lemma match_abss'_Fun_param_subset:
   assumes "match_abss' (Fun f ts) (Fun g ss)  = Some \<delta>"
     and "(t,s) \<in> set (zip ts ss)"
     and "match_abss' t s = Some \<sigma>"
   shows "\<sigma> x \<subseteq> \<delta> x"
 proof -
   obtain \<theta> where \<theta>:
       "those (map2 match_abss' ts ss) = Some \<theta>"
       "\<delta> = fun_point_Union_list \<theta>"
     using match_abss'_Fun_inv[OF assms(1)] by metis
 
   have "\<sigma> \<in> set \<theta>" using \<theta>(1) assms(2-) those_Some_iff[of "map2 match_abss' ts ss" \<theta>] by force
   thus ?thesis using \<theta>(2) unfolding fun_point_Union_list_def by auto
 qed
 
 lemma match_abss'_fv_is_nonempty:
   assumes "match_abss' t s = Some \<delta>"
     and "x \<in> fv t"
   shows "\<delta> x \<noteq> {}" (is "?P \<delta>")
 using assms
 proof (induction t s arbitrary: \<delta> rule: match_abss'.induct)
   case (2 f ts g ss)
   note prems = "2.prems"
   note IH = "2.IH"
 
   have 0: "\<forall>(t,s) \<in> set (zip ts ss). \<exists>\<sigma>. match_abss' t s = Some \<sigma>" "f = g" "length ts = length ss"
     using match_abss'_Fun_inv[OF prems(1)] by simp_all
 
   obtain t where t: "t \<in> set ts" "x \<in> fv t" using prems(2) by auto
   then obtain s where s: "s \<in> set ss" "(t,s) \<in> set (zip ts ss)"
     by (meson 0(3) in_set_impl_in_set_zip1 in_set_zipE)
   then obtain \<sigma> where \<sigma>: "match_abss' t s = Some \<sigma>" using 0(1) by fast
 
   show ?case
     using IH[OF conjI[OF 0(2,3)] s(2) _ \<sigma>] t(2) match_abss'_Fun_param_subset[OF prems(1) s(2) \<sigma>]
     by auto
 qed auto
 
 lemma match_abss'_nonempty_is_fv:
   fixes s t::"(('a,'b,'c,'d) prot_fun, 'v) term"
   assumes "match_abss' s t = Some \<delta>"
     and "\<delta> x \<noteq> {}"
   shows "x \<in> fv s"
 using assms
 proof (induction s t arbitrary: \<delta> rule: match_abss'.induct)
   case (2 f ts g ss)
   note prems = "2.prems"
   note IH = "2.IH"
 
   obtain \<theta> where \<theta>: "Some \<theta> = those (map2 match_abss' ts ss)" "\<delta> = fun_point_Union_list \<theta>"
       and fg: "f = g" "length ts = length ss"
     using match_abss'_Fun_inv[OF prems(1)] by fast
 
   have "\<exists>\<sigma> \<in> set \<theta>. \<sigma> x \<noteq> {}"
     using fg(2) prems \<theta> unfolding fun_point_Union_list_def by auto
   then obtain t' s' \<sigma> where ts':
       "(t',s') \<in> set (zip ts ss)" "match_abss' t' s' = Some \<sigma>" "\<sigma> x \<noteq> {}"
     using those_map2_SomeD[OF \<theta>(1)[symmetric]] by blast
 
   show ?case
     using ts'(3) IH[OF conjI[OF fg] ts'(1) _ ts'(2)] set_zip_leftD[OF ts'(1)] by force
 qed auto
 
 lemma match_abss'_Abs_in_funs_term:
   fixes s t::"(('a,'b,'c,'d) prot_fun, 'v) term"
   assumes "match_abss' s t = Some \<delta>"
     and "a \<in> \<delta> x"
   shows "Abs a \<in> funs_term t"
 using assms
 proof (induction s t arbitrary: a \<delta> rule: match_abss'.induct)
   case (1 y b ts) show ?case
     using match_abss'_Var_inv[OF "1.prems"(1)]  "1.prems"(2)
     by (cases "x = y") simp_all
 next
   case (2 f ts g ss)
   note prems = "2.prems"
   note IH = "2.IH"
 
   obtain \<theta> where \<theta>: "Some \<theta> = those (map2 match_abss' ts ss)" "\<delta> = fun_point_Union_list \<theta>"
       and fg: "f = g" "length ts = length ss"
     using match_abss'_Fun_inv[OF prems(1)] by fast
 
   obtain t' s' \<sigma> where ts': "(t',s') \<in> set (zip ts ss)" "match_abss' t' s' = Some \<sigma>" "a \<in> \<sigma> x"
     using fg(2) prems \<theta> those_map2_SomeD[OF \<theta>(1)[symmetric]]
     unfolding fun_point_Union_list_def by fastforce
 
   show ?case
     using ts'(1) IH[OF conjI[OF fg] ts'(1) _ ts'(2,3)]
     by (meson set_zip_rightD term.set_intros(2))
 qed auto
 
 lemma match_abss'_subst_fv_ex_abs:
   assumes "match_abss' s (s \<cdot> \<delta>) = Some \<sigma>"
     and TI: "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
   shows "\<forall>x \<in> fv s. \<exists>a ts. \<delta> x = Fun (Abs a) ts \<and> \<sigma> x = {a}" (is "?P s \<sigma>")
 using assms(1)
 proof (induction s "s \<cdot> \<delta>" arbitrary: \<sigma> rule: match_abss'.induct)
   case (2 f ts g ss)
   note prems = "2.prems"
   note hyps = "2.hyps"
 
   obtain \<theta> where \<theta>: "Some \<theta> = those (map2 match_abss' ts ss)" "\<sigma> = fun_point_Union_list \<theta>"
       and fg: "f = g" "length ts = length ss" "ss = ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>"
       and ts: "\<forall>(t,s) \<in> set (zip ts ss). \<exists>\<sigma>. match_abss' t s = Some \<sigma>"
     using match_abss'_Fun_inv[OF prems(1)[unfolded hyps(2)[symmetric]]] hyps(2) by fastforce
 
   have 0: "those (map (\<lambda>t. match_abss' t (t \<cdot> \<delta>)) ts) = Some \<theta>"
     using \<theta>(1) map2_map_subst unfolding fg(3) by metis
 
   have 1: "\<forall>t \<in> set ts. \<exists>\<sigma>. match_abss' t (t \<cdot> \<delta>) = Some \<sigma>"
     using ts zip_map_subst[of ts \<delta>] unfolding fg(3) by simp
 
   have 2: "\<sigma>' \<in> set \<theta>"
     when t: "t \<in> set ts" "match_abss' t (t \<cdot> \<delta>) = Some \<sigma>'" for t \<sigma>'
     using t 0 those_Some_iff[of "map (\<lambda>t. match_abss' t (t \<cdot> \<delta>)) ts" \<theta>] by force
 
   have 3: "?P t \<sigma>'" "\<sigma>' x \<noteq> {}"
     when t: "t \<in> set ts" "x \<in> fv t" "match_abss' t (t \<cdot> \<delta>) = Some \<sigma>'" for t \<sigma>' x
     using t hyps(1)[OF conjI[OF fg(1,2)], of "(t, t \<cdot> \<delta>)" t \<sigma>'] zip_map_subst[of ts \<delta>]
           match_abss'_fv_is_nonempty[of t "t \<cdot> \<delta>" \<sigma>' x]
     unfolding fg(3) by auto
 
   have 4: "\<sigma>' x = {}"
     when t: "x \<notin> fv t" "match_abss' t (t \<cdot> \<delta>) = Some \<sigma>'" for t \<sigma>' x
     by (meson t match_abss'_nonempty_is_fv)
 
   show ?case
   proof
     fix x assume "x \<in> fv (Fun f ts)"
     then obtain t \<sigma>' where t: "t \<in> set ts" "x \<in> fv t" and \<sigma>': "match_abss' t (t \<cdot> \<delta>) = Some \<sigma>'"
       using 1 by auto
     then obtain a tsa where a: "\<delta> x = Fun (Abs a) tsa"
       using 3[OF t \<sigma>'] by fast
 
     have "\<sigma>'' x = {a} \<or> \<sigma>'' x = {}"
       when "\<sigma>'' \<in> set \<theta>" for \<sigma>''
       using that a 0 3[of _ x] 4[of x]
       unfolding those_Some_iff by fastforce
     thus "\<exists>a ts. \<delta> x = Fun (Abs a) ts \<and> \<sigma> x = {a}"
       using a 2[OF t(1) \<sigma>'] 3[OF t \<sigma>'] unfolding \<theta>(2) fun_point_Union_list_def by auto
   qed
 qed auto
 
 lemma match_abss'_subst_disj_nonempty:
   assumes TI: "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     and "match_abss' s (s \<cdot> \<delta>) = Some \<sigma>"
     and "x \<in> fv s"
   shows "\<Inter>(ticl_abs TI ` \<sigma> x) \<noteq> {} \<and> (\<exists>a tsa. \<delta> x = Fun (Abs a) tsa \<and> \<sigma> x = {a})" (is "?P \<sigma>")
 using assms(2,3)
 proof (induction s "s \<cdot> \<delta>" arbitrary: \<sigma> rule: match_abss'.induct)
   case (1 x a ts) thus ?case unfolding ticl_abs_def by force
 next
   case (2 f ts g ss)
   note prems = "2.prems"
   note hyps = "2.hyps"
 
   obtain \<theta> where \<theta>: "Some \<theta> = those (map2 match_abss' ts ss)" "\<sigma> = fun_point_Union_list \<theta>"
       and fg: "f = g" "length ts = length ss" "ss = ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>"
       and ts: "\<forall>(t,s) \<in> set (zip ts ss). \<exists>\<sigma>. match_abss' t s = Some \<sigma>"
     using match_abss'_Fun_inv[OF prems(1)[unfolded hyps(2)[symmetric]]] hyps(2) by fastforce
 
   define ts' where "ts' \<equiv> filter (\<lambda>t. x \<in> fv t) ts"
   define \<theta>' where "\<theta>' \<equiv> map (\<lambda>t. (t, the (match_abss' t (t \<cdot> \<delta>)))) ts"
   define \<theta>'' where "\<theta>'' \<equiv> map (\<lambda>t. the (match_abss' t (t \<cdot> \<delta>))) ts'"
 
   have 0: "those (map (\<lambda>t. match_abss' t (t \<cdot> \<delta>)) ts) = Some \<theta>"
     using \<theta>(1) map2_map_subst unfolding fg(3) by metis
 
   have 1: "\<forall>t \<in> set ts. \<exists>\<sigma>. match_abss' t (t \<cdot> \<delta>) = Some \<sigma>"
     using ts zip_map_subst[of ts \<delta>] unfolding fg(3) by simp
 
   have ts_not_nil: "ts \<noteq> []"
     using prems(2) by fastforce
   hence "\<exists>t \<in> set ts. x \<in> fv t" using prems(2) by simp
   then obtain a tsa where a: "\<delta> x = Fun (Abs a) tsa" 
     using 1 match_abss'_subst_fv_ex_abs[OF _ TI, of _ \<delta>]
     by metis
   hence a': "\<sigma>' x = {a}"
     when "t \<in> set ts" "x \<in> fv t" "match_abss' t (t \<cdot> \<delta>) = Some \<sigma>'"
     for t \<sigma>'
     using that match_abss'_subst_fv_ex_abs[OF _ TI, of _ \<delta>]
     by fastforce
 
   have "ts' \<noteq> []" using prems(2) unfolding ts'_def by (simp add: filter_empty_conv) 
   hence \<theta>''_not_nil: "\<theta>'' \<noteq> []" unfolding \<theta>''_def by simp
 
   have 2: "\<sigma>' \<in> set \<theta>"
     when t: "t \<in> set ts" "match_abss' t (t \<cdot> \<delta>) = Some \<sigma>'" for t \<sigma>'
     using t 0 those_Some_iff[of "map (\<lambda>t. match_abss' t (t \<cdot> \<delta>)) ts" \<theta>] by force
 
   have 3: "?P \<sigma>'" "\<sigma>' x \<noteq> {}"
     when t: "t \<in> set ts'" "match_abss' t (t \<cdot> \<delta>) = Some \<sigma>'" for t \<sigma>'
     using t hyps(1)[OF conjI[OF fg(1,2)], of "(t, t \<cdot> \<delta>)" t \<sigma>'] zip_map_subst[of ts \<delta>]
           match_abss'_fv_is_nonempty[of t "t \<cdot> \<delta>" \<sigma>' x]
     unfolding fg(3) ts'_def by (force, force)
 
   have 4: "\<sigma>' x = {}"
     when t: "x \<notin> fv t" "match_abss' t (t \<cdot> \<delta>) = Some \<sigma>'" for t \<sigma>'
     by (meson t match_abss'_nonempty_is_fv)
 
   have 5: "\<theta> = map snd \<theta>'"
     using 0 1 unfolding \<theta>'_def by (induct ts arbitrary: \<theta>) auto
 
   have "fun_point_Union_list (map snd \<theta>') x =
         fun_point_Union_list (map snd (filter (\<lambda>(t,_). x \<in> fv t) \<theta>')) x"
     using 1 4 unfolding \<theta>'_def fun_point_Union_list_def by fastforce
   hence 6: "fun_point_Union_list \<theta> x = fun_point_Union_list \<theta>'' x"
     using 0 1 4 unfolding 5 \<theta>'_def \<theta>''_def fun_point_Union_list_def ts'_def by auto
 
   have 7: "?P \<sigma>'" "\<sigma>' x \<noteq> {}"
     when \<sigma>': "\<sigma>' \<in> set \<theta>''" for \<sigma>'
     using that 1 3 unfolding \<theta>''_def ts'_def by auto
 
   have "\<sigma>' x = {a}"
     when \<sigma>': "\<sigma>' \<in> set \<theta>''" for \<sigma>'
     using \<sigma>' a' 1 unfolding \<theta>''_def ts'_def by fastforce
   hence "fun_point_Union_list \<theta>'' x = {b | b \<sigma>'. \<sigma>' \<in> set \<theta>'' \<and> b \<in> {a}}"
     using \<theta>''_not_nil unfolding fun_point_Union_list_def by auto
   hence 8: "fun_point_Union_list \<theta>'' x = {a}"
     using \<theta>''_not_nil by auto
 
   show ?case
     using 8 a
     unfolding \<theta>(2) 6 ticl_abs_iff[OF TI] by auto
 qed simp_all
 
 lemma match_abssD:
   fixes OCC TI s
   defines "f \<equiv> (\<lambda>\<delta> x. if x \<in> fv s then \<delta> x else set OCC)"
     and "g \<equiv> (\<lambda>\<delta> x. \<Inter>(ticl_abs TI ` \<delta> x))"
   assumes \<delta>': "match_abss OCC TI s t = Some \<delta>'" 
   shows "\<exists>\<delta>. match_abss' s t = Some \<delta> \<and> \<delta>' = f (g \<delta>) \<and> (\<forall>x \<in> fv s. \<delta> x \<noteq> {} \<and> f (g \<delta>) x \<noteq> {}) \<and>
              (set OCC \<noteq> {} \<longrightarrow> (\<forall>x. f (g \<delta>) x \<noteq> {}))"
 proof -
   obtain \<delta> where \<delta>: "match_abss' s t = Some \<delta>"
     using \<delta>' unfolding match_abss_def by force
   hence "Some \<delta>' = (if \<forall>x \<in> fv s. g \<delta> x \<noteq> {} then Some (f (g \<delta>)) else None)"
     using \<delta>' unfolding match_abss_def f_def g_def Let_def by simp
   hence "\<delta>' = f (g \<delta>)" "\<forall>x \<in> fv s. \<delta> x \<noteq> {} \<and> f (g \<delta>) x \<noteq> {}"
     by (metis (no_types, lifting) option.inject option.distinct(1),
         metis (no_types, lifting) f_def option.distinct(1) match_abss'_fv_is_nonempty[OF \<delta>])
   thus ?thesis using \<delta> unfolding f_def by force
 qed
 
 lemma match_abss_ticl_abs_Inter_subset:
   assumes TI: "set TI = {(a,b). (a,b) \<in> (set TI)\<^sup>+ \<and> a \<noteq> b}"
     and \<delta>: "match_abss OCC TI s t = Some \<delta>"
     and x: "x \<in> fv s"
   shows "\<Inter>(ticl_abs TI ` \<delta> x) \<subseteq> \<delta> x"
 proof -
   let ?h1 = "\<lambda>\<delta> x. if x \<in> fv s then \<delta> x else set OCC"
   let ?h2 = "\<lambda>\<delta> x. \<Inter>(ticl_abs TI ` \<delta> x)"
 
   obtain \<delta>' where \<delta>':
       "match_abss' s t = Some \<delta>'" "\<delta> = ?h1 (?h2 \<delta>')"
       "\<forall>x \<in> fv s. \<delta>' x \<noteq> {} \<and> \<delta> x \<noteq> {}"
     using match_abssD[OF \<delta>] by blast
 
   have "\<delta> x = \<Inter>(ticl_abs TI ` \<delta>' x)" "\<delta>' x \<noteq> {}" "\<delta> x \<noteq> {}"
     using x \<delta>'(2,3) by auto
   thus ?thesis
     using ticl_abs_Inter TI by simp
 qed
 
 lemma match_abss_fv_has_abs:
   assumes "match_abss OCC TI s t = Some \<delta>"
     and "x \<in> fv s"
   shows "\<delta> x \<noteq> {}"
 using assms match_abssD by fast
 
 lemma match_abss_OCC_if_not_fv:
   fixes s t::"(('a,'b,'c,'d) prot_fun, 'v) term"
   assumes \<delta>': "match_abss OCC TI s t = Some \<delta>'"
     and x: "x \<notin> fv s"
   shows "\<delta>' x = set OCC"
 proof -
   define f where "f \<equiv> \<lambda>s::(('a,'b,'c,'d) prot_fun, 'v) term. \<lambda>\<delta> x. if x \<in> fv s then \<delta> x else set OCC"
   define g where "g \<equiv> \<lambda>\<delta>. \<lambda>x::'v. \<Inter>(ticl_abs TI ` \<delta> x)"
 
   obtain \<delta> where \<delta>: "match_abss' s t = Some \<delta>" "\<delta>' = f s (g \<delta>)"
     using match_abssD[OF \<delta>'] unfolding f_def g_def by blast
 
   show ?thesis
     using x \<delta>(2) unfolding f_def by presburger
 qed
 
 inductive synth_abs_substs_constrs_rel for FP OCC TI where
   SolveNil:
     "synth_abs_substs_constrs_rel FP OCC TI [] (\<lambda>_. set OCC)"
 | SolveCons:
     "ts \<noteq> [] \<Longrightarrow> \<forall>t \<in> set ts. synth_abs_substs_constrs_rel FP OCC TI [t] (\<theta> t)
       \<Longrightarrow> synth_abs_substs_constrs_rel FP OCC TI ts (fun_point_Inter (\<theta> ` set ts))"
 | SolvePubConst:
     "arity c = 0 \<Longrightarrow> public c
       \<Longrightarrow> synth_abs_substs_constrs_rel FP OCC TI [Fun c []] (\<lambda>_. set OCC)"
 | SolvePrivConstIn:
     "arity c = 0 \<Longrightarrow> \<not>public c \<Longrightarrow> Fun c [] \<in> set FP
       \<Longrightarrow> synth_abs_substs_constrs_rel FP OCC TI [Fun c []] (\<lambda>_. set OCC)"
 | SolvePrivConstNotin:
     "arity c = 0 \<Longrightarrow> \<not>public c \<Longrightarrow> Fun c [] \<notin> set FP
       \<Longrightarrow> synth_abs_substs_constrs_rel FP OCC TI [Fun c []] (\<lambda>_. {})"
 | SolveValueVar:
     "\<theta> = ((\<lambda>_. set OCC)(x := ticl_abss TI {a \<in> set OCC. \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s \<in> set FP}))
       \<Longrightarrow> synth_abs_substs_constrs_rel FP OCC TI [Var x] \<theta>"
 | SolveComposed:
     "arity f > 0 \<Longrightarrow> length ts = arity f
       \<Longrightarrow> \<forall>\<delta>. \<delta> \<in> \<Delta> \<longleftrightarrow> (\<exists>s \<in> set FP. match_abss OCC TI (Fun f ts) s = Some \<delta>)
       \<Longrightarrow> \<theta>1 = fun_point_Union \<Delta>
       \<Longrightarrow> synth_abs_substs_constrs_rel FP OCC TI ts \<theta>2
       \<Longrightarrow> synth_abs_substs_constrs_rel FP OCC TI [Fun f ts] (fun_point_union \<theta>1 \<theta>2)"
 
 fun synth_abs_substs_constrs_aux where
   "synth_abs_substs_constrs_aux FP OCC TI (Var x) = (
     (\<lambda>_. set OCC)(x := ticl_abss TI (set (filter (\<lambda>a. \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s \<in> set FP) OCC))))"
 | "synth_abs_substs_constrs_aux FP OCC TI (Fun f ts) = (
     if ts = []
     then if \<not>public f \<and> Fun f ts \<notin> set FP then (\<lambda>_. {}) else (\<lambda>_. set OCC)
     else let \<Delta> = map the (filter (\<lambda>\<delta>. \<delta> \<noteq> None) (map (match_abss OCC TI (Fun f ts)) FP));
              \<theta>1 = fun_point_Union_list \<Delta>;
              \<theta>2 = fun_point_Inter_list (map (synth_abs_substs_constrs_aux FP OCC TI) ts)
          in fun_point_union \<theta>1 \<theta>2)"
 
 definition synth_abs_substs_constrs where
   "synth_abs_substs_constrs FPT T \<equiv>
     let (FP,OCC,TI) = FPT;
         ts = trms_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_receive T));
         f = fun_point_Inter_list \<circ> map (synth_abs_substs_constrs_aux FP OCC TI)
     in if ts = [] then (\<lambda>_. set OCC) else f ts"
 
 (* definition synth_abs_substs_constrs where
   "synth_abs_substs_constrs FPT T \<equiv>
     let (FP,OCC,TI) = FPT;
         negsy = Not \<circ> intruder_synth_mod_timpls FP TI;
         \<Theta> = \<lambda>\<delta> x. let as = \<delta> x in if as \<noteq> {} then as else set OCC;
         C = unlabel (transaction_checks T);
         poss = transaction_poschecks_comp C;
         negs = transaction_negchecks_comp C;
         ts = trms_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_receive T));
         f = \<lambda>t. let \<Delta> = map the (filter (\<lambda>\<delta>. \<delta> \<noteq> None) (map (match_abss OCC TI t) FP))
                 in fun_point_Union_list (map \<Theta> \<Delta>);
         g = \<lambda>t. if is_Fun t \<and> args t \<noteq> []
                 then let s = hd (args t)
                 in case fv_list s of
                    [] \<Rightarrow> if negsy s then Some (f t) else None
                  | [x] \<Rightarrow> let bs = filter (\<lambda>a. poss x \<subseteq> a \<and> a \<inter> negs x = {}) OCC
                           in if list_all (\<lambda>b. negsy (s \<cdot> Var(x := \<langle>b\<rangle>\<^sub>a\<^sub>b\<^sub>s))) bs
                              then Some (f t) else None
                  | _ \<Rightarrow> None
                 else None;
         h = \<lambda>t. case g t of Some d \<Rightarrow> d | None \<Rightarrow> synth_abs_substs_constrs_aux FP OCC TI t
     in if ts = [] then (\<lambda>_. set OCC) else fun_point_Inter_list (map h ts)" *)
 (*
 poss = transaction_poschecks_comp (C A);
       negs = transaction_negchecks_comp (C A);
       bs = filter (\<lambda>a. poss PK \<subseteq> a \<and> a \<inter> negs PK = {}) OCC
     in if list_all (Not \<circ> sy \<circ> s A) bs
        then Some (map the (filter (\<lambda>\<delta>. \<delta> \<noteq> None) (map (match_abss OCC TI (t' A)) FP)))
        else None
 *)
 definition transaction_check_comp::
   "[('fun,'atom,'sets,'lbl) prot_var \<Rightarrow> 'sets set \<Rightarrow> bool,
     ('fun,'atom,'sets,'lbl) prot_term list \<times>
     'sets set list \<times>
     ('sets set \<times> 'sets set) list,
     ('fun,'atom,'sets,'lbl) prot_transaction]
   \<Rightarrow> ((('fun,'atom,'sets,'lbl) prot_var \<times> 'sets set) list) list"
 where
   "transaction_check_comp msgcs FPT T \<equiv>
     let (_, OCC, _) = FPT;
         S = unlabel (transaction_strand T);
         C = unlabel (transaction_checks T);
         xs = filter (\<lambda>x. x \<notin> set (transaction_fresh T) \<and> fst x = TAtom Value) (fv_list\<^sub>s\<^sub>s\<^sub>t S);
         posconstrs = transaction_poschecks_comp C;
         negconstrs = transaction_negchecks_comp C;
         pre_check = transaction_check_pre FPT T;
         \<Delta> = abs_substs_set xs OCC posconstrs negconstrs msgcs
     in filter (\<lambda>\<delta>. pre_check (abs_substs_fun \<delta>)) \<Delta>"
 
 definition transaction_check'::
   "[('fun,'atom,'sets,'lbl) prot_var \<Rightarrow> 'sets set \<Rightarrow> bool,
     ('fun,'atom,'sets,'lbl) prot_term list \<times>
     'sets set list \<times>
     ('sets set \<times> 'sets set) list,
     ('fun,'atom,'sets,'lbl) prot_transaction]
   \<Rightarrow> bool"
 where
   "transaction_check' msgcs FPT T \<equiv>
     list_all (\<lambda>\<delta>. transaction_check_post FPT T (abs_substs_fun \<delta>))
              (transaction_check_comp msgcs FPT T)"
 
 definition transaction_check::
   "[('fun,'atom,'sets,'lbl) prot_term list \<times>
     'sets set list \<times>
     ('sets set \<times> 'sets set) list,
     ('fun,'atom,'sets,'lbl) prot_transaction]
   \<Rightarrow> bool"
 where
   "transaction_check \<equiv> transaction_check' (\<lambda>_ _. True)"
 
 definition transaction_check_coverage_rcv::
   "[('fun,'atom,'sets,'lbl) prot_term list \<times>
     'sets set list \<times>
     ('sets set \<times> 'sets set) list,
     ('fun,'atom,'sets,'lbl) prot_transaction]
   \<Rightarrow> bool"
 where
   "transaction_check_coverage_rcv FPT T \<equiv>
     let msgcs = synth_abs_substs_constrs FPT T
     in transaction_check' (\<lambda>x a. a \<in> msgcs x) FPT T"
 
 lemma abs_subst_fun_cons:
   "abs_substs_fun ((x,b)#\<delta>) = (abs_substs_fun \<delta>)(x := b)"
 unfolding abs_substs_fun_def by fastforce
 
 lemma abs_substs_cons:
   assumes "\<delta> \<in> set (abs_substs_set xs as poss negs msgcs)"
           "b \<in> set as" "poss x \<subseteq> b" "b \<inter> negs x = {}" "msgcs x b"
   shows "(x,b)#\<delta> \<in> set (abs_substs_set (x#xs) as poss negs msgcs)"
 using assms by auto
 
 lemma abs_substs_cons':
   assumes \<delta>: "\<delta> \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs msgcs)"
     and b: "b \<in> set as" "poss x \<subseteq> b" "b \<inter> negs x = {}" "msgcs x b"
   shows "\<delta>(x := b) \<in> abs_substs_fun ` set (abs_substs_set (x#xs) as poss negs msgcs)"
 proof -
   obtain \<theta> where \<theta>: "\<delta> = abs_substs_fun \<theta>" "\<theta> \<in> set (abs_substs_set xs as poss negs msgcs)"
     using \<delta> by moura
   have "abs_substs_fun ((x, b)#\<theta>) \<in> abs_substs_fun ` set (abs_substs_set (x#xs) as poss negs msgcs)"
     using abs_substs_cons[OF \<theta>(2) b] by blast
   thus ?thesis
     using \<theta>(1) abs_subst_fun_cons[of x b \<theta>] by argo
 qed
 
 lemma abs_substs_has_abs:
   assumes "\<forall>x. x \<in> set xs \<longrightarrow> \<delta> x \<in> set as"
     and "\<forall>x. x \<in> set xs \<longrightarrow> poss x \<subseteq> \<delta> x"
     and "\<forall>x. x \<in> set xs \<longrightarrow> \<delta> x \<inter> negs x = {}"
     and "\<forall>x. x \<in> set xs \<longrightarrow> msgcs x (\<delta> x)"
     and "\<forall>x. x \<notin> set xs \<longrightarrow> \<delta> x = {}"
   shows "\<delta> \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs msgcs)"
 using assms
 proof (induction xs arbitrary: \<delta>)
   case (Cons x xs)
   define \<theta> where "\<theta> \<equiv> \<lambda>y. if y \<in> set xs then \<delta> y else {}"
 
   have "\<theta> \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs msgcs)"
     using Cons.prems Cons.IH by (simp add: \<theta>_def)
   moreover have "\<delta> x \<in> set as" "poss x \<subseteq> \<delta> x" "\<delta> x \<inter> negs x = {}" "msgcs x (\<delta> x)"
     by (simp_all add: Cons.prems(1,2,3,4))
   ultimately have 0: "\<theta>(x := \<delta> x) \<in> abs_substs_fun ` set (abs_substs_set (x#xs) as poss negs msgcs)"
     by (metis abs_substs_cons')
 
   have "\<delta> = \<theta>(x := \<delta> x)"
   proof
     fix y show "\<delta> y = (\<theta>(x := \<delta> x)) y"
     proof (cases "y \<in> set (x#xs)")
       case False thus ?thesis using Cons.prems(5) by (fastforce simp add: \<theta>_def)
     qed (auto simp add: \<theta>_def)
   qed
   thus ?case by (metis 0)
 qed (auto simp add: abs_substs_fun_def)
 
 lemma abs_substs_abss_bounded:
   assumes "\<delta> \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs msgcs)"
     and "x \<in> set xs"
   shows "\<delta> x \<in> set as"
     and "poss x \<subseteq> \<delta> x"
     and "\<delta> x \<inter> negs x = {}"
     and "msgcs x (\<delta> x)"
 using assms
 proof (induct xs as poss negs msgcs arbitrary: \<delta> rule: abs_substs_set_induct)
   case (Cons y xs as poss negs msgcs)
   { case 1 thus ?case using Cons.hyps(1) unfolding abs_substs_fun_def by fastforce }
 
   { case 2 thus ?case
     proof (cases "x = y")
       case False
       then obtain \<delta>' where \<delta>':
           "\<delta>' \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs msgcs)" "\<delta>' x = \<delta> x"
         using 2 unfolding abs_substs_fun_def by force
       moreover have "x \<in> set xs" using 2(2) False by simp
       moreover have "\<exists>b. b \<in> set as \<and> poss y \<subseteq> b \<and> b \<inter> negs y = {}"
         using 2 False by auto
       ultimately show ?thesis using Cons.hyps(2) by fastforce
     qed (auto simp add: abs_substs_fun_def)
   }
 
   { case 3 thus ?case
     proof (cases "x = y")
       case False
       then obtain \<delta>' where \<delta>':
           "\<delta>' \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs msgcs)" "\<delta>' x = \<delta> x"
         using 3 unfolding abs_substs_fun_def by force
       moreover have "x \<in> set xs" using 3(2) False by simp
       moreover have "\<exists>b. b \<in> set as \<and> poss y \<subseteq> b \<and> b \<inter> negs y = {}"
         using 3 False by auto
       ultimately show ?thesis using Cons.hyps(3) by fastforce
     qed (auto simp add: abs_substs_fun_def)
   }
 
   { case 4 thus ?case
     proof (cases "x = y")
       case False
       then obtain \<delta>' where \<delta>':
           "\<delta>' \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs msgcs)" "\<delta>' x = \<delta> x"
         using 4 unfolding abs_substs_fun_def by force
       moreover have "x \<in> set xs" using 4(2) False by simp
       moreover have "\<exists>b. b \<in> set as \<and> poss y \<subseteq> b \<and> b \<inter> negs y = {}"
         using 4 False by auto
       ultimately show ?thesis using Cons.hyps(4) by fastforce
     qed (auto simp add: abs_substs_fun_def)
   }
 qed (simp_all add: abs_substs_fun_def)
 
 lemma abs_substs_abss_bounded':
   assumes "\<delta> \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs msgcs)"
     and "x \<notin> set xs"
   shows "\<delta> x = {}"
 using assms unfolding abs_substs_fun_def
 by (induct xs as poss negs msgcs arbitrary: \<delta> rule: abs_substs_set_induct) (force, fastforce)
 
 lemma transaction_poschecks_comp_unfold:
   "transaction_poschecks_comp C x = {s. \<exists>a. \<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> set C}"
 proof (induction C)
   case (Cons c C) thus ?case
   proof (cases "\<exists>a y s. c = \<langle>a: Var y \<in> Fun (Set s) []\<rangle>")
     case True
     then obtain a y s where c: "c = \<langle>a: Var y \<in> Fun (Set s) []\<rangle>" by moura
 
     define f where "f \<equiv> transaction_poschecks_comp C"
 
     have "transaction_poschecks_comp (c#C) = f(y := insert s (f y))"
       using c by (simp add: f_def Let_def)
     moreover have "f x = {s. \<exists>a. \<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> set C}"
       using Cons.IH unfolding f_def by blast
     ultimately show ?thesis using c by auto
   next
     case False
     hence "transaction_poschecks_comp (c#C) = transaction_poschecks_comp C" (is ?P)
       using transaction_poschecks_comp.cases[of "c#C" ?P] by force
     thus ?thesis using False Cons.IH by auto
   qed
 qed simp
 
 lemma transaction_poschecks_comp_notin_fv_empty:
   assumes "x \<notin> fv\<^sub>s\<^sub>s\<^sub>t C"
   shows "transaction_poschecks_comp C x = {}"
 using assms transaction_poschecks_comp_unfold[of C x] by fastforce
 
 lemma transaction_negchecks_comp_unfold:
   "transaction_negchecks_comp C x = {s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> set C}"
 proof (induction C)
   case (Cons c C) thus ?case
   proof (cases "\<exists>y s. c = \<langle>Var y not in Fun (Set s) []\<rangle>")
     case True
     then obtain y s where c: "c = \<langle>Var y not in Fun (Set s) []\<rangle>" by moura
 
     define f where "f \<equiv> transaction_negchecks_comp C"
 
     have "transaction_negchecks_comp (c#C) = f(y := insert s (f y))"
       using c by (simp add: f_def Let_def)
     moreover have "f x = {s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> set C}"
       using Cons.IH unfolding f_def by blast
     ultimately show ?thesis using c by auto
   next
     case False
     hence "transaction_negchecks_comp (c#C) = transaction_negchecks_comp C" (is ?P)
       using transaction_negchecks_comp.cases[of "c#C" ?P] 
       by force
     thus ?thesis using False Cons.IH by fastforce
   qed
 qed simp  
 
 lemma transaction_negchecks_comp_notin_fv_empty:
   assumes "x \<notin> fv\<^sub>s\<^sub>s\<^sub>t C"
   shows "transaction_negchecks_comp C x = {}"
 using assms transaction_negchecks_comp_unfold[of C x] by fastforce
 
 lemma transaction_check_preI[intro]:
   fixes T
   defines "\<theta> \<equiv> \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x"
     and "C \<equiv> set (unlabel (transaction_checks T))"
   assumes a0: "\<forall>x \<in> set (transaction_fresh T). \<delta> x = {}"
     and a1: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> \<delta> x \<in> set OCC"
     and a2: "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<delta>)"
     and a3: "\<forall>a x s. \<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<in> \<delta> x"
     and a4: "\<forall>x s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<notin> \<delta> x"
   shows "transaction_check_pre (FP, OCC, TI) T \<delta>"
 proof -
   let ?P = "\<lambda>u. is_InSet u \<longrightarrow> (
     let x = the_elem_term u; s = the_set_term u
     in (is_Var x \<and> is_Fun_Set s) \<longrightarrow> the_Set (the_Fun s) \<in> \<delta> (the_Var x))"
 
   let ?Q = "\<lambda>u. (is_NegChecks u \<and> bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p u = [] \<and> the_eqs u = [] \<and> length (the_ins u) = 1) \<longrightarrow> (
     let x = fst (hd (the_ins u)); s = snd (hd (the_ins u))
     in (is_Var x \<and> is_Fun_Set s) \<longrightarrow> the_Set (the_Fun s) \<notin> \<delta> (the_Var x))"
 
   have 1: "?P u" when u: "u \<in> C" for u
     apply (unfold Let_def, intro impI, elim conjE)
     using u a3 Fun_Set_InSet_iff[of u] by metis
 
   have 2: "?Q u" when u: "u \<in> C" for u
     apply (unfold Let_def, intro impI, elim conjE)
     using u a4 Fun_Set_NotInSet_iff[of u] by metis
 
   show ?thesis
     using a0 a1 a2 1 2 fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
     unfolding transaction_check_pre_def \<theta>_def C_def Let_def
     by blast
 qed
 
 lemma transaction_check_pre_InSetE:
   assumes T: "transaction_check_pre FPT T \<delta>"
     and u: "u = \<langle>a: Var x \<in> Fun (Set s) []\<rangle>"
            "u \<in> set (unlabel (transaction_checks T))"
   shows "s \<in> \<delta> x"
 proof -
   have "is_InSet u \<longrightarrow> is_Var (the_elem_term u) \<and> is_Fun_Set (the_set_term u) \<longrightarrow>
         the_Set (the_Fun (the_set_term u)) \<in> \<delta> (the_Var (the_elem_term u))"
     using T u unfolding transaction_check_pre_def Let_def by blast
   thus ?thesis using Fun_Set_InSet_iff[of u a x s] u by argo
 qed
 
 lemma transaction_check_pre_NotInSetE:
   assumes T: "transaction_check_pre FPT T \<delta>"
     and u: "u = \<langle>Var x not in Fun (Set s) []\<rangle>"
            "u \<in> set (unlabel (transaction_checks T))"
   shows "s \<notin> \<delta> x"
 proof -
   have "is_NegChecks u \<and> bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p u = [] \<and> the_eqs u = [] \<and> length (the_ins u) = 1 \<longrightarrow>
          is_Var (fst (hd (the_ins u))) \<and> is_Fun_Set (snd (hd (the_ins u))) \<longrightarrow>
          the_Set (the_Fun (snd (hd (the_ins u)))) \<notin> \<delta> (the_Var (fst (hd (the_ins u))))"
     using T u unfolding transaction_check_pre_def Let_def by blast
   thus ?thesis using Fun_Set_NotInSet_iff[of u  x s] u by argo
 qed
 
 lemma transaction_check_pre_ReceiveE:
   defines "\<theta> \<equiv> \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x"
   assumes T: "transaction_check_pre (FP, OCC, TI) T \<delta>"
     and t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
   shows "intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<delta>)"
 using T t unfolding transaction_check_pre_def Let_def \<theta>_def by blast
 
 lemma transaction_check_compI[intro]:
   assumes T: "transaction_check_pre (FP, OCC, TI) T \<delta>"
     and T_adm: "admissible_transaction' T"
     and x1: "\<forall>x. (x \<in> fv_transaction T - set (transaction_fresh T) \<and> fst x = TAtom Value)
                   \<longrightarrow> \<delta> x \<in> set OCC \<and> msgcs x (\<delta> x)"
     and x2: "\<forall>x. (x \<notin> fv_transaction T - set (transaction_fresh T) \<or> fst x \<noteq> TAtom Value)
                   \<longrightarrow> \<delta> x = {}"
   shows "\<delta> \<in> abs_substs_fun ` set (transaction_check_comp msgcs (FP, OCC, TI) T)"
 proof -
   define S where "S \<equiv> unlabel (transaction_strand T)"
   define C where "C \<equiv> unlabel (transaction_checks T)"
 
   let ?xs = "fv_list\<^sub>s\<^sub>s\<^sub>t S"
 
   define poss where "poss \<equiv> transaction_poschecks_comp C"
   define negs where "negs \<equiv> transaction_negchecks_comp C"
   define ys where "ys \<equiv> filter (\<lambda>x. x \<notin> set (transaction_fresh T) \<and> fst x = TAtom Value) ?xs"
 
   have ys: "{x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value} = set ys"
     using fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of S]
     unfolding ys_def S_def by force
   
   have "\<delta> x \<in> set OCC" "msgcs x (\<delta> x)"
     when x: "x \<in> set ys" for x
     using x1 x ys by (blast, blast)
   moreover have "\<delta> x = {}"
     when x: "x \<notin> set ys" for x
     using x2 x ys by blast
   moreover have "poss x \<subseteq> \<delta> x" when x: "x \<in> set ys" for x
   proof -
     have "s \<in> \<delta> x" when u: "u = \<langle>a: Var x \<in> Fun (Set s) []\<rangle>" "u \<in> set C" for u a s
       using T u transaction_check_pre_InSetE[of "(FP, OCC, TI)" T \<delta>]
       unfolding C_def by blast
     thus ?thesis
       using transaction_poschecks_comp_unfold[of C x]
       unfolding poss_def by blast
   qed
   moreover have "\<delta> x \<inter> negs x = {}" when x: "x \<in> set ys" for x
   proof (cases "x \<in> fv\<^sub>s\<^sub>s\<^sub>t C")
     case True
     hence "s \<notin> \<delta> x" when u: "u = \<langle>Var x not in Fun (Set s) []\<rangle>" "u \<in> set C" for u s
       using T u transaction_check_pre_NotInSetE[of "(FP, OCC, TI)" T \<delta>]
       unfolding C_def by blast
     thus ?thesis
       using transaction_negchecks_comp_unfold[of C x]
       unfolding negs_def by blast
   next
     case False
     hence "negs x = {}"
       using x transaction_negchecks_comp_notin_fv_empty
       unfolding negs_def by blast
     thus ?thesis by blast
   qed
   ultimately have "\<delta> \<in> abs_substs_fun ` set (abs_substs_set ys OCC poss negs msgcs)"
     using abs_substs_has_abs[of ys \<delta> OCC poss negs msgcs]
     by fast
   thus ?thesis
     using T
     unfolding transaction_check_comp_def Let_def S_def C_def ys_def poss_def negs_def
     by fastforce
 qed
 
 context
 begin
 private lemma transaction_check_comp_in_aux:
   fixes T
   defines "C \<equiv> set (unlabel (transaction_checks T))"
   assumes T_adm: "admissible_transaction' T"
     and a1: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> (\<forall>s.
           select\<langle>Var x, Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<in> \<alpha> x)"
     and a2: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> (\<forall>s.
           \<langle>Var x in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<in> \<alpha> x)"
     and a3: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> (\<forall>s.
           \<langle>Var x not in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<notin> \<alpha> x)"
   shows "\<forall>a x s. \<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<in> \<alpha> x" (is ?A)
     and "\<forall>x s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<notin> \<alpha> x" (is ?B)
 proof -
   note * = admissible_transaction_strand_step_cases(2,3)[OF T_adm]
 
   have 1: "fst x = TAtom Value" "x \<in> fv_transaction T - set (transaction_fresh T)"
     when x: "\<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> C" for a x s
     using * x unfolding C_def by fast+
 
   have 2: "fst x = TAtom Value" "x \<in> fv_transaction T - set (transaction_fresh T)"
     when x: "\<langle>Var x not in Fun (Set s) []\<rangle> \<in> C" for x s
     using * x unfolding C_def by fast+
 
   show ?A
   proof (intro allI impI)
     fix a x s assume u: "\<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> C"
     thus "s \<in> \<alpha> x" using 1 a1 a2 by (cases a) metis+
   qed
 
   show ?B
   proof (intro allI impI)
     fix x s assume u: "\<langle>Var x not in Fun (Set s) []\<rangle> \<in> C"
     thus "s \<notin> \<alpha> x" using 2 a3 by meson
   qed
 qed
 
 lemma transaction_check_comp_in:
   fixes T
   defines "\<theta> \<equiv> \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x"
     and "C \<equiv> set (unlabel (transaction_checks T))"
   assumes T_adm: "admissible_transaction' T"
     and a1: "\<forall>x \<in> set (transaction_fresh T). \<alpha> x = {}"
     and a2: "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<alpha>)"
     and a3: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). \<forall>s.
           select\<langle>Var x, Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<in> \<alpha> x"
     and a4: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). \<forall>s.
           \<langle>Var x in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<in> \<alpha> x"
     and a5: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). \<forall>s.
           \<langle>Var x not in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<notin> \<alpha> x"
     and a6: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T).
           fst x = TAtom Value \<longrightarrow> \<alpha> x \<in> set OCC"
     and a7: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T).
           fst x = TAtom Value \<longrightarrow> msgcs x (\<alpha> x)"
   shows "\<exists>\<delta> \<in> abs_substs_fun ` set (transaction_check_comp msgcs (FP, OCC, TI) T).
           \<forall>x \<in> fv_transaction T. fst x = TAtom Value \<longrightarrow> \<alpha> x = \<delta> x"
 proof -
   let ?xs = "fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))"
   let ?ys = "filter (\<lambda>x. x \<notin> set (transaction_fresh T)) ?xs"
 
   define \<alpha>' where "\<alpha>' \<equiv> \<lambda>x.
     if x \<in> fv_transaction T - set (transaction_fresh T) \<and> fst x = TAtom Value
     then \<alpha> x
     else {}"
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
 
   have \<theta>\<alpha>_Fun: "is_Fun (t \<cdot> \<theta> \<alpha>) \<longleftrightarrow> is_Fun (t \<cdot> \<theta> \<alpha>')" for t
     unfolding \<alpha>'_def \<theta>_def
     by (induct t) auto
 
   have "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<alpha>')"
   proof (intro ballI impI)
     fix t assume t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
 
     have 1: "intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<alpha>)"
       using t a2
       by auto
 
     obtain r where r:
         "r \<in> set (unlabel (transaction_receive T))"
         "t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r"
       using t by auto
     hence "\<exists>ts. r = receive\<langle>ts\<rangle> \<and> t \<in> set ts"
       using wellformed_transaction_unlabel_cases(1)[OF T_wf]
       by fastforce
     hence 2: "fv t \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" using r by force
 
     have "fv t \<subseteq> fv_transaction T"
       by (metis (no_types, lifting) 2 transaction_strand_def sst_vars_append_subset(1)
                 unlabel_append subset_Un_eq sup.bounded_iff)
     moreover have "fv t \<inter> set (transaction_fresh T) = {}"
       using 2 T_wf vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_receive T)"]
       unfolding wellformed_transaction_def
       by fast
     ultimately have "\<theta> \<alpha> x = \<theta> \<alpha>' x" when "x \<in> fv t" for x
       using that unfolding \<alpha>'_def \<theta>_def by fastforce
     hence 3: "t \<cdot> \<theta> \<alpha> = t \<cdot> \<theta> \<alpha>'"
       using term_subst_eq by blast
 
     show "intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<alpha>')" using 1 3 by simp
   qed
   moreover have
       "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> (\<forall>s.
           select\<langle>Var x, Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<in> \<alpha>' x)"
       "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> (\<forall>s.
           \<langle>Var x in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<in> \<alpha>' x)"
       "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> (\<forall>s.
           \<langle>Var x not in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<notin> \<alpha>' x)"
     using a3 a4 a5
     unfolding \<alpha>'_def \<theta>_def C_def
     by meson+
   hence "\<forall>a x s. \<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<in> \<alpha>' x"
         "\<forall>x s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<notin> \<alpha>' x"
     using transaction_check_comp_in_aux[OF T_adm, of \<alpha>']
     unfolding C_def
     by (fast, fast)
   ultimately have 4: "transaction_check_pre (FP, OCC, TI) T \<alpha>'"
     using a6 transaction_check_preI[of T \<alpha>' OCC FP TI]
     unfolding \<alpha>'_def \<theta>_def C_def
     by simp
 
   have 5: "\<forall>x \<in> fv_transaction T. fst x = TAtom Value \<longrightarrow> \<alpha> x = \<alpha>' x"
     using a1 by (auto simp add: \<alpha>'_def)
 
   have 6: "\<alpha>' \<in> abs_substs_fun ` set (transaction_check_comp msgcs (FP, OCC, TI) T)"
     using transaction_check_compI[OF 4 T_adm, of msgcs] a6 a7
     unfolding \<alpha>'_def 
     by auto
 
   show ?thesis using 5 6 by blast
 qed
 end
 
 lemma transaction_check_trivial_case:
   assumes "transaction_updates T = []"
     and "transaction_send T = []"
   shows "transaction_check FPT T"
 using assms
 by (simp add: list_all_iff transaction_check_def transaction_check'_def transaction_check_post_def)
 
 end
 
 
 subsection \<open>Soundness of the Occurs-Message Transformation\<close>
 context stateful_protocol_model
 begin
 
 context
 begin
 
 text \<open>The occurs-message transformation, \<open>add_occurs_msgs\<close>, extends a transaction \<open>T\<close> with
 additional message-transmission steps such that the following holds:
 1. for each fresh variable \<open>x\<close> of \<open>T\<close> the message \<open>occurs (Var x)\<close> now occurs in a send-step,
 2. for each of the remaining free variables \<open>x\<close> of \<open>T\<close> the message \<open>occurs (Var x)\<close> now occurs in a
 receive-step.\<close>
 definition add_occurs_msgs where
   "add_occurs_msgs T \<equiv>
     let frsh = transaction_fresh T;
         xs = filter (\<lambda>x. x \<notin> set frsh) (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)));
         f = map (\<lambda>x. occurs (Var x));
         g = \<lambda>C. if xs = [] then C else \<langle>\<star>, receive\<langle>f xs\<rangle>\<rangle>#C;
         h = \<lambda>F. if frsh = [] then F
                 else if F \<noteq> [] \<and> fst (hd F) = \<star> \<and> is_Send (snd (hd F))
                 then \<langle>\<star>,send\<langle>f frsh@the_msgs (snd (hd F))\<rangle>\<rangle>#tl F
                 else \<langle>\<star>,send\<langle>f frsh\<rangle>\<rangle>#F
     in case T of Transaction A B C D E F \<Rightarrow> Transaction A B (g C) D E (h F)"
 
 private fun rm_occurs_msgs_constr where
   "rm_occurs_msgs_constr [] = []"
 | "rm_occurs_msgs_constr ((l,receive\<langle>ts\<rangle>)#A) = (
     if \<exists>t. occurs t \<in> set ts
     then if \<exists>t \<in> set ts. \<forall>s. t \<noteq> occurs s
          then (l,receive\<langle>filter (\<lambda>t. \<forall>s. t \<noteq> occurs s) ts\<rangle>)#rm_occurs_msgs_constr A
          else rm_occurs_msgs_constr A
     else (l,receive\<langle>ts\<rangle>)#rm_occurs_msgs_constr A)"
 | "rm_occurs_msgs_constr ((l,send\<langle>ts\<rangle>)#A) = (
     if \<exists>t. occurs t \<in> set ts
     then if \<exists>t \<in> set ts. \<forall>s. t \<noteq> occurs s
          then (l,send\<langle>filter (\<lambda>t. \<forall>s. t \<noteq> occurs s) ts\<rangle>)#rm_occurs_msgs_constr A
          else rm_occurs_msgs_constr A
     else (l,send\<langle>ts\<rangle>)#rm_occurs_msgs_constr A)"
 | "rm_occurs_msgs_constr (a#A) = a#rm_occurs_msgs_constr A"
 
 private lemma add_occurs_msgs_cases:
   fixes T C frsh xs f
   defines "T' \<equiv> add_occurs_msgs T"
     and "frsh \<equiv> transaction_fresh T"
     and "xs \<equiv> filter (\<lambda>x. x \<notin> set frsh) (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)))"
     and "xs' \<equiv> fv_transaction T - set frsh"
     and "f \<equiv> map (\<lambda>x. occurs (Var x))"
     and "C' \<equiv> if xs = [] then C else \<langle>\<star>, receive\<langle>f xs\<rangle>\<rangle>#C"
     and "ts' \<equiv> f frsh"
   assumes T: "T = Transaction A B C D E F"
   shows "F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<Longrightarrow> T' = Transaction A B C' D E (\<langle>\<star>,send\<langle>ts'@ts\<rangle>\<rangle>#F')"
     (is "?A ts F' \<Longrightarrow> ?A' ts F'")
   and "\<nexists>ts' F'. F = \<langle>\<star>,send\<langle>ts'\<rangle>\<rangle>#F' \<Longrightarrow> frsh \<noteq> [] \<Longrightarrow> T' = Transaction A B C' D E (\<langle>\<star>,send\<langle>ts'\<rangle>\<rangle>#F)"
     (is "?B \<Longrightarrow> ?B' \<Longrightarrow> ?B''")
   and "frsh = [] \<Longrightarrow> T' = Transaction A B C' D E F" (is "?C \<Longrightarrow> ?C'")
   and "transaction_decl T' = transaction_decl T"
   and "transaction_fresh T' = transaction_fresh T"
   and "xs = [] \<Longrightarrow> transaction_receive T' = transaction_receive T"
   and "xs \<noteq> [] \<Longrightarrow> transaction_receive T' = \<langle>\<star>,receive\<langle>f xs\<rangle>\<rangle>#transaction_receive T"
   and "transaction_checks T' = transaction_checks T"
   and "transaction_updates T' = transaction_updates T"
   and "transaction_send T = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<Longrightarrow>
         transaction_send T' = \<langle>\<star>,send\<langle>ts'@ts\<rangle>\<rangle>#F'" (is "?D ts F' \<Longrightarrow> ?D' ts F'")
   and "\<nexists>ts' F'. transaction_send T = \<langle>\<star>,send\<langle>ts'\<rangle>\<rangle>#F' \<Longrightarrow> frsh \<noteq> [] \<Longrightarrow>
         transaction_send T' = \<langle>\<star>,send\<langle>ts'\<rangle>\<rangle>#transaction_send T" (is "?E \<Longrightarrow> ?E' \<Longrightarrow> ?E''")
   and "frsh = [] \<Longrightarrow> transaction_send T' = transaction_send T" (is "?F \<Longrightarrow> ?F'")
   and "(xs' \<noteq> {} \<and> transaction_receive T' = \<langle>\<star>, receive\<langle>f xs\<rangle>\<rangle>#transaction_receive T) \<or>
        (xs' = {} \<and> transaction_receive T' = transaction_receive T)" (is ?G)
   and "(frsh \<noteq> [] \<and> (\<exists>ts F'.
           transaction_send T = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<and> transaction_send T' = \<langle>\<star>,send\<langle>ts'@ts\<rangle>\<rangle>#F')) \<or>
        (frsh \<noteq> [] \<and> transaction_send T' = \<langle>\<star>,send\<langle>ts'\<rangle>\<rangle>#transaction_send T) \<or>
        (frsh = [] \<and> transaction_send T' = transaction_send T)" (is ?H)
 proof -
   note defs = T'_def T frsh_def xs_def xs'_def f_def C'_def ts'_def add_occurs_msgs_def Let_def
 
   show 0: "?A ts F' \<Longrightarrow> ?A' ts F'" for ts F' unfolding defs by simp
 
   have "F = [] \<or> fst (hd F) \<noteq> \<star> \<or> \<not>is_Send (snd (hd F))" when ?B
     using that unfolding is_Send_def by (cases F) auto
   thus 1: "?B \<Longrightarrow> ?B' \<Longrightarrow> ?B''" unfolding defs by force
 
   show "?C \<Longrightarrow> ?C'" unfolding defs by auto
 
   show "transaction_decl T' = transaction_decl T"
        "transaction_fresh T' = transaction_fresh T"
        "transaction_checks T' = transaction_checks T"
        "transaction_updates T' = transaction_updates T"
     unfolding defs by simp_all
 
   show "xs = [] \<Longrightarrow> transaction_receive T' = transaction_receive T"
        "xs \<noteq> [] \<Longrightarrow> transaction_receive T' = \<langle>\<star>, receive\<langle>f xs\<rangle>\<rangle>#transaction_receive T"
     unfolding defs by simp_all
   moreover have "xs = [] \<longleftrightarrow> xs' = {}"
     using filter_empty_conv[of "\<lambda>x. x \<notin> set frsh"]
           fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
     unfolding xs_def xs'_def by blast
   ultimately show ?G by blast
 
   show 2: "?D ts F' \<Longrightarrow> ?D' ts F'" for ts F' using 0 unfolding T by simp
   show 3: "?E \<Longrightarrow> ?E' \<Longrightarrow> ?E''" using 1 unfolding T by force
   show 4: "?F \<Longrightarrow> ?F'" unfolding defs by simp
 
   show ?H
   proof (cases "frsh = []")
     case False thus ?thesis
       using 2 3[OF _ False] by (cases "\<exists>ts F'. transaction_send T = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F'") (blast,blast)
   qed (simp add: 4)
 qed
 
 private lemma add_occurs_msgs_transaction_strand_set:
   fixes T C frsh xs f
   defines "frsh \<equiv> transaction_fresh T"
     and "xs \<equiv> filter (\<lambda>x. x \<notin> set frsh) (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)))"
     and "f \<equiv> map (\<lambda>x. occurs (Var x))"
   assumes T: "T = Transaction A B C D E F"
   shows "F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<Longrightarrow>
           set (transaction_strand (add_occurs_msgs T)) \<subseteq>
           set (transaction_strand T) \<union> {\<langle>\<star>,receive\<langle>f xs\<rangle>\<rangle>,\<langle>\<star>,send\<langle>f frsh@ts\<rangle>\<rangle>}"
     (is "?A \<Longrightarrow> ?A'")
   and "F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<Longrightarrow>
           set (unlabel (transaction_strand (add_occurs_msgs T))) \<subseteq>
           set (unlabel (transaction_strand T)) \<union> {receive\<langle>f xs\<rangle>,send\<langle>f frsh@ts\<rangle>}"
     (is "?B \<Longrightarrow> ?B'")
   and "\<nexists>ts' F'. F = \<langle>\<star>,send\<langle>ts'\<rangle>\<rangle>#F' \<Longrightarrow>
           set (transaction_strand (add_occurs_msgs T)) \<subseteq>
           set (transaction_strand T) \<union> {\<langle>\<star>,receive\<langle>f xs\<rangle>\<rangle>,\<langle>\<star>,send\<langle>f frsh\<rangle>\<rangle>}"
     (is "?C \<Longrightarrow> ?C'")
   and "\<nexists>ts' F'. F = \<langle>\<star>,send\<langle>ts'\<rangle>\<rangle>#F' \<Longrightarrow>
           set (unlabel (transaction_strand (add_occurs_msgs T))) \<subseteq>
           set (unlabel (transaction_strand T)) \<union> {receive\<langle>f xs\<rangle>,send\<langle>f frsh\<rangle>}"
     (is "?D \<Longrightarrow> ?D'")
 proof -
   note 0 = add_occurs_msgs_cases[
             OF T, unfolded frsh_def[symmetric] xs_def[symmetric] f_def[symmetric]]
 
   show "?A \<Longrightarrow> ?A'" using 0(1,3) unfolding T transaction_strand_def by (cases "frsh = []") auto
   thus "?B \<Longrightarrow> ?B'" unfolding unlabel_def by force
 
   show "?C \<Longrightarrow> ?C'" using 0(2,3) unfolding T transaction_strand_def by (cases "frsh = []") auto
   thus "?D \<Longrightarrow> ?D'" unfolding unlabel_def by auto
 qed
 
 private lemma add_occurs_msgs_transaction_strand_cases:
   fixes T T'::"('a,'b,'c,'d) prot_transaction" and C frsh xs f \<theta>
   defines "T' \<equiv> add_occurs_msgs T"
     and "S \<equiv> transaction_strand T"
     and "S' \<equiv> transaction_strand T'"
     and "frsh \<equiv> transaction_fresh T"
     and "xs \<equiv> filter (\<lambda>x. x \<notin> set frsh) (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)))"
     and "f \<equiv> map (\<lambda>x. occurs (Var x))"
     and "C \<equiv> transaction_receive T"
     and "D \<equiv> transaction_checks T"
     and "E \<equiv> transaction_updates T"
     and "F \<equiv> transaction_send T"
     and "C' \<equiv> if xs = [] then C else \<langle>\<star>,receive\<langle>f xs\<rangle>\<rangle>#C"
     and "C'' \<equiv> if xs = [] then dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t C else \<langle>\<star>,send\<langle>f xs\<rangle>\<rangle>#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t C"
     and "C''' \<equiv> if xs = [] then dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (C \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) else \<langle>\<star>,send\<langle>f xs \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<rangle>#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (C \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
   shows "frsh = [] \<Longrightarrow> S' = C'@D@E@F"
       (is "?A \<Longrightarrow> ?A'")
     and "frsh \<noteq> [] \<Longrightarrow> \<nexists>ts F'. F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<Longrightarrow> S' = C'@D@E@(\<langle>\<star>,send\<langle>f frsh\<rangle>\<rangle>#F)"
       (is "?B \<Longrightarrow> ?B' \<Longrightarrow> ?B''")
     and "frsh \<noteq> [] \<Longrightarrow> \<exists>ts F'. F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<Longrightarrow>
           \<exists>ts F'. F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<and> S' = C'@D@E@(\<langle>\<star>,send\<langle>f frsh@ts\<rangle>\<rangle>#F')"
       (is "?C \<Longrightarrow> ?C' \<Longrightarrow> ?C''")
     and "frsh = [] \<Longrightarrow> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S' = C''@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t D@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t E@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t F"
       (is "?D \<Longrightarrow> ?D'")
     and "frsh \<noteq> [] \<Longrightarrow> \<nexists>ts F'. F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<Longrightarrow>
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S' = C''@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t D@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t E@(\<langle>\<star>,receive\<langle>f frsh\<rangle>\<rangle>#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t F)"
       (is "?E \<Longrightarrow> ?E' \<Longrightarrow> ?E''")
     and "frsh \<noteq> [] \<Longrightarrow> \<exists>ts F'. F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<Longrightarrow>
           \<exists>ts F'. F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<and>
                   dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S' = C''@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t D@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t E@(\<langle>\<star>,receive\<langle>f frsh@ts\<rangle>\<rangle>#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t F')"
       (is "?F \<Longrightarrow> ?F' \<Longrightarrow> ?F''")
     and "frsh = [] \<Longrightarrow>
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = C'''@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (D \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (E \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (F \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
       (is "?G \<Longrightarrow> ?G'")
     and "frsh \<noteq> [] \<Longrightarrow> \<nexists>ts F'. F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<Longrightarrow>
           dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = C'''@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (D \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (E \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@
                                (\<langle>\<star>,receive\<langle>f frsh \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<rangle>#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (F \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
       (is "?H \<Longrightarrow> ?H' \<Longrightarrow> ?H''")
     and "frsh \<noteq> [] \<Longrightarrow> \<exists>ts F'. F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<Longrightarrow>
           \<exists>ts F'. F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F' \<and>
                   dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = C'''@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (D \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (E \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@
                                        (\<langle>\<star>,receive\<langle>f frsh@ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<rangle>#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (F' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
       (is "?I \<Longrightarrow> ?I' \<Longrightarrow> ?I''")
 proof -
   obtain A' B' CC' D' E' F' where T: "T = Transaction A' B' CC' D' E' F'" by (cases T) simp
 
   note 0 = add_occurs_msgs_cases[
             OF T, unfolded frsh_def[symmetric] xs_def[symmetric] f_def[symmetric] T'_def[symmetric]]
 
   note defs = S'_def C_def D_def E_def F_def C'_def C''_def T transaction_strand_def
 
   show A: "?A \<Longrightarrow> ?A'" using 0(3) unfolding defs by simp
   show B: "?B \<Longrightarrow> ?B' \<Longrightarrow> ?B''" using 0(2) unfolding defs by simp
   show C: "?C \<Longrightarrow> ?C' \<Longrightarrow> ?C''" using 0(1) unfolding defs by force
 
   have 1: "C''' = C'' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"
     using subst_lsst_cons[of "\<langle>\<star>, send\<langle>f xs\<rangle>\<rangle>" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t C" \<theta>] dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of C \<theta>]
     unfolding C'''_def C''_def by (cases "xs = []") auto
 
   have 2: "(\<langle>\<star>, receive\<langle>ts\<rangle>\<rangle>#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t G) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta> = \<langle>\<star>, receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<rangle>#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (G \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" 
     for ts and G::"('a,'b,'c,'d) prot_strand"
     using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of G \<theta>] subst_lsst_cons[of "\<langle>\<star>, receive\<langle>ts\<rangle>\<rangle>" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t G" \<theta>]
     by simp
 
   note 3 = subst_lsst_append[of _ _ \<theta>] dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of _ \<theta>]
 
   show "?D \<Longrightarrow> ?D'" using A unfolding defs by fastforce
   thus "?G \<Longrightarrow> ?G'" unfolding 1 by (metis 3)
 
   show "?E \<Longrightarrow> ?E' \<Longrightarrow> ?E''" using B unfolding defs by fastforce
   thus "?H \<Longrightarrow> ?H' \<Longrightarrow> ?H''" unfolding 1 by (metis 2 3)
 
   show "?F \<Longrightarrow> ?F' \<Longrightarrow> ?F''" using C unfolding defs by fastforce
   thus "?I \<Longrightarrow> ?I' \<Longrightarrow> ?I''" unfolding 1 by (metis 2 3)
 qed
 
 private lemma add_occurs_msgs_trms_transaction:
   fixes T::"('a,'b,'c,'d) prot_transaction"
   shows "trms_transaction (add_occurs_msgs T) =
           trms_transaction T \<union> (\<lambda>x. occurs (Var x))`(fv_transaction T \<union> set (transaction_fresh T))"
     (is "?A = ?B")
 proof
   let ?occs = "(\<lambda>x. occurs (Var x)) ` (fv_transaction T \<union> set (transaction_fresh T))"
 
   define frsh where "frsh \<equiv> transaction_fresh T"
   define xs where "xs \<equiv> filter (\<lambda>x. x \<notin> set frsh) (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)))"
   define f where "f \<equiv> map (\<lambda>x. occurs (Var x)::('a,'b,'c,'d) prot_term)"
 
   obtain A B C D E F where T: "T = Transaction A B C D E F" by (cases T) simp
 
   note 0 = add_occurs_msgs_transaction_strand_set(2,4)[
             OF T, unfolded f_def[symmetric] frsh_def[symmetric] xs_def[symmetric]]
 
   note 1 = add_occurs_msgs_transaction_strand_cases(1,2,3)[
             of T, unfolded f_def[symmetric] frsh_def[symmetric] xs_def[symmetric]]
 
   have 2: "set (f xs) \<union> set (f frsh) = ?occs"
   proof -
     define ys where "ys \<equiv> fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))"
     let ?ys' = "fv_transaction T - set frsh"
     define g where "g \<equiv> filter (\<lambda>x. x \<notin> set frsh)"
 
     have "set (g ys) = ?ys'"
       using fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"] unfolding ys_def g_def by auto  
     hence "set (f (g ys)) = (\<lambda>x. occurs (Var x)) ` ?ys'" unfolding f_def by force
     moreover have "set (f frsh) = (\<lambda>x. occurs (Var x)) ` set frsh" unfolding f_def by force
     ultimately show ?thesis
       unfolding xs_def frsh_def[symmetric] ys_def[symmetric] g_def[symmetric] by blast
   qed
 
   have 3: "set (f []) = {}" unfolding f_def by blast
 
   have "trms_transaction (add_occurs_msgs T) \<subseteq> trms_transaction T \<union> set (f xs) \<union> set (f frsh)"
   proof (cases "\<exists>ts F'. F = \<langle>\<star>, send\<langle>ts\<rangle>\<rangle>#F'")
     case True
     then obtain ts F' where F: "F = \<langle>\<star>, send\<langle>ts\<rangle>\<rangle>#F'" by blast
     have "set ts \<subseteq> trms_transaction T" unfolding T F trms_transaction_unfold by auto
     thus ?thesis using 0(1)[OF F] by force
   next
     case False show ?thesis using 0(2)[OF False] by force
   qed
   thus "?A \<subseteq> ?B" using 2 by blast
 
   have "trms_transaction T \<union> set (f xs) \<union> set (f frsh) \<subseteq> trms_transaction (add_occurs_msgs T)"
   proof (cases "frsh = []")
     case True show ?thesis using 1(1)[OF True] 3 unfolding True by (cases xs) (fastforce,force)
   next
     case False
     note * = 1(2-)[OF False]
     show ?thesis
     proof (cases "\<exists>ts F'. transaction_send T = \<langle>\<star>, send\<langle>ts\<rangle>\<rangle>#F'")
       case True show ?thesis using *(2)[OF True] 3 by force
     next
       case False show ?thesis using *(1)[OF False] 3 by force
     qed
   qed
   thus "?B \<subseteq> ?A" using 2 by blast
 qed
 
 private lemma add_occurs_msgs_vars_eq:
   fixes T::"('fun,'var,'sets,'lbl) prot_transaction"
   assumes T_adm: "admissible_transaction' T"
   shows "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive (add_occurs_msgs T)) =
          fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?A)
     and "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send (add_occurs_msgs T)) =
          fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<union> set (transaction_fresh T)" (is ?B)
     and "fv_transaction (add_occurs_msgs T) = fv_transaction T" (is ?C)
     and "bvars_transaction (add_occurs_msgs T) = bvars_transaction T" (is ?D)
     and "vars_transaction (add_occurs_msgs T) = vars_transaction T" (is ?E)
     and "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand (add_occurs_msgs T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) =
          fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" (is ?F)
     and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand (add_occurs_msgs T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) =
          bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" (is ?G)
     and "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand (add_occurs_msgs T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) =
          vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" (is ?H)
     and "set (transaction_fresh (add_occurs_msgs T)) = set (transaction_fresh T)" (is ?I)
 proof -
   obtain A B C D E F where T: "T = Transaction A B C D E F" by (cases T) simp
 
   have T_fresh: "set (transaction_fresh T) \<subseteq> fv_transaction T"
     using admissible_transactionE(7)[OF T_adm] unfolding fv_transaction_unfold by blast
 
   note 0 = add_occurs_msgs_cases[OF T]
 
   define xs where "xs \<equiv>
     filter (\<lambda>x. x \<notin> set (transaction_fresh T)) (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)))"
 
   show D: ?D
   proof -
     have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive (add_occurs_msgs T)) = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
       using 0(6,7) by (cases "xs = []") (auto simp add: xs_def)
     moreover have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send (add_occurs_msgs T)) = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
     proof (cases "\<exists>ts' F'. F = \<langle>\<star>, send\<langle>ts'\<rangle>\<rangle>#F'")
       case True thus ?thesis using 0(1) unfolding T by force
     next
       case False show ?thesis using 0(2)[OF False] 0(3) unfolding T by (cases "B = []") auto
     qed
     ultimately show ?thesis using 0(8,9) unfolding bvars_transaction_unfold by argo
   qed
 
   have T_no_bvars:
       "bvars_transaction T = {}"
       "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}"
       "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) = {}"
       "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) = {}"
       "bvars_transaction (add_occurs_msgs T) = {}"
     using admissible_transactionE(4)[OF T_adm] D
     unfolding bvars_transaction_unfold by (blast,blast,blast,blast,blast)
 
   have T_fv_subst:
       "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv_transaction T)" (is ?Q1)
       "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T))" (is ?Q2)
       "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T))" (is ?Q3)
       "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" (is ?Q4)
       "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand (add_occurs_msgs T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
        fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand (add_occurs_msgs T)))" (is ?Q5)
       "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive (add_occurs_msgs T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
        fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive (add_occurs_msgs T)))" (is ?Q6)
     for \<delta>
   proof -
     note * = fv\<^sub>s\<^sub>s\<^sub>t_subst_if_no_bvars
 
     have **: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive (add_occurs_msgs T)) = {}"
       using T_no_bvars(5) unfolding bvars_transaction_unfold by fast
 
     show ?Q1 using *[OF T_no_bvars(1)] unfolding unlabel_subst by blast
     show ?Q2 using *[OF T_no_bvars(2)] unfolding unlabel_subst by blast
     show ?Q3 using *[OF T_no_bvars(3)] unfolding unlabel_subst by blast
     show ?Q4 using *[OF T_no_bvars(4)] unfolding unlabel_subst by blast
     show ?Q5 using *[OF T_no_bvars(5)] unfolding unlabel_subst by blast
     show ?Q6 using *[OF **] unfolding unlabel_subst by blast
   qed
 
   have A: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive (add_occurs_msgs T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
            fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
     for \<delta>
   proof -
     define rcv_trms where 
       "rcv_trms \<equiv> map (\<lambda>x. occurs (Var x)::('fun,'var,'sets,'lbl) prot_term) xs"
 
     have "fv\<^sub>s\<^sub>e\<^sub>t (set rcv_trms) = fv_transaction T - set (transaction_fresh T)"
          "rcv_trms = [] \<longleftrightarrow> xs = []"
       using fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
       unfolding rcv_trms_def xs_def by auto
     hence 1: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive (add_occurs_msgs T)) =
               (fv_transaction T - set (transaction_fresh T)) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
       using 0(6,7)[unfolded rcv_trms_def[symmetric] xs_def[symmetric]] by (cases "xs = []") auto
   
     have 2: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<subseteq> fv_transaction T - set (transaction_fresh T)"
       using admissible_transactionE(12)[OF T_adm] unfolding fv_transaction_unfold by fast
 
     have 3: "fv_transaction T - set (transaction_fresh T) =
              fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
       using admissible_transactionE(7,10,12,13)[OF T_adm]
       unfolding fv_transaction_unfold by blast
   
     show ?thesis using 1 2 3 T_fv_subst(2,3,6)[of \<delta>] by force
   qed
 
   show ?A using A[of Var] unfolding subst_lsst_id_subst by blast
 
   show B: ?B using 0(14) by fastforce
 
   have B': "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send (add_occurs_msgs T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
             fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` set (transaction_fresh T))"
     for \<delta>
   proof -
     note * = fv\<^sub>s\<^sub>s\<^sub>t_subst_if_no_bvars[of _ \<delta>]
 
     have **: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send (add_occurs_msgs T)) = {}"
       using T_no_bvars(5) unfolding bvars_transaction_unfold by fast
 
     show ?thesis
       using B *[OF T_no_bvars(4)] *[OF **]
       unfolding unlabel_subst by simp
   qed
 
   show C: ?C
     using A[of Var] B T_fresh
     unfolding fv_transaction_unfold 0(8,9) subst_lsst_id_subst by blast
 
   show ?E using C D vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t by metis
 
   have "fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` set (transaction_fresh T)) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
     using T_fresh
     unfolding fv\<^sub>s\<^sub>s\<^sub>t_subst_if_no_bvars[OF T_no_bvars(1), of \<theta>, unfolded unlabel_subst]
     by auto
   thus F: ?F
     using A[of \<theta>] B'[of \<theta>] fv\<^sub>s\<^sub>s\<^sub>t_append
           fv\<^sub>s\<^sub>s\<^sub>t_subst_if_no_bvars[OF T_no_bvars(1), of \<theta>, unfolded unlabel_subst]
           fv\<^sub>s\<^sub>s\<^sub>t_subst_if_no_bvars[OF T_no_bvars(5), of \<theta>, unfolded unlabel_subst C]
     unfolding transaction_strand_def by argo
 
   show G: ?G using D bvars\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst by metis
 
   show ?H using F G vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t by metis
 
   show ?I using 0(5) by argo
 qed
 
 private lemma add_occurs_msgs_trms:
   "trms_transaction (add_occurs_msgs T) =
     trms_transaction T \<union> (\<lambda>x. occurs (Var x)) ` (set (transaction_fresh T) \<union> fv_transaction T)"
 proof -
   let ?f = "\<lambda>x. occurs (Var x)"
   let ?xs = "filter (\<lambda>x. x \<notin> set (transaction_fresh T))
                     (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)))"
 
   obtain A B C D E F where T: "T = Transaction A B C D E F" by (cases T) simp
 
   note 0 = add_occurs_msgs_cases[OF T]
 
   have "set ?xs = fv_transaction T - set (transaction_fresh T)"
     using fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"] by auto
   hence 1: "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive (add_occurs_msgs T)) =
            trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> ?f ` (fv_transaction T - set (transaction_fresh T))"
     using 0(6,7) by (cases "?xs = []") auto
 
   have 2: "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send (add_occurs_msgs T)) =
            trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<union> ?f ` set (transaction_fresh T)"
     using 0(10,11,12) by (cases "transaction_fresh T = []") (simp,fastforce)
 
   have 3: "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive (add_occurs_msgs T)) \<union>
            trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send (add_occurs_msgs T)) =
            trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<union>
            ?f ` (set (transaction_fresh T) \<union> fv_transaction T)"
     using 1 2 by blast
 
   show ?thesis using 3 unfolding trms_transaction_unfold 0(8,9) by blast
 qed
 
 lemma add_occurs_msgs_admissible_occurs_checks:
   fixes T::"('fun,'atom,'sets,'lbl) prot_transaction"
   assumes T_adm: "admissible_transaction' T"
   shows "admissible_transaction' (add_occurs_msgs T)" (is ?A)
     and "admissible_transaction_occurs_checks (add_occurs_msgs T)" (is ?B)
 proof -
   let ?T' = "add_occurs_msgs T"
 
   obtain A B C D E F where T: "T = Transaction A B C D E F" by (cases T) simp
 
   note defs = T add_occurs_msgs_def Let_def admissible_transaction'_def
               admissible_transaction_occurs_checks_def
 
   note defs' = admissible_transaction_terms_def wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric]
 
   note 1 = add_occurs_msgs_cases[OF T]
   note 2 = add_occurs_msgs_vars_eq[OF T_adm]
   note 3 = add_occurs_msgs_trms[of T]
   note 4 = add_occurs_msgs_transaction_strand_set[OF T]
 
   have occurs_wf: "wf\<^sub>t\<^sub>r\<^sub>m (occurs (Var x))" for x::"('fun,'atom,'sets,'lbl) prot_var" by fastforce
 
   have occurs_funs: "funs_term (occurs (Var x)) = {OccursFact, OccursSec}"
     for x::"('fun,'atom,'sets,'lbl) prot_var"
     by force
 
   have occurs_funs_not_attack: "\<not>(\<exists>f \<in> \<Union>(funs_term ` trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r). is_Attack f)"
     when "r = receive\<langle>map (\<lambda>x. occurs (Var x)) xs\<rangle> \<or> r = send\<langle>map (\<lambda>x. occurs (Var x)) ys\<rangle>"
     for r::
       "(('fun,'atom,'sets,'lbl) prot_fun, ('fun,'atom,'sets,'lbl) prot_var) stateful_strand_step"
     and xs ys::"('fun,'atom,'sets,'lbl) prot_var list"
     using that by fastforce
 
   have occurs_funs_not_attack': "\<not>(\<exists>f \<in> \<Union>(funs_term ` trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r). is_Attack f)"
     when "r = send\<langle>map (\<lambda>x. occurs (Var x)) xs@ts\<rangle>"
     and "\<not>(\<exists>f \<in> \<Union>(funs_term ` trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\<langle>ts\<rangle>)). is_Attack f)"
     for r::
       "(('fun,'atom,'sets,'lbl) prot_fun, ('fun,'atom,'sets,'lbl) prot_var) stateful_strand_step"
     and xs::"('fun,'atom,'sets,'lbl) prot_var list"
     and ts
     using that by fastforce
 
   let ?P1 = "\<lambda>T. wellformed_transaction T"
   let ?P2 = "\<lambda>T. transaction_decl T () = []"
   let ?P3 = "\<lambda>T. list_all (\<lambda>x. fst x = TAtom Value) (transaction_fresh T)"
   let ?P4 = "\<lambda>T. \<forall>x \<in> vars_transaction T. is_Var (fst x) \<and> (the_Var (fst x) = Value)"
   let ?P5 = "\<lambda>T. bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = {}"
   let ?P6 = "\<lambda>T. set (transaction_fresh T) \<subseteq>
                   fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (filter (is_Insert \<circ> snd) (transaction_updates T)) \<union>
                   fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
   let ?P7 = "\<lambda>T. \<forall>x \<in> fv_transaction T - set (transaction_fresh T).
                  \<forall>y \<in> fv_transaction T - set (transaction_fresh T).
                    x \<noteq> y \<longrightarrow> \<langle>Var x != Var y\<rangle> \<in> set (unlabel (transaction_checks T)) \<or>
                              \<langle>Var y != Var x\<rangle> \<in> set (unlabel (transaction_checks T))"
   let ?P8 = "\<lambda>T. fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)
                   - set (transaction_fresh T)
                   \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
   let ?P9 = "\<lambda>T. \<forall>r \<in> set (unlabel (transaction_checks T)).
                   is_Equality r \<longrightarrow> fv (the_rhs r) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
   let ?P10 = "\<lambda>T. fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<subseteq>
                     fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union>
                     fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (filter (\<lambda>s. is_InSet (snd s) \<and> the_check (snd s) = Assign)
                                   (transaction_checks T))"
   let ?P11 = "\<lambda>T. admissible_transaction_checks T"
   let ?P12 = "\<lambda>T. admissible_transaction_updates T"
   let ?P13 = "\<lambda>T. admissible_transaction_terms T"
   let ?P14 = "\<lambda>T. admissible_transaction_send_occurs_form T"
   let ?P15 = "\<lambda>T. list_all (\<lambda>a. is_Receive (snd a) \<longrightarrow> the_msgs (snd a) \<noteq> [])
                            (transaction_receive T)"
   let ?P16 = "\<lambda>T. list_all (\<lambda>a. is_Send (snd a) \<longrightarrow> the_msgs (snd a) \<noteq> []) (transaction_send T)"
 
   have T_props:
       "?P1 T" "?P2 T" "?P3 T" "?P4 T" "?P5 T" "?P6 T" "?P7 T" "?P8 T" "?P9 T" "?P10 T" "?P11 T"
       "?P12 T" "?P13 T" "?P14 T" "?P15 T" "?P16 T"
     using T_adm unfolding defs by meson+
 
   have 5: "wf'\<^sub>s\<^sub>s\<^sub>t (X \<union> Y) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand (add_occurs_msgs T))))"
     when X: "X = fst ` set (transaction_decl T ())"
       and Y: "Y = set (transaction_fresh T)"
       and T_wf: "wf'\<^sub>s\<^sub>s\<^sub>t (X \<union> Y) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))"
     for X Y
   proof -
     define frsh where "frsh \<equiv> transaction_fresh T"
     define xs where "xs \<equiv> fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))"
     define ys where "ys \<equiv> filter (\<lambda>x. x \<notin> set frsh) xs"
 
     let ?snds = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T))"
     let ?snds' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive (add_occurs_msgs T)))"
     let ?chks = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T))"
     let ?chks' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks (add_occurs_msgs T)))"
     let ?upds = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T))"
     let ?upds' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates (add_occurs_msgs T)))"
     let ?rcvs = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))"
     let ?rcvs' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send (add_occurs_msgs T)))"
 
     have p0: "set ?snds \<subseteq> set ?snds'" using 1(13) by auto
 
     have p1: "?chks = ?chks'" "?upds = ?upds'" using 1(8,9) by (argo,argo)
 
     have p2: "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t ?snds \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t ?snds'"
              "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (?snds@?chks@?upds) \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (?snds'@?chks'@?upds')"
              "X \<union> Y \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (?snds@?chks@?upds) \<subseteq>
               X \<union> Y \<union>  wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (?snds'@?chks'@?upds')"
       using p0 p1 unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def by auto
 
     have "wf'\<^sub>s\<^sub>s\<^sub>t (X \<union> Y \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (?snds@?chks@?upds)) ?rcvs"
       using T_wf wf\<^sub>s\<^sub>s\<^sub>t_append_exec[of "X \<union> Y" "?snds@?chks@?upds" ?rcvs]
       unfolding transaction_strand_unlabel_dual_unfold by simp
     hence r0: "wf'\<^sub>s\<^sub>s\<^sub>t (X \<union> Y \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (?snds'@?chks'@?upds')) ?rcvs"
       using wf\<^sub>s\<^sub>s\<^sub>t_vars_mono'[OF _ p2(3)] by blast
 
     have "list_all is_Send (unlabel (transaction_send T))"
       using admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
       unfolding wellformed_transaction_def by blast
     hence "list_all is_Receive ?rcvs" by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(2))
     hence r1: "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t ?rcvs \<subseteq> X \<union> Y \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (?snds'@?chks'@?upds')"
       using wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_receives_only_eq wf\<^sub>s\<^sub>s\<^sub>t_receives_only_fv_subset[OF r0] by blast
 
     have "fv\<^sub>s\<^sub>e\<^sub>t ((\<lambda>x. occurs (Var x)) ` set (transaction_fresh T)) \<subseteq> Y"
       unfolding Y by auto
     hence r2: "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t ?rcvs' \<subseteq> X \<union> Y \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (?snds'@?chks'@?upds')"
       using 1(14) r1 unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by fastforce (* TODO: find faster proof *)
 
     have r3: "wf'\<^sub>s\<^sub>s\<^sub>t (X \<union> Y) (?snds'@?chks'@?upds')"
     proof -
       have *: "wf'\<^sub>s\<^sub>s\<^sub>t (X \<union> Y) (?snds@?chks'@?upds')"
         using T_wf wf\<^sub>s\<^sub>s\<^sub>t_prefix[of "X \<union> Y" "?snds@?chks@?upds" ?rcvs] p1
         unfolding transaction_strand_unlabel_dual_unfold by simp
 
       have "?snds' = ?snds \<or> (\<exists>ts. ?snds' = send\<langle>ts\<rangle>#?snds)" using 1(13) by auto
       thus ?thesis
       proof
         assume "?snds' = ?snds" thus ?thesis using * by simp
       next
         assume "\<exists>ts. ?snds' = send\<langle>ts\<rangle>#?snds"
         then obtain ts where "?snds' = send\<langle>ts\<rangle>#?snds" by blast
         thus ?thesis using wf\<^sub>s\<^sub>s\<^sub>t_sends_only_prepend[OF *, of "[send\<langle>ts\<rangle>]"] by simp
       qed
     qed
 
     have "wf'\<^sub>s\<^sub>s\<^sub>t (X \<union> Y) (?snds'@?chks'@?upds'@?rcvs')"
       using wf\<^sub>s\<^sub>s\<^sub>t_append_suffix''[OF r3] r2 by auto
     thus ?thesis
       using unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append
       unfolding transaction_strand_def by auto
   qed
 
   have T'_props_1: "?P1 ?T'"
     unfolding wellformed_transaction_def
     apply (intro conjI)
     subgoal using 1(13) T_props(1) unfolding wellformed_transaction_def by force
     subgoal using 1(8) T_props(1) unfolding wellformed_transaction_def by simp
     subgoal using 1(9) T_props(1) unfolding wellformed_transaction_def by simp
     subgoal using 1(14) T_props(1) unfolding wellformed_transaction_def by force
     subgoal using 1(4) T_props(1) unfolding wellformed_transaction_def by simp
     subgoal using 1(5) T_props(1) unfolding wellformed_transaction_def by simp
     subgoal using 1(4,5) T_props(1) unfolding wellformed_transaction_def by simp
     subgoal using T_props(1) unfolding 2(1) 1(5) wellformed_transaction_def by blast
     subgoal using 1(5,8) T_props(1) unfolding wellformed_transaction_def by simp
     subgoal using 1(5) 2(4) T_props(1) unfolding wellformed_transaction_def by simp
     subgoal using 2(3,4) T_props(1) unfolding wellformed_transaction_def by simp
     subgoal using 1(4,5) 5 T_props(1) unfolding wellformed_transaction_def by simp 
     done
 
   have T'_props_2_12:
       "?P2 ?T'" "?P3 ?T'" "?P4 ?T'" "?P5 ?T'" "?P6 ?T'" "?P7 ?T'" "?P8 ?T'" "?P9 ?T'" "?P10 ?T'"
       "?P11 ?T'" "?P12 ?T'"
     subgoal using T_props(2) unfolding defs by force
     subgoal using T_props(3) unfolding defs by force
     subgoal using T_props(4) 2(5) by argo
     subgoal using T_props(5) 2(4) by argo
     subgoal using T_props(6) 1(5,8) 2(2) by auto
     subgoal using T_props(7) 1(5,8) 2(3) by presburger
     subgoal using T_props(8) 1(5,9) 2(1,2) by auto
     subgoal using T_props(9) 1(8) 2(1) by auto
     subgoal using T_props(10) 1(8) 2(1) by auto
     subgoal using T_props(11) 1(8) unfolding admissible_transaction_checks_def by argo
     subgoal using T_props(12) 1(9) unfolding admissible_transaction_updates_def by argo
     done
 
   (* TODO: clean up? *)
   have T'_props_13_aux:
       "transaction_fresh ?T' = []" (is ?Q1)
       "is_Send r" (is ?Q2)
       "length (the_msgs r) = 1" (is ?Q3)
       "is_Fun_Attack (hd (the_msgs r))" (is ?Q4)
     when r: "r \<in> set (unlabel (transaction_strand (add_occurs_msgs T)))"
             "\<exists>f \<in> \<Union>(funs_term ` trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r). is_Attack f" (is "?Q' (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r)")
     for r
   proof -
     note q0 = conjunct2[OF conjunct2[OF T_props(13)[unfolded defs']]]
 
     let ?Q'' = "\<lambda>ts' F'. F = \<langle>\<star>, send\<langle>ts'\<rangle>\<rangle>#F'"
     let ?f = "map (\<lambda>x. occurs (Var x))"
     let ?frsh = "transaction_fresh T"
     let ?xs = "fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))"
 
     have q1: "r \<noteq> send\<langle>?f ?frsh\<rangle>" "r \<noteq> receive\<langle>?f (filter (\<lambda>x. x \<notin> set ?frsh) ?xs)\<rangle>"
              "\<forall>f \<in> \<Union>(funs_term ` set (?f ?frsh)). \<not>is_Attack f"
       using r(2) by (fastforce,fastforce,simp)
 
     have q2: "send\<langle>ts'\<rangle> \<in> set (unlabel (transaction_strand T))"
              "r = send\<langle>?f ?frsh@ts'\<rangle> \<or> r \<in> set (unlabel (transaction_strand T))"
       when "?Q'' ts' F'" for ts' F'
       subgoal using that unfolding T transaction_strand_def by force
       subgoal using that r(1) 4(2)[OF that] q1 unfolding T transaction_strand_def by fast
       done
 
     have q3: "?Q' (set ts')"
       when r': "?Q'' ts' F'" "r \<notin> set (unlabel (transaction_strand T))" for ts' F'
     proof -
       have "r = send\<langle>?f ?frsh@ts'\<rangle>" using q2(2)[OF r'(1)] r'(2) by argo
       thus ?thesis using r(2) by fastforce
     qed
     
     have q4: "r \<in> set (unlabel (transaction_strand T))" when "\<nexists>ts' F'. ?Q'' ts' F'"
       using 4(4)[OF that] r(1) q1(1,2) by blast
 
     have "\<exists>r' \<in> set (unlabel (transaction_strand T)). ?Q' (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r')"
       when "?Q'' ts' F'" for ts' F'
       apply (cases "r \<in> set (unlabel (transaction_strand T))")
       subgoal using q2(2)[OF that] r(2) by metis
       subgoal using q2(1)[OF that] q3[OF that] trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(1)[of ts'] by metis
       done
     hence "?frsh = []" when "?Q'' ts' F'" for ts' F' using q0 that by blast
     hence "r = send\<langle>ts'\<rangle> \<or> r \<in> set (unlabel (transaction_strand T))" when "?Q'' ts' F'" for ts' F'
       using q2(2)[OF that] that by blast
     hence "r \<in> set (unlabel (transaction_strand T))" using q2(1) q4 by fast
     thus ?Q1 ?Q2 ?Q3 ?Q4 using r(2) q0 unfolding 1(5) by auto
   qed
 
   have T'_props_13: "?P13 ?T'"
     unfolding defs' 3
     apply (intro conjI)
     subgoal using conjunct1[OF T_props(13)[unfolded defs']] occurs_wf by fast
     subgoal using conjunct1[OF conjunct2[OF T_props(13)[unfolded defs']]] occurs_funs by auto
     subgoal using T'_props_13_aux by meson
     done
 
   have T'_props_14: "?P14 ?T'"
   proof (cases "\<exists>ts' F'. transaction_send T = \<langle>\<star>,send\<langle>ts'\<rangle>\<rangle>#F'")
     case True
     then obtain ts' F' where F': "transaction_send T = \<langle>\<star>,send\<langle>ts'\<rangle>\<rangle>#F'" by meson
     show ?thesis
       using T_props(14) 1(10)[OF F'] F' 1(5,12)
       unfolding admissible_transaction_send_occurs_form_def Let_def
       by (cases "transaction_fresh T = []") auto
   next
     case False show ?thesis
       using T_props(14) 1(11)[OF False] 1(5,12)
       unfolding admissible_transaction_send_occurs_form_def Let_def
       by (cases "transaction_fresh T = []") auto
   qed
 
   let ?xs = "fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))"
 
   have T'_props_15: "?P15 ?T'"
     using T_props(15) 1(6,7) unfolding Let_def
     by (cases "filter (\<lambda>x. x \<notin> set (transaction_fresh T)) ?xs = []") (simp,fastforce)
 
   have T'_props_16: "?P16 ?T'"
   proof (cases "\<exists>ts' F'. transaction_send T = \<langle>\<star>,send\<langle>ts'\<rangle>\<rangle>#F'")
     case True
     then obtain ts' F' where F': "transaction_send T = \<langle>\<star>,send\<langle>ts'\<rangle>\<rangle>#F'" by meson
     show ?thesis
       using T_props(16) 1(10)[OF F'] F' 1(5,12)
       unfolding Let_def by (cases "transaction_fresh T = []") auto
   next
     case False show ?thesis
       using T_props(16) 1(11)[OF False] 1(5,12)
       unfolding Let_def by (cases "transaction_fresh T = []") auto
   qed
 
   note T'_props = T'_props_1 T'_props_2_12 T'_props_13 T'_props_14 T'_props_15 T'_props_16
 
   show ?A using T'_props unfolding admissible_transaction'_def by meson
 
   have 5: "set (filter (\<lambda>x. x \<notin> set (transaction_fresh T))
                        (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)))) =
            fv_transaction T - set (transaction_fresh T)"
     using fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t by fastforce
 
   have "transaction_receive ?T' \<noteq> []"
     and "is_Receive (hd (unlabel (transaction_receive ?T')))"
     and "\<forall>x \<in> fv_transaction ?T' - set (transaction_fresh ?T'). fst x = TAtom Value \<longrightarrow>
             occurs (Var x) \<in> set (the_msgs (hd (unlabel (transaction_receive ?T'))))"
     when x: "x \<in> fv_transaction ?T' - set (transaction_fresh ?T')" "fst x = TAtom Value" for x
     using 1(13) 5 x unfolding 1(5) 2(3) by (force,force,force)
   moreover have "transaction_send ?T' \<noteq> []" (is ?C)
     and "is_Send (hd (unlabel (transaction_send ?T')))" (is ?D)
     and "\<forall>x \<in> set (transaction_fresh ?T').
            occurs (Var x) \<in> set (the_msgs (hd (unlabel (transaction_send ?T'))))" (is ?E)
     when T'_frsh: "transaction_fresh ?T' \<noteq> []"
     using 1(14) T'_frsh unfolding 1(5) by auto
   ultimately show ?B
     using T'_props_14 unfolding admissible_transaction_occurs_checks_def Let_def by blast
 qed
 
 private lemma add_occurs_msgs_in_trms_subst_cases:
   fixes T::"('fun,'atom,'sets,'lbl) prot_transaction"
   assumes T_adm: "admissible_transaction' T"
     and t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand (add_occurs_msgs T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"  
   shows "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<or>
          (\<exists>x \<in> fv_transaction T. t = occurs (\<theta> x))"
 proof -
   define frsh where "frsh \<equiv> transaction_fresh T"
   define xs where "xs \<equiv> filter (\<lambda>x. x \<notin> set frsh) (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)))"
   define f where "f \<equiv> map (\<lambda>x. occurs (Var x)::('fun,'atom,'sets,'lbl) prot_term)"
 
   obtain A B C D E F where T: "T = Transaction A B C D E F" by (cases T) simp
 
   note T'_adm = add_occurs_msgs_admissible_occurs_checks(1)[OF T_adm]
 
   have 0: "set (transaction_fresh T) \<subseteq> fv_transaction T"
     using admissible_transactionE(7)[OF T_adm]
     unfolding fv_transaction_unfold by blast
   hence 00: "set (f xs) \<union> set (f frsh) = (\<lambda>x. occurs (Var x)) ` fv_transaction T"
     using fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
     unfolding f_def xs_def frsh_def by auto
 
   note 1 = add_occurs_msgs_transaction_strand_set[OF T]
 
   have 2: "set (transaction_strand (add_occurs_msgs T)) \<subseteq>
            set (transaction_strand T) \<union> {\<langle>\<star>,receive\<langle>f xs\<rangle>\<rangle>,\<langle>\<star>,send\<langle>f frsh\<rangle>\<rangle>}"
     when "\<nexists>ts F'. F = \<langle>\<star>,send\<langle>ts\<rangle>\<rangle>#F'"
     using 1(3,4)[OF that] unfolding f_def[symmetric] frsh_def[symmetric] xs_def[symmetric] by blast
 
   have 3: "trms_transaction (add_occurs_msgs T) =
            trms_transaction T \<union> (\<lambda>x. occurs (Var x)) ` fv_transaction T"
     using 0 add_occurs_msgs_trms_transaction[of T] by blast
 
   have 4: "bvars_transaction T \<inter> subst_domain \<theta> = {}"
           "bvars_transaction (add_occurs_msgs T) \<inter> subst_domain \<theta> = {}"
     using admissible_transactionE(4)[OF T_adm] admissible_transactionE(4)[OF T'_adm]
     by (blast,blast)
 
   note 5 = trms\<^sub>s\<^sub>s\<^sub>t_subst[OF 4(1), unfolded unlabel_subst]
            trms\<^sub>s\<^sub>s\<^sub>t_subst[OF 4(2), unfolded unlabel_subst]
 
   note 6 = fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t_subst[
             OF _ 4(1), unfolded add_occurs_msgs_admissible_occurs_checks(1)[OF T_adm] unlabel_subst]
 
   show ?thesis
     using t 6 unfolding 3 5 by fastforce
 qed
 
 private lemma add_occurs_msgs_updates_send_filter_iff:
   fixes f
   defines "f \<equiv> \<lambda>T. list_ex (\<lambda>a. is_Send (snd a) \<or> is_Update (snd a)) (transaction_strand T)"
     and "g \<equiv> \<lambda>T. transaction_fresh T = [] \<longrightarrow> f T"
   shows "map add_occurs_msgs (filter g P) = filter g (map add_occurs_msgs P)"
 proof -
   have "g T \<longleftrightarrow> g (add_occurs_msgs T)" for T
   proof -
     obtain A B C D E F where T: "T = Transaction A B C D E F" by (cases T) simp_all
     note 0 = add_occurs_msgs_cases[OF T]
     show ?thesis using 0(6,7,12) unfolding g_def f_def transaction_strand_def 0(5,8,9) by fastforce
   qed
   thus ?thesis by (induct P) simp_all
 qed
 
 lemma add_occurs_msgs_updates_send_filter_iff':
   fixes f
   defines "f \<equiv> \<lambda>T. list_ex (\<lambda>a. is_Send (snd a) \<or> is_Update (snd a)) (transaction_strand T)"
     and "g \<equiv> \<lambda>T. transaction_fresh T = [] \<longrightarrow> transaction_updates T \<noteq> [] \<or> transaction_send T \<noteq> []"
   shows "map add_occurs_msgs (filter g P) = filter g (map add_occurs_msgs P)"
 proof -
   have "g T \<longleftrightarrow> g (add_occurs_msgs T)" for T
   proof -
     obtain A B C D E F where T: "T = Transaction A B C D E F" by (cases T) simp_all
     note 0 = add_occurs_msgs_cases[OF T]
     show ?thesis using 0(6,7,12) unfolding g_def f_def transaction_strand_def 0(5,8,9) by argo
   qed
   thus ?thesis by (induct P) simp_all
 qed
 
 private lemma rm_occurs_msgs_constr_Cons:
   defines "f \<equiv> rm_occurs_msgs_constr"
   shows
     "\<not>is_Receive a \<Longrightarrow> \<not>is_Send a \<Longrightarrow> f ((l,a)#A) = (l,a)#f A"
     "is_Receive a \<Longrightarrow> \<nexists>t. occurs t \<in> set (the_msgs a) \<Longrightarrow> f ((l,a)#A) = (l,a)#f A"
     "is_Receive a \<Longrightarrow> \<exists>t. occurs t \<in> set (the_msgs a) \<Longrightarrow>
       \<exists>t \<in> set (the_msgs a). \<forall>s. t \<noteq> occurs s \<Longrightarrow>
       f ((l,a)#A) = (l,receive\<langle>filter (\<lambda>t. \<forall>s. t \<noteq> occurs s) (the_msgs a)\<rangle>)#f A"
     "is_Receive a \<Longrightarrow> \<exists>t. occurs t \<in> set (the_msgs a) \<Longrightarrow>
       \<forall>t \<in> set (the_msgs a). \<exists>s. t = occurs s \<Longrightarrow> f ((l,a)#A) = f A"
     "is_Send a \<Longrightarrow> \<nexists>t. occurs t \<in> set (the_msgs a) \<Longrightarrow> f ((l,a)#A) = (l,a)#f A"
     "is_Send a \<Longrightarrow> \<exists>t. occurs t \<in> set (the_msgs a) \<Longrightarrow>
       \<exists>t \<in> set (the_msgs a). \<forall>s. t \<noteq> occurs s \<Longrightarrow>
       f ((l,a)#A) = (l,send\<langle>filter (\<lambda>t. \<forall>s. t \<noteq> occurs s) (the_msgs a)\<rangle>)#f A"
     "is_Send a \<Longrightarrow> \<exists>t. occurs t \<in> set (the_msgs a) \<Longrightarrow>
       \<forall>t \<in> set (the_msgs a). \<exists>s. t = occurs s \<Longrightarrow> f ((l,a)#A) = f A"
 unfolding f_def by (cases a; auto)+
 
 private lemma rm_occurs_msgs_constr_Cons':
   defines "f \<equiv> rm_occurs_msgs_constr"
     and "g \<equiv> filter (\<lambda>t. \<forall>s. t \<noteq> occurs s)"
   assumes a: "is_Receive a \<or> is_Send a"
   shows
     "\<nexists>t. occurs t \<in> set (the_msgs a) \<Longrightarrow> f ((l,a)#A) = (l,a)#f A"
     "\<exists>t. occurs t \<in> set (the_msgs a) \<Longrightarrow>
       \<exists>t \<in> set (the_msgs a). \<forall>s. t \<noteq> occurs s \<Longrightarrow>
       is_Send a \<Longrightarrow> f ((l,a)#A) = (l,send\<langle>g (the_msgs a)\<rangle>)#f A"
     "\<exists>t. occurs t \<in> set (the_msgs a) \<Longrightarrow>
       \<exists>t \<in> set (the_msgs a). \<forall>s. t \<noteq> occurs s \<Longrightarrow>
       is_Receive a \<Longrightarrow> f ((l,a)#A) = (l,receive\<langle>g (the_msgs a)\<rangle>)#f A"
     "\<exists>t. occurs t \<in> set (the_msgs a) \<Longrightarrow>
       \<forall>t \<in> set (the_msgs a). \<exists>s. t = occurs s \<Longrightarrow> f ((l,a)#A) = f A"
 using a unfolding f_def g_def by (cases a; auto)+
 
 private lemma rm_occurs_msgs_constr_Cons'':
   defines "f \<equiv> rm_occurs_msgs_constr"
     and "g \<equiv> filter (\<lambda>t. \<forall>s. t \<noteq> occurs s)"
   assumes a: "a = receive\<langle>ts\<rangle> \<or> a = send\<langle>ts\<rangle>"
   shows "f ((l,a)#A) = (l,a)#f A \<or> f ((l,a)#A) = (l,receive\<langle>g ts\<rangle>)#f A \<or>
          f ((l,a)#A) = (l,send\<langle>g ts\<rangle>)#f A \<or> f ((l,a)#A) = f A"
 using rm_occurs_msgs_constr_Cons(2-)[of a l A] a unfolding f_def g_def by (cases a) auto
 
 private lemma rm_occurs_msgs_constr_ik_subset:
   "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (rm_occurs_msgs_constr A) \<subseteq> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
 proof (induction A)
   case (Cons a A)
   let ?f = "filter (\<lambda>t. \<forall>s. t \<noteq> occurs s)"
 
   note IH = Cons.IH
 
   obtain l b where a: "a = (l,b)" by (metis surj_pair)
 
   have 0: "set (unlabel A) \<subseteq> set (unlabel (a#A))" by auto
 
   note 1 = rm_occurs_msgs_constr_Cons[of b l A]
   note 2 = in_ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t_iff
   note 3 = ik\<^sub>s\<^sub>s\<^sub>t_set_subset[OF 0]
   note 4 = ik\<^sub>s\<^sub>s\<^sub>t_append
   note 5 = 4[of "unlabel [a]" "unlabel A"] 4[of "unlabel [a]" "unlabel (rm_occurs_msgs_constr A)"]
 
   show ?case
   proof (cases "is_Send b \<or> is_Receive b")
     case True
     note b_cases = this
 
     define ts where "ts \<equiv> the_msgs b"
 
     have ts_cases: "is_Send b \<Longrightarrow> b = send\<langle>ts\<rangle>" "is_Receive b \<Longrightarrow> b = receive\<langle>ts\<rangle>"
       unfolding ts_def by simp_all
 
     have 6:
         "is_Send b \<Longrightarrow> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t [(l,b)] = {}"
         "is_Send b \<Longrightarrow> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t [(l,send\<langle>the_msgs b\<rangle>)] = {}"
         "is_Send b \<Longrightarrow> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t [(l,send\<langle>?f (the_msgs b)\<rangle>)] = {}"
         "is_Receive b \<Longrightarrow> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t [(l,b)] = set ts"
         "is_Receive b \<Longrightarrow> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t [(l,receive\<langle>the_msgs b\<rangle>)] = set ts"
         "is_Receive b \<Longrightarrow> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t [(l,receive\<langle>?f (the_msgs b)\<rangle>)] = set (?f ts)"
       using 2[of _ "[(l, send\<langle>the_msgs b\<rangle>)]"]
             2[of _ "[(l, send\<langle>?f (the_msgs b)\<rangle>)]"]
             2[of _ "[(l, receive\<langle>the_msgs b\<rangle>)]"]
             2[of _ "[(l, receive\<langle>?f (the_msgs b)\<rangle>)]"]
             b_cases ts_cases
       by auto
 
     have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (rm_occurs_msgs_constr (a#A)) = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (rm_occurs_msgs_constr A)"
       when b: "is_Send b"
     proof (cases "\<exists>t. occurs t \<in> set (the_msgs b)")
       case True
       note 7 = 1(6,7)[OF b True]
 
       show ?thesis
       proof (cases "\<exists>t \<in> set (the_msgs b). \<forall>s. t \<noteq> occurs s")
         case True show ?thesis
           using 4[of "unlabel [(l,send\<langle>?f (the_msgs b)\<rangle>)]"
                      "unlabel (rm_occurs_msgs_constr A)"]
           unfolding a 7(1)[OF True] 6(3)[OF b] by simp
       next
         case False
         hence F: "\<forall>t \<in> set (the_msgs b). \<exists>s. t = occurs s" by simp
         show ?thesis
           using 4[of "unlabel [(l,send\<langle>the_msgs b\<rangle>)]" "unlabel (rm_occurs_msgs_constr A)"]
           unfolding a 7(2)[OF F] 6(2)[OF b] by simp
       qed
     next
       case False show ?thesis
         using 4[of "unlabel [(l,b)]" "unlabel (rm_occurs_msgs_constr A)"]
         unfolding a 1(5)[OF b False] 6(1)[OF b] by auto
     qed
     moreover have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (rm_occurs_msgs_constr (a#A)) \<subseteq> set ts \<union> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (rm_occurs_msgs_constr A)"
       when b: "is_Receive b"
     proof (cases "\<exists>t. occurs t \<in> set (the_msgs b)")
       case True
       note 8 = 1(3,4)[OF b True]
 
       show ?thesis
       proof (cases "\<exists>t \<in> set (the_msgs b). \<forall>s. t \<noteq> occurs s")
         case True show ?thesis
           using 4[of "unlabel [(l,receive\<langle>?f (the_msgs b)\<rangle>)]"
                      "unlabel (rm_occurs_msgs_constr A)"]
           unfolding a 8(1)[OF True] 6(6)[OF b] by auto
       next
         case False
         hence F: "\<forall>t \<in> set (the_msgs b). \<exists>s. t = occurs s" by simp
         show ?thesis
           using 4[of "unlabel [(l,receive\<langle>the_msgs b\<rangle>)]" "unlabel (rm_occurs_msgs_constr A)"]
           unfolding a 8(2)[OF F] 6(5)[OF b] by simp
       qed
     next
       case False show ?thesis
         using 4[of "unlabel [(l,b)]" "unlabel (rm_occurs_msgs_constr A)"]
         unfolding a 1(2)[OF b False] 6(4)[OF b] by auto
     qed
     moreover have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = set ts \<union> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" when b: "is_Receive b"
       using ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t_Cons(2)[of l ts A] unfolding a ts_cases(2)[OF b] by blast
     ultimately show ?thesis using IH 3 b_cases by blast
   qed (use 1(1) IH 5 a in auto)
 qed simp
 
 private lemma rm_occurs_msgs_constr_append:
   "rm_occurs_msgs_constr (A@B) = rm_occurs_msgs_constr A@rm_occurs_msgs_constr B"
 by (induction A rule: rm_occurs_msgs_constr.induct) auto
 
 private lemma rm_occurs_msgs_constr_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t:
   "rm_occurs_msgs_constr (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (rm_occurs_msgs_constr A)"
 proof (induction A)
   case (Cons a A)
   obtain l b where a: "a = (l,b)" by (metis surj_pair)
   show ?case using Cons.IH unfolding a by (cases b) auto
 qed simp
 
 private lemma rm_occurs_msgs_constr_dbupd\<^sub>s\<^sub>s\<^sub>t_eq:
   "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (rm_occurs_msgs_constr A)) I D = dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I D"
 proof (induction A arbitrary: I D)
   case (Cons a A)
   obtain l b where a: "a = (l,b)" by (metis surj_pair)
   show ?case
   proof (cases "is_Receive b \<or> is_Send b")
     case True
     then obtain ts where b: "b = receive\<langle>ts\<rangle> \<or> b = send\<langle>ts\<rangle>" by (cases b) simp_all
     show ?thesis using rm_occurs_msgs_constr_Cons''[OF b, of l A] Cons.IH b unfolding a by fastforce
   next
     case False thus ?thesis using Cons.IH unfolding a by (cases b) auto
   qed
 qed simp
 
 private lemma rm_occurs_msgs_constr_subst:
   fixes A::"('a,'b,'c,'d) prot_strand" and \<theta>::"('a,'b,'c,'d) prot_subst"
   assumes "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<nexists>t. \<theta> x = occurs t" "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<theta> x \<noteq> Fun OccursSec []"
   shows "rm_occurs_msgs_constr (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = (rm_occurs_msgs_constr A) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"
     (is "?f (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = (?f A) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>")
 using assms
 proof (induction A)
   case (Cons a A)
   note 0 = rm_occurs_msgs_constr_Cons
   note 1 = rm_occurs_msgs_constr_Cons'
 
   define f where "f \<equiv> ?f"
   define not_occ where "not_occ \<equiv> \<lambda>t::('a,'b,'c,'d) prot_term. \<forall>s. t \<noteq> occurs s"
   define flt where "flt \<equiv> filter not_occ"
 
   obtain l b where a: "a = (l,b)" by (metis surj_pair)
 
   have 2: "\<nexists>t. \<theta> x = occurs t" "\<theta> x \<noteq> Fun OccursSec []"
     when b: "is_Receive b \<or> is_Send b" and t: "t \<in> set (the_msgs b)" and x: "x \<in> fv t" for x t
     using Cons.prems x t b unfolding a by (cases b; auto)+
 
   have IH: "f (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = (f A) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"
     using Cons.prems Cons.IH unfolding f_def by simp
 
   show ?case
   proof (cases "is_Receive b \<or> is_Send b")
     case True
     note T = this
     then obtain ts where ts: "b = receive\<langle>ts\<rangle> \<or> b = send\<langle>ts\<rangle>" by (cases b) simp_all
     hence ts': "b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle> \<or> b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = send\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>" by auto
 
     have the_msgs_b: "the_msgs b = ts" "the_msgs (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>"
       using ts ts' by auto
 
     have 4: "is_Receive (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) \<or> is_Send (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
       using T by (cases b) simp_all
 
     note 6 = 1[OF T, of l A, unfolded f_def[symmetric]]
     note 7 = 1[OF 4, of l "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>", unfolded f_def[symmetric]]
     note 8 = ts IH subst_lsst_cons[of _ _ \<theta>]
 
     have 9: "t \<cdot> \<theta> \<in> set (the_msgs (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>))" "not_occ (t \<cdot> \<theta>)"
       when t: "t \<in> set (the_msgs b)" "not_occ t" for t
     proof -
       show "t \<cdot> \<theta> \<in> set (the_msgs (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>))" using t ts ts' by auto
       moreover have "not_occ (t \<cdot> \<theta>)" when "t = Var x" for x
         using 2[OF T t(1)] t(2) unfolding that not_occ_def by simp
       moreover have "not_occ (t \<cdot> \<theta>)" when "t = Fun g ss" "g \<noteq> OccursFact" for g ss
         using 2[OF T t(1)] t(2) that(2) unfolding that(1) not_occ_def by simp
       moreover have "not_occ (t \<cdot> \<theta>)"
         when "t = Fun OccursFact ss" "\<nexists>s1 s2. ss = [s1,s2]" for ss
         using 2[OF T t(1)] t(2) that(2) unfolding that(1) not_occ_def by auto
       moreover have "not_occ (t \<cdot> \<theta>)"
         when "t = Fun OccursFact [s1,s2]" for s1 s2
         using 2[OF T t(1)] t(2) unfolding that not_occ_def by (cases s1) auto
       ultimately show "not_occ (t \<cdot> \<theta>)" by (cases t) (metis, metis)
     qed
 
     have 10: "not_occ t"
       when t: "t \<in> set (the_msgs b)" "not_occ (t \<cdot> \<theta>)" for t
     proof -
       have "t \<cdot> \<theta> \<in> set (the_msgs (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>))" using t ts ts' by auto
       moreover have "not_occ t" when "t = Var x" for x
         using 2[OF T t(1)] t(2) unfolding that not_occ_def by simp
       moreover have "not_occ t" when "t = Fun g ss" "g \<noteq> OccursFact" for g ss
         using 2[OF T t(1)] t(2) that(2) unfolding that(1) not_occ_def by simp
       moreover have "not_occ t"
         when "t = Fun OccursFact ss" "\<nexists>s1 s2. ss = [s1,s2]" for ss
         using 2[OF T t(1)] t(2) that(2) unfolding that(1) not_occ_def by auto
       moreover have "not_occ t"
         when "t = Fun OccursFact [s1,s2]" for s1 s2
         using 2[OF T t(1)] t(2) unfolding that not_occ_def by (cases s1) auto
       ultimately show "not_occ t" unfolding not_occ_def by force
     qed
 
     have 11: "not_occ (t \<cdot> \<theta>) \<longleftrightarrow> not_occ t" when "t \<in> set ts" for t
       using that 9 10 unfolding the_msgs_b by blast
 
     have 5: "(\<exists>t. occurs t \<in> set ts) \<longleftrightarrow> (\<exists>t. occurs t \<in> set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
       using 11 image_iff unfolding not_occ_def by fastforce
 
     have 12: "flt (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>) = (flt ts) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>" using 11 
     proof (induction ts)
       case (Cons t ts)
       hence "not_occ (t \<cdot> \<theta>) = not_occ t" "flt (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>) = (flt ts) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>" by auto
       thus ?case unfolding flt_def by auto
     qed (metis flt_def filter.simps(1) map_is_Nil_conv)
 
     show ?thesis
     proof (cases "\<exists>t. occurs t \<in> set (the_msgs b)")
       case True
       note T1 = this
       hence T2: "\<exists>t. occurs t \<in> set (the_msgs (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>))" using 5 unfolding the_msgs_b by simp
 
       show ?thesis
       proof (cases "\<exists>t \<in> set (the_msgs b). \<forall>s. t \<noteq> occurs s")
         case True
         note T1' = this
         have T2': "\<exists>t \<in> set (the_msgs (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)). \<forall>s. t \<noteq> occurs s"
           using T1' 11 unfolding the_msgs_b not_occ_def by auto
 
         show ?thesis using T
         proof
           assume b: "is_Receive b"
           hence b\<theta>: "is_Receive (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)" using ts by fastforce
 
           show ?thesis
             using 6(3)[OF T1 T1' b] 7(3)[OF T2 T2' b\<theta>] IH 12
             unfolding f_def[symmetric] a flt_def[symmetric] not_occ_def[symmetric] the_msgs_b
             by (simp add: subst_lsst_cons)
         next
           assume b: "is_Send b"
           hence b\<theta>: "is_Send (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)" using ts by fastforce
 
           show ?thesis
             using 6(2)[OF T1 T1' b] 7(2)[OF T2 T2' b\<theta>] IH 12
             unfolding f_def[symmetric] a flt_def[symmetric] not_occ_def[symmetric] the_msgs_b
             by (simp add: subst_lsst_cons)
         qed
       next
         case False
         hence F: "\<forall>t \<in> set (the_msgs b). \<exists>s. t = occurs s" by blast
         hence F': "\<forall>t \<in> set (the_msgs (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)). \<exists>s. t = occurs s" unfolding the_msgs_b by auto
 
         have *: "\<exists>t. occurs t \<in> set (the_msgs b)" when "the_msgs b \<noteq> []"
           using that F by (cases "the_msgs b") auto
         hence **: "\<exists>t. occurs t \<in> set (the_msgs (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>))" when "the_msgs b \<noteq> []"
           using that 5 unfolding the_msgs_b by simp
 
         show ?thesis
         proof (cases "ts = []")
           case True
           hence ***: "\<nexists>t. occurs t \<in> set (the_msgs b)" "\<nexists>t. occurs t \<in> set (the_msgs (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>))"
             unfolding the_msgs_b by simp_all
 
           show ?thesis
             using IH 6(1)[OF ***(1)] 7(1)[OF ***(2)]
             unfolding a f_def[symmetric] True
             by (simp add: subst_lsst_cons)
         next
           case False thus ?thesis
             using IH 6(4)[OF * F] 7(4)[OF ** F']
             unfolding f_def[symmetric] not_occ_def[symmetric] a the_msgs_b
             by (simp add: subst_lsst_cons)
         qed
       qed
     next
       case False
       note F = this
       have F': "\<nexists>t. occurs t \<in> set (the_msgs (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>))"
         using F 11 unfolding not_occ_def the_msgs_b by fastforce
 
       show ?thesis
         using IH 6(1)[OF F] 7(1)[OF F']
         unfolding a f_def[symmetric] True
         by (simp add: subst_lsst_cons)
     qed
   next
     case False
     hence *: "\<not>is_Receive b" "\<not>is_Send b" "\<not>is_Receive (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)" "\<not>is_Send (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
       by (cases b; auto)+
 
     show ?thesis
       using IH 0(1)[OF *(1,2), of l A] 0(1)[OF *(3,4), of l "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"] subst_lsst_cons[of a _ \<theta>]
       unfolding a f_def by simp
   qed
 qed simp
 
 private lemma rm_occurs_msgs_constr_transaction_strand:
   assumes T_adm: "admissible_transaction' T"
   shows "rm_occurs_msgs_constr (transaction_checks T) = transaction_checks T" (is ?A)
     and "rm_occurs_msgs_constr (transaction_updates T) = transaction_updates T" (is ?B)
     and "admissible_transaction_no_occurs_msgs T \<Longrightarrow>
           rm_occurs_msgs_constr (transaction_receive T) = transaction_receive T" (is "?C \<Longrightarrow> ?C'")
     and "admissible_transaction_no_occurs_msgs T \<Longrightarrow>
           rm_occurs_msgs_constr (transaction_send T) = transaction_send T" (is "?D \<Longrightarrow> ?D'")
 proof -
   note 0 = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
   note 1 = wellformed_transaction_cases[OF 0]
 
   have 2: "\<exists>ts. b = receive\<langle>ts\<rangle> \<and> (\<nexists>t. occurs t \<in> set ts)"
     when "admissible_transaction_no_occurs_msgs T" "(l,b) \<in> set (transaction_receive T)" for l b
     using that 1(1)[OF that(2)]
     unfolding admissible_transaction_no_occurs_msgs_def Let_def list_all_iff by fastforce
 
   have 3: "\<exists>ts. b = send\<langle>ts\<rangle> \<and> (\<nexists>t. occurs t \<in> set ts)"
     when "admissible_transaction_no_occurs_msgs T" "(l,b) \<in> set (transaction_send T)" for l b
     using that 1(4)[OF that(2)]
     unfolding admissible_transaction_no_occurs_msgs_def Let_def list_all_iff by fastforce
 
   define A where "A \<equiv> transaction_receive T"
   define B where "B \<equiv> transaction_checks T"
   define C where "C \<equiv> transaction_updates T"
   define D where "D \<equiv> transaction_send T"
 
   show ?A using 1(2) unfolding B_def[symmetric]
   proof (induction B)
     case (Cons a A)
     hence IH: "rm_occurs_msgs_constr A = A" by (meson list.set_intros(2))
     obtain l b where a: "a = (l,b)" by (metis surj_pair)
     show ?case using Cons.prems IH unfolding a by (cases b) auto
   qed simp
 
   show ?B using 1(3) unfolding C_def[symmetric]
   proof (induction C)
     case (Cons a A)
     hence IH: "rm_occurs_msgs_constr A = A" by (meson list.set_intros(2))
     obtain l b where a: "a = (l,b)" by (metis surj_pair)
     show ?case using Cons.prems IH unfolding a by (cases b) auto
   qed simp
 
   show ?C' when ?C using 2[OF that] unfolding A_def[symmetric]
   proof (induction A)
     case (Cons a A)
     hence IH: "rm_occurs_msgs_constr A = A" by (meson list.set_intros(2))
     obtain l b where a: "a = (l,b)" by (metis surj_pair)
     obtain ts where b: "b = receive\<langle>ts\<rangle>" using Cons.prems unfolding a by auto
     show ?case using Cons.prems IH unfolding a b by fastforce
   qed simp
 
 
   show ?D' when ?D using 3[OF that] unfolding D_def[symmetric]
   proof (induction D)
     case (Cons a A)
     hence IH: "rm_occurs_msgs_constr A = A" by (meson list.set_intros(2))
     obtain l b where a: "a = (l,b)" by (metis surj_pair)
     obtain ts where b: "b = send\<langle>ts\<rangle>" using Cons.prems unfolding a by auto
     show ?case using Cons.prems IH unfolding a b by fastforce
   qed simp
 qed
 
 private lemma rm_occurs_msgs_constr_transaction_strand':
   fixes T::"('fun,'atom,'sets,'lbl) prot_transaction"
   assumes T_adm: "admissible_transaction' T"
     and T_no_occ: "admissible_transaction_no_occurs_msgs T"
   shows "rm_occurs_msgs_constr (transaction_strand (add_occurs_msgs T)) = transaction_strand T"
     (is "?f (?g (?h T)) = ?g T")
 proof -
   obtain A B C D E F where T: "T = Transaction A B C D E F" by (cases T) simp
 
   have B: "B = transaction_fresh T" unfolding T by simp
   have F: "F = transaction_send T" unfolding T by simp
 
   define xs where "xs \<equiv> filter (\<lambda>x. x \<notin> set B) (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)))"
 
   note 0 = rm_occurs_msgs_constr_transaction_strand
   note 1 = add_occurs_msgs_admissible_occurs_checks[OF T_adm]
   note 2 = 0(3,4)[OF T_adm T_no_occ]
   note 3 = add_occurs_msgs_cases[OF T]
   note 4 = 0(1,2)[OF 1(1)]
 
   have 5: "?f (transaction_checks (?h T)) = transaction_checks T"
           "?f (transaction_updates (?h T)) = transaction_updates T"
     using 4 3(8,9) by (argo, argo)
 
   have 6: "?f (transaction_receive (?h T)) = transaction_receive T"
   proof (cases "xs = []")
     case True show ?thesis using 3(6)[OF True[unfolded xs_def B]] 2(1) by simp
   next
     case False show ?thesis
       using False 3(7)[OF False[unfolded xs_def B]] 2(1)
             rm_occurs_msgs_constr_Cons(4)[
               of "receive\<langle>map (\<lambda>x. occurs (Var x)) xs\<rangle>" \<star> "transaction_receive T"]
       unfolding B[symmetric] xs_def[symmetric] 
       by (cases xs) (blast, auto)
   qed
 
   have 7: "?f (transaction_send (?h T)) = transaction_send T"
   proof (cases "\<exists>ts' F'. F = \<langle>\<star>, send\<langle>ts'\<rangle>\<rangle>#F'")
     case True
     then obtain ts' F' where F': "F = \<langle>\<star>, send\<langle>ts'\<rangle>\<rangle>#F'" by blast
 
     have *: "transaction_send (?h T) = \<langle>\<star>, send\<langle>map (\<lambda>x. occurs (Var x)) B@ts'\<rangle>\<rangle>#F'"
       using 3(1)[OF F'] unfolding T by fastforce
 
     have **: "ts' \<noteq> []" using admissible_transactionE(17)[OF T_adm] unfolding T F' by auto
 
     have ***: "\<forall>s. t \<noteq> occurs s" when t: "t \<in> set ts'" for t
       using that T_no_occ
       unfolding T F' admissible_transaction_no_occurs_msgs_def Let_def list_all_iff by auto
 
     let ?ts = "map (\<lambda>x. occurs (Var x)) B@ts'"
 
     have "\<exists>t \<in> set ?ts. \<forall>s. t \<noteq> occurs s" using ** *** by (cases ts') auto
     moreover have "filter (\<lambda>t. \<forall>s. t \<noteq> occurs s) ?ts = ts'" using *** by simp
     moreover have "\<exists>t. occurs t \<in> set ?ts" when "B \<noteq> []" using that by (cases B) auto
     moreover have "?f [\<langle>\<star>, send\<langle>ts'\<rangle>\<rangle>] = [\<langle>\<star>, send\<langle>ts'\<rangle>\<rangle>]"
       using 2(2) ** *** unfolding F[symmetric] F' by force
     hence "?f F' = F'"
       using 2(2) rm_occurs_msgs_constr_append[of "[\<langle>\<star>, send\<langle>ts'\<rangle>\<rangle>]" F']
       unfolding F[symmetric] F' by fastforce
     ultimately have "?f (\<langle>\<star>, send\<langle>?ts\<rangle>\<rangle>#F') = \<langle>\<star>, send\<langle>ts'\<rangle>\<rangle>#F'"
       using 2(2) 3(10)[OF F'[unfolded F]] 3(12)
             rm_occurs_msgs_constr.simps(3)[of \<star> ts' F']
             rm_occurs_msgs_constr_append[of "[\<langle>\<star>, send\<langle>ts'\<rangle>\<rangle>]" F']
       unfolding F[symmetric] F' B[symmetric] by auto
     thus ?thesis using F * unfolding F' by argo
   next
     case False show ?thesis
       using 3(2)[OF False] 3(3) 2(2)
       unfolding B[symmetric] xs_def[symmetric] F[symmetric]
       by (cases B) auto
   qed
 
   show ?thesis
     using 5 6 7 rm_occurs_msgs_constr_append
     unfolding transaction_strand_def by metis
 qed
 
 private lemma rm_occurs_msgs_constr_transaction_strand'':
   fixes T::"('fun,'atom,'sets,'lbl) prot_transaction"
   assumes T_adm: "admissible_transaction' T"
     and T_no_occ: "admissible_transaction_no_occurs_msgs T"
     and \<theta>: "\<forall>x \<in> fv_transaction (add_occurs_msgs T). \<nexists>t. \<theta> x = occurs t"
            "\<forall>x \<in> fv_transaction (add_occurs_msgs T). \<theta> x \<noteq> Fun OccursSec []"
   shows "rm_occurs_msgs_constr (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand (add_occurs_msgs T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) =
          dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 using rm_occurs_msgs_constr_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t[of "transaction_strand (add_occurs_msgs T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
       rm_occurs_msgs_constr_subst[OF \<theta>] rm_occurs_msgs_constr_transaction_strand'[OF T_adm T_no_occ]
 by argo
 
 private lemma rm_occurs_msgs_constr_bvars_subst_eq:
   "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (rm_occurs_msgs_constr A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 proof -
   have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (rm_occurs_msgs_constr A) = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
   proof (induction A)
     case (Cons a A)
     obtain l b where a: "a = (l,b)" by (metis surj_pair)
     show ?case using Cons.IH unfolding a by (cases b) auto
   qed simp
   thus ?thesis by (metis bvars\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst)
 qed
 
 private lemma rm_occurs_msgs_constr_reachable_constraints_fv_eq:
   assumes P: "\<forall>T \<in> set P. admissible_transaction' T"
              "\<forall>T \<in> set P. admissible_transaction_no_occurs_msgs T"
     and A: "A \<in> reachable_constraints (map add_occurs_msgs P)"
   shows "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (rm_occurs_msgs_constr A) = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
 using A
 proof (induction A rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   let ?f = rm_occurs_msgs_constr
   let ?B = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
   define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   obtain T' where T': "T' \<in> set P" "T = add_occurs_msgs T'"
     using step.hyps(2) by auto
 
   have T_adm: "admissible_transaction' T"
     using add_occurs_msgs_admissible_occurs_checks(1) step.hyps(2) P by auto
 
   have T'_adm: "admissible_transaction' T'"
     and T'_no_occ: "admissible_transaction_no_occurs_msgs T'"
     using T'(1) P by (blast,blast)
 
   have "?f (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
     using rm_occurs_msgs_constr_transaction_strand''[OF T'_adm T'_no_occ, of \<theta>]
           admissible_transaction_decl_fresh_renaming_subst_not_occurs[OF T_adm step.hyps(3,4,5)]
     unfolding T'(2) \<theta>_def[symmetric] by blast
   moreover have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
     using add_occurs_msgs_vars_eq(6)[OF T'_adm, of \<theta>] unfolding T'(2) by blast
   ultimately have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?f ?B) = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?B"
     using fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unfolding T'(2) \<theta>_def[symmetric] by metis
   thus ?case
     using step.IH fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel ?B"]
           rm_occurs_msgs_constr_append[of \<A> ?B]
     by force
 qed simp
 
 private lemma rm_occurs_msgs_constr_reachable_constraints_vars_eq:
   assumes P: "\<forall>T \<in> set P. admissible_transaction' T"
              "\<forall>T \<in> set P. admissible_transaction_no_occurs_msgs T"
     and A: "A \<in> reachable_constraints (map add_occurs_msgs P)"
   shows "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (rm_occurs_msgs_constr A) = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
 using rm_occurs_msgs_constr_bvars_subst_eq[of _ Var]
       rm_occurs_msgs_constr_reachable_constraints_fv_eq[OF P A]
 by (metis vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t subst_lsst_id_subst)
 
 private lemma rm_occurs_msgs_constr_reachable_constraints_trms_cases_aux:
   assumes A: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t A" "bvars\<^sub>s\<^sub>s\<^sub>t A = {}"
     and t: "t = occurs (\<theta> x)"
     and \<theta>: "(\<exists>y. \<theta> x = Var y) \<or> (\<exists>c. \<theta> x = Fun c [])"
   shows "(\<exists>x \<in> fv\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>). t = occurs (Var x)) \<or>
          (\<exists>c. Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>) \<and> t = occurs (Fun c []))"
 using A
 proof (induction A)
   case (Cons a A)
   have 0: "bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) = {}" "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) \<inter> subst_domain \<theta> = {}"
     using Cons.prems(2) by auto
 
   note 1 = fv\<^sub>s\<^sub>s\<^sub>t_Cons[of a A] trms\<^sub>s\<^sub>s\<^sub>t_cons[of a A] subst_sst_cons[of a A \<theta>]
 
   show ?case
   proof (cases "x \<in> fv\<^sub>s\<^sub>s\<^sub>t A")
     case False
     hence x: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" using Cons.prems(1) by simp
 
     note 2 = x t \<theta>
 
     have 3: "\<theta> x \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
       using subst_subterms[OF fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p[OF x]] trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[OF 0(3)] by auto
 
     have "Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)" when "\<theta> x = Fun c []" for c
       using that 3 t by argo
     moreover have "y \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)" when "\<theta> x = Var y" for y
       using that 3 var_subterm_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p[of y "a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>"] 0(2) 
       unfolding vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst by simp
     ultimately have
         "(\<exists>x \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>). t = occurs (Var x)) \<or>
          (\<exists>c. Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) \<and> t = occurs (Fun c []))"
       using t \<theta> by fast
     thus ?thesis using 1 by auto
   qed (use Cons.IH[OF _ 0(1)] 1 in force)
 qed simp
 
 private lemma rm_occurs_msgs_constr_reachable_constraints_trms_cases:
   assumes P: "\<forall>T \<in> set P. admissible_transaction' T"
              "\<forall>T \<in> set P. admissible_transaction_no_occurs_msgs T"
     and A: "A = rm_occurs_msgs_constr B"
     and B: "B \<in> reachable_constraints (map add_occurs_msgs P)"
     and t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B"
   shows "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<or> (\<exists>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. t = occurs (Var x)) \<or>
          (\<exists>c. Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<and> t = occurs (Fun c []))"
     (is "?A A \<or> ?B A \<or> ?C A")
 proof -
   define rm_occs where
     "rm_occs \<equiv> \<lambda>A::('fun,'atom,'sets,'lbl) prot_strand. rm_occurs_msgs_constr A"
   define Q where "Q \<equiv> \<lambda>A. ?A A \<or> ?B A \<or> ?C A"
 
   have 0: "Q B" when "Q A" "set A \<subseteq> set B" for A B
     using that unfolding Q_def fv\<^sub>s\<^sub>s\<^sub>t_def trms\<^sub>s\<^sub>s\<^sub>t_def unlabel_def by auto
 
   have "Q A" using B t unfolding A
   proof (induction rule: reachable_constraints.induct)
     case (step \<A> T \<xi> \<sigma> \<alpha>)
     define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
     define \<B> where "\<B> \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 
     obtain T' where T': "T' \<in> set P" "T = add_occurs_msgs T'"
       using step.hyps(2) by auto
 
     note T'_adm = bspec[OF P(1) T'(1)] bspec[OF P(2) T'(1)]
     note T_adm = add_occurs_msgs_admissible_occurs_checks[OF T'_adm(1), unfolded T'(2)[symmetric]]
 
     note 1 = \<theta>_def[symmetric] \<B>_def[symmetric] rm_occs_def[symmetric]
     note 2 = rm_occurs_msgs_constr_append[of \<A> \<B>, unfolded rm_occs_def[symmetric]]
 
     note 3 = admissible_transaction_decl_fresh_renaming_subst_not_occurs[
                 OF T_adm(1) step.hyps(3,4,5)]
 
     have 4: "rm_occs (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) =
              dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
       using 3 rm_occurs_msgs_constr_transaction_strand''[OF T'_adm]
       unfolding T'(2) 1 by blast 
 
     have 5: "(\<exists>y. \<theta> x = Var y) \<or> (\<exists>c. \<theta> x = Fun c [])" for x
       using transaction_decl_fresh_renaming_substs_range'(1)[OF step.hyps(3,4,5)]
       unfolding \<theta>_def[symmetric] by blast
 
     show ?case
     proof (cases "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>")
       case True show ?thesis using 0[OF step.IH[OF True]] unfolding 1 2 by simp
     next
       case False
       hence "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" using step.prems unfolding \<B>_def \<theta>_def by simp
       hence "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<or>
              (\<exists>x \<in> fv_transaction T'. t = occurs (\<theta> x))"
         using add_occurs_msgs_in_trms_subst_cases[OF T'_adm(1), of t \<theta>]
         unfolding \<B>_def trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq T'(2) by blast
       moreover have "(\<exists>y. \<theta> x = Var y) \<or> (\<exists>c. \<theta> x = Fun c [])" for x
         using transaction_decl_fresh_renaming_substs_range'(1)[OF step.hyps(3,4,5)]
         unfolding \<theta>_def[symmetric] by blast
       ultimately have "Q (rm_occs \<B>)"
         using rm_occurs_msgs_constr_reachable_constraints_trms_cases_aux[
                 of _ "unlabel (transaction_strand T')" t \<theta>]
               admissible_transactionE(4)[OF T'_adm(1)]
         unfolding Q_def \<B>_def 4 trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unlabel_subst
         by fast
       thus ?thesis using 0[of "rm_occs \<B>"] unfolding 1 2 by auto
     qed
   qed simp
   thus ?thesis unfolding Q_def by blast
 qed
 
 private lemma rm_occurs_msgs_constr_receive_attack_iff:
   fixes A::"('a,'b,'c,'d) prot_strand"
   shows "(\<exists>ts. attack\<langle>n\<rangle> \<in> set ts \<and> receive\<langle>ts\<rangle> \<in> set (unlabel A)) \<longleftrightarrow>
          (\<exists>ts. attack\<langle>n\<rangle> \<in> set ts \<and> receive\<langle>ts\<rangle> \<in> set (unlabel (rm_occurs_msgs_constr A)))"
   (is "(\<exists>ts. attack\<langle>n\<rangle> \<in> set ts \<and> ?A A ts) \<longleftrightarrow> (\<exists>ts. attack\<langle>n\<rangle> \<in> set ts \<and> ?B A ts)")
 proof
   let ?att = "\<lambda>ts. attack\<langle>n\<rangle> \<in> set ts"
 
   define f where "f \<equiv> \<lambda>ts::('a,'b,'c,'d) prot_term list. filter (\<lambda>t. \<forall>s. t \<noteq> occurs s) ts"
 
   have 0: "?att ts \<longleftrightarrow> ?att (f ts)"
           "?att ts \<Longrightarrow> \<exists>t. occurs t \<in> set ts \<Longrightarrow> \<exists>t \<in> set ts. \<forall>s. t \<noteq> occurs s"
           "\<nexists>t. occurs t \<in> set ts \<Longrightarrow> f ts = ts"
     for ts::"('a,'b,'c,'d) prot_term list"
     unfolding f_def
     subgoal by simp
     subgoal by auto
     subgoal by (induct ts) auto
     done
 
   have "?B A (f ts)" when A: "?A A ts" and ts: "?att ts" for ts using A
   proof (induction A)
     case (Cons a A)
     obtain l b where a: "a = (l,b)" by (metis surj_pair)
 
     show ?case
     proof (cases "?A A ts")
       case True thus ?thesis using Cons.IH unfolding a by (cases b) simp_all
     next
       case False
       hence b: "b = receive\<langle>ts\<rangle>" using Cons.prems unfolding a by simp
       show ?thesis using 0(2)[OF ts] 0(3) unfolding a b f_def by simp
     qed
   qed simp
   thus "(\<exists>ts. ?att ts \<and> ?A A ts) \<Longrightarrow> (\<exists>ts. ?att ts \<and> ?B A ts)" using 0(1) by fast
 
   have "\<exists>ts'. ts = f ts' \<and> ?A A ts'" when B: "?B A ts" and ts: "?att ts" for ts using B
   proof (induction A)
     case (Cons a A)
     obtain l b where a: "a = (l,b)" by (metis surj_pair)
 
     note 1 = rm_occurs_msgs_constr_Cons
 
     have 2: "receive\<langle>ts\<rangle> \<in> set (unlabel (rm_occurs_msgs_constr A))"
       when rcv_ts: "receive\<langle>ts\<rangle> \<in> set (unlabel (rm_occurs_msgs_constr ((l,send\<langle>ts'\<rangle>)#A)))"
       for l ts ts' and A::"('a,'b,'c,'d) prot_strand"
     proof -
       have *: "is_Send (send\<langle>ts'\<rangle>)" by simp
 
       have "set (unlabel (rm_occurs_msgs_constr [(l, send\<langle>ts'\<rangle>)])) \<subseteq> {send\<langle>ts'\<rangle>, send\<langle>f ts'\<rangle>}"
         using 1(5-7)[OF *, of l "[]"] unfolding f_def by auto
       thus ?thesis using rcv_ts rm_occurs_msgs_constr_append[of "[(l,send\<langle>ts'\<rangle>)]" A] by auto
     qed
 
     show ?case
     proof (cases "?B A ts")
       case True thus ?thesis using Cons.IH by auto
     next
       case False
       hence 3: "receive\<langle>ts\<rangle> \<in> set (unlabel (rm_occurs_msgs_constr [a]))"
         using rm_occurs_msgs_constr_append[of "[a]" A] Cons.prems by simp
 
       obtain ts' where b: "b = receive\<langle>ts'\<rangle>" and b': "is_Receive b"
         using 2[of ts l _ A] Cons.prems False
         unfolding a by (cases b) auto
 
       have ts': "the_msgs (receive\<langle>ts'\<rangle>) = ts'" by simp
 
       have "\<exists>t \<in> set (the_msgs b). \<forall>s. t \<noteq> occurs s" when "\<exists>t. occurs t \<in> set (the_msgs b)"
         using that 3 1(4)[OF b' that, of l "[]"] unfolding a by force
       hence "ts = f ts'"
         using 3 0(3)[of ts'] 1(3)[OF b', of l "[]", unfolded rm_occurs_msgs_constr.simps(1)]
         unfolding a b ts' f_def[symmetric] by fastforce
       thus ?thesis unfolding a b by auto
     qed
   qed simp
   thus "(\<exists>ts. ?att ts \<and> ?B A ts) \<Longrightarrow> (\<exists>ts. ?att ts \<and> ?A A ts)" using 0 by fast
 qed
 
 private lemma add_occurs_msgs_soundness_aux1:
   fixes P::"('fun,'atom,'sets,'lbl) prot"
   defines "wt_attack \<equiv> \<lambda>\<I> \<A> l n. welltyped_constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
   assumes P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_val: "has_initial_value_producing_transaction P"
     and A: "\<A> \<in> reachable_constraints P" "wt_attack \<I> \<A> l n"
   shows "\<exists>\<B> \<in> reachable_constraints P. \<exists>\<J>.
           wt_attack \<J> \<B> l n \<and> (\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>. \<exists>n. \<J> x = Fun (Val n) [])"
 proof -
   let ?f = "\<lambda>(T,\<xi>,\<sigma>,\<alpha>). dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   let ?g = "concat \<circ> map ?f"
   let ?rcv_att = "\<lambda>A n. receive\<langle>[attack\<langle>n\<rangle>]\<rangle> \<in> set (unlabel A)"
   let ?wt_model = welltyped_constraint_model
 
   define valconst_cases where "valconst_cases \<equiv>
     \<lambda>I::('fun,'atom,'sets,'lbl) prot_subst. \<lambda>x.
       (\<exists>n. I x = Fun (Val n) []) \<or> (\<exists>n. I x = Fun (PubConst Value n) [])"
 
   define valconsts_only where "valconsts_only \<equiv>
     \<lambda>X. \<lambda>I::('fun,'atom,'sets,'lbl) prot_subst. \<forall>x \<in> X. \<exists>n. I x = Fun (Val n) []"
 
   define db_eq where "db_eq \<equiv>
     \<lambda>A B::('fun,'atom,'sets,'lbl) prot_constr. \<lambda>s. \<lambda>upds::('fun,'atom,'sets,'lbl) prot_constr.
       let f = filter is_Update \<circ> unlabel;
           g = filter (\<lambda>a. \<nexists>l t ts. a = (l,insert\<langle>t,Fun (Set s) ts\<rangle>))
       in (upds = [] \<and> f A = f B) \<or> (upds \<noteq> [] \<and> f (g A) = f (g B))"
 
   define db_upds_consts_fresh where "db_upds_consts_fresh \<equiv>
     \<lambda>A::('fun,'atom,'sets,'lbl) prot_constr. \<lambda>X. \<lambda>J::('fun,'atom,'sets,'lbl) prot_subst. 
       \<forall>x \<in> X. (\<exists>n. \<I> x = Fun (PubConst Value n) []) \<longrightarrow> (\<forall>n s.
         insert\<langle>Fun (Val n) [],s\<rangle> \<in> set (unlabel A) \<or>
         delete\<langle>Fun (Val n) [],s\<rangle> \<in> set (unlabel A) \<longrightarrow>
           J x \<noteq> Fun (Val n) [])"
 
   define subst_eq_on_privvals where "subst_eq_on_privvals \<equiv> \<lambda>X \<J>.
     \<forall>x \<in> X. (\<exists>n. \<I> x = Fun (Val n) []) \<longrightarrow> \<I> x = \<J> x"
 
   define subst_in_ik_if_subst_pubval where "subst_in_ik_if_subst_pubval \<equiv>
     \<lambda>X \<J>. \<lambda>\<B>::('fun,'atom,'sets,'lbl) prot_constr.
       \<forall>x \<in> X. (\<exists>n. \<I> x = Fun (PubConst Value n) []) \<longrightarrow> \<J> x \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>"
 
   define subst_eq_iff where "subst_eq_iff \<equiv> \<lambda>X. \<lambda>\<J>::('fun,'atom,'sets,'lbl) prot_subst.
     \<forall>x \<in> X. \<forall>y \<in> X. \<I> x = \<I> y \<longleftrightarrow> \<J> x = \<J> y"
 
   obtain x_val T_val T_upds s_val ts_val l1_val l2_val where x_val:
       "T_val \<in> set P" "Var x_val \<in> set ts_val" "\<Gamma>\<^sub>v x_val = TAtom Value"
       "fv\<^sub>s\<^sub>e\<^sub>t (set ts_val) = {x_val}" "\<forall>n. \<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts_val)"
       "T_val = Transaction (\<lambda>(). []) [x_val] [] [] T_upds [(l1_val,send\<langle>ts_val\<rangle>)]"
       "T_upds = [] \<or>
        (T_upds = [(l2_val,insert\<langle>Var x_val,\<langle>s_val\<rangle>\<^sub>s\<rangle>)] \<and>
         (\<forall>T \<in> set P. \<forall>(l,a) \<in> set (transaction_strand T). \<forall>t.
           a \<noteq> select\<langle>t,\<langle>s_val\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> \<langle>t in \<langle>s_val\<rangle>\<^sub>s\<rangle> \<and> a \<noteq> \<langle>t not in \<langle>s_val\<rangle>\<^sub>s\<rangle> \<and>
           a \<noteq> delete\<langle>t,\<langle>s_val\<rangle>\<^sub>s\<rangle>))"
     using has_initial_value_producing_transactionE[OF P_val P, of thesis]
     by (auto simp add: disj_commute)
 
   have 0: "\<nexists>n. Fun (PubConst Value n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" when "\<B> \<in> reachable_constraints P" for \<B>
     using reachable_constraints_val_funs_private(1)[OF that P(1)] funs_term_Fun_subterm'
     unfolding is_PubConstValue_def by fastforce
 
   have I: "?wt_model \<I> \<A>" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     using welltyped_constraint_model_prefix[OF A(2)[unfolded wt_attack_def]]
           A(2)[unfolded wt_attack_def welltyped_constraint_model_def constraint_model_def]
     by blast+
 
   have 1: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. valconst_cases \<I> x"
     using reachable_constraints_fv_Value_const_cases[OF P(1) A(1) I(1)]
     unfolding valconst_cases_def by blast
 
   have 2: "?rcv_att \<A> n"
     using A(2) strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" "[send\<langle>[attack\<langle>n\<rangle>]\<rangle>]" \<I>]
           reachable_constraints_receive_attack_if_attack'(2)[OF A(1) P(1) I(1)]
     unfolding wt_attack_def welltyped_constraint_model_def constraint_model_def by simp
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF bspec[OF P(1)]]
 
   have lmm:
       "\<exists>\<B> \<in> reachable_constraints P. \<exists>\<J>.
           ?wt_model \<J> \<B> \<and> valconsts_only (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X) \<J> \<and> (?rcv_att \<A> n \<longrightarrow> ?rcv_att \<B> n) \<and>
           subst_eq_on_privvals (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X) \<J> \<and>
           subst_in_ik_if_subst_pubval (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X) \<J> \<B> \<and>
           subst_eq_iff (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X) \<J> \<and>
           vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<and> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<and>
           (\<forall>n \<in> N. \<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)) \<and>
           ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<and> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<and>
           db_eq \<A> \<B> s_val T_upds \<and>
           db_upds_consts_fresh \<A> (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X) \<J>"
     when "finite N" "\<forall>n \<in> N. \<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" "X \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
          "finite X" "\<forall>x \<in> X. valconst_cases \<I> x" "\<forall>x \<in> X. \<Gamma>\<^sub>v x = TAtom Value"
     for N X
     using A(1) I(1) 1 that
   proof (induction arbitrary: N X rule: reachable_constraints.induct)
     case init
     define pubvals where "pubvals \<equiv> {n | n x. x \<in> X \<and> \<I> x = Fun (PubConst Value n) []}"
     define X_vals where "X_vals \<equiv> {n | n x. x \<in> X \<and> \<I> x = Fun (Val n) []}"
 
     have X_vals_finite: "finite X_vals"
       using finite_surj[OF init.prems(6),
                         of X_vals "\<lambda>x. THE n. \<I> x = Fun (Val n) []"]
       unfolding X_vals_def by force
 
     have pubvals_finite: "finite pubvals"
       using finite_surj[OF init.prems(6),
                         of pubvals "\<lambda>x. THE n. \<I> x = Fun (PubConst Value n) []"]
       unfolding pubvals_def by force
 
     obtain T_val_fresh_vals and \<delta>::"nat \<Rightarrow> nat"
       where T_val_fresh_vals: "T_val_fresh_vals \<inter> (N \<union> X_vals) = {}"
         and \<delta>: "inj \<delta>" "\<delta> ` pubvals = T_val_fresh_vals"
       using ex_finite_disj_nat_inj[OF pubvals_finite finite_UnI[OF init.prems(3) X_vals_finite]]
       by blast
 
     have T_val_fresh_vals_finite: "finite T_val_fresh_vals"
       using pubvals_finite \<delta>(2) by blast
 
     obtain \<B>::"('fun,'atom,'sets,'lbl) prot_constr"
       where B:
           "\<B> \<in> reachable_constraints P"
           "T_upds = [] \<Longrightarrow> list_all is_Receive (unlabel \<B>)"
           "T_upds \<noteq> [] \<Longrightarrow> list_all (\<lambda>a. is_Insert a \<or> is_Receive a) (unlabel \<B>)"
           "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> = {}"
           "\<forall>n. Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<longrightarrow> Fun (Val n) [] \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>"
           "T_val_fresh_vals = {n. Fun (Val n) [] \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>}"
           "\<forall>l a. (l,a) \<in> set \<B> \<and> is_Insert a \<longrightarrow>
                   (l = l2_val \<and> (\<exists>n. a = insert\<langle>Fun (Val n) [],\<langle>s_val\<rangle>\<^sub>s\<rangle>))"
       using reachable_constraints_initial_value_transaction[
               OF P reachable_constraints.init T_val_fresh_vals_finite _ x_val]
       by auto
 
     define \<J> where "\<J> \<equiv> \<lambda>x.
       if x \<in> X \<and> (\<exists>n. \<I> x = Fun (PubConst Value n) [])
       then Fun (Val (\<delta> (THE n. \<I> x = Fun (PubConst Value n) []))) []
       else \<I> x"
 
     have 0: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] \<subseteq> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] \<subseteq> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" "?rcv_att [] n \<longrightarrow> ?rcv_att \<B> n"
             "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>"
       using B(4) vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<B>"] by auto
 
     have 1: "db_eq [] \<B> s_val T_upds" using B(2,3,7)
     proof (induction \<B>)
       case (Cons a B)
       then obtain l b where a: "a = (l,b)" by (metis surj_pair)
 
       have IH: "db_eq [] B s_val T_upds" using Cons.prems Cons.IH by auto
 
       show ?case
       proof (cases "T_upds = []")
         case True
         hence "is_Receive b" using a Cons.prems(1) by simp
         thus ?thesis using IH unfolding a db_eq_def Let_def by auto
       next
         case False
         hence "is_Insert b \<or> is_Receive b" using a Cons.prems(2) by simp
         hence "\<exists>t. a = (l2_val,insert\<langle>t,\<langle>s_val\<rangle>\<^sub>s\<rangle>)" when b: "\<not>is_Receive b"
           using b Cons.prems(3) unfolding a by (metis list.set_intros(1))
         thus ?thesis using IH False unfolding a db_eq_def Let_def by auto
       qed
     qed (simp add: db_eq_def)
 
     have 2: "?wt_model \<J> \<B>"
       unfolding welltyped_constraint_model_def constraint_model_def
     proof (intro conjI)
       show "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<J>" using I(4) init.prems(8) unfolding \<J>_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by fastforce
 
       show "strand_sem_stateful {} {} (unlabel \<B>) \<J>"
         using B(2,3) strand_sem_stateful_if_no_send_or_check[of "unlabel \<B>" "{}" "{}" \<J>]
         unfolding list_all_iff by blast
 
       show "subst_domain \<J> = UNIV" "ground (subst_range \<J>)"
         using I(2) unfolding \<J>_def subst_domain_def by auto
 
       show "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<J>)"
         using I(3) unfolding \<J>_def by fastforce
     qed
 
     have 3: "valconsts_only (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] \<union> X) \<J>"
       using init.prems(7) unfolding \<J>_def valconsts_only_def valconst_cases_def by fastforce
 
     have 4: "subst_eq_on_privvals (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] \<union> X) \<J>"
       unfolding subst_eq_on_privvals_def \<J>_def by force
 
     have 5: "subst_in_ik_if_subst_pubval (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] \<union> X) \<J> \<B>"
     proof (unfold subst_in_ik_if_subst_pubval_def; intro ballI impI)
       fix x assume x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] \<union> X" and "\<exists>n. \<I> x = Fun (PubConst Value n) []"
       then obtain n where n: "\<I> x = Fun (PubConst Value n) []" by blast 
 
       have "n \<in> pubvals" using x n unfolding pubvals_def by fastforce
       hence "\<delta> n \<in> T_val_fresh_vals" using \<delta>(2) by fast
       hence "Fun (Val (\<delta> n)) [] \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" using B(6) by fast
       thus "\<J> x \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" using x n unfolding \<J>_def by simp
     qed
 
     have 6: "subst_eq_iff (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] \<union> X) \<J>"
     proof (unfold subst_eq_iff_def; intro ballI)
       fix x y assume "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] \<union> X" "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] \<union> X"
       hence x: "x \<in> X" and y: "y \<in> X" by auto
 
       show "\<I> x = \<I> y \<longleftrightarrow> \<J> x = \<J> y"
       proof
         show "\<I> x = \<I> y \<Longrightarrow> \<J> x = \<J> y" using x y unfolding \<J>_def by presburger
       next
         assume J_eq: "\<J> x = \<J> y" show "\<I> x = \<I> y"
         proof (cases "\<exists>n. \<I> x = Fun (PubConst Value n) []")
           case True
           then obtain n where n: "\<I> x = Fun (PubConst Value n) []" by blast
           hence J_x: "\<J> x = Fun (Val (\<delta> n)) []" using x unfolding \<J>_def by simp
 
           show ?thesis
           proof (cases "\<exists>m. \<I> y = Fun (PubConst Value m) []")
             case True
             then obtain m where m: "\<I> y = Fun (PubConst Value m) []" by blast
             have J_y: "\<J> y = Fun (Val (\<delta> m)) []" using y m unfolding \<J>_def by simp
             show ?thesis using J_eq J_x J_y injD[OF \<delta>(1), of n m] n m by auto
           next
             case False
             then obtain m where m: "\<I> y = Fun (Val m) []"
               using init.prems(7) y unfolding valconst_cases_def by blast
             moreover have "\<delta> n \<in> T_val_fresh_vals" using \<delta>(2) x n unfolding pubvals_def by blast
             moreover have "m \<in> X_vals" using y m unfolding X_vals_def by blast
             ultimately have "\<J> x \<noteq> \<I> y" using m J_x T_val_fresh_vals by auto
             moreover have "\<J> y = \<I> y" using m unfolding \<J>_def by simp
             ultimately show ?thesis using J_eq by argo
           qed
         next
           case False
           then obtain n where n: "\<I> x = Fun (Val n) []"
             using init.prems(7) x unfolding valconst_cases_def by blast
           hence J_x: "\<J> x = \<I> x" unfolding \<J>_def by auto
 
           show ?thesis
           proof (cases "\<exists>m. \<I> y = Fun (PubConst Value m) []")
             case False
             then obtain m where m: "\<I> y = Fun (Val m) []"
               using init.prems(7) y unfolding valconst_cases_def by blast
             have J_y: "\<J> y = \<I> y" using y m unfolding \<J>_def by simp
             show ?thesis using J_x J_y J_eq by presburger
           next
             case True
             then obtain m where m: "\<I> y = Fun (PubConst Value m) []" by blast
             hence "\<J> y = Fun (Val (\<delta> m)) []" using y unfolding \<J>_def by fastforce
             moreover have "\<delta> m \<in> T_val_fresh_vals" using \<delta>(2) y m unfolding pubvals_def by blast
             moreover have "n \<in> X_vals" using x n unfolding X_vals_def by blast
             ultimately have "\<J> y \<noteq> \<I> x" using n J_x T_val_fresh_vals by auto
             thus ?thesis using J_x J_eq by argo
           qed
         qed
       qed
     qed
 
     have 7: "\<forall>n \<in> N. Fun (Val n) [] \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)"
       using B(5,6) T_val_fresh_vals by blast
 
     have 8: "db_upds_consts_fresh [] (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] \<union> X) \<J>" unfolding db_upds_consts_fresh_def by simp
 
     show ?case using B(1) 0 1 2 3 4 5 6 7 8 by blast
   next
     case (step \<A> T \<xi> \<sigma> \<alpha> N X')
     define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
     define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
     define T'_pubvals where "T'_pubvals \<equiv> {n. \<exists>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'. \<I> x = Fun (PubConst Value n) []}"
     define \<A>_vals where "\<A>_vals \<equiv> {n. Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>}"
     define \<I>_vals where "\<I>_vals \<equiv> {n. \<exists>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X' \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'. \<I> x = Fun (Val n) []}"
     define \<sigma>_vals where "\<sigma>_vals \<equiv> {n. Fun (Val n) [] \<in> subst_range \<sigma>}"
 
     have 3: "welltyped_constraint_model \<I> \<A>"
             "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. valconst_cases \<I> x"
             "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'. valconst_cases \<I> x"
             "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> {}) (unlabel T') \<I>"
             "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X'. valconst_cases \<I> x"
       using step.prems(2) welltyped_constraint_model_prefix[OF step.prems(1)]
             step.prems(1)[unfolded welltyped_constraint_model_def constraint_model_def]
             strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" "unlabel T'" \<I>]
             step.prems(7)
       unfolding \<theta>_def[symmetric] T'_def[symmetric] unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append
       by (blast,blast,blast,simp,blast)
 
     note T_adm = bspec[OF P step.hyps(2)]
     note T_wf = admissible_transaction_is_wellformed_transaction[OF T_adm]
     note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T_adm step.hyps(3)]
 
     note 4 = admissible_transaction_sem_iff
     note 5 = iffD1[OF 4[OF T_adm I(2,3), of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> {}" \<theta>,
                         unfolded T'_def[symmetric]]
                       3(4)]
 
     note \<sigma>_dom = transaction_fresh_subst_domain[OF step.hyps(4)]
 
     have \<sigma>_ran: "\<exists>n. t = Fun (Val n) []" when t: "t \<in> subst_range \<sigma>" for t
     proof -
       obtain x where x: "x \<in> set (transaction_fresh T)" "t = \<sigma> x"
         using \<sigma>_dom t by auto
       show ?thesis
         using x(1) admissible_transactionE(2)[OF T_adm]
               transaction_fresh_subst_sends_to_val[OF step.hyps(4) x(1)]
         unfolding x(2) by meson
     qed
 
     have T'_vals_in_\<sigma>: "Fun (Val k) [] \<in> subst_range \<sigma>"
       when k: "Fun (Val k) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for k
     proof -
       have "Fun (Val k) [] \<in> (subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
         using k admissible_transactionE(4)[OF T_adm]
               transaction_decl_fresh_renaming_substs_trms[
                 OF step.hyps(3,4,5), of "transaction_strand T"]
         unfolding T'_def \<theta>_def[symmetric] trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq by fast
       then obtain t where t: "t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms_transaction T" "t \<cdot> \<theta> = Fun (Val k) []" by force
       hence "Fun (Val k) [] \<in> subst_range \<theta>"
         using admissible_transactions_no_Value_consts(1)[OF T_adm] by (cases t) force+
       thus ?thesis
         using transaction_decl_fresh_renaming_substs_range'(4)[OF step.hyps(3,4,5)] \<xi>_empty
         unfolding \<theta>_def[symmetric] by blast
     qed
 
     have \<sigma>_vals_is_T'_vals: "k \<in> \<sigma>_vals \<longleftrightarrow> Fun (Val k) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for k
     proof
       show "k \<in> \<sigma>_vals" when "Fun (Val k) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
         using that T'_vals_in_\<sigma> unfolding \<sigma>_vals_def by blast
 
       show "Fun (Val k) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" when k: "k \<in> \<sigma>_vals"
       proof -
         have "Fun (Val k) [] \<in> subst_range \<sigma>" using k unfolding \<sigma>_vals_def by fast
         then obtain x where x: "x \<in> fv_transaction T" "\<sigma> x = Fun (Val k) []"
           using admissible_transactionE(7)[OF T_adm]
                 transaction_fresh_subst_domain[OF step.hyps(4)]
          unfolding fv_transaction_unfold by fastforce
 
         have "\<theta> x = Fun (Val k) []" using x(2) unfolding \<theta>_def \<xi>_empty subst_compose_def by auto
         thus ?thesis
           using fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t_subst[OF x(1), of \<theta>]
                 admissible_transactionE(4)[OF T_adm]
           unfolding T'_def trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unlabel_subst by simp
       qed
     qed
 
     have \<sigma>_vals_N_disj: "N \<inter> \<sigma>_vals = {}"
       using step.prems(4) \<sigma>_vals_is_T'_vals
       unfolding \<theta>_def[symmetric] T'_def[symmetric] unlabel_append trms\<^sub>s\<^sub>s\<^sub>t_append by blast
 
     have T'_pubvals_finite: "finite T'_pubvals"
       using finite_surj[OF fv\<^sub>s\<^sub>s\<^sub>t_finite[of "unlabel T'"],
                         of T'_pubvals "\<lambda>x. THE n. \<I> x = Fun (PubConst Value n) []"]
       unfolding T'_pubvals_def by force
 
     have \<sigma>_vals_finite: "finite \<sigma>_vals"
     proof -
       have *: "finite (subst_range \<sigma>)" using transaction_fresh_subst_domain[OF step.hyps(4)] by simp
       show ?thesis
         using finite_surj[OF *, of \<sigma>_vals "\<lambda>t. THE n. t = Fun (Val n) []"]
         unfolding \<sigma>_vals_def by force
     qed
 
     have \<A>_vals_finite: "finite \<A>_vals"
     proof -
       have *: "\<A>_vals \<subseteq> (\<lambda>t. THE n. t = Fun (Val n) []) ` subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
         unfolding \<A>_vals_def by force
       show ?thesis
         by (rule finite_surj[OF subterms_union_finite[OF trms\<^sub>s\<^sub>s\<^sub>t_finite] *])
     qed
 
     have \<I>_vals_finite: "finite \<I>_vals"
     proof -
       define X where "X \<equiv> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X' \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
       have *: "finite X" using fv\<^sub>s\<^sub>s\<^sub>t_finite step.prems(6) unfolding X_def by blast
       show ?thesis
         using finite_surj[OF *, of \<I>_vals "\<lambda>x. THE n. \<I> x = Fun (Val n) []"]
         unfolding \<I>_vals_def X_def[symmetric] by force
     qed
 
     obtain T_val_fresh_vals and \<delta>::"nat \<Rightarrow> nat"
       where T_val_fresh_vals: "T_val_fresh_vals \<inter> (N \<union> \<sigma>_vals \<union> \<A>_vals \<union> \<I>_vals) = {}"
         and \<delta>: "inj \<delta>" "\<delta> ` T'_pubvals = T_val_fresh_vals"
       using step.prems(3) T'_pubvals_finite \<sigma>_vals_finite \<A>_vals_finite \<I>_vals_finite
       by (metis finite_UnI ex_finite_disj_nat_inj)
 
     define N' where "N' \<equiv> N \<union> \<sigma>_vals \<union> T_val_fresh_vals"
 
     have T_val_fresh_vals_finite: "finite T_val_fresh_vals"
       using T'_pubvals_finite \<delta>(2) by blast
 
     have N'_finite: "finite N'"
       using step.prems(3) T'_pubvals_finite T_val_fresh_vals_finite \<sigma>_vals_finite
       unfolding N'_def by auto
 
     have \<A>_vals_trms_in: "n \<in> \<A>_vals" when "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" for n
       using that unfolding \<A>_vals_def by blast
 
     have N'_notin_\<A>: "\<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" when n: "n \<in> N'" for n
     proof -
       have ?thesis when n': "n \<in> N"
         using n' step.prems(4) unfolding N'_def unlabel_append trms\<^sub>s\<^sub>s\<^sub>t_append by blast
       moreover have ?thesis when n': "n \<in> \<sigma>_vals"
         using n' step.hyps(4) unfolding \<sigma>_vals_def transaction_fresh_subst_def by blast
       moreover have ?thesis when n': "n \<in> T_val_fresh_vals"
         using n' T_val_fresh_vals \<A>_vals_trms_in by blast
       ultimately show ?thesis using n unfolding N'_def by blast
     qed
 
     have T'_fv_\<A>_disj: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = {}"
       using transaction_decl_fresh_renaming_substs_vars_disj(8)[OF step.hyps(3,4,5)]
             transaction_decl_fresh_renaming_substs_vars_subset(4)[OF step.hyps(3,4,5,2)]
       unfolding \<theta>_def[symmetric] T'_def fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq by blast
 
     have X'_disj: "X' \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}" "X' \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = {}"
       using step.prems(5)
       unfolding \<theta>_def[symmetric] T'_def[symmetric] unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append
       by (blast, blast)
 
     have X'_disj': "(X' \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
       using X'_disj(1) T'_fv_\<A>_disj by blast
 
     have X'_finite: "finite (X' \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
       using step.prems(6) fv\<^sub>s\<^sub>s\<^sub>t_finite by blast
 
     have \<A>_X'_valconstcases: "\<forall>x \<in> X' \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'. valconst_cases \<I> x"
       using 3(3,5) by blast
 
     have T'_value_vars: "\<Gamma>\<^sub>v x = TAtom Value" when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for x
       using x reachable_constraints_fv_Value_typed[
                 OF P reachable_constraints.step[OF step.hyps]]
       unfolding \<theta>_def[symmetric] T'_def[symmetric] unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by blast
 
     have X'_T'_value_vars: "\<forall>x \<in> X' \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'. \<Gamma>\<^sub>v x = TAtom Value"
       using step.prems(8) T'_value_vars by blast
 
     have N'_not_subterms_\<A>: "\<forall>n \<in> N'. \<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
       using N'_notin_\<A> by blast
 
     obtain \<B> \<J> where B:
         "\<B> \<in> reachable_constraints P" "?wt_model \<J> \<B>"
         "valconsts_only (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X' \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<J>" "?rcv_att \<A> n \<longrightarrow> ?rcv_att \<B> n"
         "subst_eq_on_privvals (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X' \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<J>"
         "subst_in_ik_if_subst_pubval (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X' \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<J> \<B>"
         "subst_eq_iff (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X' \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<J>"
         "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>"
         "\<forall>n \<in> N'. \<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)"
         "db_eq \<A> \<B> s_val T_upds"
         "db_upds_consts_fresh \<A> (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X' \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<J>"
       using step.IH[OF 3(1,2) N'_finite N'_not_subterms_\<A> X'_disj' X'_finite
                        \<A>_X'_valconstcases X'_T'_value_vars]
       unfolding Un_assoc by fast
 
     have J:
         "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<J>" "constr_sem_stateful \<J> (unlabel \<B>)"
         "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<J>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<J>)"
       using B(2) unfolding welltyped_constraint_model_def constraint_model_def by blast+
 
     have T_val_fresh_vals_notin_\<B>: "\<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)"
         when "n \<in> T_val_fresh_vals" for n
       using that B(12) unfolding N'_def by blast
     hence "\<forall>n \<in> T_val_fresh_vals. \<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)" by blast
     then obtain T_val_constr::"('fun,'atom,'sets,'lbl) prot_constr"
       where T_val_constr:
           "\<B>@T_val_constr \<in> reachable_constraints P"
           "T_val_constr \<in> reachable_constraints P"
           "T_upds = [] \<Longrightarrow> list_all is_Receive (unlabel T_val_constr)"
           "T_upds \<noteq> [] \<Longrightarrow> list_all (\<lambda>a. is_Insert a \<or> is_Receive a) (unlabel T_val_constr)"
           "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr = {}"
           "\<forall>n. Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<longrightarrow> Fun (Val n) [] \<notin> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr"
           "\<forall>n. Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr \<longrightarrow> Fun (Val n) [] \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr"
           "T_val_fresh_vals = {n. Fun (Val n) [] \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr}"
           "\<forall>l a. (l,a) \<in> set T_val_constr \<and> is_Insert a \<longrightarrow>
                   (l = l2_val \<and> (\<exists>n. a = insert\<langle>Fun (Val n) [],\<langle>s_val\<rangle>\<^sub>s\<rangle>))"
       using reachable_constraints_initial_value_transaction[
               OF P B(1) T_val_fresh_vals_finite _ x_val]
       by blast
 
     have T_val_constr_no_upds_if_no_T_upds:
         "filter is_Update (unlabel T_val_constr) = []"
       when "T_upds = []"
       using T_val_constr(3)[OF that] by (induct T_val_constr) auto
 
     have T_val_fresh_vals_is_T_val_constr_vals:
         "k \<in> T_val_fresh_vals \<longleftrightarrow> Fun (Val k) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr"
       for k
       using that T_val_constr(7,8) ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset by fast
 
     have T_val_constr_no_fv: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr = {}"
       using T_val_constr(5) vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t by fast
 
     have T_val_\<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<B>@T_val_constr))"
     proof -
       have "\<not>(t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<B>@T_val_constr))" when t: "t \<in> subst_range \<sigma>" for t
       proof -
         obtain k where k: "t = Fun (Val k) []" using t \<sigma>_ran by fast
         have "k \<in> \<sigma>_vals" using t unfolding k \<sigma>_vals_def by blast
         thus ?thesis
           using B(12) T_val_fresh_vals T_val_constr(7,8)
           unfolding N'_def k unlabel_append trms\<^sub>s\<^sub>s\<^sub>t_append by blast
       qed
       thus ?thesis using step.hyps(4) unfolding transaction_fresh_subst_def by fast
     qed
 
     have T_val_\<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<B>@T_val_constr))"
       using step.hyps B(8) T_val_constr(5) by auto
 
     define \<B>' where "\<B>' \<equiv> \<B>@T_val_constr@T'"
 
     define \<K> where "\<K> \<equiv> \<lambda>x.
       if x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'
       then if \<exists>n. \<I> x = Fun (PubConst Value n) []
            then if \<exists>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> y = \<I> x
                 then \<J> (SOME y. y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X' \<and> \<I> y = \<I> x)
                 else Fun (Val (\<delta> (THE n. \<I> x = Fun (PubConst Value n) []))) []
            else \<I> x
       else \<J> x"
 
     have \<sigma>_ground_ran: "ground (subst_range \<sigma>)" "range_vars \<sigma> = {}" 
       and \<xi>_ran_bvars_disj: "range_vars \<xi> \<inter> bvars_transaction T = {}"
       using transaction_fresh_subst_domain[OF step.hyps(4)]
             transaction_fresh_subst_range_vars_empty[OF step.hyps(4)]
             transaction_decl_subst_range_vars_empty[OF step.hyps(3)]
       by (metis range_vars_alt_def, argo, blast)
 
     have \<B>_T'_fv_disj: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = {}"
       using T'_fv_\<A>_disj unfolding B(9) by argo
     hence \<J>_\<K>_fv_\<B>_eq: "\<J> x = \<K> x" when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'" for x
       using x X'_disj unfolding \<K>_def by auto
 
     have B'1: "\<B>' \<in> reachable_constraints P"
       using reachable_constraints.step[OF T_val_constr(1) step.hyps(2,3) T_val_\<sigma> T_val_\<alpha>]
       unfolding \<B>'_def T'_def \<theta>_def by simp
 
     have "\<exists>n. \<K> x = Fun (Val n) []" when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<union> X'" for x
     proof (cases "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'")
       case True
       note T = this
       show ?thesis
       proof (cases "\<exists>n. \<I> x = Fun (PubConst Value n) []")
         case True thus ?thesis
           using T B(3,9) someI_ex[of "\<lambda>y. y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X' \<and> \<I> y = \<I> x"]
           unfolding \<K>_def valconsts_only_def
           by (cases "\<exists>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> y = \<I> x") (meson, auto)
       next
         case False thus ?thesis
           using T 3(3) unfolding \<K>_def valconst_cases_def by fastforce
       qed
     next
       case False thus ?thesis using x B(3) unfolding \<K>_def valconsts_only_def by auto
     qed
     hence B'3: "valconsts_only (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<union> X') \<K>" unfolding valconsts_only_def by blast
 
     have B'4: "?rcv_att \<B>' n" when "?rcv_att (\<A>@T') n"
       using that B(4) unfolding \<B>'_def by auto
 
     have "\<I> x = \<K> x" when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<union> X'" "\<I> x = Fun (Val n) []" for x n
     proof -
       have "\<K> x = \<J> x" when "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" using that unfolding \<K>_def by meson
       moreover have "\<K> x = \<I> x" when "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" using that x unfolding \<K>_def by simp
       ultimately show ?thesis
         using B(5) x
         unfolding subst_eq_on_privvals_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append
         by (cases "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'") auto
     qed
     hence B'5: "subst_eq_on_privvals (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<union> X') \<K>"
       unfolding subst_eq_on_privvals_def by blast
 
     have \<A>_fv_\<K>_eq_\<J>: "\<K> x = \<J> x" when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X'" for x
     proof -
       have "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" using x T'_fv_\<A>_disj X'_disj by blast
       thus ?thesis unfolding \<K>_def by argo
     qed
 
     have T'_fv_\<I>_val_\<K>_eq_\<J>: "\<K> x = \<I> x" 
       when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "\<nexists>n. \<I> x = Fun (PubConst Value n) []" for x
       using x B'5 3(3) unfolding unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append valconst_cases_def \<K>_def by meson
 
     have T'_fv_\<I>_pubval_\<K>_eq_\<delta>_fresh_val:
         "\<K> x = Fun (Val (\<delta> n)) []" "\<delta> n \<in> T_val_fresh_vals" 
       when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "\<I> x = Fun (PubConst Value n) []" "\<forall>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> y \<noteq> \<I> x"
       for x n
     proof -
       show "\<K> x = Fun (Val (\<delta> n)) []" using x unfolding \<K>_def by auto
       show "\<delta> n \<in> T_val_fresh_vals" using \<delta>(2) x unfolding T'_pubvals_def by blast
     qed
 
     have T'_fv_\<I>_pubval_\<K>_eq_\<J>_val:
         "\<exists>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<exists>m. \<I> y = \<I> x \<and> \<K> x = \<J> y \<and> \<K> x = Fun (Val m) []"
       when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "\<I> x = Fun (PubConst Value n) []" "\<exists>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> y = \<I> x"
       for x n
     proof -
       have "\<K> x = \<J> (SOME y. y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X' \<and> \<I> y = \<I> x)" using x unfolding \<K>_def by meson
       then obtain y where y: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'" "\<I> y = \<I> x" "\<K> x = \<J> y"
         using x(3) someI_ex[of "\<lambda>y. y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X' \<and> \<I> y = \<I> x"] by blast
       thus ?thesis using B(3,9) unfolding valconsts_only_def by auto
     qed
 
     have T'_fv_\<I>_pubval_\<K>_eq_val: "\<exists>n. \<K> x = Fun (Val n) []"
       when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "\<I> x = Fun (PubConst Value n) []" for x n
       using T'_fv_\<I>_pubval_\<K>_eq_\<delta>_fresh_val[OF x] T'_fv_\<I>_pubval_\<K>_eq_\<J>_val[OF x] by auto
 
     have B'6': "\<K> x \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>"
       when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X'" "\<I> x = Fun (PubConst Value n) []" for x n
       using x B(6) \<A>_fv_\<K>_eq_\<J> x(2) unfolding B(8) subst_in_ik_if_subst_pubval_def by simp
 
     have B'6'': "\<K> x \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr"
       when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "\<I> x = Fun (PubConst Value n) []" for x n
     proof (cases "\<exists>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> y = \<I> x")
       case True thus ?thesis
         using B(6) x(2) T'_fv_\<I>_pubval_\<K>_eq_\<J>_val[OF x True]
         unfolding B(9) subst_in_ik_if_subst_pubval_def by force
     next
       case False thus ?thesis
         using T_val_constr(8) T'_fv_\<I>_pubval_\<K>_eq_\<delta>_fresh_val[OF x] by force
     qed
 
     have "\<K> x \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>'"
       when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<union> X'" "\<I> x = Fun (PubConst Value n) []" for x n
     proof (cases "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'")
       case True thus ?thesis using B'6''[OF _ x(2)] unfolding \<B>'_def by auto
     next
       case False
       hence "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X'"
         using x(1) unfolding unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by blast
       thus ?thesis using B'6' x(2) unfolding \<B>'_def by simp
     qed
     hence B'6: "subst_in_ik_if_subst_pubval (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<union> X') \<K> \<B>'"
       unfolding subst_in_ik_if_subst_pubval_def by blast
 
     have B'7: "subst_eq_iff (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<union> X') \<K>"
     proof (unfold subst_eq_iff_def; intro ballI)
       fix x y assume xy: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<union> X'" "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<union> X'"
 
       let ?Q = "\<lambda>x y. \<I> x = \<I> y \<longleftrightarrow> \<K> x = \<K> y"
 
       have *: "?Q x y"
         when xy: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X'" "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X'" "y \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for x y
         using B(7) xy unfolding \<K>_def subst_eq_iff_def by force
 
       have **: "?Q x y" when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X'" and y: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for x y
       proof -
         have xy_neq: "x \<noteq> y" using x y T'_fv_\<A>_disj X'_disj by blast
 
         have x_eq: "\<K> x = \<J> x"
           using \<A>_fv_\<K>_eq_\<J> x by blast
 
         have x_eq_if_val: "\<I> x = \<J> x" when "\<I> x = Fun (Val n) []" for n
           using that x B(5) unfolding subst_eq_on_privvals_def by blast
 
         have x_neq_if_neq_val: "\<I> x \<noteq> \<J> x" when "\<I> x = Fun (PubConst Value n) []" for n
           by (metis that B(3) x UnI1 prot_fun.distinct(37) term.inject(2) valconsts_only_def)
 
         have y_eq_if_val: "\<I> y = \<K> y" when "\<I> y = Fun (Val n) []" for n
           using that y B'5 unfolding subst_eq_on_privvals_def by simp
 
         have y_eq: "\<K> y = Fun (Val (\<delta> n)) []"
           when "\<I> y = Fun (PubConst Value n) []" "\<forall>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> z \<noteq> \<I> y" for n
           by (rule T'_fv_\<I>_pubval_\<K>_eq_\<delta>_fresh_val(1)[OF y that])
 
         have y_eq': "\<exists>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<exists>m. \<I> z = \<I> y \<and> \<K> y = \<J> z \<and> \<K> y = Fun (Val m) []"
           when "\<I> y = Fun (PubConst Value n) []" "\<exists>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> z = \<I> y" for n
           by (rule T'_fv_\<I>_pubval_\<K>_eq_\<J>_val[OF y that])
 
         have K_eq_if_I_eq: "\<I> x = \<I> y \<Longrightarrow> \<K> x = \<K> y"
           apply (cases "\<exists>n. \<I> x = Fun (PubConst Value n) []")
           subgoal using B(7,9) unfolding subst_eq_iff_def by (metis UnI1 x x_eq y_eq')
           subgoal by (metis x_eq x T'_fv_\<I>_val_\<K>_eq_\<J>[OF y] 3(5) valconst_cases_def x_eq_if_val)
           done
 
         have K_neq_if_I_neq_val: "\<K> x \<noteq> \<K> y"
           when n: "\<I> y = Fun (Val n) []"
             and m: "\<I> x = Fun (PubConst Value m) []"
           for n m
         proof -
           have I_neq: "\<I> x \<noteq> \<I> y" using n m by simp
 
           note y_eq'' = y_eq_if_val[OF n]
           note x_neq = x_neq_if_neq_val[OF m]
 
           have x_ex: "\<exists>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> z = \<I> x" using x unfolding B(9) by blast
           have J1: "\<J> x \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" using B(6) x m unfolding subst_in_ik_if_subst_pubval_def by fast
           have J2: "\<I> x \<noteq> \<J> x"
             by (metis m B(3) x UnI1 prot_fun.distinct(37) term.inject(2) valconsts_only_def)
           have J3: "\<I> y = \<J> y" using B(5) n y unfolding subst_eq_on_privvals_def by blast
           have K_x: "\<K> x \<noteq> \<I> x" using J2 x_eq by presburger
           have x_notin: "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" using x T'_fv_\<A>_disj X'_disj by blast
           have K_x': "\<K> x = \<J> x" using x_notin unfolding \<K>_def by argo
           have K_y: "\<K> y = \<J> y" using y_eq'' J3 by argo
 
           have "\<J> x \<noteq> \<J> y" using I_neq x y B(7) unfolding subst_eq_iff_def by blast
           thus ?thesis using K_x' K_y by argo
         qed
 
         show ?thesis
         proof
           show "\<I> x = \<I> y \<Longrightarrow> \<K> x = \<K> y" by (rule K_eq_if_I_eq)
         next
           assume xy_eq: "\<K> x = \<K> y" show "\<I> x = \<I> y"
           proof (cases "\<exists>n. \<I> y = Fun (PubConst Value n) []")
             case True
             then obtain n where n: "\<I> y = Fun (PubConst Value n) []" by blast
 
             show ?thesis
             proof (cases "\<exists>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> z = \<I> y")
               case True thus ?thesis
                 using B(7,9) unfolding subst_eq_iff_def by (metis xy_eq UnI1 x x_eq y_eq'[OF n])
             next
               case False
               hence F: "\<forall>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> z \<noteq> \<I> y" by blast
               note y_eq'' = y_eq[OF n F]
 
               have n_in: "\<delta> n \<in> T_val_fresh_vals"
                 using  \<delta>(2) x_eq xy_eq T_val_fresh_vals_notin_\<B> y n
                 unfolding T'_pubvals_def by blast
               hence y_notin: "\<not>(\<K> y \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)"
                 using T_val_fresh_vals_notin_\<B> y_eq'' ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel \<B>"]
                 by auto
 
               show ?thesis
               proof (cases "\<exists>m. \<I> x = Fun (PubConst Value m) []")
                 case True thus ?thesis
                   using y_notin B(6) x xy_eq x_eq
                   unfolding B(9) subst_in_ik_if_subst_pubval_def
                   by fastforce
               next
                 case False
                 then obtain m where m: "\<I> x = Fun (Val m) []"
                   using 3(5) x unfolding valconst_cases_def by fast
                 hence "\<I> x = \<J> x" using x B(5) unfolding subst_eq_on_privvals_def by blast
                 hence "\<K> x = Fun (Val m) []" using m x_eq by argo
                 moreover have "m \<notin> T_val_fresh_vals"
                   using m T_val_fresh_vals x unfolding \<I>_vals_def by blast
                 hence "m \<noteq> \<delta> n" using n_in by blast
                 ultimately have False using xy_eq y_eq'' by force
                 thus ?thesis by simp
               qed
             qed
           next
             case False
             then obtain n where n: "\<I> y = Fun (Val n) []"
               using 3(3) y unfolding valconst_cases_def by fast
 
             note y_eq'' = y_eq_if_val[OF n]
 
             show ?thesis
             proof (cases "\<exists>m. \<I> x = Fun (Val m) []")
               case True thus ?thesis by (metis xy_eq x_eq y_eq'' x_eq_if_val)
             next
               case False 
               then obtain m where m: "\<I> x = Fun (PubConst Value m) []"
                 using 3(5) x unfolding valconst_cases_def by blast
 
               show ?thesis using K_neq_if_I_neq_val[OF n m] xy_eq by blast
             qed
           qed
         qed
       qed
 
       have ***: "?Q x y" when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" and y: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for x y
       proof
         assume xy_eq: "\<I> x = \<I> y" show "\<K> x = \<K> y"
         proof (cases "\<exists>n. \<I> x = Fun (PubConst Value n) []")
           case True thus ?thesis
             using xy_eq x y B(7) T'_fv_\<I>_pubval_\<K>_eq_\<delta>_fresh_val(1) T'_fv_\<I>_pubval_\<K>_eq_\<J>_val
             unfolding B(9) subst_eq_iff_def by (metis (no_types) UnI1)
         qed (metis xy_eq x y T'_fv_\<I>_val_\<K>_eq_\<J>)
       next
         assume xy_eq: "\<K> x = \<K> y"
 
         have case1: False
           when x': "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
             and y': "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
             and xy_eq': "\<K> x = \<K> y"
             and m: "\<I> x = Fun (PubConst Value m) []"
             and n: "\<I> y = Fun (Val n) []"
           for x y n m
         proof -
           have F: "\<nexists>n. \<I> y = Fun (PubConst Value n) []" using n by auto
 
           note x_eq = T'_fv_\<I>_pubval_\<K>_eq_\<delta>_fresh_val[OF x' m]
           note y_eq = T'_fv_\<I>_val_\<K>_eq_\<J>[OF y' F]
 
           have "\<exists>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> z = \<I> x"
           proof (rule ccontr)
             assume no_z: "\<not>(\<exists>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> z = \<I> x)"
             hence "n \<noteq> \<delta> m" using n y' x_eq(2) T_val_fresh_vals unfolding \<I>_vals_def by blast
             thus False using xy_eq' x_eq y_eq(1) n no_z by auto
           qed
           then obtain z k where z:
               "z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'" "\<I> z = \<I> x" "\<K> x = \<J> z" "\<K> x = Fun (Val k) []"
             using T'_fv_\<I>_pubval_\<K>_eq_\<J>_val[OF x' m] by blast
 
           have "\<I> y = \<J> z" using z(2,3) y_eq xy_eq' by presburger
           hence "\<I> x = \<I> y" using z(1,2) ** B(9) \<J>_\<K>_fv_\<B>_eq y' y_eq by metis
           thus False using n m by simp
         qed
 
         have case2: "m = n"
           when x': "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
             and y': "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
             and xy_eq': "\<K> x = \<K> y"
             and m: "\<I> x = Fun (PubConst Value m) []"
             and n: "\<I> y = Fun (PubConst Value n) []"
           for x y n m
         proof (cases "\<forall>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> z \<noteq> \<I> x")
           case True show ?thesis
             apply (cases "\<forall>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> X'. \<I> z \<noteq> \<I> y")
             subgoal
               using xy_eq' m n T'_fv_\<I>_pubval_\<K>_eq_\<delta>_fresh_val[OF x' m True]
                     T'_fv_\<I>_pubval_\<K>_eq_\<delta>_fresh_val[OF y' n] injD[OF \<delta>(1), of m n]
               by fastforce
             subgoal by (metis x' y' xy_eq' ** B(9) True)
             done
         qed (metis x' y' xy_eq' m n ** B(9) prot_fun.inject(6) term.inject(2))
 
         have case3: "m = n"
           when x': "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
             and y': "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
             and xy_eq': "\<K> x = \<K> y"
             and m: "\<I> x = Fun (Val m) []"
             and n: "\<I> y = Fun (Val n) []"
           for x y n m
           using x' y' xy_eq' m n T'_fv_\<I>_val_\<K>_eq_\<J> by fastforce
 
         show "\<I> x = \<I> y"
           using x y xy_eq case1 case2 case3 3(3)
           unfolding valconst_cases_def by metis
       qed
 
       have ****: "?Q x y" when xy: "x \<in> X'" "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for x y
       proof -
         have xy': "y \<notin> X'" "y \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
           using xy X'_disj T'_fv_\<A>_disj by (blast, blast, blast)
 
         have K_x: "\<K> x = \<J> x" using xy(2) unfolding \<K>_def by argo
 
         have I_iff_J: "\<I> x = \<I> y \<longleftrightarrow> \<J> x = \<J> y" using xy B(7) unfolding subst_eq_iff_def by fast
 
         show ?thesis using K_x I_iff_J K_x injD[OF \<delta>(1)] xy B(7,9) ** by (meson UnCI)
       qed
 
       show "?Q x y"
         using xy * **[of x y] **[of y x] ***[of x y] ****[of x y] ****[of y x]
         unfolding unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by (metis Un_iff)
     qed
 
     have B'8_9: "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>'" "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>'"
       using B(8,9) T_val_constr(5) vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel T_val_constr"]
       unfolding \<B>'_def unlabel_append vars\<^sub>s\<^sub>s\<^sub>t_append fv\<^sub>s\<^sub>s\<^sub>t_append by simp_all
 
     have I': "\<exists>n. \<I> x = Fun (PubConst Value n) []"
       when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "\<nexists>n. \<I> x = Fun (Val n) []" for x
       using x 3(3) unfolding valconst_cases_def by fast
 
     have B'10_11: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<subseteq> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>'" "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<subseteq> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>'"
       using B(10,11) unfolding N'_def \<B>'_def unlabel_append trms\<^sub>s\<^sub>s\<^sub>t_append ik\<^sub>s\<^sub>s\<^sub>t_append
       by (blast, blast)
 
     have B'12: "\<forall>n \<in> N. \<not>(Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>')"
       using B(12) \<sigma>_vals_is_T'_vals \<sigma>_vals_N_disj T_val_fresh_vals
             T_val_fresh_vals_is_T_val_constr_vals
       unfolding N'_def \<B>'_def unfolding unlabel_append trms\<^sub>s\<^sub>s\<^sub>t_append ik\<^sub>s\<^sub>s\<^sub>t_append by fast
 
     have B'13: "db_eq (\<A>@T') \<B>' s_val T_upds"
     proof -
       let ?f = "filter is_Update \<circ> unlabel"
       let ?g = "filter (\<lambda>a. \<nexists>l t ts. a = (l, insert\<langle>t,Fun (Set s_val) ts\<rangle>))"
 
       have "?f (?g T_val_constr) = []" using T_val_constr(3,4,9)
       proof (induction T_val_constr)
         case (Cons a B)
         then obtain l b where a: "a = (l,b)" by (metis surj_pair)
   
         have IH: "?f (?g B) = []" using Cons.prems Cons.IH by auto
 
         show ?case
         proof (cases "T_upds = []")
           case True
           hence "is_Receive b" using a Cons.prems(1,2) by simp
           thus ?thesis using IH unfolding a Let_def by auto
         next
           case False
           hence "is_Insert b \<or> is_Receive b" using a Cons.prems(1,2) by simp
           hence "\<exists>t. a = (l2_val, insert\<langle>t,\<langle>s_val\<rangle>\<^sub>s\<rangle>)" when b: "\<not>is_Receive b"
             using b Cons.prems(3) unfolding a by (metis list.set_intros(1))
           thus ?thesis using IH unfolding a Let_def by auto
         qed
       qed simp
       hence "?f (?g (\<A>@T')) = ?f (?g \<A>)@?f (?g T')"
             "?f (?g (\<B>@T_val_constr@T')) = ?f (?g \<B>)@?f (?g T')"
         when "T_upds \<noteq> []"
         by simp_all
       moreover have "?f T_val_constr = []" when "T_upds = []"
         using T_val_constr_no_upds_if_no_T_upds[OF that] by force
       hence "?f (\<A>@T') = ?f \<A>@?f T'"
             "?f (\<B>@T_val_constr@T') = ?f \<B>@?f T'"
         when "T_upds = []"
         using that by auto
       ultimately show ?thesis using B(13) unfolding \<B>'_def db_eq_def Let_def by presburger  
     qed
 
     have B'14: "db_upds_consts_fresh (\<A>@T') (fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<union> X') \<K>"
     proof (unfold db_upds_consts_fresh_def; intro ballI allI impI; elim exE)
       fix x s n m
       assume x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<union> X'"
         and n: "insert\<langle>Fun (Val n) [],s\<rangle> \<in> set (unlabel (\<A>@T')) \<or>
                 delete\<langle>Fun (Val n) [],s\<rangle> \<in> set (unlabel (\<A>@T'))"
               (is "?A (\<A>@T')")
         and m: "\<I> x = Fun (PubConst Value m) []"
 
       have A_cases: "?A \<A> \<or> ?A T'" using n by force
 
       have n_in_case: "n \<in> \<sigma>_vals" when A: "?A T'"
       proof -
         obtain t s' where t:
           "insert\<langle>t,s'\<rangle> \<in> set (unlabel (transaction_strand T)) \<or>
            delete\<langle>t,s'\<rangle> \<in> set (unlabel (transaction_strand T))"
           "Fun (Val n) [] = t \<cdot> \<theta>"
         using A dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(4,5)
               stateful_strand_step_mem_substD(4,5)[of _ _ _ \<theta>]
               subst_lsst_unlabel[of _ \<theta>]
         unfolding T'_def by (metis (no_types, opaque_lifting))
 
         have "Fun (Val n) [] \<in> subst_range \<theta>"
           using t transaction_inserts_are_Value_vars(1)[OF T_wf(1,3), of t s']
                 transaction_deletes_are_Value_vars(1)[OF T_wf(1,3), of t s']
           by force
         hence "Fun (Val n) [] \<in> subst_range \<sigma>"
           using transaction_decl_fresh_renaming_substs_range'(4)[
                   OF step.hyps(3,4,5) _ \<xi>_empty]
           unfolding \<theta>_def by blast
         thus ?thesis unfolding \<sigma>_vals_def by fast
       qed
 
       have in_A_case: "\<K> x \<noteq> Fun (Val n) []"
         when y: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X'" "\<I> x = \<I> y" "\<K> x = \<J> y" for y
         using A_cases
       proof
         assume "?A \<A>" thus ?thesis
           using B(14) m y(1,3) unfolding db_upds_consts_fresh_def y(2) by auto
       next
         assume "?A T'"
         hence "n \<in> N'" using n_in_case unfolding N'_def by blast
         moreover have "\<J> y \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>"
           using B(6) y(1) m ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset
           unfolding y(2) subst_in_ik_if_subst_pubval_def by blast
         ultimately show ?thesis using B(12) y(3) by fastforce
       qed
 
       show "\<K> x \<noteq> Fun (Val n) []"
       proof (cases "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'")
         case True
         note 0 = T'_fv_\<I>_pubval_\<K>_eq_\<delta>_fresh_val[OF True m, unfolded B(9)[symmetric]]
         note 1 = T'_fv_\<I>_pubval_\<K>_eq_\<J>_val[OF True m, unfolded B(9)[symmetric]]
 
         show ?thesis
         proof (cases "\<forall>y\<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X'. \<I> y \<noteq> \<I> x")
           case True show ?thesis
             using A_cases 0[OF True] T_val_fresh_vals n_in_case
             unfolding \<A>_vals_def by force
         next
           case False
           then obtain y where "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X'" "\<I> y = \<I> x" "\<K> x = \<J> y" using 1 by blast
           thus ?thesis using in_A_case by auto
         qed
       next
         case False
         hence x_in: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> X'" using x unfolding unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by fast
         hence x_eq: "\<K> x = \<J> x" using \<A>_fv_\<K>_eq_\<J> by blast
 
         show ?thesis using in_A_case[OF x_in _ x_eq] by blast
       qed
     qed
 
     have B'2: "?wt_model \<K> \<B>'"
     proof (unfold welltyped_constraint_model_def; intro conjI)
       have "\<Gamma> (\<K> x) = \<Gamma>\<^sub>v x" for x
       proof -
         have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<J>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
           using B(2) 3(1) unfolding welltyped_constraint_model_def by (blast,blast)
         hence *: "\<And>y. \<Gamma> (\<J> y) = \<Gamma>\<^sub>v y" "\<And>y. \<Gamma> (\<I> y) = \<Gamma>\<^sub>v y" unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by auto
 
         show ?thesis
         proof (cases "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'")
           case True
           note x = this
           show ?thesis
           proof (cases "\<exists>n. \<I> x = Fun (PubConst Value n) []")
             case True thus ?thesis using T'_fv_\<I>_pubval_\<K>_eq_val[OF x] T'_value_vars[OF x] by force
           next
             case False thus ?thesis using x * unfolding \<K>_def by presburger
           qed
         next
           case False thus ?thesis using *(1) unfolding \<K>_def by presburger
         qed
       qed
       thus "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<K>" unfolding \<K>_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by force
 
       show "constraint_model \<K> \<B>'"
       proof (unfold constraint_model_def; intro conjI)
         have *: "strand_sem_stateful {} {} (unlabel \<A>) \<I>"
                 "strand_sem_stateful {} {} (unlabel \<B>) \<J>"
                 "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<J>"
                 "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<J>)"
           using B(2) 3(1) unfolding welltyped_constraint_model_def constraint_model_def by fast+
 
         show K0: "subst_domain \<K> = UNIV"
         proof -
           have "x \<in> subst_domain \<K>" for x
           proof (cases "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'")
             case True thus ?thesis
               using T'_fv_\<I>_pubval_\<K>_eq_val[OF True] T'_fv_\<I>_val_\<K>_eq_\<J>[OF True] *(3)
               unfolding subst_domain_def by (cases "\<exists>n. \<I> x = Fun (PubConst Value n) []") auto
           next
             case False thus ?thesis using *(4) unfolding \<K>_def subst_domain_def by auto
           qed
           thus ?thesis by blast
         qed
 
         have "fv (\<K> x) = {}" for x
           using interpretation_grounds_all[OF *(3)]
                 interpretation_grounds_all[OF *(4)]
           unfolding \<K>_def by simp
         thus K1: "ground (subst_range \<K>)" by simp
 
         have "wf\<^sub>t\<^sub>r\<^sub>m (Fun (Val n) [])" for n by fastforce
         moreover have "wf\<^sub>t\<^sub>r\<^sub>m (\<I> x)" "wf\<^sub>t\<^sub>r\<^sub>m (\<J> x)" for x using *(5,6) by (fastforce,fastforce)
         ultimately have "wf\<^sub>t\<^sub>r\<^sub>m (\<K> x)" for x unfolding \<K>_def by auto
         thus K2: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<K>)" by simp
 
         show "strand_sem_stateful {} {} (unlabel \<B>') \<K>"
         proof (unfold \<B>'_def unlabel_append strand_sem_append_stateful Un_empty_left; intro conjI)
           let ?sem = "\<lambda>M D A. strand_sem_stateful M D (unlabel A) \<K>"
           let ?M1 = "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<K>"
           let ?M2 = "?M1 \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr \<cdot>\<^sub>s\<^sub>e\<^sub>t \<K>)"
           let ?D1 = "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<B>) \<K> {}"
           let ?D2 = "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel T_val_constr) \<K> ?D1"
 
           show "?sem {} {} \<B>"
             using \<J>_\<K>_fv_\<B>_eq strand_sem_model_swap[OF _ *(2)] by blast
 
           show "?sem ?M1 ?D1 T_val_constr"
             using T_val_constr(3,4) strand_sem_stateful_if_no_send_or_check
             unfolding list_all_iff by blast
 
           have D2: "?D2 = ?D1 \<union> {(t \<cdot> \<K>, s \<cdot> \<K>) | t s. insert\<langle>t,s\<rangle> \<in> set (unlabel T_val_constr)}"
             using T_val_constr(3,4) dbupd\<^sub>s\<^sub>s\<^sub>t_no_deletes
             unfolding list_all_iff by blast
 
           have K3: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<K>"
             using K0 K1 by argo
 
           have rcv_\<theta>_is_\<alpha>: "t \<cdot> \<theta> = t \<cdot> \<alpha>"
             when t: "(l,receive\<langle>ts\<rangle>) \<in> set (transaction_receive T)" "t \<in> set ts" for l ts t
           proof -
             have "fv t \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
               using t(2) stateful_strand_step_fv_subset_cases(2)[OF unlabel_in[OF t(1)]] by auto
             hence "t \<cdot> \<sigma> = t" using t \<sigma>_dom \<sigma>_ran admissible_transactionE(12,13)[OF T_adm] by blast
             thus ?thesis unfolding \<theta>_def \<xi>_empty by simp
           qed
       
           have eq_\<theta>_is_\<alpha>: "t \<cdot> \<theta> = t \<cdot> \<alpha>" "s \<cdot> \<theta> = s \<cdot> \<alpha>"
             when t: "(l,\<langle>ac: t \<doteq> s\<rangle>) \<in> set (transaction_checks T)" for l ac t s
           proof -
             have "fv t \<union> fv s \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
               using stateful_strand_step_fv_subset_cases(3)[OF unlabel_in[OF t]] by auto
             hence "t \<cdot> \<sigma> = t" "s \<cdot> \<sigma> = s"
               using t \<sigma>_dom \<sigma>_ran admissible_transactionE(12,13)[OF T_adm] by (blast, blast)
             thus "t \<cdot> \<theta> = t \<cdot> \<alpha>" "s \<cdot> \<theta> = s \<cdot> \<alpha>" unfolding \<theta>_def \<xi>_empty by simp_all
           qed
 
           have noteq_\<theta>_is_\<alpha>: "t \<cdot> \<theta> = t \<cdot> \<alpha>" "s \<cdot> \<theta> = s \<cdot> \<alpha>"
             when t: "(l,\<langle>t != s\<rangle>) \<in> set (transaction_checks T)" for l t s
           proof -
             have "fv t \<union> fv s \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
               using stateful_strand_step_fv_subset_cases(8)[OF unlabel_in[OF t]] by auto
             hence "t \<cdot> \<sigma> = t" "s \<cdot> \<sigma> = s"
               using t \<sigma>_dom \<sigma>_ran admissible_transactionE(12,13)[OF T_adm] by (blast, blast)
             thus "t \<cdot> \<theta> = t \<cdot> \<alpha>" "s \<cdot> \<theta> = s \<cdot> \<alpha>" unfolding \<theta>_def \<xi>_empty by simp_all
           qed
 
           have in_\<theta>_is_\<alpha>: "t \<cdot> \<theta> = t \<cdot> \<alpha>" "s \<cdot> \<theta> = s \<cdot> \<alpha>"
             when t: "(l,\<langle>ac: t \<in> s\<rangle>) \<in> set (transaction_checks T)" for l ac t s
           proof -
             have "fv t \<union> fv s \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
               using stateful_strand_step_fv_subset_cases(6)[OF unlabel_in[OF t]] by auto
             hence "t \<cdot> \<sigma> = t" "s \<cdot> \<sigma> = s"
               using t \<sigma>_dom \<sigma>_ran admissible_transactionE(12,13)[OF T_adm] by (blast, blast)
             thus "t \<cdot> \<theta> = t \<cdot> \<alpha>" "s \<cdot> \<theta> = s \<cdot> \<alpha>" unfolding \<theta>_def \<xi>_empty by simp_all
           qed
 
           have notin_\<theta>_is_\<alpha>: "t \<cdot> \<theta> = t \<cdot> \<alpha>" "s \<cdot> \<theta> = s \<cdot> \<alpha>"
             when t: "(l,\<langle>t not in s\<rangle>) \<in> set (transaction_checks T)" for l t s
           proof -
             have "fv t \<union> fv s \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
               using stateful_strand_step_fv_subset_cases(9)[OF unlabel_in[OF t]] by auto
             hence "t \<cdot> \<sigma> = t" "s \<cdot> \<sigma> = s"
               using t \<sigma>_dom \<sigma>_ran admissible_transactionE(12,13)[OF T_adm] by (blast, blast)
             thus "t \<cdot> \<theta> = t \<cdot> \<alpha>" "s \<cdot> \<theta> = s \<cdot> \<alpha>" unfolding \<theta>_def \<xi>_empty by simp_all
           qed
 
           have T'_trm_no_val: "\<nexists>n. s = Fun (Val n) [] \<or> s = Fun (PubConst Value n) []"
             when t: "t \<in> trms_transaction T" "s \<sqsubseteq> t \<cdot> \<alpha>" for t s
           proof -
             have ?thesis when "s \<sqsubseteq> t"
               using that t admissible_transactions_no_Value_consts'[OF T_adm]
                     admissible_transactions_no_PubConsts[OF T_adm]
               by blast
             moreover have "Fun k [] \<sqsubseteq> u" when "Fun k [] \<sqsubseteq> u \<cdot> \<alpha>" for k u using that
             proof (induction u)
               case (Var x) thus ?case
                 using transaction_renaming_subst_is_renaming(2)[OF step.hyps(5), of x] by fastforce
             qed auto
             ultimately show ?thesis using t by blast
           qed
 
           define flt1 where "flt1 \<equiv> \<lambda>A::('fun,'atom,'sets,'lbl) prot_constr.
                                       filter is_Update (unlabel A)"
           define flt2 where "flt2 \<equiv> \<lambda>A::('fun,'atom,'sets,'lbl) prot_constr.
                                       filter (\<lambda>a. \<nexists>l t ts. a = (l, insert\<langle>t,\<langle>s_val\<langle>ts\<rangle>\<rangle>\<^sub>s\<rangle>)) A"
           define flt3 where "flt3 \<equiv> \<lambda>A::(('fun,'atom,'sets,'lbl) prot_fun,
                                           ('fun,'atom,'sets,'lbl) prot_var) stateful_strand.
                                       filter (\<lambda>a. \<nexists>t ts. a = insert\<langle>t,\<langle>s_val\<langle>ts\<rangle>\<rangle>\<^sub>s\<rangle>) A"
 
           have flt2_subset: "set (unlabel (flt2 A)) \<subseteq> set (unlabel A)" for A
             unfolding flt2_def unlabel_def by auto
 
           have flt2_unlabel: "unlabel (flt2 A) = flt3 (unlabel A)" for A
             unfolding flt2_def flt3_def by (induct A) auto
 
           have flt2_suffix:
               "suffix (filter (\<lambda>a. \<nexists>t ts. a = insert\<langle>t,\<langle>s_val\<langle>ts\<rangle>\<rangle>\<^sub>s\<rangle>) A) (unlabel (flt2 B))"
             when "suffix A (unlabel B)" for A B
             using that unfolding flt2_def by (induct B arbitrary: A rule: List.rev_induct) auto
 
           have flt_AB: "flt1 (flt2 \<A>) = flt1 (flt2 \<B>)"
           proof -
             have *: "flt1 (flt2 \<A>) = filter is_Update (flt3 (unlabel \<A>))"
                     "flt1 (flt2 \<B>) = filter is_Update (flt3 (unlabel \<B>))"
               using flt2_unlabel unfolding flt1_def by presburger+
 
             have **: "filter is_Update (flt3 C) = flt3 (filter is_Update C)" for C
             proof (induction C)
               case Nil thus ?case unfolding flt3_def by force
             next
               case (Cons c C) thus ?case unfolding flt3_def by (cases c) auto
             qed
 
             show ?thesis
             proof (cases "T_upds = []")
               case True
               hence "filter is_Update (unlabel \<A>) = filter is_Update (unlabel \<B>)"
                 using B(13) unfolding db_eq_def by fastforce
               thus ?thesis using ** unfolding * by presburger
             next
               case False thus ?thesis
                 using B(13) unfolding flt1_def flt2_def db_eq_def Let_def by force
             qed
           qed
 
           have A_setops_Fun: "\<forall>t s. insert\<langle>t,s\<rangle> \<in> set (unlabel \<A>) \<longrightarrow> (\<exists>g ts. s = Fun g ts)"
             using reachable_constraints_setops_form[OF step.hyps(1) P]
             unfolding setops\<^sub>s\<^sub>s\<^sub>t_def by fastforce
 
           have A_insert_delete_not_subterm:
               "\<I> x = \<K> x \<or> (\<not>(\<I> x \<sqsubseteq> t) \<and> \<not>(\<I> x \<sqsubseteq> s) \<and> \<not>(\<K> x \<sqsubseteq> t) \<and> \<not>(\<K> x \<sqsubseteq> s))"
             when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<union> fv t \<union> fv s"
               and x_neq: "\<I> x \<noteq> \<K> x"
               and ts: "insert\<langle>t,s\<rangle> \<in> set (unlabel \<A>) \<or> delete\<langle>t,s\<rangle> \<in> set (unlabel \<A>)"
             for x t s
           proof -
             have x_in: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
               using ts x stateful_strand_step_fv_subset_cases(4,5) by blast
 
             note ts' = reachable_constraints_insert_delete_form[OF step.hyps(1) P ts]
 
             have *: "\<I> x = \<K> x" when n: "\<I> x = Fun (Val n) []" for n
               using n B'5 x_in
               unfolding subst_eq_on_privvals_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append
               by blast
 
             have **: "\<not>(\<I> x \<sqsubseteq> t)" "\<not>(\<I> x \<sqsubseteq> s)" "\<not>(\<K> x \<sqsubseteq> t)" "\<not>(\<K> x \<sqsubseteq> s)"
               when n: "\<I> x = Fun (PubConst Value n) []" for n
             proof -
               show "\<not>(\<I> x \<sqsubseteq> s)"
                 using ts'(1) x_in 3(2,3) unfolding valconst_cases_def by fastforce
 
               show "\<not>(\<K> x \<sqsubseteq> s)"
                 using ts'(1) x_in B'3
                 unfolding valconsts_only_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by force
 
               show "\<not>(\<I> x \<sqsubseteq> t)" using n ts'(3) by fastforce
 
               from ts'(3) have "\<K> x \<noteq> t"
               proof
                 assume "\<exists>y. t = Var y" thus ?thesis
                   using B'3 x_in unfolding valconsts_only_def by force
               next
                 assume "\<exists>k. t = Fun (Val k) []" thus ?thesis
                   using B'14 n x_in ts unfolding db_upds_consts_fresh_def by auto
               qed
               thus "\<not>(\<K> x \<sqsubseteq> t)" using ts'(3) by auto
             qed
 
             show ?thesis using * ** 3(2,3) x_in unfolding valconst_cases_def by fast
           qed
 
           have flt2_insert_in_iff:
               "insert\<langle>u,v\<rangle> \<in> set (unlabel A) \<longleftrightarrow> insert\<langle>u,v\<rangle> \<in> set (unlabel (flt2 A))"
             (is "?A A \<longleftrightarrow> ?B A")
             when h: "s = \<langle>h\<rangle>\<^sub>s" "h \<noteq> s_val" and t: "(t \<cdot> I,s \<cdot> I) = (u,v) \<cdot>\<^sub>p I"
             for t s h u v A and I::"('fun,'atom,'sets,'lbl) prot_subst"
           proof
             show "?B A \<Longrightarrow> ?A A" using flt2_subset by fast
             show "?A A \<Longrightarrow> ?B A"
             proof (induction A)
               case (Cons a A)
               obtain l b where a: "a = (l,b)" by (metis surj_pair)
               show ?case
               proof (cases "b = insert\<langle>u,v\<rangle>")
                 case True thus ?thesis using h t unfolding a flt2_def by force
               next
                 case False thus ?thesis using Cons.prems Cons.IH unfolding a flt2_def by auto
               qed
             qed simp
           qed
 
           have flt2_inset_iff:
               "(t \<cdot> \<K>, s \<cdot> \<K>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (flt2 \<B>)) \<K> {} \<longleftrightarrow>
                (t \<cdot> \<K>, s \<cdot> \<K>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<B>) \<K> {}"
             (is "?A \<longleftrightarrow> ?B")
             when h: "s = \<langle>h\<rangle>\<^sub>s" "h \<noteq> s_val"
             for t s h
           proof
             let ?C1 = "\<lambda>u v B C. suffix (delete\<langle>u,v\<rangle>#B) (unlabel C)"
             let ?C2 = "\<lambda>t s u v. (t,s) = (u,v) \<cdot>\<^sub>p \<K>"
             let ?C3 = "\<lambda>t s C. \<exists>u v. ?C2 t s u v \<and> insert\<langle>u,v\<rangle> \<in> set C"
             let ?D = "\<lambda>t s C. \<forall>u v B. ?C1 u v B C \<and> ?C2 t s u v \<longrightarrow> ?C3 t s B"
 
             let ?db = "\<lambda>C D. dbupd\<^sub>s\<^sub>s\<^sub>t C \<K> D"
 
             have "?C3 t s B"
               when "?D t s (flt2 \<B>)" "?C1 u v B \<B>" "?C2 t s u v" for u v B t s
               using that flt2_suffix flt2_subset by fastforce
             thus "?A \<Longrightarrow> ?B" using flt2_subset unfolding dbupd\<^sub>s\<^sub>s\<^sub>t_in_iff by blast
 
             show ?A when ?B using that
             proof (induction \<B> rule: List.rev_induct)
               case (snoc a A)
               obtain l b where a: "a = (l,b)" by (metis surj_pair)
 
               have *:
                   "?db (unlabel (A@[a])) {} = ?db [b] (?db (unlabel A) {})"
                   "?db (unlabel (flt2 (A@[a]))) {} =
                    ?db (unlabel (flt2 [a])) (?db (unlabel (flt2 A)) {})"
                 using dbupd\<^sub>s\<^sub>s\<^sub>t_append[of _ _ \<K> "{}"] unfolding a flt2_def by auto
 
               show ?case
               proof (cases "\<exists>u v. b = insert\<langle>u,v\<rangle> \<and> (t \<cdot> \<K>, s \<cdot> \<K>) = (u,v) \<cdot>\<^sub>p \<K>")
                 case True
                 then obtain u v where "b = insert\<langle>u,v\<rangle>" "(t \<cdot> \<K>, s \<cdot> \<K>) = (u, v) \<cdot>\<^sub>p \<K>" by force
                 thus ?thesis using h *(2) unfolding a flt2_def by auto
               next
                 case False
                 hence IH: "(t \<cdot> \<K>, s \<cdot> \<K>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (flt2 A)) \<K> {}"
                   using snoc.prems snoc.IH unfolding *(1) by (cases b) auto
 
                 show ?thesis
                 proof (cases "is_Delete b")
                   case True
                   then obtain u v where b: "b = delete\<langle>u,v\<rangle>" by (cases b) auto
 
                   have b': "unlabel (flt2 [a]) = [b]"
                            "unlabel (flt2 (A@[a])) = unlabel (flt2 A)@[b]"
                     unfolding a flt2_def b by (fastforce,fastforce)
 
                   have "(t \<cdot> \<K>, s \<cdot> \<K>) \<noteq> (u,v) \<cdot>\<^sub>p \<K>" using *(1) snoc.prems unfolding b' b by simp
                   thus ?thesis using *(2) IH unfolding b' b by simp
                 next
                   case False thus ?thesis using *(2) IH unfolding a flt2_def by (cases b) auto
                 qed
               qed
             qed simp
           qed
 
           have inset_model_swap:
               "(t \<cdot> \<I>, s \<cdot> \<I>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> {} \<longleftrightarrow>
                (t \<cdot> \<K>, s \<cdot> \<K>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<B>) \<K> {}"
             (is "?in \<I> (unlabel \<A>) \<longleftrightarrow> ?in \<K> (unlabel \<B>)")
             when h: "s = \<langle>h\<rangle>\<^sub>s"
                     "h \<noteq> s_val \<or> filter is_Update (unlabel \<A>) = filter is_Update (unlabel \<B>)"
               and t: "t = Var tx"
               and t_s_fv: "fv t \<union> fv s \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
               and q: "\<forall>x \<in> fv t \<union> fv s.
                         \<I> x = \<K> x \<or> (\<not>(\<I> x \<sqsubseteq> t) \<and> \<not>(\<I> x \<sqsubseteq> s) \<and> \<not>(\<K> x \<sqsubseteq> t) \<and> \<not>(\<K> x \<sqsubseteq> s))"
                      "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv t \<union> fv s. \<exists>c. \<I> x = Fun c []"
                      "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv t \<union> fv s. \<exists>c. \<K> x = Fun c []"
                      "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv t \<union> fv s. \<forall>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv t \<union> fv s.
                         \<I> x = \<I> y \<longleftrightarrow> \<K> x = \<K> y"
             for t s h tx
           proof -
             let ?upds = "\<lambda>A. filter is_Update (unlabel A)"
 
             have flt2_fv: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (flt2 \<A>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
               using fv\<^sub>s\<^sub>s\<^sub>t_mono[OF flt2_subset[of \<A>]] by blast
 
             have upds_fv: "fv\<^sub>s\<^sub>s\<^sub>t (?upds \<A>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" by auto
 
             have flt2_upds_fv: "fv\<^sub>s\<^sub>s\<^sub>t (?upds (flt2 \<A>)) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (?upds \<A>)"
               using flt2_subset[of \<A>] by auto
 
             have h_neq: "Set h \<noteq> (Set s_val::('fun,'atom,'sets,'lbl) prot_fun)"
               when "h \<noteq> s_val"
               using that by simp
 
             have *: "\<Union>(fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r ` {}) = {}" "{} \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I> = {}" "{} \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<K> = {}" by blast+
 
             have "?in \<I> (?upds (flt2 \<A>)) \<longleftrightarrow> ?in \<K> (?upds (flt2 \<A>))"
             proof
               let ?X = "fv\<^sub>s\<^sub>s\<^sub>t (?upds (flt2 \<A>)) \<union> fv t \<union> fv s \<union>
                          \<Union>(fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r ` ({}::(('fun,'atom,'sets,'lbl) prot_term \<times>
                                           ('fun,'atom,'sets,'lbl) prot_term) set))"
 
               let ?q0 = "\<lambda>\<delta> \<theta>.
                     \<forall>x \<in> ?X.
                       \<delta> x = \<theta> x \<or>
                       (\<not>(\<delta> x \<sqsubseteq> t) \<and> \<not>(\<delta> x \<sqsubseteq> s) \<and>\<not>(\<theta> x \<sqsubseteq> t) \<and> \<not>(\<theta> x \<sqsubseteq> s) \<and>
                        (\<forall>(u,v) \<in> {}. \<not>(\<delta> x \<sqsubseteq> u) \<and> \<not>(\<delta> x \<sqsubseteq> v) \<and> \<not>(\<theta> x \<sqsubseteq> u) \<and> \<not>(\<theta> x \<sqsubseteq> v)) \<and>
                        (\<forall>u v. insert\<langle>u,v\<rangle> \<in> set (?upds (flt2 \<A>)) \<or>
                               delete\<langle>u,v\<rangle> \<in> set (?upds (flt2 \<A>)) \<longrightarrow>
                                 \<not>(\<delta> x \<sqsubseteq> u) \<and> \<not>(\<delta> x \<sqsubseteq> v) \<and> \<not>(\<theta> x \<sqsubseteq> u) \<and> \<not>(\<theta> x \<sqsubseteq> v)))"
 
               let ?q1 = "\<lambda>\<delta>. \<forall>x \<in> ?X. \<exists>c. \<delta> x = Fun c []"
 
               let ?q2 = "\<lambda>\<delta> \<theta>. \<forall>x \<in> ?X. \<forall>y \<in> ?X. \<delta> x = \<delta> y \<longleftrightarrow> \<theta> x = \<theta> y"
 
               have q0: "?q0 \<I> \<K>" "?q0 \<K> \<I>"
               proof -
                 have upd_ex:
                     "\<exists>u v. x \<in> fv u \<union> fv v \<and>
                            (insert\<langle>u,v\<rangle> \<in> set (?upds A) \<or> delete\<langle>u,v\<rangle> \<in> set (?upds A))"
                   when "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (?upds A)" for x and A::"('fun,'atom,'sets,'lbl) prot_constr"
                   using that
                 proof (induction A)
                   case (Cons a A)
                   obtain l b where a: "a = (l,b)" by (metis surj_pair)
                   show ?case using Cons.IH Cons.prems unfolding a by (cases b) auto
                 qed simp
                 
                 have "\<not>(\<I> x \<sqsubseteq> t)" "\<not>(\<I> x \<sqsubseteq> s)" "\<not>(\<K> x \<sqsubseteq> t)" "\<not>(\<K> x \<sqsubseteq> s)"
                   when x: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (?upds (flt2 \<A>)) \<union> fv t \<union> fv s"
                     and x_neq: "\<I> x \<noteq> \<K> x"
                   for x
                 proof -
                   have "\<not>(\<I> x \<sqsubseteq> t) \<and> \<not>(\<I> x \<sqsubseteq> s) \<and> \<not>(\<K> x \<sqsubseteq> t) \<and> \<not>(\<K> x \<sqsubseteq> s)"
                   proof (cases "x \<in> fv t \<union> fv s")
                     case True thus ?thesis using q(1) x_neq by blast
                   next
                     case False
                     hence "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" using x flt2_upds_fv upds_fv by blast
                     hence "\<exists>n. \<K> x = Fun (Val n) []"
                           "\<exists>n. \<I> x = Fun (Val n) [] \<or> \<I> x = Fun (PubConst Value n) []"
                       using B'3 3(2)
                       unfolding valconst_cases_def valconsts_only_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append
                       by (blast, blast)
                     thus ?thesis unfolding t h(1) by auto
                   qed
                   thus "\<not>(\<I> x \<sqsubseteq> t)" "\<not>(\<I> x \<sqsubseteq> s)" "\<not>(\<K> x \<sqsubseteq> t)" "\<not>(\<K> x \<sqsubseteq> s)" by simp_all
                 qed
                 moreover have "\<not>(\<I> x \<sqsubseteq> u)" "\<not>(\<I> x \<sqsubseteq> v)" "\<not>(\<K> x \<sqsubseteq> u)" "\<not>(\<K> x \<sqsubseteq> v)"
                   when x: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (?upds (flt2 \<A>)) \<union> fv t \<union> fv s"
                     and x_neq: "\<I> x \<noteq> \<K> x"
                     and uv: "insert\<langle>u,v\<rangle> \<in> set (?upds (flt2 \<A>)) \<or>
                              delete\<langle>u,v\<rangle> \<in> set (?upds (flt2 \<A>))"
                   for x u v
                 proof -
                   have uv': "insert\<langle>u,v\<rangle> \<in> set (unlabel \<A>) \<or> delete\<langle>u,v\<rangle> \<in> set (unlabel \<A>)"
                     using uv flt2_subset by auto
 
                   have x_in: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<union> fv u \<union> fv v"
                     using t_s_fv x flt2_upds_fv upds_fv by blast
 
                   show "\<not>(\<I> x \<sqsubseteq> u)" "\<not>(\<I> x \<sqsubseteq> v)" "\<not>(\<K> x \<sqsubseteq> u)" "\<not>(\<K> x \<sqsubseteq> v)"
                     using x_neq A_insert_delete_not_subterm[OF x_in x_neq uv'] by simp_all
                 qed
                 ultimately show "?q0 \<I> \<K>" unfolding upd_ex unfolding *
                   by (metis (no_types, lifting) empty_iff sup_bot_right)
                 thus "?q0 \<K> \<I>" by (metis (lifting) empty_iff)
               qed
 
               have q1: "?q1 \<I>" "?q1 \<K>"
                 using q(2,3) flt2_upds_fv upds_fv by (blast,blast)
 
               have q2: "?q2 \<I> \<K>" "?q2 \<K> \<I>"
                 using q(4) flt2_upds_fv upds_fv unfolding * by (blast,blast)
 
               show "?in \<I> (?upds (flt2 \<A>)) \<Longrightarrow> ?in \<K> (?upds (flt2 \<A>))"
                 using dbupd\<^sub>s\<^sub>s\<^sub>t_subst_const_swap[OF _ q0(1) q1(1,2) q2(1)] by force
 
               show "?in \<K> (?upds (flt2 \<A>)) \<Longrightarrow> ?in \<I> (?upds (flt2 \<A>))"
                 using dbupd\<^sub>s\<^sub>s\<^sub>t_subst_const_swap[OF _ q0(2) q1(2,1) q2(2)] by force
             qed
             hence flt2_subst_swap: "?in \<I> (unlabel (flt2 \<A>)) \<longleftrightarrow> ?in \<K> (unlabel (flt2 \<A>))"
               using dbupd\<^sub>s\<^sub>s\<^sub>t_filter by blast
 
             (* TODO: merge with similar proof above? *)
             have "?in \<I> (?upds \<A>) \<longleftrightarrow> ?in \<K> (?upds \<A>)"
             proof
               let ?X = "fv\<^sub>s\<^sub>s\<^sub>t (?upds \<A>) \<union> fv t \<union> fv s \<union>
                          \<Union>(fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r ` ({}::(('fun,'atom,'sets,'lbl) prot_term \<times>
                                           ('fun,'atom,'sets,'lbl) prot_term) set))"
 
               let ?q0 = "\<lambda>\<delta> \<theta>.
                     \<forall>x \<in> ?X.
                       \<delta> x = \<theta> x \<or>
                       (\<not>(\<delta> x \<sqsubseteq> t) \<and> \<not>(\<delta> x \<sqsubseteq> s) \<and>\<not>(\<theta> x \<sqsubseteq> t) \<and> \<not>(\<theta> x \<sqsubseteq> s) \<and>
                        (\<forall>(u,v) \<in> {}. \<not>(\<delta> x \<sqsubseteq> u) \<and> \<not>(\<delta> x \<sqsubseteq> v) \<and> \<not>(\<theta> x \<sqsubseteq> u) \<and> \<not>(\<theta> x \<sqsubseteq> v)) \<and>
                        (\<forall>u v. insert\<langle>u,v\<rangle> \<in> set (?upds \<A>) \<or>
                               delete\<langle>u,v\<rangle> \<in> set (?upds \<A>) \<longrightarrow>
                                 \<not>(\<delta> x \<sqsubseteq> u) \<and> \<not>(\<delta> x \<sqsubseteq> v) \<and> \<not>(\<theta> x \<sqsubseteq> u) \<and> \<not>(\<theta> x \<sqsubseteq> v)))"
 
               let ?q1 = "\<lambda>\<delta>. \<forall>x \<in> ?X. \<exists>c. \<delta> x = Fun c []"
 
               let ?q2 = "\<lambda>\<delta> \<theta>. \<forall>x \<in> ?X. \<forall>y \<in> ?X. \<delta> x = \<delta> y \<longleftrightarrow> \<theta> x = \<theta> y"
 
               have q0: "?q0 \<I> \<K>" "?q0 \<K> \<I>"
               proof -
                 have upd_ex:
                     "\<exists>u v. x \<in> fv u \<union> fv v \<and>
                            (insert\<langle>u,v\<rangle> \<in> set (?upds A) \<or> delete\<langle>u,v\<rangle> \<in> set (?upds A))"
                   when "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (?upds A)" for x and A::"('fun,'atom,'sets,'lbl) prot_constr"
                   using that
                 proof (induction A)
                   case (Cons a A)
                   obtain l b where a: "a = (l,b)" by (metis surj_pair)
                   show ?case using Cons.IH Cons.prems unfolding a by (cases b) auto
                 qed simp
                 
                 have "\<not>(\<I> x \<sqsubseteq> t)" "\<not>(\<I> x \<sqsubseteq> s)" "\<not>(\<K> x \<sqsubseteq> t)" "\<not>(\<K> x \<sqsubseteq> s)"
                   when x: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (?upds \<A>) \<union> fv t \<union> fv s"
                     and x_neq: "\<I> x \<noteq> \<K> x"
                   for x
                 proof -
                   have "\<not>(\<I> x \<sqsubseteq> t) \<and> \<not>(\<I> x \<sqsubseteq> s) \<and> \<not>(\<K> x \<sqsubseteq> t) \<and> \<not>(\<K> x \<sqsubseteq> s)"
                   proof (cases "x \<in> fv t \<union> fv s")
                     case True thus ?thesis using q(1) x_neq by blast
                   next
                     case False
                     hence "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" using x flt2_upds_fv upds_fv by blast
                     hence "\<exists>n. \<K> x = Fun (Val n) []"
                           "\<exists>n. \<I> x = Fun (Val n) [] \<or> \<I> x = Fun (PubConst Value n) []"
                       using B'3 3(2)
                       unfolding valconst_cases_def valconsts_only_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append
                       by (blast, blast)
                     thus ?thesis unfolding t h(1) by auto
                   qed
                   thus "\<not>(\<I> x \<sqsubseteq> t)" "\<not>(\<I> x \<sqsubseteq> s)" "\<not>(\<K> x \<sqsubseteq> t)" "\<not>(\<K> x \<sqsubseteq> s)" by simp_all
                 qed
                 moreover have "\<not>(\<I> x \<sqsubseteq> u)" "\<not>(\<I> x \<sqsubseteq> v)" "\<not>(\<K> x \<sqsubseteq> u)" "\<not>(\<K> x \<sqsubseteq> v)"
                   when x: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (?upds \<A>) \<union> fv t \<union> fv s"
                     and x_neq: "\<I> x \<noteq> \<K> x"
                     and uv: "insert\<langle>u,v\<rangle> \<in> set (?upds \<A>) \<or>
                              delete\<langle>u,v\<rangle> \<in> set (?upds \<A>)"
                   for x u v
                 proof -
                   have uv': "insert\<langle>u,v\<rangle> \<in> set (unlabel \<A>) \<or> delete\<langle>u,v\<rangle> \<in> set (unlabel \<A>)"
                     using uv flt2_subset by auto
 
                   have x_in: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<union> fv u \<union> fv v"
                     using t_s_fv x flt2_upds_fv upds_fv by blast
 
                   show "\<not>(\<I> x \<sqsubseteq> u)" "\<not>(\<I> x \<sqsubseteq> v)" "\<not>(\<K> x \<sqsubseteq> u)" "\<not>(\<K> x \<sqsubseteq> v)"
                     using x_neq A_insert_delete_not_subterm[OF x_in x_neq uv'] by simp_all
                 qed
                 ultimately show "?q0 \<I> \<K>" unfolding upd_ex unfolding *
                   by (metis (no_types, lifting) empty_iff sup_bot_right)
                 thus "?q0 \<K> \<I>" by (metis (lifting) empty_iff)
               qed
 
               have q1: "?q1 \<I>" "?q1 \<K>"
                 using q(2,3) flt2_upds_fv upds_fv by (blast,blast)
 
               have q2: "?q2 \<I> \<K>" "?q2 \<K> \<I>"
                 using q(4) flt2_upds_fv upds_fv unfolding * by (blast,blast)
 
               show "?in \<I> (?upds \<A>) \<Longrightarrow> ?in \<K> (?upds \<A>)"
                 using dbupd\<^sub>s\<^sub>s\<^sub>t_subst_const_swap[OF _ q0(1) q1(1,2) q2(1)] by force
 
               show "?in \<K> (?upds \<A>) \<Longrightarrow> ?in \<I> (?upds \<A>)"
                 using dbupd\<^sub>s\<^sub>s\<^sub>t_subst_const_swap[OF _ q0(2) q1(2,1) q2(2)] by force
             qed
             hence db_subst_swap:
                 "?in \<I> (unlabel \<A>) \<longleftrightarrow> ?in \<K> (unlabel \<A>)"
               using dbupd\<^sub>s\<^sub>s\<^sub>t_filter by blast
 
             have "?in \<K> (unlabel \<B>)" when A: "?in \<I> (unlabel \<A>)" using h(2)
             proof
               assume h': "h \<noteq> s_val"
               have "?in \<I> (unlabel (flt2 \<A>))"
                 using A flt2_unlabel dbupd\<^sub>s\<^sub>s\<^sub>t_set_term_neq_in_iff[OF h_neq[OF h'] A_setops_Fun]
                 unfolding h(1) flt3_def by simp
               hence "?in \<K> (unlabel (flt2 \<A>))" using flt2_subst_swap by blast
               hence "?in \<K> (flt1 (flt2 \<A>))" using dbupd\<^sub>s\<^sub>s\<^sub>t_filter unfolding flt1_def by blast
               hence "?in \<K> (flt1 (flt2 \<B>))" using flt_AB by simp
               hence "?in \<K> (unlabel (flt2 \<B>))" using dbupd\<^sub>s\<^sub>s\<^sub>t_filter unfolding flt1_def by blast
               thus ?thesis using flt2_inset_iff[OF h(1) h'] by fast
             next
               assume h': "filter is_Update (unlabel \<A>) = filter is_Update (unlabel \<B>)"
               have "?in \<K> (unlabel \<A>)" using A db_subst_swap by blast
               hence "?in \<K> (flt1 \<A>)" using dbupd\<^sub>s\<^sub>s\<^sub>t_filter unfolding flt1_def by blast
               hence "?in \<K> (flt1 \<B>)" using h' unfolding flt1_def by simp
               thus ?thesis using dbupd\<^sub>s\<^sub>s\<^sub>t_filter unfolding flt1_def by blast
             qed
             moreover have "\<not>?in \<K> (unlabel \<B>)" when A: "\<not>?in \<I> (unlabel \<A>)" using h(2)
             proof
               assume h': "h \<noteq> s_val"
               have "\<not>?in \<I> (unlabel (flt2 \<A>))"
                 using A flt2_unlabel dbupd\<^sub>s\<^sub>s\<^sub>t_set_term_neq_in_iff[OF h_neq[OF h'] A_setops_Fun]
                 unfolding h(1) flt3_def by simp
               hence "\<not>?in \<K> (unlabel (flt2 \<A>))" using flt2_subst_swap by blast
               hence "\<not>?in \<K> (flt1 (flt2 \<A>))" using dbupd\<^sub>s\<^sub>s\<^sub>t_filter unfolding flt1_def by blast
               hence "\<not>?in \<K> (flt1 (flt2 \<B>))" using flt_AB by simp
               hence "\<not>?in \<K> (unlabel (flt2 \<B>))" using dbupd\<^sub>s\<^sub>s\<^sub>t_filter unfolding flt1_def by blast
               thus ?thesis using flt2_inset_iff[OF h(1) h'] by fast
             next
               assume h': "filter is_Update (unlabel \<A>) = filter is_Update (unlabel \<B>)"
               have "\<not>?in \<K> (unlabel \<A>)" using A db_subst_swap by blast
               hence "\<not>?in \<K> (flt1 \<A>)" using dbupd\<^sub>s\<^sub>s\<^sub>t_filter unfolding flt1_def by blast
               hence "\<not>?in \<K> (flt1 \<B>)" using h' unfolding flt1_def by simp
               thus ?thesis using dbupd\<^sub>s\<^sub>s\<^sub>t_filter unfolding flt1_def by blast
             qed
             ultimately show ?thesis by blast
           qed
 
           have "?M2 \<turnstile> t \<cdot> \<theta> \<cdot> \<K>"
             when ts: "(l, receive\<langle>ts\<rangle>) \<in> set (transaction_receive T)" "t \<in> set ts" for l t ts
           proof -
             have *: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<theta> \<cdot> \<I>" using 5 ts by blast
 
             note t\<theta>\<alpha> = rcv_\<theta>_is_\<alpha>[OF ts]
 
             have t_T'_trm: "t \<in> trms_transaction T"
               using trms\<^sub>s\<^sub>s\<^sub>t_memI(2)[OF unlabel_in[OF ts(1)] ts(2)]
               unfolding trms_transaction_unfold by blast
 
             have t_T'_trm': "t \<cdot> \<theta> \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
               using trms\<^sub>s\<^sub>s\<^sub>t_memI(2)[
                       OF stateful_strand_step_subst_inI(2)[
                           OF unlabel_in[OF ts(1)], unfolded unlabel_subst]]
                     ts(2)
               unfolding T'_def trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq trms_transaction_subst_unfold by auto
 
             note t_no_val = T'_trm_no_val[OF t_T'_trm, unfolded t\<theta>\<alpha>[symmetric]]
 
             have t_fv_T': "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
               using ts(2) stateful_strand_step_fv_subset_cases(2)[
                       OF stateful_strand_step_subst_inI(2)[OF unlabel_in[OF ts(1)], of \<theta>]]
               unfolding T'_def unlabel_subst fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq fv_transaction_subst_unfold
               by auto
 
             have ik_B_fv_subset: "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>"
               by (meson UnE fv_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t subset_iff)
 
             let ?fresh_vals = "(\<lambda>n. Fun (Val n) []) ` T_val_fresh_vals"
 
             have q0: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<theta> \<cdot> \<I>" using * B(10) by (blast intro: ideduct_mono)
 
             have q1: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>) \<union> fv (t \<cdot> \<theta>). valconst_cases \<I> x"
               using 3(2,3) t_fv_T' ik_B_fv_subset unfolding B(9) by blast
 
             have q2: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>) \<union> fv (t \<cdot> \<theta>). \<exists>n. \<K> x = Fun (Val n) []"
               using B'3 t_fv_T' ik_B_fv_subset
               unfolding valconsts_only_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append B(9)
               by blast
 
             have T_val_constr_ik:
               "\<exists>M. ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr = M \<union> ?fresh_vals"
               "\<exists>M. ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr \<cdot>\<^sub>s\<^sub>e\<^sub>t \<K> = (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<K>) \<union> ?fresh_vals"
             proof -
               obtain M where M: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr = M \<union> ?fresh_vals"
                 using T_val_constr(8) by blast
               have "?fresh_vals \<cdot>\<^sub>s\<^sub>e\<^sub>t \<K> = ?fresh_vals" by fastforce
               thus "\<exists>M. ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr = M \<union> ?fresh_vals"
                    "\<exists>M. ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr \<cdot>\<^sub>s\<^sub>e\<^sub>t \<K> = (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<K>) \<union> ?fresh_vals"
                 using M by (fastforce, fastforce)
             qed
 
             have "\<K> x \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T_val_constr"
               when x: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>) \<union> fv (t \<cdot> \<theta>)" "\<I> x = Fun (PubConst Value n) []" for x n
               using x(1) B'6'[OF _ x(2)] B'6''[OF _ x(2)] t_fv_T' ik_B_fv_subset
               unfolding B(9) unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by blast
             hence q3: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>) \<union> fv (t \<cdot> \<theta>).
                         (\<exists>n. \<I> x = Fun (PubConst Value n) []) \<longrightarrow> \<K> x \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<union> ?fresh_vals"
               using T_val_constr_ik(1) T_val_constr(8) q2
               unfolding B(9) \<B>'_def unlabel_append ik\<^sub>s\<^sub>s\<^sub>t_append fv\<^sub>s\<^sub>s\<^sub>t_append
               by (metis (no_types, lifting) UnE UnI1 UnI2 image_iff mem_Collect_eq)
 
             have q4: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>) \<union> fv (t \<cdot> \<theta>). (\<exists>n. \<I> x = Fun (Val n) []) \<longrightarrow> \<I> x = \<K> x"
               using B'5 t_fv_T' ik_B_fv_subset
               unfolding subst_eq_on_privvals_def B(9) unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append
               by blast
 
             have q5: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>) \<union> fv (t \<cdot> \<theta>). \<forall>y \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>) \<union> fv (t \<cdot> \<theta>).
                         \<I> x = \<I> y \<longleftrightarrow> \<K> x = \<K> y"
               using B'7 t_fv_T' ik_B_fv_subset
               unfolding subst_eq_iff_def B(9) unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append
               by blast
 
             have q6: "\<forall>n. \<not>(Fun (PubConst Value n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t insert (t \<cdot> \<theta>) (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>))"
             proof -
               have "\<nexists>n. s = Fun (PubConst Value n) []" when s: "s \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>'" for s
               proof -
                 have "f \<noteq> PubConst Value n" when f: "f \<in> funs_term s" for f n
                   using f s reachable_constraints_val_funs_private(1)[OF B'1 P, of f]
                   unfolding is_PubConstValue_def is_PubConst_def the_PubConst_type_def
                   by (metis (mono_tags, lifting) UN_I funs_term_subterms_eq(2) prot_fun.simps(85))
                 thus ?thesis by fastforce
               qed
               moreover have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<subseteq> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>'"
                 using ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset unfolding \<B>'_def unlabel_append trms\<^sub>s\<^sub>s\<^sub>t_append by blast
               ultimately show ?thesis
                 using t_no_val by blast
             qed
 
             show ?thesis
               using deduct_val_const_swap[OF q0 q1[unfolded valconst_cases_def] q2 q3 q4 q5 q6]
                     T_val_constr_ik(2)
               by (blast intro: ideduct_mono)
           qed
           moreover have "t \<cdot> \<theta> \<cdot> \<K> = s \<cdot> \<theta> \<cdot> \<K>"
             when ts: "(l, \<langle>ac: t \<doteq> s\<rangle>) \<in> set (transaction_checks T)" for l ac t s
           proof -
             have q0: "t \<cdot> \<theta> \<cdot> \<I> = s \<cdot> \<theta> \<cdot> \<I>" using 5 ts by blast
 
             have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>ac: (t \<cdot> \<theta>) \<doteq> (s \<cdot> \<theta>)\<rangle>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
               using stateful_strand_step_fv_subset_cases(3)[
                       OF stateful_strand_step_subst_inI(3)[OF unlabel_in[OF ts], of \<theta>]]
               unfolding unlabel_subst by simp
             hence t_s_fv: "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "fv (s \<cdot> \<theta>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
               unfolding T'_def fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq fv_transaction_subst_unfold[of T \<theta>]
               by (fastforce, fastforce)
 
             have "t \<in> trms_transaction T" "s \<in> trms_transaction T"
               using trms\<^sub>s\<^sub>s\<^sub>t_memI(3,4)[OF unlabel_in[OF ts]]
               unfolding trms_transaction_unfold by (blast, blast)
             hence "\<nexists>n. u = Fun (Val n) [] \<or> u = Fun (PubConst Value n) []"
               when u: "u \<sqsubseteq> t \<cdot> \<theta> \<or> u \<sqsubseteq> s \<cdot> \<theta>" for u
               using u T'_trm_no_val unfolding eq_\<theta>_is_\<alpha>[OF ts] by blast
             hence "\<not>(\<I> x \<sqsubseteq> t \<cdot> \<theta>)" "\<not>(\<I> x \<sqsubseteq> s \<cdot> \<theta>)"
               when x: "x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>)" for x
               using x t_s_fv I' by (fast, fast)
             hence q1:
                 "\<forall>x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>). \<I> x = \<K> x \<or> (\<not>(\<I> x \<sqsubseteq> t \<cdot> \<theta>) \<and> \<not>(\<I> x \<sqsubseteq> s \<cdot> \<theta>))"
               by blast
 
             have q2: "\<forall>x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>). \<exists>c. \<I> x = Fun c []"
               using t_s_fv 3(3) unfolding valconst_cases_def by blast
 
             have q3: "\<forall>x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>). \<exists>c. \<K> x = Fun c []"
               using t_s_fv B'3 unfolding valconsts_only_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by blast
 
             have q4: "\<forall>x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>). \<forall>y \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>).
                         \<I> x = \<I> y \<longleftrightarrow> \<K> x = \<K> y"
               using B'7 t_s_fv unfolding subst_eq_iff_def B(9) unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by blast
 
             show ?thesis by (rule subst_const_swap_eq'[OF q0 q1 q2 q3 q4])
           qed
           moreover have "t \<cdot> \<theta> \<cdot> \<K> \<noteq> s \<cdot> \<theta> \<cdot> \<K>"
             when ts: "(l, \<langle>t != s\<rangle>) \<in> set (transaction_checks T)" for l t s
           proof -
             have q0: "t \<cdot> \<theta> \<cdot> \<I> \<noteq> s \<cdot> \<theta> \<cdot> \<I>" using 5 ts by blast
 
             have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>(t \<cdot> \<theta>) != (s \<cdot> \<theta>)\<rangle>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
               using stateful_strand_step_fv_subset_cases(8)[
                       OF stateful_strand_step_subst_inI(8)[OF unlabel_in[OF ts], of \<theta>]]
               unfolding unlabel_subst by simp
             hence t_s_fv: "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "fv (s \<cdot> \<theta>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
               unfolding T'_def fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq fv_transaction_subst_unfold[of T \<theta>]
               by (fastforce, fastforce)
 
             have "t \<in> trms_transaction T" "s \<in> trms_transaction T"
               using trms\<^sub>s\<^sub>s\<^sub>t_memI(9)[OF unlabel_in[OF ts]]
               unfolding trms_transaction_unfold by auto
             hence "\<nexists>n. u = Fun (Val n) []" when u: "u \<sqsubseteq> t \<cdot> \<theta> \<or> u \<sqsubseteq> s \<cdot> \<theta>" for u
               using u T'_trm_no_val unfolding noteq_\<theta>_is_\<alpha>[OF ts] by blast
             hence "\<not>(\<K> x \<sqsubseteq> t \<cdot> \<theta>)" "\<not>(\<K> x \<sqsubseteq> s \<cdot> \<theta>)"
               when x: "x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>)" for x
               using x t_s_fv B'3
               unfolding valconsts_only_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append
               by (fast, fast)
             hence q1: "\<forall>x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>). \<K> x = \<I> x \<or> (\<not>(\<K> x \<sqsubseteq> t \<cdot> \<theta>) \<and> \<not>(\<K> x \<sqsubseteq> s \<cdot> \<theta>))"
               by blast
 
             have q2: "\<forall>x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>). \<exists>c. \<K> x = Fun c []"
               using t_s_fv B'3 unfolding valconsts_only_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by blast
 
             have q3: "\<forall>x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>). \<exists>c. \<I> x = Fun c []"
               using t_s_fv 3(3) unfolding valconst_cases_def by blast
 
             have q4: "\<forall>x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>). \<forall>y \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>).
                         \<K> x = \<K> y \<longleftrightarrow> \<I> x = \<I> y"
               using B'7 t_s_fv unfolding subst_eq_iff_def B(9) unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by blast
 
             show ?thesis using q0 subst_const_swap_eq'[OF _ q1 q2 q3 q4] by fast
           qed
           moreover have "(t \<cdot> \<theta> \<cdot> \<K>, s \<cdot> \<theta> \<cdot> \<K>) \<in> ?D2"
             when ts: "(l, \<langle>ac: t \<in> s\<rangle>) \<in> set (transaction_checks T)" for l ac t s
           proof -
             have s_neq_s_val:
                 "s \<noteq> \<langle>s_val\<rangle>\<^sub>s \<or> filter is_Update (unlabel \<A>) = filter is_Update (unlabel \<B>)"
             proof (cases "T_upds = []")
               case False thus ?thesis
                 using step.hyps(2) ts x_val(7)
                 unfolding transaction_strand_def
                 by (cases ac) fastforce+
             qed (use B(13)[unfolded db_eq_def] in simp)
 
             have ts': "\<langle>ac: t \<in> s\<rangle> \<in> set (unlabel (transaction_strand T))"
               using ts unlabel_in[OF ts] unfolding transaction_strand_def by fastforce
 
             have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>ac: (t \<cdot> \<theta>) \<in> (s \<cdot> \<theta>)\<rangle>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
               using stateful_strand_step_fv_subset_cases(6)[
                       OF stateful_strand_step_subst_inI(6)[OF unlabel_in[OF ts], of \<theta>]]
               unfolding unlabel_subst by simp
             hence t_s_fv: "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "fv (s \<cdot> \<theta>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
               unfolding T'_def fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq fv_transaction_subst_unfold[of T \<theta>]
               by (fastforce, fastforce)
 
             have "t \<in> trms_transaction T" "s \<in> trms_transaction T"
               using ts' unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by (force, force)
             hence "\<nexists>n. u = Fun (Val n) [] \<or> u = Fun (PubConst Value n) []"
               when u: "u \<sqsubseteq> t \<cdot> \<theta> \<or> u \<sqsubseteq> s \<cdot> \<theta>" for u
               using u T'_trm_no_val unfolding in_\<theta>_is_\<alpha>[OF ts] by blast
             hence "\<not>(\<K> x \<sqsubseteq> t \<cdot> \<theta>)" "\<not>(\<K> x \<sqsubseteq> s \<cdot> \<theta>)" "\<not>(\<I> x \<sqsubseteq> t \<cdot> \<theta>)" "\<not>(\<I> x \<sqsubseteq> s \<cdot> \<theta>)"
               when x: "x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>)" for x
               using x t_s_fv B'3 I'
               unfolding valconsts_only_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append
               by (fast,fast,fast,fast)
             hence q1: "\<forall>x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>).
                         \<I> x = \<K> x \<or>
                         (\<not>(\<I> x \<sqsubseteq> t \<cdot> \<theta>) \<and> \<not>(\<I> x \<sqsubseteq> s \<cdot> \<theta>) \<and> \<not>(\<K> x \<sqsubseteq> t \<cdot> \<theta>) \<and> \<not>(\<K> x \<sqsubseteq> s \<cdot> \<theta>))"
               by blast
 
             have q2: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>). \<exists>c. \<I> x = Fun c []"
               using t_s_fv 3(2,3) unfolding valconst_cases_def by blast
 
             have q3: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>). \<exists>c. \<K> x = Fun c []"
               using t_s_fv B'3 unfolding valconsts_only_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by blast
 
             have q4: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>).
                       \<forall>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>).
                         \<I> x = \<I> y \<longleftrightarrow> \<K> x = \<K> y"
               using B'7 t_s_fv unfolding subst_eq_iff_def B(9) unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by blast
 
             obtain h tx where s: "s = \<langle>h\<rangle>\<^sub>s" and tx: "t = Var tx"
               using ts' transaction_selects_are_Value_vars[OF T_wf(1,2), of t s]
                     transaction_inset_checks_are_Value_vars[OF T_adm, of t s]
               by (cases ac) auto
 
             have h:
                 "s \<cdot> \<theta> = \<langle>h\<rangle>\<^sub>s"
                 "h \<noteq> s_val \<or> filter is_Update (unlabel \<A>) = filter is_Update (unlabel \<B>)"
               using s s_neq_s_val by (simp,blast)
 
             obtain ty where ty: "t \<cdot> \<theta> = Var ty"
               using tx transaction_renaming_subst_is_renaming(2)[OF step.hyps(5), of tx]
               unfolding in_\<theta>_is_\<alpha>[OF ts] by force
 
             have "(t \<cdot> \<theta> \<cdot> \<I>, s \<cdot> \<theta> \<cdot> \<I>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> {}" using 5 ts by blast
             hence "(t \<cdot> \<theta> \<cdot> \<K>, s \<cdot> \<theta> \<cdot> \<K>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<B>) \<K> {}"
               using inset_model_swap[OF h ty _ q1 q2 q3 q4] t_s_fv by simp
             thus ?thesis unfolding D2 by blast
           qed
           moreover have "(t \<cdot> \<theta> \<cdot> \<K>, s \<cdot> \<theta> \<cdot> \<K>) \<notin> ?D2"
             when ts: "(l, \<langle>t not in s\<rangle>) \<in> set (transaction_checks T)" for l t s
           proof -
             have s_neq_s_val:
                 "(T_upds \<noteq> [] \<and> s \<noteq> \<langle>s_val\<rangle>\<^sub>s) \<or>
                  (T_upds = [] \<and> filter is_Update (unlabel \<A>) = filter is_Update (unlabel \<B>))"
             proof (cases "T_upds = []")
               case False thus ?thesis
                 using step.hyps(2) ts x_val(7) unfolding transaction_strand_def by force
             qed (use B(13)[unfolded db_eq_def] in simp)
 
             have ts': "\<langle>t not in s\<rangle> \<in> set (unlabel (transaction_strand T))"
               using ts unlabel_in[OF ts] unfolding transaction_strand_def by fastforce
 
             have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>(t \<cdot> \<theta>) not in (s \<cdot> \<theta>)\<rangle>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
               using stateful_strand_step_fv_subset_cases(9)[
                       OF stateful_strand_step_subst_inI(9)[OF unlabel_in[OF ts], of \<theta>]]
               unfolding unlabel_subst by simp
             hence t_s_fv: "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "fv (s \<cdot> \<theta>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
               unfolding T'_def fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq fv_transaction_subst_unfold[of T \<theta>]
               by (fastforce, fastforce)
 
             have "t \<in> trms_transaction T" "s \<in> trms_transaction T"
               using ts' unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by (force, force)
             hence "\<nexists>n. u = Fun (Val n) [] \<or> u = Fun (PubConst Value n) []"
               when u: "u \<sqsubseteq> t \<cdot> \<theta> \<or> u \<sqsubseteq> s \<cdot> \<theta>" for u
               using u T'_trm_no_val unfolding notin_\<theta>_is_\<alpha>[OF ts] by blast
             hence "\<not>(\<K> x \<sqsubseteq> t \<cdot> \<theta>)" "\<not>(\<K> x \<sqsubseteq> s \<cdot> \<theta>)" "\<not>(\<I> x \<sqsubseteq> t \<cdot> \<theta>)" "\<not>(\<I> x \<sqsubseteq> s \<cdot> \<theta>)"
               when x: "x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>)" for x
               using x t_s_fv B'3 I'
               unfolding valconsts_only_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append
               by (fast,fast,fast,fast)
             hence q1: "\<forall>x \<in> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>).
                         \<I> x = \<K> x \<or>
                         (\<not>(\<I> x \<sqsubseteq> t \<cdot> \<theta>) \<and> \<not>(\<I> x \<sqsubseteq> s \<cdot> \<theta>) \<and> \<not>(\<K> x \<sqsubseteq> t \<cdot> \<theta>) \<and> \<not>(\<K> x \<sqsubseteq> s \<cdot> \<theta>))"
               by blast
 
             have q2: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>). \<exists>c. \<I> x = Fun c []"
               using t_s_fv 3(2,3) unfolding valconst_cases_def by blast
 
             have q3: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>). \<exists>c. \<K> x = Fun c []"
               using t_s_fv B'3 unfolding valconsts_only_def unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by blast
 
             have q4: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>).
                       \<forall>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>).
                         \<I> x = \<I> y \<longleftrightarrow> \<K> x = \<K> y"
               using B'7 t_s_fv unfolding subst_eq_iff_def B(9) unlabel_append fv\<^sub>s\<^sub>s\<^sub>t_append by blast
 
             obtain h tx where s: "s = \<langle>h\<rangle>\<^sub>s" and tx: "t = Var tx"
               using transaction_notinset_checks_are_Value_vars(1,2)[OF T_adm ts', of t s] by auto
 
             have h:
                 "s \<cdot> \<theta> = \<langle>h\<rangle>\<^sub>s"
                 "h \<noteq> s_val \<or> filter is_Update (unlabel \<A>) = filter is_Update (unlabel \<B>)"
                 "T_upds \<noteq> [] \<Longrightarrow> h \<noteq> s_val"
               using s s_neq_s_val by (simp,blast,blast)
 
             obtain ty where ty: "t \<cdot> \<theta> = Var ty"
               using tx transaction_renaming_subst_is_renaming(2)[OF step.hyps(5), of tx]
               unfolding notin_\<theta>_is_\<alpha>[OF ts] by force
 
             have *: "(t \<cdot> \<theta> \<cdot> \<K>, s \<cdot> \<theta> \<cdot> \<K>) \<noteq> (u \<cdot> \<K>, v \<cdot> \<K>)"
               when u: "insert\<langle>u,v\<rangle> \<in> set (unlabel T_val_constr)"
                 and h': "h \<noteq> s_val"
               for u v
             proof -
               have "v = \<langle>s_val\<rangle>\<^sub>s" using T_val_constr(9) unlabel_mem_has_label[OF u] by force
               thus ?thesis using h(1) h' by simp
             qed
 
             have "(t \<cdot> \<theta> \<cdot> \<I>, s \<cdot> \<theta> \<cdot> \<I>) \<notin> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> {}" using 5 ts by blast
             hence **: "(t \<cdot> \<theta> \<cdot> \<K>, s \<cdot> \<theta> \<cdot> \<K>) \<notin> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<B>) \<K> {}"
               using inset_model_swap[OF h(1,2) ty _ q1 q2 q3 q4] t_s_fv by simp
             
             show ?thesis
             proof (cases "T_upds = []")
               case True
               have "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel T_val_constr) I D = D" for I D
                 using T_val_constr_no_upds_if_no_T_upds[OF True]
                       dbupd\<^sub>s\<^sub>s\<^sub>t_filter[of "unlabel T_val_constr"]
                 by force
               thus ?thesis using ** by simp 
             next
               case False thus ?thesis
                 using ** * h(3) T_val_constr_no_upds_if_no_T_upds unfolding D2 by blast
             qed
           qed
           ultimately show "?sem ?M2 ?D2 T'"
             unfolding T'_def 4[OF T_adm K3 K2] by blast
         qed
       qed
     qed
 
     show ?case
       using B'1 B'2 B'3 B'4 B'5 B'6 B'7 B'8_9 B'10_11 B'12 B'13 B'14
       unfolding \<theta>_def[symmetric] T'_def[symmetric] by blast
   qed
 
   obtain \<B> \<J> where B:
       "\<B> \<in> reachable_constraints P" "?wt_model \<J> \<B>"
       "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<exists>n. \<J> x = Fun (Val n) []" "?rcv_att \<A> n \<longrightarrow> ?rcv_att \<B> n" "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>"
     using lmm[OF finite.emptyI _ _ finite.emptyI] unfolding valconsts_only_def by auto
  
   show ?thesis
     using B(1,3) welltyped_constraint_model_attack_if_receive_attack[OF B(2)] B(4) 2
     unfolding wt_attack_def B(5) by (meson list.set_intros(1))
 qed
 
 private lemma add_occurs_msgs_soundness_aux2:
   assumes P: "\<forall>T \<in> set P. admissible_transaction T"
     and A: "\<A> \<in> reachable_constraints P"
   shows "\<exists>\<B> \<in> reachable_constraints (map add_occurs_msgs P). \<A> = rm_occurs_msgs_constr \<B>"
 using A
 proof (induction rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   let ?A' = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
   let ?B' = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand (add_occurs_msgs T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 
   obtain A B C D E F where T: "T = Transaction A B C D E F" by (cases T) simp
 
   have P': "\<forall>T \<in> set P. admissible_transaction' T"
              "\<forall>T \<in> set P. admissible_transaction_no_occurs_msgs T"
     using P admissible_transactionE'(1,2) by (blast,blast)
 
   note T_adm' = bspec[OF P step.hyps(2)]
   note T_adm = bspec[OF P'(1) step.hyps(2)]
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T_adm step.hyps(3)]
   note T_fresh_val = admissible_transactionE(2)[OF T_adm]
 
   note T_no_occ = admissible_transactionE'(2)[OF T_adm']
 
   obtain \<B> where B:
       "\<B> \<in> reachable_constraints (map add_occurs_msgs P)" "\<A> = rm_occurs_msgs_constr \<B>"
     using step.IH by blast
 
   note 0 = add_occurs_msgs_cases[OF T]
   note 1 = add_occurs_msgs_vars_eq[OF bspec[OF P'(1)]]
   note 2 = add_occurs_msgs_trms[of T]
   note 3 = add_occurs_msgs_transaction_strand_set[OF T]
 
   have 4: "add_occurs_msgs T \<in> set (map add_occurs_msgs P)"
     using step.hyps(2) by simp
 
   have 5: "transaction_decl_subst \<xi> (add_occurs_msgs T)"
     using step.hyps(3) 0(4) unfolding transaction_decl_subst_def by argo
 
   have "t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)"
        "t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction (add_occurs_msgs T))"
     when t: "t \<in> subst_range \<sigma>" for t
   proof -
     obtain c where c: "t = Fun (Val c) []"
       using t T_fresh_val transaction_fresh_subst_domain[OF step.hyps(4)]
             transaction_fresh_subst_sends_to_val[OF step.hyps(4), of _ thesis]
       by fastforce
 
     have *: "t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" "t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)"
       using t step.hyps(4) unfolding transaction_fresh_subst_def by (fast,fast)
 
     have "t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<or> (\<exists>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. t \<sqsubseteq> occurs (Var x)) \<or>
            (\<exists>c. Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<and> t \<sqsubseteq> occurs (Fun c []))"
       when t: "t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>"
       using t rm_occurs_msgs_constr_reachable_constraints_trms_cases[OF P' B(2,1)] by fast
     thus "t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)"
       using *(1) unfolding c by fastforce
 
     show "t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction (add_occurs_msgs T))"
       using *(2) unfolding 2 c by force
   qed
   hence 6: "transaction_fresh_subst \<sigma> (add_occurs_msgs T) (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)"
     using step.hyps(4) unfolding transaction_fresh_subst_def 0(5) 2 by fast
 
   have 7: "transaction_renaming_subst \<alpha> (map add_occurs_msgs P) (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>)"
     using step.hyps(5) rm_occurs_msgs_constr_reachable_constraints_vars_eq[OF P' B(1)] B(2) 1(5)
     unfolding transaction_renaming_subst_def by simp
 
   have "?A' = rm_occurs_msgs_constr ?B'"
     using admissible_transaction_decl_fresh_renaming_subst_not_occurs[OF T_adm step.hyps(3,4,5)]
           rm_occurs_msgs_constr_transaction_strand''[OF T_adm T_no_occ]
     unfolding \<theta>_def[symmetric] by metis
   hence 8: "\<A>@?A' = rm_occurs_msgs_constr (\<B>@?B')"
     by (metis rm_occurs_msgs_constr_append B(2))
 
   show ?case using reachable_constraints.step[OF B(1) 4 5 6 7] 8 unfolding \<theta>_def by blast
 qed (metis reachable_constraints.init rm_occurs_msgs_constr.simps(1))
 
 private lemma add_occurs_msgs_soundness_aux3:
   assumes P: "\<forall>T \<in> set P. admissible_transaction T"
     and A: "\<A> \<in> reachable_constraints (map add_occurs_msgs P)"
            "welltyped_constraint_model \<I> (rm_occurs_msgs_constr \<A>)"
     and I: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<exists>n. \<I> x = Fun (Val n) []" (is "?I \<A>")
   shows "welltyped_constraint_model \<I> \<A>" (is "?Q \<I> \<A>")
 using A I
 proof (induction \<A> rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   let ?f = rm_occurs_msgs_constr
   let ?sem = "\<lambda>B. strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> {}) (unlabel B) \<I>"
 
   define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
   define \<B> where "\<B> \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 
   obtain T' where T': "T' \<in> set P" "T = add_occurs_msgs T'"
     using step.hyps(2) by fastforce
   then obtain A' B' C' D' E' F' where T'': "T' = Transaction A' B' C' D' E' F'" 
     using prot_transaction.exhaust by blast
 
   have P': "\<forall>T \<in> set (map add_occurs_msgs P). admissible_transaction' T"
            "\<forall>T \<in> set (map add_occurs_msgs P). admissible_transaction_occurs_checks T"
            "\<forall>T \<in> set P. admissible_transaction' T"
            "\<forall>T \<in> set P. admissible_transaction_no_occurs_msgs T"
     using P admissible_transactionE' add_occurs_msgs_admissible_occurs_checks
     by (fastforce,fastforce,fastforce,fastforce)
 
   note T_adm = bspec[OF P'(1) step.hyps(2)]
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
   note T'_adm = bspec[OF P'(3) T'(1)]
   note T'_no_occ = bspec[OF P'(4) T'(1)]
   note T'_wf = admissible_transaction_is_wellformed_transaction(1)[OF T'_adm]
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T_adm step.hyps(3)]
   note T_fresh_val = admissible_transactionE(2)[OF T_adm]
 
   have 0: "?Q \<I> (?f \<A>)" "?I \<A>" "?I \<B>"
     by (metis step.prems(1) welltyped_constraint_model_prefix rm_occurs_msgs_constr_append,
         simp_all add: step.prems(2) \<theta>_def \<B>_def)
 
   note IH = step.IH[OF 0(1,2)]
 
   have I': "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
     using step.prems(1) unfolding welltyped_constraint_model_def constraint_model_def by blast+
 
   have 1: "\<forall>x \<in> fv_transaction T. \<nexists>t. \<theta> x = occurs t"
           "\<forall>x \<in> fv_transaction T. \<theta> x \<noteq> Fun OccursSec []"
     using admissible_transaction_decl_fresh_renaming_subst_not_occurs[OF T_adm step.hyps(3,4,5)]
     unfolding \<theta>_def[symmetric] by simp_all
 
   have "(ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?f \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     using rm_occurs_msgs_constr_ik_subset by fast
   hence 2: "?sem (?f \<B>)"
     using step.prems(1) strand_sem_append_stateful[of "{}" "{}" "unlabel (?f \<A>)" "unlabel (?f \<B>)"]
           rm_occurs_msgs_constr_dbupd\<^sub>s\<^sub>s\<^sub>t_eq[of \<A> \<I> "{}"] rm_occurs_msgs_constr_append[of \<A> \<B>]
           strand_sem_ik_mono_stateful[of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?f \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" _ _ _ "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"]
     unfolding welltyped_constraint_model_def constraint_model_def \<theta>_def[symmetric] \<B>_def[symmetric]
     by auto
 
   note 3 = rm_occurs_msgs_constr_transaction_strand''[
             OF T'_adm T'_no_occ 1[unfolded T'(2)], unfolded \<B>_def[symmetric] T'(2)[symmetric]]
 
   note 4 = add_occurs_msgs_cases[OF T'', unfolded T'(2)[symmetric]]
 
 
   define xs where "xs \<equiv> fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T'))"
   define flt where "flt \<equiv> filter (\<lambda>x. x \<notin> set (transaction_fresh T'))"
   define occs where "occs \<equiv> map (\<lambda>x. occurs (Var x)::('fun,'atom,'sets,'lbl) prot_term)"
 
   note 6 = add_occurs_msgs_transaction_strand_cases(7,8,9)[
             of T' \<theta>, unfolded xs_def[symmetric] flt_def[symmetric] occs_def[symmetric]
                               T'(2)[symmetric]]
 
   have 7: "x \<in> fv_transaction T - set (transaction_fresh T)"
     when x: "x \<in> set (flt xs)" for x
     using that fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t add_occurs_msgs_vars_eq(3,9)[OF T'_adm]
     unfolding xs_def flt_def T'(2) by force
 
   have 9: "\<exists>y. \<theta> x = Var y"
     when x: "x \<in> set (flt xs)" for x
   proof -
     have *: "x \<notin> fst ` set (transaction_decl T ())"
       using admissible_transactionE(1)[OF T_adm] by simp
 
     have **: "x \<notin> set (transaction_fresh T)" using 7[OF x] by simp
 
     show ?thesis
       using transaction_decl_fresh_renaming_substs_range(4)[OF step.hyps(3,4,5) * **]
       unfolding \<theta>_def by blast
   qed
 
   have 8: "\<exists>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>. \<theta> x = Var y"
     when x: "x \<in> set (flt xs)" for x
   proof -
     note * = 7[OF x]
 
     obtain y where y: "\<theta> x = Var y" using 9[OF x] by blast
 
     have "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))" by (metis * Diff_iff fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq)
     have "\<theta> x \<in> \<theta> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" using * by fast
     hence "fv (\<theta> x) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv_transaction T)" by force
     hence "fv (\<theta> x) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
       using fv\<^sub>s\<^sub>s\<^sub>t_subst_if_no_bvars[OF admissible_transactionE(4)[OF T_adm], of \<theta>]
       by (metis unlabel_subst)
     hence "fv (\<theta> x) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" by (metis fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq \<B>_def)
     thus ?thesis using y by simp
   qed
 
   have \<B>_var_is_\<I>_val: "\<exists>n. \<I> x = Fun (Val n) []" when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B>" for x
     using step.prems(2) x unfolding \<B>_def[symmetric] \<theta>_def[symmetric] by auto
 
   have T'_var_is_\<theta>\<I>_val: "\<exists>n. \<theta> x \<cdot> \<I> = Fun (Val n) []" when x: "x \<in> set (flt xs)" for x
     using 8[OF x] \<B>_var_is_\<I>_val by force
 
 
   (* TODO: extract lemma *)
   have poschecks_has_occ: "occurs (Fun (Val n) []) \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
     when x: "\<langle>ac: t \<in> s\<rangle> \<in> set (unlabel \<B>)"
       and n: "t \<cdot> \<I> = Fun (Val n) []"
     for ac t s n
   proof -
     have *: "(t \<cdot> \<I>, s \<cdot> \<I>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> {}"
     proof -
       obtain t' s' where t':
           "\<langle>ac: t' \<in> s'\<rangle> \<in> set (unlabel (transaction_checks T'))" "t = t' \<cdot> \<theta>" "s = s' \<cdot> \<theta>"
         using 4(8) x stateful_strand_step_mem_substD(6)
               wellformed_transaction_strand_unlabel_memberD(10)[OF T_wf(1)]
               dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(6)
         unfolding \<B>_def by (metis (no_types) unlabel_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst)
 
       have "(t' \<cdot> \<theta> \<cdot> \<I>, s' \<cdot> \<theta> \<cdot> \<I>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> {}"
         using t'(1) 2
               wellformed_transaction_unlabel_sem_iff[
                 OF T'_wf(1) I'(2,3), of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> {}" \<theta>]
         unfolding 3 by blast
       thus ?thesis using t'(2,3) by simp
     qed
 
     have "t' \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
       when "insert\<langle>t',s'\<rangle> \<in> set (unlabel \<A>)" for t' s'
       using that by force
 
     have "t \<cdot> \<I> \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
     proof -
       obtain t' s' where t': "insert\<langle>t',s'\<rangle> \<in> set (unlabel \<A>)" "t \<cdot> \<I> = t' \<cdot> \<I>" "s \<cdot> \<I> = s' \<cdot> \<I>"
         using * db\<^sub>s\<^sub>s\<^sub>t_in_cases[of "t \<cdot> \<I>" "s \<cdot> \<I>" "unlabel \<A>" \<I> "[]"]
               db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>" \<I> "[]"]
         by auto
 
       have t'': "t' = t \<cdot> \<I> \<or> (\<exists>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. t' = Var y \<and> \<I> y = t \<cdot> \<I>)"
         using t'(1,2) stateful_strand_step_fv_subset_cases(4)
         unfolding n by (cases t') (force,force)
       thus ?thesis
       proof
         assume "t' = t \<cdot> \<I>" thus ?thesis using t'(1) by force
       next
         assume "\<exists>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. t' = Var y \<and> \<I> y = t \<cdot> \<I>"
         then obtain y where y: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" "\<I> y = t \<cdot> \<I>" by blast
 
         have "\<Gamma>\<^sub>v y = TAtom Value"
           using y(2) wt_subst_trm''[OF I'(1), of "Var y"] unfolding n by simp
         hence "\<exists>B. prefix B \<A> \<and> t \<cdot> \<I> \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B"
           by (metis y constraint_model_Value_var_in_constr_prefix[OF step.hyps(1) IH P'(1,2)])
         thus ?thesis unfolding prefix_def by auto
       qed
     qed
     thus ?thesis
       using reachable_constraints_occurs_fact_ik_case'[OF step.hyps(1) P'(1,2)]
       unfolding n by blast
   qed
 
   (* TODO: extract lemma *)
   have snds_has_occ: "occurs (Fun (Val n) []) \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
     when ts: "send\<langle>ts\<rangle> \<in> set (unlabel \<B>)"
       and n: "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     for ts n
   proof -
     have "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
       using ts dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) unfolding \<B>_def by metis
     then obtain ts' where ts':
         "receive\<langle>ts'\<rangle> \<in> set (unlabel (transaction_strand T))" "ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>"
       by (metis subst_lsst_memD(1) unlabel_in unlabel_mem_has_label)
 
 
     have "?sem (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
       using 2 strand_sem_append_stateful[of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> {}"]
       unfolding 3 transaction_dual_subst_unlabel_unfold by blast
     moreover have "list_all is_Receive (unlabel (transaction_receive T'))"
       using T'_wf unfolding wellformed_transaction_def by blast
     hence "list_all is_Send (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
       by (metis subst_lsst_unlabel subst_sst_list_all(2) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(1))
     hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) = {}"
       using in_ik\<^sub>s\<^sub>s\<^sub>t_iff unfolding list_all_iff is_Send_def by fast
     ultimately have *: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot>  \<I>"
       when "send\<langle>ts\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))" "t \<in> set ts"
       for t ts
       using strand_sem_stateful_sends_deduct[OF _ that] by simp
     hence *: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<theta> \<cdot> \<I>"
       when ts: "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_receive T'))" "t \<in> set ts" for t ts
       using ts(2) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2)[of "ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>" "transaction_receive T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
             stateful_strand_step_subst_inI(2)[OF ts(1), of \<theta>, unfolded unlabel_subst]
       by auto
 
     have **: "set (flt xs) = fv_transaction T' - set (transaction_fresh T')"
       using fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t unfolding flt_def xs_def by fastforce
 
     have rcv_case: ?thesis
       when "ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>" "Fun (Val n) [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
            "receive\<langle>ts'\<rangle> \<in> set (unlabel (transaction_receive T'))"
       for ts ts'
       using that * reachable_constraints_occurs_fact_ik_case''[OF step.hyps(1) IH P'(1,2)] by auto
 
     have "receive\<langle>ts'\<rangle> \<in> set (unlabel (transaction_receive T))"
       using wellformed_transaction_strand_unlabel_memberD(1)[OF T_wf] ts'(1) by blast
     hence "(ts' = map (\<lambda>x. occurs (Var x)) (flt xs) \<and> ts' \<noteq> []) \<or>
            receive\<langle>ts'\<rangle> \<in> set (unlabel (transaction_receive T'))"
       (is "?A \<or> ?B")
       using ** ts'(1) add_occurs_msgs_cases(13)[OF T'']
       unfolding T'(2)[symmetric] xs_def[symmetric] flt_def[symmetric] by force
     thus ?thesis
     proof
       assume ?A
       then obtain x where x: "x \<in> set (flt xs)" "Fun (Val n) [] \<sqsubseteq> \<theta> x \<cdot> \<I>"
         using ts' n by fastforce
       
       have x': "\<theta> x \<cdot> \<I> = Fun (Val n) []" "x \<in> fv_transaction T" "x \<notin> set (transaction_fresh T)"
                "x \<in> fv_transaction T'" "x \<notin> set (transaction_fresh T')"
         using x(2) T'_var_is_\<theta>\<I>_val[OF x(1)] 7[OF x(1)] ** x(1) by fastforce+
 
       let ?snds = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
       let ?chks = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
 
       have B_subsets: "set ?chks \<subseteq> set (unlabel \<B>)"
         unfolding \<B>_def transaction_dual_subst_unlabel_unfold 4(8) by fastforce
 
       from admissible_transaction_fv_in_receives_or_selects_dual_subst[OF T'_adm x'(4,5), of \<theta>]
       show ?thesis
       proof
         assume "\<exists>ts. send\<langle>ts\<rangle> \<in> set ?snds \<and> \<theta> x \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts"
         then obtain ss where ss: "send\<langle>ss\<rangle> \<in> set ?snds" "\<theta> x \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ss" by blast
         
         obtain ss' where ss':
             "ss = ss' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>" "receive\<langle>ss'\<rangle> \<in> set (unlabel (transaction_receive T'))"
           by (metis ss(1) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) subst_lsst_memD(1)
                     unlabel_in unlabel_mem_has_label)
 
         show ?thesis
           using rcv_case[OF ss'(1) _ ss'(2)] subst_subterms[OF ss(2), of \<I>] x'(1) by argo
       qed (use B_subsets poschecks_has_occ[OF _ x'(1)] in blast)
     qed (metis rcv_case[OF ts'(2) n])
   qed
 
   (* TODO: extract lemma *)
   have "occurs (\<theta> x \<cdot> \<I>) \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" when x: "x \<in> set (flt xs)" for x
   proof -
     have "(\<exists>ac s. \<langle>ac: \<theta> x \<in> s\<rangle> \<in> set (unlabel \<B>)) \<or>
            (\<exists>ts. send\<langle>ts\<rangle> \<in> set (unlabel \<B>) \<and> \<theta> x \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts)"
       (is "(\<exists>ac s. ?A ac s) \<or> (\<exists>ts. ?B1 ts \<and> ?B2 ts)")
       using 7[OF x] admissible_transaction_fv_in_receives_or_selects_dual_subst[OF T_adm, of x \<theta>]
       unfolding \<B>_def transaction_dual_subst_unlabel_unfold by auto
     thus ?thesis
     proof
       assume "\<exists>ac s. ?A ac s"
       then obtain ac s where s: "?A ac s" by blast
       show ?thesis using poschecks_has_occ[OF s] T'_var_is_\<theta>\<I>_val[OF x] by force
     next
       assume "\<exists>ts. ?B1 ts \<and> ?B2 ts"
       then obtain ts where ts: "?B1 ts" "?B2 ts" by meson
       have ts': "\<theta> x \<cdot> \<I> \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by (metis ts(2) subst_subterms)
       show ?thesis using snds_has_occ[OF ts(1)] ts' T'_var_is_\<theta>\<I>_val[OF x] by force
     qed
   qed
   hence "occurs (\<theta> x \<cdot> \<I>) \<cdot> \<I> \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" when "x \<in> set (flt xs)" for x using that by fast
   moreover have "occurs (\<theta> x \<cdot> \<I>) \<cdot> \<I> = occurs (\<theta> x \<cdot> \<I>)" for x
     using subst_ground_ident[OF interpretation_grounds[OF I'(2), of "\<theta> x"], of \<I>] by simp
   ultimately have "occurs (\<theta> x \<cdot> \<I>) \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" when "x \<in> set (flt xs)" for x
     using that by auto
   hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>" when "t \<in> set (occs (flt xs) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)" for t
     using that unfolding occs_def by auto
   hence occs_sem: "?sem [\<langle>\<star>, send\<langle>occs (flt xs) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<rangle>]"
     by auto
 
 
   (* TODO: extract lemma *)
   have "?sem \<B>"
   proof -
     let ?IK = "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     let ?DB = "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> {}"
     let ?snds = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
     let ?snds_occs = "(\<langle>\<star>, send\<langle>occs (flt xs) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<rangle>)#?snds"
     let ?chks = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
     let ?upds = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
     let ?rcvs = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 
     note * = strand_sem_append_stateful[of _ _ _ _ \<I>]
     note ** = transaction_dual_subst_unlabel_unfold
     have ***: "\<And>M. M \<union> (ik\<^sub>s\<^sub>s\<^sub>t [] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) = M"
               "\<And>D. dbupd\<^sub>s\<^sub>s\<^sub>t [] \<I> D = D"
       by simp_all
 
     have snds_sem:
         "?sem ?snds"
         "?sem ?snds_occs"
       using 2 occs_sem *[of ?IK ?DB]
       unfolding 3 ** by (blast, fastforce)
 
     have "list_all is_Receive (unlabel (transaction_receive T'))"
       using T'_wf unfolding wellformed_transaction_def by blast
     hence "list_all is_Send (unlabel ?snds)" "list_all is_Send (unlabel ?snds_occs)"
       using subst_sst_list_all(2) unlabel_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(1)
       by (metis, metis (no_types) list.pred_inject(2) stateful_strand_step.disc(1) unlabel_Cons(1))
     hence "\<forall>a \<in> set (unlabel ?snds). \<not>is_Receive a \<and> \<not>is_Insert a \<and> \<not>is_Delete a"
           "\<forall>a \<in> set (unlabel ?snds_occs). \<not>is_Receive a \<and> \<not>is_Insert a \<and> \<not>is_Delete a"
       unfolding list_all_iff by (blast,blast)
     hence snds_no_upds:
         "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?snds \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = {}"
         "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel ?snds) \<I> ?DB = ?DB"
         "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?snds_occs) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = {}"
         "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel ?snds_occs) \<I> ?DB = ?DB"
       by (metis ik\<^sub>s\<^sub>s\<^sub>t_snoc_no_receive_empty, metis dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd,
           metis ik\<^sub>s\<^sub>s\<^sub>t_snoc_no_receive_empty, metis dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd)
 
     have chks_sem:
         "?sem ?chks"
       using 2 snds_no_upds *
       unfolding 3 ** by auto
 
     have "list_all is_Check_or_Assignment (unlabel (transaction_checks T'))"
       using T'_wf unfolding wellformed_transaction_def by blast
     hence "list_all is_Check_or_Assignment (unlabel ?chks)"
       by (metis (no_types) subst_sst_list_all(11) unlabel_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(11))
     hence "\<forall>a \<in> set (unlabel ?chks). \<not>is_Receive a \<and> \<not>is_Insert a \<and> \<not>is_Delete a"
       unfolding list_all_iff by blast
     hence chks_no_upds:
         "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?chks \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = {}"
         "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel ?chks) \<I> ?DB = ?DB"
       by (metis ik\<^sub>s\<^sub>s\<^sub>t_snoc_no_receive_empty, metis dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd)
 
     have upds_sem:
         "?sem ?upds"
       using 2 snds_no_upds chks_no_upds *
       unfolding 3 ** by auto
 
     have "list_all is_Send (unlabel (transaction_send T'))"
       using T'_wf unfolding wellformed_transaction_def by fast
     hence "list_all is_Send (unlabel (transaction_send T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
       by (metis (no_types, opaque_lifting) subst_sst_list_all(1) unlabel_subst)
     hence rcvs_is_rcvs: "list_all is_Receive (unlabel ?rcvs)"
       using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all(2) by blast
 
     have rcvs_sem: "strand_sem_stateful M D (unlabel rcvs) \<I>"
       when "list_all is_Receive (unlabel rcvs)"
       for M D and rcvs::"('fun, 'atom, 'sets, 'lbl) prot_strand"
       using rcvs_is_rcvs strand_sem_receive_prepend_stateful[of M D "[]" \<I>, OF _ that] by auto
 
     have B_sem: "?sem (?snds@?chks@?upds@rcvs)"
                 "?sem (?snds_occs@?chks@?upds@rcvs)"
       when "list_all is_Receive (unlabel rcvs)" for rcvs
       using strand_sem_append_stateful[of _ _ _ _ \<I>]
             snds_sem snds_no_upds chks_sem chks_no_upds
             upds_sem rcvs_sem[OF that]
       by (force, force)
 
     show ?thesis
     proof (cases "transaction_fresh T' = []")
       case True
       show ?thesis using B_sem[OF rcvs_is_rcvs] unfolding \<B>_def 6(1)[OF True] by force
     next
       case False
       note F = this
       show ?thesis
       proof (cases "\<exists>ts F'. transaction_send T' = \<langle>\<star>, send\<langle>ts\<rangle>\<rangle>#F'")
         case True
         obtain ts F' rcvs' where F':
             "transaction_send T' = \<langle>\<star>, send\<langle>ts\<rangle>\<rangle>#F'"
             "\<B> = (if flt xs = [] then ?snds else ?snds_occs)@?chks@?upds@rcvs'"
             "rcvs' = \<langle>\<star>, receive\<langle>occs (transaction_fresh T')@ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<rangle>#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (F' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
           using 6(3)[OF F True] unfolding \<B>_def by blast
 
         have *: "list_all is_Receive (unlabel rcvs')"
           using rcvs_is_rcvs dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_Cons(1)[of \<star> ts "F' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
                 subst_lsst_cons[of "\<langle>\<star>, send\<langle>ts\<rangle>\<rangle>" F' \<theta>]
           unfolding F'(1,3) list_all_iff by auto
 
         show ?thesis using B_sem[OF *] unfolding F'(2) by fastforce
       next
         case False
         have *:
             "list_all is_Receive (unlabel (\<langle>\<star>, receive\<langle>occs (transaction_fresh T') \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<rangle>#?rcvs))"
           using rcvs_is_rcvs by auto
 
         show ?thesis using B_sem[OF *] unfolding \<B>_def 6(2)[OF F False] by fastforce
       qed
     qed
   qed
   thus ?case
     using IH strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" "unlabel \<B>" \<I>]
     unfolding welltyped_constraint_model_def constraint_model_def \<theta>_def[symmetric] \<B>_def[symmetric]
     by simp
 qed simp
 
 theorem add_occurs_msgs_soundness:
   defines "wt_attack \<equiv> \<lambda>\<I> \<A> l n. welltyped_constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
   assumes P: "\<forall>T \<in> set P. admissible_transaction T"
              "has_initial_value_producing_transaction P"
     and A: "\<A> \<in> reachable_constraints P" "wt_attack \<I> \<A> l n"
   shows "\<exists>\<B> \<in> reachable_constraints (map add_occurs_msgs P). \<exists>\<J>. wt_attack \<J> \<B> l n"
 proof -
   have P': "\<forall>T \<in> set (map add_occurs_msgs P). admissible_transaction' T"
            "\<forall>T \<in> set (map add_occurs_msgs P). admissible_transaction_occurs_checks T"
            "\<forall>T \<in> set P. admissible_transaction' T"
            "\<forall>T \<in> set P. admissible_transaction_no_occurs_msgs T"
     using P admissible_transactionE' add_occurs_msgs_admissible_occurs_checks
     by (fastforce,fastforce,fastforce,fastforce)
 
   obtain \<A>' \<J> where A':
       "\<A>' \<in> reachable_constraints P" "wt_attack \<J> \<A>' l n" "\<forall>x\<in>fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>'. \<exists>n. \<J> x = Fun (Val n) []"
     using add_occurs_msgs_soundness_aux1[OF P'(3) P(2) A[unfolded wt_attack_def]]
     unfolding wt_attack_def by blast
 
   have J: "welltyped_constraint_model \<J> \<A>'"
     using A'(2) welltyped_constraint_model_prefix
     unfolding wt_attack_def by blast
 
   obtain \<B> where B:
       "\<B> \<in> reachable_constraints (map add_occurs_msgs P)" "\<A>' = rm_occurs_msgs_constr \<B>"
     using add_occurs_msgs_soundness_aux2[OF P(1) A'(1)] by blast
 
   have J': "welltyped_constraint_model \<J> \<B>"
     using add_occurs_msgs_soundness_aux3[OF P(1) B(1) J[unfolded B(2)]]
           A'(3) rm_occurs_msgs_constr_reachable_constraints_fv_eq[OF P'(3,4) B(1)]
     unfolding wt_attack_def B(2) by blast
 
   obtain ts where ts: "receive\<langle>ts\<rangle> \<in> set (unlabel \<B>)" "attack\<langle>n\<rangle> \<in> set ts"
     using reachable_constraints_receive_attack_if_attack''[OF P'(3) A'(1,2)[unfolded wt_attack_def]]
           rm_occurs_msgs_constr_receive_attack_iff[of n \<B>]
     unfolding B(2)[symmetric] by auto
 
   have J'': "wt_attack \<J> \<B> l n"
     using welltyped_constraint_model_attack_if_receive_attack[OF J' ts]
     unfolding wt_attack_def by fast
 
   show ?thesis
     using B(1) J'' by blast
 qed
 
 end
 
 end
 
 
 subsection \<open>Automatically Checking Protocol Security in a Typed Model\<close>
 context stateful_protocol_model
 begin
 
 definition abs_intruder_knowledge ("\<alpha>\<^sub>i\<^sub>k") where
   "\<alpha>\<^sub>i\<^sub>k S \<I> \<equiv> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<I>)"
 
 definition abs_value_constants ("\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s") where
   "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s S \<I> \<equiv> {t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>. \<exists>n. t = Fun (Val n) []} \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<I>)"
 
 definition abs_term_implications ("\<alpha>\<^sub>t\<^sub>i") where
   "\<alpha>\<^sub>t\<^sub>i \<A> T \<theta> \<I> \<equiv> {(s,t) | s t x.
     s \<noteq> t \<and> x \<in> fv_transaction T \<and> x \<notin> set (transaction_fresh T) \<and>
     Fun (Abs s) [] = \<theta> x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) \<and>
     Fun (Abs t) [] = \<theta> x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I>)}"
 
 lemma abs_intruder_knowledge_append:
   "\<alpha>\<^sub>i\<^sub>k (A@B) \<I> =
     (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) \<I>) \<union>
     (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) \<I>)"
 by (metis unlabel_append abs_set_union image_Un ik\<^sub>s\<^sub>s\<^sub>t_append abs_intruder_knowledge_def)
 
 lemma abs_value_constants_append:
   fixes A B::"('a,'b,'c,'d) prot_strand"
   shows "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s (A@B) \<I> =
       {t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>. \<exists>n. t = Fun (Val n) []} \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) \<I>) \<union>
       {t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>. \<exists>n. t = Fun (Val n) []} \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) \<I>)"
 proof -
   define a0 where "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B)) \<I>)"
   define M where "M \<equiv> \<lambda>a::('a,'b,'c,'d) prot_strand.
                             {t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t a) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>. \<exists>n. t = Fun (Val n) []}"
 
   have "M (A@B) = M A \<union> M B"
     using image_Un[of "\<lambda>x. x \<cdot> \<I>" "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"]
     unfolding M_def unlabel_append[of A B] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" "unlabel B"] by blast
   hence "M (A@B) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0 = (M A \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0) \<union> (M B \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0)" by (simp add: abs_set_union)
   thus ?thesis unfolding abs_value_constants_def a0_def M_def by force 
 qed
 
 lemma transaction_renaming_subst_has_no_pubconsts_abss:
   fixes \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_renaming_subst \<alpha> P A"
   shows "subst_range \<alpha> \<inter> pubval_terms = {}" (is ?A)
     and "subst_range \<alpha> \<inter> abs_terms = {}" (is ?B)
 proof -
   { fix t assume "t \<in> subst_range \<alpha>"
     then obtain x where "t = Var x" 
       using transaction_renaming_subst_is_renaming(1)[OF assms]
       by force
     hence "t \<notin> pubval_terms" "t \<notin> abs_terms" by simp_all
   } thus ?A ?B by auto
 qed
 
 lemma transaction_fresh_subst_has_no_pubconsts_abss:
   fixes \<sigma>::"('fun,'atom,'sets,'lbl) prot_subst"
   assumes "transaction_fresh_subst \<sigma> T \<A>" "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
   shows "subst_range \<sigma> \<inter> pubval_terms = {}" (is ?A)
     and "subst_range \<sigma> \<inter> abs_terms = {}" (is ?B)
 proof -
   { fix t assume "t \<in> subst_range \<sigma>"
     then obtain x where "x \<in> set (transaction_fresh T)" "\<sigma> x = t"
       using assms(1) unfolding transaction_fresh_subst_def by auto
     then obtain n where "t = Fun (Val n) []" 
       using transaction_fresh_subst_sends_to_val[OF assms(1)] assms(2)
       by meson
     hence "t \<notin> pubval_terms" "t \<notin> abs_terms" unfolding is_PubConstValue_def by simp_all
   } thus ?A ?B by auto
 qed
 
 lemma reachable_constraints_GSMP_no_pubvals_abss:
   assumes "\<A> \<in> reachable_constraints P"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and \<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>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
            "\<forall>n. PubConst Value n \<notin> \<Union>(funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
            "\<forall>n. Abs n \<notin> \<Union>(funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
   shows "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> GSMP (\<Union>T \<in> set P. trms_transaction T) - (pubval_terms \<union> abs_terms)"
     (is "?A \<subseteq> ?B")
 using assms(1) \<I>(4,5)
 proof (induction \<A> rule: reachable_constraints.induct)
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   define trms_P where "trms_P \<equiv> (\<Union>T \<in> set P. trms_transaction T)"
   define T' where "T' \<equiv> transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   have \<xi>_elim: "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = \<sigma> \<circ>\<^sub>s \<alpha>"
     using admissible_transaction_decl_subst_empty[OF bspec[OF P step.hyps(2)] step.hyps(3)]
     by simp
 
   note T_fresh = admissible_transactionE(2)[OF bspec[OF P step.hyps(2)]]
   note T_no_bvars = admissible_transactionE(4)[OF bspec[OF P step.hyps(2)]]
 
   have T_no_PubVal: "\<forall>T \<in> set P. \<forall>n. PubConst Value n \<notin> \<Union>(funs_term ` trms_transaction T)"
     and T_no_Abs: "\<forall>T \<in> set P. \<forall>n. Abs n \<notin> \<Union>(funs_term ` trms_transaction T)"
     using admissible_transactions_no_Value_consts''[OF bspec[OF P]] by metis+
 
   have \<I>': "\<forall>n. PubConst Value n \<notin> \<Union> (funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
            "\<forall>n. Abs n \<notin> \<Union> (funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
     using step.prems fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] unlabel_append[of \<A>]
     by auto
 
   have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (rm_vars (set X) (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))" for X
     using wt_subst_rm_vars[of "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" "set X"]
           transaction_decl_fresh_renaming_substs_wt[OF step.hyps(3-5)]
     by metis
   hence wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t ((rm_vars (set X) (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<circ>\<^sub>s \<I>)" for X
     using \<I>(2) wt_subst_compose by fast
 
   have wftrms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range ((rm_vars (set X) (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<circ>\<^sub>s \<I>))" for X
     using wf_trms_subst_compose[OF wf_trms_subst_rm_vars' \<I>(3)]
           transaction_decl_fresh_renaming_substs_range_wf_trms[OF step.hyps(3-5)]
     by fast
 
   have "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> ?B"
   proof
     fix t assume "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     hence "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq by blast
     then obtain s X where s:
         "s \<in> trms_transaction T"
         "t = s \<cdot> rm_vars (set X) (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<circ>\<^sub>s \<I>"
         "set X \<subseteq> bvars_transaction T"
       using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst'' unfolding T'_def by blast
 
     define \<theta> where "\<theta> \<equiv> rm_vars (set X) (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
     note 0 = pubval_terms_subst_range_comp[OF 
               transaction_fresh_subst_has_no_pubconsts_abss(1)[OF step.hyps(4) T_fresh]
               transaction_renaming_subst_has_no_pubconsts_abss(1)[OF step.hyps(5)]]
              abs_terms_subst_range_comp[OF 
               transaction_fresh_subst_has_no_pubconsts_abss(2)[OF step.hyps(4) T_fresh]
               transaction_renaming_subst_has_no_pubconsts_abss(2)[OF step.hyps(5)]]
 
     have 1: "s \<in> trms_P" using step.hyps(2) s(1) unfolding trms_P_def by auto
 
     have s_nin: "s \<notin> pubval_terms" "s \<notin> abs_terms"
       using 1 T_no_PubVal T_no_Abs funs_term_Fun_subterm
       unfolding trms_P_def is_PubConstValue_def is_Abs_def is_PubConst_def
       by (fastforce, blast)
 
     have 2: "(\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')) \<inter> pubval_terms = {}"
             "(\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')) \<inter> abs_terms = {}"
             "subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<inter> pubval_terms = {}"
             "subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<inter> abs_terms = {}"
       using 0 step.prems funs_term_Fun_subterm
       unfolding T'_def \<theta>_def \<xi>_elim
       by (fastforce simp add: is_PubConstValue_def is_PubConst_def,
           fastforce simp add: is_Abs_def,
           argo, argo)
 
     have "subst_range \<theta> \<subseteq> subst_range (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       using rm_vars_img_subset unfolding \<theta>_def \<xi>_elim by blast 
     hence 3: "subst_range \<theta> \<inter> pubval_terms = {}"
              "subst_range \<theta> \<inter> abs_terms = {}"
       using 2(3,4) step.prems funs_term_Fun_subterm
       unfolding T'_def \<theta>_def \<xi>_elim by (blast,blast)
     
     have "(\<I> ` fv (s \<cdot> \<theta>)) \<inter> pubval_terms = {}"
          "(\<I> ` fv (s \<cdot> \<theta>)) \<inter> abs_terms = {}"
     proof -
       have "\<theta> = \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" "bvars_transaction T = {}" "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
         using s(3) T_no_bvars step.hyps(2) rm_vars_empty
               vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel T'"]
               bvars\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel (transaction_strand T)" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
               unlabel_subst[of "transaction_strand T" "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
         unfolding \<theta>_def T'_def by simp_all
       hence "fv (s \<cdot> \<theta>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
         using trms\<^sub>s\<^sub>s\<^sub>t_fv_subst_subset[OF s(1), of \<theta>] unlabel_subst[of "transaction_strand T" \<theta>]
         unfolding T'_def by auto
       moreover have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
         using fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"]
               unlabel_append[of \<A> "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"]
               fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of T']
         by simp_all
       hence "\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<inter> pubval_terms = {}" "\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<inter> abs_terms = {}"
         using 2(1,2) by blast+
       ultimately show "(\<I> ` fv (s \<cdot> \<theta>)) \<inter> pubval_terms = {}" "(\<I> ` fv (s \<cdot> \<theta>)) \<inter> abs_terms = {}"
         by blast+
     qed
     hence \<sigma>\<alpha>\<I>_disj: "((\<theta> \<circ>\<^sub>s \<I>) ` fv s) \<inter> pubval_terms = {}" 
                     "((\<theta> \<circ>\<^sub>s \<I>) ` fv s) \<inter> abs_terms = {}" 
       using pubval_terms_subst_range_comp'[of \<theta> "fv s" \<I>]
             abs_terms_subst_range_comp'[of \<theta> "fv s" \<I>]
             pubval_terms_subst_range_disj[OF 3(1), of s]
             abs_terms_subst_range_disj[OF 3(2), of s]
       by (simp_all add: subst_apply_fv_unfold)
     
     have 4: "t \<notin> pubval_terms" "t \<notin> abs_terms"
       using s(2) s_nin \<sigma>\<alpha>\<I>_disj
             pubval_terms_subst[of s "rm_vars (set X) (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<circ>\<^sub>s \<I>"]
             pubval_terms_subst_range_disj[of "rm_vars (set X) (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<circ>\<^sub>s \<I>" s]
             abs_terms_subst[of s "rm_vars (set X) (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<circ>\<^sub>s \<I>"]
             abs_terms_subst_range_disj[of "rm_vars (set X) (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<circ>\<^sub>s \<I>" s]
       unfolding \<theta>_def
       by blast+
 
     have "t \<in> SMP trms_P" "fv t = {}"
       by (metis s(2) SMP.Substitution[OF SMP.MP[OF 1] wt wftrms, of X], 
           metis s(2) subst_subst_compose[of s "rm_vars (set X) (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)" \<I>]
                      interpretation_grounds[OF \<I>(1), of "s \<cdot> rm_vars (set X) (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"])
     hence 5: "t \<in> GSMP trms_P" unfolding GSMP_def by simp
     
     show "t \<in> ?B" using 4 5 by (auto simp add: trms_P_def)
   qed
   thus ?case
     using step.IH[OF \<I>'] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] unlabel_append[of \<A>]
           image_Un[of "\<lambda>x. x \<cdot> \<I>" "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"]
     by (simp add: T'_def)
 qed simp
 
 lemma \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_aux:
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and T: "T \<in> set P"
     and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
            "t = Fun (Val n) [] \<or> t = Var x"
     and neq:
       "t \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) \<noteq>
        t \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>)"
   shows "\<exists>y \<in> fv_transaction T - set (transaction_fresh T).
           t \<cdot> \<I> = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<and> \<Gamma>\<^sub>v y = TAtom Value"
 proof -
   let ?\<A>' = "\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   let ?\<B> = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"
   let ?\<B>' = "?\<B> \<cdot>\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
   let ?\<B>'' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
 
   have \<I>_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     and \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     and \<I>_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
     by (metis \<I> welltyped_constraint_model_def constraint_model_def,
         metis \<I> welltyped_constraint_model_def,
         metis \<I> welltyped_constraint_model_def constraint_model_def)
 
   note T_adm = bspec[OF P(1) T]
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
   note T_adm_upds = admissible_transaction_is_wellformed_transaction(3)[OF T_adm]
 
   have T_fresh_vars_value_typed: "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
     using T P(1) protocol_transaction_vars_TAtom_typed(3)[of T] P(1) by simp
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T_adm \<xi>]
 
   note \<xi>\<sigma>\<alpha>_wt = transaction_decl_fresh_renaming_substs_wt[OF \<xi> \<sigma> \<alpha>]
 
   have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \<A>_reach)
   hence t_wf: "wf\<^sub>t\<^sub>r\<^sub>m t" using t by auto
 
   have \<A>_no_val_bvars: "\<not>TAtom Value \<sqsubseteq> \<Gamma>\<^sub>v x"
     when "x \<in> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" for x
     using P(1) reachable_constraints_no_bvars \<A>_reach
           vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"] that
           admissible_transactionE(4)
     by fast
 
   have x': "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" when "t = Var x"
     using that t by (simp add: var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t)
 
   have "\<exists>f \<in> funs_term (t \<cdot> \<I>). is_Val f"
     using abs_eq_if_no_Val neq by metis
   hence "\<exists>n T. Fun (Val n) T \<sqsubseteq> t \<cdot> \<I>"
     using funs_term_Fun_subterm
     unfolding is_Val_def by fast
   hence "TAtom Value \<sqsubseteq> \<Gamma> (Var x)" when "t = Var x"
     using wt_subst_trm''[OF \<I>_wt, of "Var x"] that
           subtermeq_imp_subtermtypeeq[of "t \<cdot> \<I>"] wf_trm_subst[OF \<I>_wf, of t] t_wf
     by fastforce
   hence x_val: "\<Gamma>\<^sub>v x = TAtom Value" when "t = Var x"
     using reachable_constraints_vars_TAtom_typed[OF \<A>_reach P x'] that
     by fastforce
   hence x_fv: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" when "t = Var x" using x'
     using reachable_constraints_Value_vars_are_fv[OF \<A>_reach P x'] that
     by blast
   then obtain m where m: "t \<cdot> \<I> = Fun (Val m) []"
     using constraint_model_Value_term_is_Val[
             OF \<A>_reach welltyped_constraint_model_prefix[OF \<I>] P P_occ, of x]
           t(2) x_val
     by force
   hence 0: "\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) m \<noteq> \<alpha>\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>@?\<B>'') \<I>) m"
     using neq by (simp add: unlabel_def)
 
   have t_val: "\<Gamma> t = TAtom Value" using x_val t by force
 
   obtain u s where s: "t \<cdot> \<I> = u \<cdot> \<I>" "insert\<langle>u,s\<rangle> \<in> set ?\<B>' \<or> delete\<langle>u,s\<rangle> \<in> set ?\<B>'"
     using to_abs_neq_imp_db_update[OF 0] m
     by (metis (no_types, lifting) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst subst_lsst_unlabel)
   then obtain u' s' where s':
       "u = u' \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" "s = s' \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
       "insert\<langle>u',s'\<rangle> \<in> set ?\<B> \<or> delete\<langle>u',s'\<rangle> \<in> set ?\<B>"
     using stateful_strand_step_mem_substD(4,5)
     by blast
   hence s'': "insert\<langle>u',s'\<rangle> \<in> set (unlabel (transaction_strand T)) \<or>
               delete\<langle>u',s'\<rangle> \<in> set (unlabel (transaction_strand T))"
     using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(4,5)[of u' s' "transaction_strand T"]
     by simp_all
   then obtain y where y: "y \<in> fv_transaction T" "u' = Var y"
     using transaction_inserts_are_Value_vars[OF T_wf T_adm_upds, of u' s']
           transaction_deletes_are_Value_vars[OF T_wf T_adm_upds, of u' s']
           stateful_strand_step_fv_subset_cases(4,5)[of u' s' "unlabel (transaction_strand T)"]
     by auto
-  hence 1: "t \<cdot> \<I> = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>" using y s(1) s'(1) by (metis subst_apply_term.simps(1)) 
+  hence 1: "t \<cdot> \<I> = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>" using y s(1) s'(1) by (metis eval_term.simps(1)) 
 
   have 2: "y \<notin> set (transaction_fresh T)" when "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<noteq> \<sigma> y"
     using transaction_fresh_subst_grounds_domain[OF \<sigma>, of y] subst_compose[of \<sigma> \<alpha> y] that \<xi>_empty
     by (auto simp add: subst_ground_ident)
 
   have 3: "y \<notin> set (transaction_fresh T)" when "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     using 2 that \<sigma> unfolding transaction_fresh_subst_def by fastforce
 
   have 4: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
             (\<exists>B. prefix B \<A> \<and> x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> \<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B))"
     by (metis welltyped_constraint_model_prefix[OF \<I>]
               constraint_model_Value_var_in_constr_prefix[OF \<A>_reach _ P P_occ])
 
   have 5: "\<Gamma>\<^sub>v y = TAtom Value"
     using 1 t_val
           wt_subst_trm''[OF \<xi>\<sigma>\<alpha>_wt, of "Var y"]
           wt_subst_trm''[OF \<I>_wt, of t]
           wt_subst_trm''[OF \<I>_wt, of "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y"]
     by (auto simp del: subst_subst_compose)
 
   have "y \<notin> set (transaction_fresh T)"
   proof (cases "t = Var x")
     case True (* \<I> x occurs in \<A> but not in subst_range \<sigma>, so y cannot be fresh *)
     hence *: "\<I> x = Fun (Val m) []" "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" "\<I> x = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>"
       using m t(1) 1 x_fv x' by (force, blast, force)
 
     obtain B where B: "prefix B \<A>" "\<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
       using *(2) 4 x_val[OF True] by fastforce
     hence "\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
       using transaction_fresh_subst_range_fresh(1)[OF \<sigma>] trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)[of B]
       unfolding prefix_def by fast
     thus ?thesis using *(1,3) B(2) 2 by (metis subst_imgI term.distinct(1))
   next
     case False
     hence "t \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" using t by simp
     thus ?thesis using 1 3 by argo
   qed
   thus ?thesis using 1 5 y(1) by fast
 qed
 
 lemma \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_Var:
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and T: "T \<in> set P"
     and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
   shows "\<I> x \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>) \<in>
             timpl_closure_set {\<I> x \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)} (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>)"
 proof -
   define a0 where "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
   define a0' where "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>)"
   define a3 where "a3 \<equiv> \<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>"
 
   have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \<A>_reach)
 
   note T_adm = bspec[OF P(1) T]
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T_adm \<xi>]
   note \<xi>\<sigma>\<alpha>_wt = transaction_decl_fresh_renaming_substs_wt[OF \<xi> \<sigma> \<alpha>]
 
   have \<I>_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     and \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     and \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
     by (metis \<I> welltyped_constraint_model_def constraint_model_def,
         metis \<I> welltyped_constraint_model_def,
         metis \<I> welltyped_constraint_model_def constraint_model_def)
 
   have "\<Gamma>\<^sub>v x = Var Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = Var (prot_atom.Atom a))"
     using reachable_constraints_vars_TAtom_typed[OF \<A>_reach P, of x]
           x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"]
     by auto
 
   hence "\<I> x \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {\<I> x \<cdot>\<^sub>\<alpha> a0} a3"
   proof
     assume x_val: "\<Gamma>\<^sub>v x = TAtom Value"
     show "\<I> x \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {\<I> x \<cdot>\<^sub>\<alpha> a0} a3"
     proof (cases "\<I> x \<cdot>\<^sub>\<alpha> a0 = \<I> x \<cdot>\<^sub>\<alpha> a0'")
       case False
       hence "\<exists>y \<in> fv_transaction T - set (transaction_fresh T).
               \<I> x = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<and> \<Gamma>\<^sub>v y = TAtom Value"
         using \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_aux[OF \<A>_reach T \<I> \<xi> \<sigma> \<alpha> P P_occ fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t[OF x], of _ x]
         unfolding a0_def a0'_def
         by fastforce
       then obtain y where y:
           "y \<in> fv_transaction T - set (transaction_fresh T)"
           "\<I> x = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>"
           "\<I> x \<cdot>\<^sub>\<alpha> a0 = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0"
           "\<I> x \<cdot>\<^sub>\<alpha> a0' = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0'"
           "\<Gamma>\<^sub>v y = TAtom Value"
         by metis
       then obtain n where n: "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = Fun (Val n) []"
         using \<Gamma>\<^sub>v_TAtom''(2)[of y] x x_val
               transaction_var_becomes_Val[
                 OF reachable_constraints.step[OF \<A>_reach T \<xi> \<sigma> \<alpha>] \<I> \<xi> \<sigma> \<alpha> P P_occ T, of y]
         by force
 
       have "a0 n \<noteq> a0' n"
            "y \<in> fv_transaction T"
            "y \<notin> set (transaction_fresh T)"
            "absc (a0 n) = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0"
            "absc (a0' n) = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0'"
         using y n False by force+
       hence 1: "(a0 n, a0' n) \<in> a3" 
         unfolding a0_def a0'_def a3_def abs_term_implications_def
         by blast
       
       have 2: "\<I> x \<cdot>\<^sub>\<alpha> a0' \<in> set \<langle>a0 n --\<guillemotright> a0' n\<rangle>\<langle>\<I> x \<cdot>\<^sub>\<alpha> a0\<rangle>"
         using y n timpl_apply_const by auto
 
       show ?thesis
         using timpl_closure.TI[OF timpl_closure.FP 1] 2
               term_variants_pred_iff_in_term_variants[
                 of "(\<lambda>_. [])(Abs (a0 n) := [Abs (a0' n)])"]
         unfolding timpl_closure_set_def timpl_apply_term_def
         by auto
     qed (auto intro: timpl_closure_setI)
   next
     assume "\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a)"
     then obtain a where x_atom: "\<Gamma>\<^sub>v x = TAtom (Atom a)" by moura
 
     obtain f T where fT: "\<I> x = Fun f T"
       using interpretation_grounds[OF \<I>_interp, of "Var x"]
       by (cases "\<I> x") auto
 
     have fT_atom: "\<Gamma> (Fun f T) = TAtom (Atom a)"
       using wt_subst_trm''[OF \<I>_wt, of "Var x"] x_atom fT
       by simp
 
     have T: "T = []"
       using fT wf_trm_subst[OF \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s, of "Var x"] const_type_inv_wf[OF fT_atom]
       by fastforce
 
     have f: "\<not>is_Val f" using fT_atom unfolding is_Val_def by auto
 
     have "\<I> x \<cdot>\<^sub>\<alpha> b = \<I> x" for b
       using T fT abs_term_apply_const(2)[OF f]
       by auto
     thus "\<I> x \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {\<I> x \<cdot>\<^sub>\<alpha> a0} a3"
       by (auto intro: timpl_closure_setI)
   qed
   thus ?thesis by (metis a0_def a0'_def a3_def)
 qed
 
 lemma \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_Val:
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and T: "T \<in> set P"
     and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and n: "Fun (Val n) [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
   shows "Fun (Val n) [] \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>) \<in>
             timpl_closure_set {Fun (Val n) [] \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)} (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>)"
 proof -
   define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   define a0 where "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
   define a0' where "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<I>)"
   define a3 where "a3 \<equiv> \<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>"
 
   have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \<A>_reach)
 
   note T_adm = bspec[OF P(1) T]
 
   have "Fun (Abs (a0' n)) [] \<in> timpl_closure_set {Fun (Abs (a0 n)) []} a3"
   proof (cases "a0 n = a0' n")
     case False
     then obtain x where x:
         "x \<in> fv_transaction T - set (transaction_fresh T)" "Fun (Val n) [] = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I>"
       using \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_aux[OF \<A>_reach T \<I> \<xi> \<sigma> \<alpha> P P_occ n]
       by (fastforce simp add: a0_def a0'_def T'_def)
     hence "absc (a0 n) = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0" "absc (a0' n) = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0'"
       by simp_all
     hence 1: "(a0 n, a0' n) \<in> a3"
       using False x(1)
       unfolding a0_def a0'_def a3_def abs_term_implications_def T'_def
       by blast
     show ?thesis
       using timpl_apply_Abs[of "[]" "[]" "a0 n" "a0' n"]
             timpl_closure.TI[OF timpl_closure.FP[of "Fun (Abs (a0 n)) []" a3] 1]
             term_variants_pred_iff_in_term_variants[of "(\<lambda>_. [])(Abs (a0 n) := [Abs (a0' n)])"]
       unfolding timpl_closure_set_def timpl_apply_term_def
       by force
   qed (auto intro: timpl_closure_setI)
   thus ?thesis by (simp add: a0_def a0'_def a3_def T'_def)
 qed
 
 lemma \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_ik:
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and T: "T \<in> set P"
     and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and t: "t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
   shows "t \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>) \<in>
             timpl_closure_set {t \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)} (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>)"
 proof -
   define a0 where "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
   define a0' where "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>)"
   define a3 where "a3 \<equiv> \<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>"
 
   let ?U = "\<lambda>T a. map (\<lambda>s. s \<cdot> \<I> \<cdot>\<^sub>\<alpha> a) T"
 
   have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \<A>_reach)
 
   note T_adm = bspec[OF P(1) T]
 
   have "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" "wf\<^sub>t\<^sub>r\<^sub>m t" using \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s t ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset by force+
   hence "\<forall>t0 \<in> subterms t. t0 \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {t0 \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0} a3"
   proof (induction t)
     case (Var x) thus ?case
       using \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_Var[OF \<A>_reach T \<I> \<xi> \<sigma> \<alpha> P P_occ, of x]
             ik\<^sub>s\<^sub>s\<^sub>t_var_is_fv[of x "unlabel \<A>"] vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"]
       by (simp add: a0_def a0'_def a3_def)
   next
     case (Fun f S)
     have IH: "\<forall>t0 \<in> subterms t. t0 \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {t0 \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0} a3"
       when "t \<in> set S" for t
       using that Fun.prems(1) wf_trm_param[OF Fun.prems(2)] Fun.IH
       by (meson in_subterms_subset_Union params_subterms subsetCE)
     hence "t \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {t \<cdot>\<^sub>\<alpha> a0} a3"
       when "t \<in> set (map (\<lambda>s. s \<cdot> \<I>) S)" for t
       using that by auto
     hence "t \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure (t \<cdot>\<^sub>\<alpha> a0) a3"
       when "t \<in> set (map (\<lambda>s. s \<cdot> \<I>) S)" for t
       using that timpl_closureton_is_timpl_closure by auto
     hence "(t \<cdot>\<^sub>\<alpha> a0, t \<cdot>\<^sub>\<alpha> a0') \<in> timpl_closure' a3"
       when "t \<in> set (map (\<lambda>s. s \<cdot> \<I>) S)" for t
       using that timpl_closure_is_timpl_closure' by auto
     hence IH': "((?U S a0) ! i, (?U S a0') ! i) \<in> timpl_closure' a3"
       when "i < length (map (\<lambda>s. s \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0) S)" for i
       using that by auto
 
     show ?case
     proof (cases "\<exists>n. f = Val n")
       case True
       then obtain n where "Fun f S = Fun (Val n) []"
         using Fun.prems(2) unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by force
       moreover have "Fun f S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
         using ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset Fun.prems(1) by blast
       ultimately show ?thesis
         using \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_Val[OF \<A>_reach T \<I> \<xi> \<sigma> \<alpha> P P_occ]
         by (simp add: a0_def a0'_def a3_def)
     next
       case False
       hence "Fun f S \<cdot> \<I> \<cdot>\<^sub>\<alpha> a = Fun f (map (\<lambda>t. t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a) S)" for a by (cases f) simp_all
       hence "(Fun f S \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0, Fun f S \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0') \<in> timpl_closure' a3"
         using timpl_closure_FunI[OF IH']
         by simp
       hence "Fun f S \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {Fun f S \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0} a3"
         using timpl_closureton_is_timpl_closure
               timpl_closure_is_timpl_closure'
         by metis
       thus ?thesis using IH by simp
     qed
   qed
   thus ?thesis by (simp add: a0_def a0'_def a3_def)
 qed
 
 lemma transaction_prop1:
   assumes "\<delta> \<in> abs_substs_fun ` set (transaction_check_comp msgcs (FP, OCC, TI) T)"
     and "x \<in> fv_transaction T"
     and "x \<notin> set (transaction_fresh T)"
     and "\<delta> x \<noteq> absdbupd (unlabel (transaction_updates T)) x (\<delta> x)"
     and "transaction_check' msgcs (FP, OCC, TI) T"
     and TI: "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
   shows "(\<delta> x, absdbupd (unlabel (transaction_updates T)) x (\<delta> x)) \<in> (set TI)\<^sup>+"
 proof -
   let ?upd = "\<lambda>x. absdbupd (unlabel (transaction_updates T)) x (\<delta> x)"
 
   have 0: "fv_transaction T = set (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)))"
     by (metis fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]) 
 
   have 1: "transaction_check_post (FP, OCC, TI) T \<delta>"
     using assms(1,5)
     unfolding transaction_check_def transaction_check'_def list_all_iff
     by blast
 
   have "(\<delta> x, ?upd x) \<in> set TI \<longleftrightarrow> (\<delta> x, ?upd x) \<in> (set TI)\<^sup>+"
     using TI using assms(4) by blast
   thus ?thesis
     using assms(2,3,4) 0 1 in_trancl_closure_iff_in_trancl_fun[of _ _ TI]
     unfolding transaction_check_post_def List.member_def Let_def by blast
 qed
 
 lemma transaction_prop2:
   assumes \<delta>: "\<delta> \<in> abs_substs_fun ` set (transaction_check_comp msgcs (FP, OCC, TI) T)"
     and x: "x \<in> fv_transaction T" "fst x = TAtom Value"
     and T_check: "transaction_check' msgcs (FP, OCC, TI) T"
     and T_adm: "admissible_transaction' T"
     and T_occ: "admissible_transaction_occurs_checks T"
     and FP:
       "analyzed (timpl_closure_set (set FP) (set TI))"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
     and OCC:
       "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
       "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
     and TI:
       "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
   shows "x \<notin> set (transaction_fresh T) \<Longrightarrow> \<delta> x \<in> set OCC" (is "?A' \<Longrightarrow> ?A")
     and "absdbupd (unlabel (transaction_updates T)) x (\<delta> x) \<in> set OCC" (is ?B)
 proof -
   let ?xs = "fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))"
   let ?ys = "filter (\<lambda>x. x \<notin> set (transaction_fresh T) \<and> fst x = TAtom Value) ?xs"
   let ?C = "unlabel (transaction_checks T)"
   let ?poss = "transaction_poschecks_comp ?C"
   let ?negs = "transaction_negchecks_comp ?C"
   let ?\<delta>upd = "\<lambda>y. absdbupd (unlabel (transaction_updates T)) y (\<delta> y)"
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
 
   have 0: "{x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value} = set ?ys"
     using fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
     by force
 
   have 1: "transaction_check_pre (FP, OCC, TI) T \<delta>"
     using \<delta> unfolding transaction_check_comp_def Let_def by fastforce
 
   have 2: "transaction_check_post (FP, OCC, TI) T \<delta>"
     using \<delta> T_check unfolding transaction_check_def transaction_check'_def list_all_iff by auto
 
   have 3: "\<delta> \<in> abs_substs_fun ` set (abs_substs_set ?ys OCC ?poss ?negs msgcs)"
     using \<delta> unfolding transaction_check_comp_def Let_def by force
 
   show A: ?A when ?A' using that 0 3 x abs_substs_abss_bounded by blast
 
   have 4: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
     when x': "x \<in> set (transaction_fresh T)"
     using x' admissible_transactionE(7)[OF T_adm] by blast
 
   have "intruder_synth_mod_timpls FP TI (occurs (absc (?\<delta>upd x)))"
     when x': "x \<in> set (transaction_fresh T)"
   proof -
     obtain l ts S where ts:
         "transaction_send T = (l,send\<langle>ts\<rangle>)#S" "occurs (Var x) \<in> set ts"
       using admissible_transaction_occurs_checksE2[OF T_occ x'] by blast
     hence "occurs (Var x) \<in> set ts" "send\<langle>ts\<rangle> \<in> set (unlabel (transaction_send T))"
       using x' unfolding suffix_def by (fastforce, fastforce)
     thus ?thesis using 2 x unfolding transaction_check_post_def by fastforce
   qed
   hence "timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c occurs (absc (?\<delta>upd x))"
     when x': "x \<in> set (transaction_fresh T)"
     using x' intruder_synth_mod_timpls_is_synth_timpl_closure_set[
             OF TI, of FP "occurs (absc (?\<delta>upd x))"]
     by argo
   hence "Abs (?\<delta>upd x) \<in> \<Union>(funs_term ` timpl_closure_set (set FP) (set TI))"
     when x': "x \<in> set (transaction_fresh T)"
     using x' ideduct_synth_priv_fun_in_ik[
             of "timpl_closure_set (set FP) (set TI)" "occurs (absc (?\<delta>upd x))"]
     by simp
   hence "\<exists>t \<in> timpl_closure_set (set FP) (set TI). Abs (?\<delta>upd x) \<in> funs_term t"
     when x': "x \<in> set (transaction_fresh T)"
     using x' by force
   hence 5: "?\<delta>upd x \<in> set OCC" when x': "x \<in> set (transaction_fresh T)"
     using x' OCC by fastforce
 
   have 6: "?\<delta>upd x \<in> set OCC" when x': "x \<notin> set (transaction_fresh T)"
   proof (cases "\<delta> x = ?\<delta>upd x")
     case False
     hence "(\<delta> x, ?\<delta>upd x) \<in> (set TI)\<^sup>+" "\<delta> x \<in> set OCC"
       using A 2 x' x TI
       unfolding transaction_check_post_def fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t Let_def
                 in_trancl_closure_iff_in_trancl_fun[symmetric]
                 List.member_def
       by blast+
     thus ?thesis using timpl_closure_set_absc_subset_in[OF OCC(2)] by blast
   qed (simp add: A x' x(1))
 
   show ?B by (metis 5 6)
 qed
 
 lemma transaction_prop3:
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and T: "T \<in> set P"
     and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and FP:
       "analyzed (timpl_closure_set (set FP) (set TI))"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
       "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
     and OCC:
       "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
       "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
       "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
     and TI:
       "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     and P:
       "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
   shows "\<forall>x \<in> set (transaction_fresh T). (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc {}" (is ?A)
     and "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T).
             intruder_synth_mod_timpls FP TI (t \<cdot> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>))" (is ?B)
     and "\<forall>x \<in> fv_transaction T - set (transaction_fresh T).
          \<forall>s. select\<langle>Var x,Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))
                  \<longrightarrow> (\<exists>ss. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc ss \<and> s \<in> ss)" (is ?C)
     and "\<forall>x \<in> fv_transaction T - set (transaction_fresh T).
          \<forall>s. \<langle>Var x in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))
                  \<longrightarrow> (\<exists>ss. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc ss \<and> s \<in> ss)" (is ?D)
     and "\<forall>x \<in> fv_transaction T - set (transaction_fresh T).
          \<forall>s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))
                  \<longrightarrow> (\<exists>ss. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc ss \<and> s \<notin> ss)" (is ?E)
     and "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
          (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) \<in> absc ` set OCC" (is ?F)
 proof -
   let ?T' = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   let ?\<theta> = "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
   define a0 where "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
   define a0' where "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@?T') \<I>)"
   define fv_AT' where "fv_AT' \<equiv> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@?T')"
 
   note T_adm = bspec[OF P(1) T]
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
   note T_adm' = admissible_transaction_is_wellformed_transaction(2-4)[OF T_adm]
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T_adm \<xi>]
   hence \<xi>_elim: "?\<theta> = \<sigma> \<circ>\<^sub>s \<alpha>" by simp
 
   have \<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>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
            "\<forall>n. PubConst Value n \<notin> \<Union>(funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
            "\<forall>n. Abs n \<notin> \<Union>(funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
            "\<forall>n. PubConst Value n \<notin> \<Union>(funs_term ` (\<I> ` fv_AT'))"
            "\<forall>n. Abs n \<notin> \<Union>(funs_term ` (\<I> ` fv_AT'))"
     using \<I> admissible_transaction_occurs_checks_prop'[
             OF \<A>_reach welltyped_constraint_model_prefix[OF \<I>] P P_occ]
           admissible_transaction_occurs_checks_prop'[
             OF reachable_constraints.step[OF \<A>_reach T \<xi> \<sigma> \<alpha>] \<I> P P_occ]
     unfolding welltyped_constraint_model_def constraint_model_def is_Val_def is_Abs_def fv_AT'_def
     by (meson,meson,meson,metis,metis,metis,metis)
 
   have T_no_pubconsts: "\<forall>n. PubConst Value n \<notin> \<Union>(funs_term ` trms_transaction T)"
     and T_no_abss: "\<forall>n. Abs n \<notin> \<Union>(funs_term ` trms_transaction T)"
     and T_fresh_vars_value_typed: "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
     and T_fv_const_typed: "\<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
     using protocol_transaction_vars_TAtom_typed
           protocol_transactions_no_pubconsts
           protocol_transactions_no_abss
           funs_term_Fun_subterm P T
     by (fast, fast, fast, fast)
 
   have wt_\<sigma>\<alpha>\<I>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>)"
     using \<I>'(2) wt_subst_compose transaction_fresh_subst_wt[OF \<sigma>]
           transaction_renaming_subst_wt[OF \<alpha>]
     by blast
 
   have 1: "?\<theta> y \<cdot> \<I> = \<sigma> y" when "y \<in> set (transaction_fresh T)" for y
     using transaction_fresh_subst_grounds_domain[OF \<sigma> that] subst_compose[of \<sigma> \<alpha> y]
     unfolding \<xi>_elim by (simp add: subst_ground_ident)
 
   have 2: "?\<theta> y \<cdot> \<I> \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" when "y \<in> set (transaction_fresh T)" for y
     using 1[OF that] that \<sigma> unfolding transaction_fresh_subst_def by auto
 
   have 3: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
             (\<exists>B. prefix B \<A> \<and> x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> \<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B))"
     by (metis welltyped_constraint_model_prefix[OF \<I>]
               constraint_model_Value_var_in_constr_prefix[OF \<A>_reach _ P P_occ])
 
   have 4: "\<exists>n. ?\<theta> y \<cdot> \<I> = Fun (Val n) []"
     when "y \<in> fv_transaction T" "\<Gamma>\<^sub>v y = TAtom Value" for y
     using transaction_var_becomes_Val[
             OF reachable_constraints.step[OF \<A>_reach T \<xi> \<sigma> \<alpha>] \<I> \<xi> \<sigma> \<alpha> P P_occ T]
           that T_fv_const_typed \<Gamma>\<^sub>v_TAtom''[of y]
     by metis
 
   have \<I>_is_T_model: "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) (set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)) (unlabel ?T') \<I>"
     using \<I> unlabel_append[of \<A> ?T'] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>" \<I> "[]"]
           strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" "unlabel ?T'" \<I>]
     by (simp add: welltyped_constraint_model_def constraint_model_def db\<^sub>s\<^sub>s\<^sub>t_def)
 
   have T_rcv_no_val_bvars: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<inter> subst_domain ?\<theta> = {}"
     using admissible_transaction_no_bvars[OF T_adm] bvars_transaction_unfold[of T] by blast
 
   show ?A
   proof
     fix y assume y: "y \<in> set (transaction_fresh T)"
     then obtain yn where yn: "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = Fun (Val yn) []" "Fun (Val yn) [] \<in> subst_range \<sigma>"
       by (metis \<xi>_elim T_fresh_vars_value_typed transaction_fresh_subst_sends_to_val'[OF \<sigma>])
 
     { \<comment> \<open>since \<open>y\<close> is fresh \<open>(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>\<close> cannot be part of the database state of \<open>\<I> \<A>\<close>\<close>
       fix t' s assume t': "insert\<langle>t',s\<rangle> \<in> set (unlabel \<A>)" "t' \<cdot> \<I> = Fun (Val yn) []"
       then obtain z where t'_z: "t' = Var z" using 2[OF y] yn(1) by (cases t') auto
       hence z: "z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" "\<I> z = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>" using t' yn(1) by force+
       hence z': "\<Gamma>\<^sub>v z = TAtom Value"
         by (metis \<Gamma>.simps(1) \<Gamma>_consts_simps(2) t'(2) t'_z wt_subst_trm'' \<I>'(2))
 
       obtain B where B: "prefix B \<A>" "\<I> z \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" using z z' 3 by fastforce
       hence "\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
         using transaction_fresh_subst_range_fresh(1)[OF \<sigma>] trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)[of B]
         unfolding prefix_def by fast
       hence False using B(2) 1[OF y] z yn(1) by (metis subst_imgI term.distinct(1)) 
     } hence "\<nexists>s. (?\<theta> y \<cdot> \<I>, s) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
       using db\<^sub>s\<^sub>s\<^sub>t_in_cases[of "?\<theta> y \<cdot> \<I>" _ "unlabel \<A>" \<I> "[]"] yn(1)
       by (force simp add: db\<^sub>s\<^sub>s\<^sub>t_def)
     thus "?\<theta> y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc {}"
       using to_abs_empty_iff_notin_db[of yn "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I> []"] yn(1)
       by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def)
   qed
 
   show receives_covered: ?B
   proof
     fix t assume t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
     hence t_in_T: "t \<in> trms_transaction T"
       using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)[of "transaction_receive T"]
       unfolding transaction_strand_def by fast
 
     obtain ts where ts: "t \<in> set ts" "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_receive T))"
       using t wellformed_transaction_send_receive_trm_cases(1)[OF T_wf] by blast
 
     have t_rcv: "receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t ?\<theta>\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?\<theta>))"
       using subst_lsst_unlabel_member[of "receive\<langle>ts\<rangle>" "transaction_receive T" ?\<theta>]
             trms\<^sub>s\<^sub>s\<^sub>t_in[OF t] ts
       by fastforce
     
     have "list_all (\<lambda>t. ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> ?\<theta> \<cdot> \<I>) ts"
       using wellformed_transaction_sem_receives[OF T_wf \<I>_is_T_model t_rcv]
       unfolding list_all_iff by fastforce
     hence *: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> ?\<theta> \<cdot> \<I>" using ts(1) unfolding list_all_iff by fast
 
     have t_fv: "fv (t \<cdot> ?\<theta>) \<subseteq> fv_AT'"
       using fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] unlabel_append[of \<A>]
             fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?\<theta>"]
             ts(1) t_rcv fv_transaction_subst_unfold[of T ?\<theta>]
       unfolding fv_AT'_def by force
 
     have **: "\<forall>t \<in> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
       using FP(3) by (auto simp add: a0_def abs_intruder_knowledge_def)
 
     note lms1 = pubval_terms_subst[OF _ pubval_terms_subst_range_disj[
                   OF transaction_fresh_subst_has_no_pubconsts_abss(1)[OF \<sigma>], of t]]
                 pubval_terms_subst[OF _ pubval_terms_subst_range_disj[
                   OF transaction_renaming_subst_has_no_pubconsts_abss(1)[OF \<alpha>], of "t \<cdot> \<sigma>"]]
 
     note lms2 = abs_terms_subst[OF _ abs_terms_subst_range_disj[
                   OF transaction_fresh_subst_has_no_pubconsts_abss(2)[OF \<sigma>], of t]]
                 abs_terms_subst[OF _ abs_terms_subst_range_disj[
                   OF transaction_renaming_subst_has_no_pubconsts_abss(2)[OF \<alpha>], of "t \<cdot> \<sigma>"]]
 
     have "t \<in> (\<Union>T\<in>set P. trms_transaction T)" "fv (t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I>) = {}"
       using t_in_T T interpretation_grounds[OF \<I>'(1)] by fast+
     moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>))"
       using wf_trm_subst_rangeI[of \<sigma>, OF transaction_fresh_subst_is_wf_trm[OF \<sigma>]]
             wf_trm_subst_rangeI[of \<alpha>, OF transaction_renaming_subst_is_wf_trm[OF \<alpha>]]
             wf_trms_subst_compose[of \<sigma> \<alpha>, THEN wf_trms_subst_compose[OF _ \<I>'(3)]]
       by blast
     moreover
     have "t \<notin> pubval_terms"
       using t_in_T T_no_pubconsts funs_term_Fun_subterm
       unfolding is_PubConstValue_def is_PubConst_def by fastforce
     hence "t \<cdot> ?\<theta> \<notin> pubval_terms"
       using lms1 T_fresh_vars_value_typed
       unfolding \<xi>_elim by auto
     hence "t \<cdot> ?\<theta> \<cdot> \<I> \<notin> pubval_terms"
       using \<I>'(6) t_fv pubval_terms_subst'[of "t \<cdot> ?\<theta>" \<I>]
       by auto
     moreover have "t \<notin> abs_terms"
       using t_in_T T_no_abss funs_term_Fun_subterm
       unfolding is_Abs_def by force
     hence "t \<cdot> ?\<theta> \<notin> abs_terms"
       using lms2 T_fresh_vars_value_typed
       unfolding \<xi>_elim by auto
     hence "t \<cdot> ?\<theta> \<cdot> \<I> \<notin> abs_terms"
       using \<I>'(7) t_fv abs_terms_subst'[of "t \<cdot> ?\<theta>" \<I>]
       by auto
     ultimately have ***:
         "t \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I> \<in> GSMP (\<Union>T\<in>set P. trms_transaction T) - (pubval_terms \<union> abs_terms)"
       using SMP.Substitution[OF SMP.MP[of t "\<Union>T\<in>set P. trms_transaction T"], of "\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>"]
             subst_subst_compose[of t ?\<theta> \<I>] wt_\<sigma>\<alpha>\<I>
       unfolding GSMP_def \<xi>_elim by fastforce
 
     have ****:
         "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> GSMP (\<Union>T\<in>set P. trms_transaction T) - (pubval_terms \<union> abs_terms)"
       using reachable_constraints_GSMP_no_pubvals_abss[OF \<A>_reach P \<I>'(1-5)]
             ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel \<A>"]
       by blast
 
     show "intruder_synth_mod_timpls FP TI (t \<cdot> ?\<theta> \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>))"
       using deduct_FP_if_deduct[OF **** ** * ***] deducts_eq_if_analyzed[OF FP(1)]
             intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI, of FP]
       unfolding a0_def by force
   qed
 
   show ?C
   proof (intro ballI allI impI)
     fix y s
     assume y: "y \<in> fv_transaction T - set (transaction_fresh T)"
        and s: "select\<langle>Var y, Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))"
     hence "select\<langle>Var y, Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_strand T))"
       unfolding transaction_strand_def unlabel_def by auto
     hence y_val: "\<Gamma>\<^sub>v y = TAtom Value"
       using transaction_selects_are_Value_vars[OF T_wf T_adm'(1)]
       by fastforce
 
     have "select\<langle>?\<theta> y, Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?\<theta>))"
       using subst_lsst_unlabel_member[OF s]
       by fastforce
     hence "((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>, Fun (Set s) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
       using wellformed_transaction_sem_pos_checks[
               OF T_wf \<I>_is_T_model,
               of Assign "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y" "Fun (Set s) []"]
       by simp
     thus "\<exists>ss. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc ss \<and> s \<in> ss"
       using to_abs_alt_def[of "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>"] 4[of y] y y_val by auto
   qed
 
   show ?D
   proof (intro ballI allI impI)
     fix y s
     assume y: "y \<in> fv_transaction T - set (transaction_fresh T)"
        and s: "\<langle>Var y in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))"
     hence "\<langle>Var y in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_strand T))"
       unfolding transaction_strand_def unlabel_def by auto
     hence y_val: "\<Gamma>\<^sub>v y = TAtom Value"
       using transaction_inset_checks_are_Value_vars[OF T_adm]
       by fastforce
 
     have "\<langle>?\<theta> y in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?\<theta>))"
       using subst_lsst_unlabel_member[OF s]
       by fastforce
     hence "(?\<theta> y \<cdot> \<I>, Fun (Set s) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
       using wellformed_transaction_sem_pos_checks[
               OF T_wf \<I>_is_T_model,
               of Check "?\<theta> y" "Fun (Set s) []"]
       by simp
     thus "\<exists>ss. ?\<theta> y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc ss \<and> s \<in> ss"
       using to_abs_alt_def[of "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>"] 4[of y] y y_val by auto
   qed
 
   show ?E
   proof (intro ballI allI impI)
     fix y s
     assume y: "y \<in> fv_transaction T - set (transaction_fresh T)"
        and s: "\<langle>Var y not in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))"
     hence "\<langle>Var y not in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_strand T))"
       unfolding transaction_strand_def unlabel_def by auto
     hence y_val: "\<Gamma>\<^sub>v y = TAtom Value"
       using transaction_notinset_checks_are_Value_vars(1)[
               OF T_adm, of "[]" "[]" "[(Var y, Fun (Set s) [])]" "Var y" "Fun (Set s) []"]
       by force
 
     have "\<langle>?\<theta> y not in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?\<theta>))"
       using subst_lsst_unlabel_member[OF s]
       by fastforce
     hence "(?\<theta> y \<cdot> \<I>, Fun (Set s) []) \<notin> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
       using wellformed_transaction_sem_neg_checks'(2)[
               OF T_wf \<I>_is_T_model,
               of "[]" "?\<theta> y" "Fun (Set s) []"]
       by simp
     moreover have "list_all admissible_transaction_updates P"
       using Ball_set[of P "admissible_transaction"] P(1)
             Ball_set[of P admissible_transaction_updates]
             admissible_transaction_is_wellformed_transaction(3)
       by fast
     moreover have "list_all wellformed_transaction P"
       using P(1) Ball_set[of P "admissible_transaction"] Ball_set[of P wellformed_transaction]
             admissible_transaction_is_wellformed_transaction(1)
       by blast
     ultimately have "((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>, Fun (Set s) S) \<notin> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)" for S
       using reachable_constraints_db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_args_empty[OF \<A>_reach] 
       unfolding admissible_transaction_updates_def
       by auto
     thus "\<exists>ss. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc ss \<and> s \<notin> ss"
       using to_abs_alt_def[of "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>"] 4[of y] y y_val by auto
   qed
 
   show ?F
   proof (intro ballI impI)
     fix y assume y: "y \<in> fv_transaction T - set (transaction_fresh T)" "\<Gamma>\<^sub>v y = TAtom Value"
     then obtain yn where yn: "?\<theta> y \<cdot> \<I> = Fun (Val yn) []" using 4 by moura
     hence y_abs: "?\<theta> y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = Fun (Abs (\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) yn)) []" by simp
 
     have "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<or> (y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<and>
           (\<exists>t s. select\<langle>t,s\<rangle> \<in> set (unlabel (transaction_checks T)) \<and> y \<in> fv t \<union> fv s))"
       using admissible_transaction_fv_in_receives_or_selects[OF T_adm] y by blast
     thus "?\<theta> y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) \<in> absc ` set OCC"
     proof
       assume "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
       then obtain ts where ts:
           "receive\<langle>ts\<rangle> \<in> set (unlabel (transaction_receive T))" "y \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
         using wellformed_transaction_unlabel_cases(1)[OF T_wf]
         by (force simp add: unlabel_def)
       
       have *: "?\<theta> y \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t ?\<theta> \<circ>\<^sub>s \<I>)"
               "list_all (\<lambda>t. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t \<cdot> ?\<theta> \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)) ts"
         using ts fv_subterms_substI[of y _ "?\<theta> \<circ>\<^sub>s \<I>"] subst_compose[of ?\<theta> \<I> y]
               subterms_subst_subset[of "?\<theta> \<circ>\<^sub>s \<I>"] receives_covered
         unfolding intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI, symmetric] list_all_iff
         by fastforce+
 
       have "Abs (\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) yn) \<in> \<Union>(funs_term ` (timpl_closure_set (set FP) (set TI)))"
         using * y_abs abs_subterms_in[of "?\<theta> y \<cdot> \<I>" _ "\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"]
               ideduct_synth_priv_fun_in_ik[
                 OF _ funs_term_Fun_subterm'[of "Abs (\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) yn)" "[]"]]
         unfolding list_all_iff by fastforce
       hence "?\<theta> y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) \<in> subterms\<^sub>s\<^sub>e\<^sub>t (timpl_closure_set (set FP) (set TI))"
         using y_abs wf_trms_subterms[OF timpl_closure_set_wf_trms[OF FP(2), of "set TI"]]
               funs_term_Fun_subterm[of "Abs (\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) yn)"]
         unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by fastforce
       hence "funs_term (?\<theta> y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>))
               \<subseteq> (\<Union>t \<in> timpl_closure_set (set FP) (set TI). funs_term t)"
         using funs_term_subterms_eq(2)[of "timpl_closure_set (set FP) (set TI)"] by blast
       thus ?thesis using y_abs OCC(1) by fastforce
     next
       assume "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<and>
           (\<exists>t s. select\<langle>t,s\<rangle> \<in> set (unlabel (transaction_checks T)) \<and> y \<in> fv t \<union> fv s)"
       then obtain t t' where
           "select\<langle>t,t'\<rangle> \<in> set (unlabel (transaction_checks T))" "y \<in> fv t \<union> fv t'"
         by blast
       then obtain l s where "(l,select\<langle>Var y, Fun (Set s) []\<rangle>) \<in> set (transaction_checks T)"
         using admissible_transaction_strand_step_cases(2)[OF T_adm]
         unfolding unlabel_def by fastforce
       then obtain U where U:
           "prefix (U@[(l,select\<langle>Var y, Fun (Set s) []\<rangle>)]) (transaction_checks T)"
         using in_set_conv_decomp[of "(l, select\<langle>Var y,Fun (Set s) []\<rangle>)" "transaction_checks T"]
         by (auto simp add: prefix_def)
       hence "select\<langle>Var y, Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))"
         by (force simp add: prefix_def unlabel_def)
       hence "select\<langle>?\<theta> y, Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?\<theta>))"
         using subst_lsst_unlabel_member
         by fastforce
       hence "(Fun (Val yn) [], Fun (Set s) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
         using yn wellformed_transaction_sem_pos_checks[
                 OF T_wf \<I>_is_T_model, of Assign "?\<theta> y" "Fun (Set s) []"]
         by fastforce
       hence "Fun (Val yn) [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
         using db\<^sub>s\<^sub>s\<^sub>t_in_cases[of "Fun (Val yn) []"]
         by (fastforce simp add: db\<^sub>s\<^sub>s\<^sub>t_def)
       thus ?thesis
         using OCC(3) yn abs_in[of "Fun (Val yn) []" _ "\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"]
         unfolding abs_value_constants_def
         by (metis (mono_tags, lifting) mem_Collect_eq subsetCE) 
     qed
   qed
 qed
 
 lemma transaction_prop4:
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and T: "T \<in> set P"
     and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and x: "x \<in> set (transaction_fresh T)"
     and y: "y \<in> fv_transaction T - set (transaction_fresh T)" "\<Gamma>\<^sub>v y = TAtom Value"
   shows "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>))" (is ?A)
     and "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>))" (is ?B)
 proof -
   let ?T' = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
 
   from \<I> have \<I>': "welltyped_constraint_model \<I> \<A>"
     using welltyped_constraint_model_prefix by auto
 
   note T_P_adm = bspec[OF P(1)]
   note T_adm = bspec[OF P(1) T]
 
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
 
   have be: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
     using T_P_adm \<A>_reach reachable_constraints_no_bvars admissible_transaction_no_bvars(2)
     by blast
 
   have T_no_bvars: "fv_transaction T = vars_transaction T"
     using admissible_transaction_no_bvars[OF T_adm] by simp
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T_adm \<xi>]
 
   have \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" by (metis \<I> welltyped_constraint_model_def)
 
   have x_val: "fst x = TAtom Value"
     using x admissible_transactionE(14)[OF T_adm] unfolding list_all_iff by blast
 
   obtain xn where xn: "\<sigma> x = Fun (Val xn) []"
     using x_val transaction_fresh_subst_sends_to_val[OF \<sigma> x] \<Gamma>\<^sub>v_TAtom''(2)[of x] by meson
   hence xnxn: "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x = Fun (Val xn) []"
     unfolding subst_compose_def \<xi>_empty by auto
 
   from xn xnxn have a0: "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> = Fun (Val xn) []"
     by auto
 
   have b0: "\<Gamma>\<^sub>v x = TAtom Value"
     using P x T protocol_transaction_vars_TAtom_typed(3)
     by metis
 
   note 0 = a0 b0
 
   have \<sigma>_x_nin_A: "\<sigma> x \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
   proof -
     have "\<sigma> x \<in> subst_range \<sigma>"
       by (metis transaction_fresh_subst_sends_to_val[OF \<sigma> x b0])
     moreover
     have "\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
       using \<sigma> transaction_fresh_subst_def[of \<sigma> T "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"] by blast
     ultimately
     show ?thesis
       by auto
   qed
 
   have *: "y \<notin> set (transaction_fresh T)"
      using assms by auto
 
   have **: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<or> (y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<and>
             (\<exists>t s. select\<langle>t,s\<rangle> \<in> set (unlabel (transaction_checks T)) \<and> y \<in> fv t \<union> fv s))"
     using * y admissible_transaction_fv_in_receives_or_selects[OF T_adm]
     by blast
 
   have y_fv: "y \<in> fv_transaction T" using y fv_transaction_unfold by blast
   
   have y_val: "fst y = TAtom Value" using y(2) \<Gamma>\<^sub>v_TAtom''(2) by blast
 
   have "\<sigma> x \<cdot> \<I> \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>))"
   proof (rule ccontr)
     assume "\<not>\<sigma> x \<cdot> \<I> \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>))"
     then have a: "\<sigma> x \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>))"
       by auto
 
     then have \<sigma>_x_I_in_A: "\<sigma> x \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
       using reachable_constraints_subterms_subst[OF \<A>_reach \<I>' P] by blast
 
     have "\<exists>u. u \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<and> \<I> u = \<sigma> x"
     proof -
       from \<sigma>_x_I_in_A have "\<exists>tu. tu \<in> \<Union> (subterms ` (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<and> tu \<cdot> \<I> = \<sigma> x \<cdot> \<I>"
         by force
       then obtain tu where tu: "tu \<in> \<Union> (subterms ` (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<and> tu \<cdot> \<I> = \<sigma> x \<cdot> \<I>"
         by auto
       then have "tu \<noteq> \<sigma> x"
         using \<sigma>_x_nin_A by auto
       moreover
       have "tu \<cdot> \<I> = \<sigma> x"
         using tu by (simp add: xn)
       ultimately
       have "\<exists>u. tu = Var u"
         unfolding xn by (cases tu) auto
       then obtain u where "tu = Var u"
         by auto
       have "u \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<and> \<I> u = \<sigma> x"
       proof -
         have "u \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
           using \<open>tu = Var u\<close> tu var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t by fastforce 
         then have "u \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
           using be vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"] by blast
         moreover
         have "\<I> u = \<sigma> x"
           using \<open>tu = Var u\<close> \<open>tu \<cdot> \<I> = \<sigma> x\<close> by auto
         ultimately
         show ?thesis
           by auto
       qed
       then show "\<exists>u. u \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<and> \<I> u = \<sigma> x"
         by metis
     qed
     then obtain u where u:
       "u \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" "\<I> u = \<sigma> x"
       by auto
     then have u_TA: "\<Gamma>\<^sub>v u = TAtom Value"
       using P(1) T x_val \<Gamma>\<^sub>v_TAtom''(2)[of x]
             wt_subst_trm''[OF \<I>_wt, of "Var u"] wt_subst_trm''[of \<sigma> "Var x"] 
             transaction_fresh_subst_wt[OF \<sigma>] protocol_transaction_vars_TAtom_typed(3)
       by force
     have "\<exists>B. prefix B \<A> \<and> u \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> \<I> u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
       using u u_TA
       by (metis welltyped_constraint_model_prefix[OF \<I>]
                 constraint_model_Value_var_in_constr_prefix[OF \<A>_reach _ P P_occ])
     then obtain B where "prefix B \<A> \<and> u \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> \<I> u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
       by blast
     moreover have "\<Union>(subterms ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t xs) \<subseteq> \<Union>(subterms ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ys)"
       when "prefix xs ys"
       for xs ys::"('fun,'atom,'sets,'lbl) prot_strand"
       using that subterms\<^sub>s\<^sub>e\<^sub>t_mono trms\<^sub>s\<^sub>s\<^sub>t_mono unlabel_mono set_mono_prefix by metis
     ultimately have "\<I> u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
       by blast
     then have "\<sigma> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
       using u by auto
     then show "False"
       using \<sigma>_x_nin_A by auto
   qed
   then show ?A
-    using subst_apply_term.simps(1)[of x \<sigma>]
+    using eval_term.simps(1)[of _ x \<sigma>]
     unfolding subst_compose_def xn \<xi>_empty by auto
 
   from ** show ?B
   proof
     define T' where "T' \<equiv> transaction_receive T"
     define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
     assume y: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
     hence "Var y \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" by (metis T'_def fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t)
     then obtain z where z: "z \<in> set (unlabel T')" "Var y \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p z)"
       by (induct T') auto
 
     have "is_Receive z"
       using Ball_set[of "unlabel T'" is_Receive] z(1)
             admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
       unfolding wellformed_transaction_def T'_def
       by blast
     then obtain tys where "z = receive\<langle>tys\<rangle>" by (cases z) auto
     hence tys: "receive\<langle>tys \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle> \<in> set (unlabel (T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" "\<theta> y \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set tys \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
       using z subst_mono unfolding subst_apply_labeled_stateful_strand_def unlabel_def by force+
     hence y_deduct: "list_all (\<lambda>t. ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<theta> \<cdot> \<I>) tys"
       using transaction_receive_deduct[OF T_wf _ \<xi> \<sigma> \<alpha>] \<I>
       unfolding T'_def \<theta>_def welltyped_constraint_model_def list_all_iff by auto
 
     obtain ty where ty: "ty \<in> set tys" "\<theta> y \<sqsubseteq> ty \<cdot> \<theta>" "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> ty \<cdot> \<theta> \<cdot> \<I>"
       using tys y_deduct unfolding list_all_iff by blast
 
     obtain zn where zn: "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = Fun (Val zn) []"
       using transaction_var_becomes_Val[
               OF reachable_constraints.step[OF \<A>_reach T \<xi> \<sigma> \<alpha>] \<I> \<xi> \<sigma> \<alpha> P P_occ T y_fv y_val]
       by metis
 
     have "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)"
       using ty tys(2) y_deduct private_fun_deduct_in_ik[of _ _ "Val zn"]
       by (metis \<theta>_def zn subst_mono public.simps(3))
     thus ?B
       using ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel \<A>" \<I>] unlabel_subst[of \<A> \<I>]
             subterms\<^sub>s\<^sub>e\<^sub>t_mono[OF ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>)"]]
       by fastforce
   next
     assume y': "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<and>
                 (\<exists>t s. select\<langle>t,s\<rangle> \<in> set (unlabel (transaction_checks T)) \<and> y \<in> fv t \<union> fv s)"
     then obtain s where s: "select\<langle>Var y,s\<rangle> \<in> set (unlabel (transaction_checks T))"
                            "fst y = TAtom Value"
       using admissible_transaction_strand_step_cases(1,2)[OF T_adm] by fastforce
 
     obtain z zn where zn: "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y = Var z" "\<I> z = Fun (Val zn) []"
       using transaction_var_becomes_Val[
               OF reachable_constraints.step[OF \<A>_reach T \<xi> \<sigma> \<alpha>] \<I> \<xi> \<sigma> \<alpha> P P_occ T y_fv s(2)]
             transaction_decl_fresh_renaming_substs_range(4)[OF \<xi> \<sigma> \<alpha> _ *]
             transaction_decl_subst_empty_inv[OF \<xi>[unfolded \<xi>_empty]]
       by auto
 
     have transaction_selects_db_here:
         "\<And>n s. select\<langle>Var (TAtom Value, n), Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))
                 \<Longrightarrow> (\<alpha> (TAtom Value, n) \<cdot> \<I>, Fun (Set s) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
       using transaction_selects_db[OF T_adm _ \<xi> \<sigma> \<alpha>] \<I>
       unfolding welltyped_constraint_model_def by auto
 
     have "\<exists>n. y = (Var Value, n)"
       using T \<Gamma>\<^sub>v_TAtom_inv(2) y_fv y(2)
       by blast
     moreover
     have "admissible_transaction_checks T"
       using admissible_transaction_is_wellformed_transaction(2)[OF T_adm]
       by blast
     then have "is_Fun_Set (the_set_term (select\<langle>Var y,s\<rangle>))"
       using s unfolding admissible_transaction_checks_def
       by auto
     then have "\<exists>ss. s = Fun (Set ss) []"
       using is_Fun_Set_exi
       by auto
     ultimately
     obtain n ss where nss: "y = (TAtom Value, n)" "s = Fun (Set ss) []"
       by auto
     then have "select\<langle>Var (TAtom Value, n), Fun (Set ss) []\<rangle> \<in> set (unlabel (transaction_checks T))"
       using s by auto
     then have in_db: "(\<alpha> (TAtom Value, n) \<cdot> \<I>, Fun (Set ss) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
       using transaction_selects_db_here[of n ss] by auto
     have "(\<I> z, s) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
     proof -
       have "(\<alpha> y \<cdot> \<I>, s) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
         using in_db nss by auto
       moreover 
       have "\<alpha> y = Var z"
         using zn \<xi>_empty * \<sigma>
         by (metis (no_types, opaque_lifting) subst_compose_def subst_imgI subst_to_var_is_var
                   term.distinct(1) transaction_fresh_subst_def var_comp(2)) 
       then have "\<alpha> y \<cdot> \<I> = \<I> z"
         by auto
       ultimately
       show "(\<I> z, s) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
         by auto
     qed
     then have "\<exists>t' s'. insert\<langle>t',s'\<rangle> \<in> set (unlabel \<A>) \<and> \<I> z = t' \<cdot> \<I> \<and> s = s' \<cdot> \<I>"
       using db\<^sub>s\<^sub>s\<^sub>t_in_cases[of "\<I> z" s "unlabel \<A>" \<I> "[]"] unfolding db\<^sub>s\<^sub>s\<^sub>t_def by auto
     then obtain t' s' where t's': "insert\<langle>t',s'\<rangle> \<in> set (unlabel \<A>) \<and> \<I> z = t' \<cdot> \<I> \<and> s = s' \<cdot> \<I>"
       by auto
     then have "t' \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
       by force
     then have "t' \<cdot> \<I> \<in> (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
       by auto
     then have "\<I> z \<in> (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
       using t's' by auto
     then have "\<I> z \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>))"
       using reachable_constraints_subterms_subst[
               OF \<A>_reach welltyped_constraint_model_prefix[OF \<I>] P]
       by auto
     then show ?B
       using zn(1) by simp
   qed
 qed
 
 lemma transaction_prop5:
   fixes T \<xi> \<sigma> \<alpha> \<A> \<I> T' a0 a0' \<theta>
   defines "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     and "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
     and "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<I>)"
     and "\<theta> \<equiv> \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x"
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and T: "T \<in> set P"
     and \<I>: "welltyped_constraint_model \<I> (\<A>@T')"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and FP:
       "analyzed (timpl_closure_set (set FP) (set TI))"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
       "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
     and OCC:
       "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
       "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
       "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
     and TI:
       "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     and P:
       "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ:
       "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and step: "list_all (transaction_check (FP, OCC, TI)) P"
   shows "\<exists>\<delta> \<in> abs_substs_fun ` set (transaction_check_comp (\<lambda>_ _. True) (FP, OCC, TI) T).
          \<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
             (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 = absc (\<delta> x) \<and>
             (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' = absc (absdbupd (unlabel (transaction_updates T)) x (\<delta> x))"
 proof -
   define comp0 where
     "comp0 \<equiv> abs_substs_fun ` set (transaction_check_comp (\<lambda>_ _. True) (FP, OCC, TI) T)"
   define check0 where "check0 \<equiv> transaction_check (FP, OCC, TI) T"
   define upd where "upd \<equiv> \<lambda>\<delta> x. absdbupd (unlabel (transaction_updates T)) x (\<delta> x)"
   define b0 where "b0 \<equiv> \<lambda>x. THE b. absc b = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0"
 
   note all_defs = comp0_def check0_def a0_def a0'_def upd_def b0_def \<theta>_def T'_def
 
   have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \<A>_reach)
 
   have \<I>_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     and \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     and \<I>_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
     by (metis \<I> welltyped_constraint_model_def constraint_model_def,
         metis \<I> welltyped_constraint_model_def,
         metis \<I> welltyped_constraint_model_def constraint_model_def)
 
   have \<I>_is_T_model: "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) (set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)) (unlabel T') \<I>"
     using \<I> unlabel_append[of \<A> T'] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>" \<I> "[]"]
           strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" "unlabel T'" \<I>]
     by (simp add: welltyped_constraint_model_def constraint_model_def db\<^sub>s\<^sub>s\<^sub>t_def)
 
   note T_adm = bspec[OF P(1) T]
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
 
   have T_no_bvars: "fv_transaction T = vars_transaction T" "bvars_transaction T = {}"
     using admissible_transaction_no_bvars[OF T_adm] by simp_all
 
   have T_vars_const_typed: "\<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
     and T_fresh_vars_value_typed: "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
     using T P protocol_transaction_vars_TAtom_typed(2,3)[of T] by simp_all
 
   note \<xi>_empty = admissible_transaction_decl_subst_empty[OF T_adm \<xi>]
 
   have wt_\<sigma>\<alpha>\<I>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>)" and wt_\<sigma>\<alpha>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     using \<I>_wt wt_subst_compose transaction_decl_fresh_renaming_substs_wt[OF \<xi> \<sigma> \<alpha>]
     by (blast, blast)
 
   have T_vars_vals: "\<forall>x \<in> fv_transaction T. \<exists>n. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> = Fun (Val n) []"
   proof
     fix x assume x: "x \<in> fv_transaction T"
     have "\<exists>n. (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> = Fun (Val n) []"
     proof (cases "x \<in> subst_domain \<sigma>")
       case True
       then obtain n where "\<sigma> x = Fun (Val n) []"
         using transaction_fresh_subst_sends_to_val[OF \<sigma>]
               transaction_fresh_subst_domain[OF \<sigma>]
               T_fresh_vars_value_typed
         by metis
       thus ?thesis by (simp add: subst_compose_def)
     next
       case False
       hence *: "(\<sigma> \<circ>\<^sub>s \<alpha>) x = \<alpha> x" by (auto simp add: subst_compose_def)
       
       obtain y where y: "\<Gamma>\<^sub>v x = \<Gamma>\<^sub>v y" "\<alpha> x = Var y"
         using transaction_renaming_subst_wt[OF \<alpha>]
               transaction_renaming_subst_is_renaming(1)[OF \<alpha>]
         by (metis \<Gamma>.simps(1) prod.exhaust wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
       hence "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
         using x * T_no_bvars(2) unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
               fv\<^sub>s\<^sub>s\<^sub>t_subst_fv_subset[of x "unlabel (transaction_strand T)" "\<sigma> \<circ>\<^sub>s \<alpha>"]
         by auto
       hence "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
         using fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
               fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] unlabel_append[of \<A>]
         by auto
       thus ?thesis
         using x y * T P (* T_vars_const_typed *)
               constraint_model_Value_term_is_Val[
                 OF reachable_constraints.step[OF \<A>_reach T \<xi> \<sigma> \<alpha>] \<I>[unfolded T'_def] P P_occ, of y]
               admissible_transaction_Value_vars[of T] \<xi>_empty
         by simp
     qed
     thus "\<exists>n. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> = Fun (Val n) []" using \<xi>_empty by simp
   qed
 
   have T_vars_absc: "\<forall>x \<in> fv_transaction T. \<exists>!n. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 = absc n"
     using T_vars_vals by fastforce
   hence "(absc \<circ> b0) x = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0" when "x \<in> fv_transaction T" for x
     using that unfolding b0_def by fastforce
   hence T_vars_absc': "t \<cdot> (absc \<circ> b0) = t \<cdot> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0"
     when "fv t \<subseteq> fv_transaction T" "\<nexists>n T. Fun (Val n) T \<in> subterms t" for t
     using that(1) abs_term_subst_eq'[OF _ that(2), of "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>" a0 "absc \<circ> b0"]
           subst_compose[of "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" \<I>] subst_subst_compose[of t "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" \<I>]
     by fastforce
 
   have "\<exists>\<delta> \<in> comp0. \<forall>x \<in> fv_transaction T. fst x = TAtom Value \<longrightarrow> b0 x = \<delta> x"
   proof -
     let ?C = "set (unlabel (transaction_checks T))"
     let ?xs = "fv_transaction T - set (transaction_fresh T)"
 
     note * = transaction_prop3[OF \<A>_reach T \<I>[unfolded T'_def] \<xi> \<sigma> \<alpha> FP OCC TI P P_occ]
 
     have **:
         "\<forall>x \<in> set (transaction_fresh T). b0 x = {}"
         "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> b0)"
           (is ?B)
     proof -
       show ?B
       proof (intro ballI impI)
         fix t assume t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
         hence t': "fv t \<subseteq> fv_transaction T" "\<nexists>n T. Fun (Val n) T \<in> subterms t"
           using trms_transaction_unfold[of T] vars_transaction_unfold[of T]
                 trms\<^sub>s\<^sub>s\<^sub>t_fv_vars\<^sub>s\<^sub>s\<^sub>t_subset[of t "unlabel (transaction_strand T)"]
                 admissible_transactions_no_Value_consts'[OF T_adm]
                 wellformed_transaction_send_receive_fv_subset(1)[OF T_wf t(1)]
           by blast+
         
         have "intruder_synth_mod_timpls FP TI (t \<cdot> (absc \<circ> b0))"
           using t(1) t' *(2) T_vars_absc'
           by (metis a0_def)
         moreover have "(absc \<circ> b0) x = (\<theta> b0) x" when "x \<in> fv t" for x
           using that T P admissible_transaction_Value_vars[of T]
                 \<open>fv t \<subseteq> fv_transaction T\<close> \<Gamma>\<^sub>v_TAtom''(2)[of x]
           unfolding \<theta>_def by fastforce
         hence "t \<cdot> (absc \<circ> b0) = t \<cdot> \<theta> b0"
           using term_subst_eq[of t "absc \<circ> b0" "\<theta> b0"] by argo
         ultimately show "intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> b0)"
           using intruder_synth.simps[of "set FP"] by (cases "t \<cdot> \<theta> b0") metis+
       qed
     qed (simp add: *(1) a0_def b0_def)
 
     have ***: "\<forall>x \<in> ?xs. \<forall>s. select\<langle>Var x,Fun (Set s) []\<rangle> \<in> ?C \<longrightarrow> s \<in> b0 x"
               "\<forall>x \<in> ?xs. \<forall>s. \<langle>Var x in Fun (Set s) []\<rangle> \<in> ?C \<longrightarrow> s \<in> b0 x"
               "\<forall>x \<in> ?xs. \<forall>s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> ?C \<longrightarrow> s \<notin> b0 x"
               "\<forall>x \<in> ?xs. fst x = TAtom Value \<longrightarrow> b0 x \<in> set OCC"
       unfolding a0_def b0_def
       using *(3,4) apply (force, force)
       using *(5) apply force
       using *(6) admissible_transaction_Value_vars[OF bspec[OF P T]] by force
 
     show ?thesis
       using transaction_check_comp_in[OF T_adm **[unfolded \<theta>_def] ***]
       unfolding comp0_def
       by metis
   qed
   hence 1: "\<exists>\<delta> \<in> comp0. \<forall>x \<in> fv_transaction T.
               fst x = TAtom Value \<longrightarrow> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 = absc (\<delta> x)"
     using T_vars_absc unfolding b0_def a0_def by fastforce
 
   obtain \<delta> where \<delta>:
       "\<delta> \<in> comp0"
       "\<forall>x \<in> fv_transaction T. fst x = TAtom Value \<longrightarrow> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 = absc (\<delta> x)"
     using 1 by moura
 
   have 2: "\<theta> x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) = absc (absdbupd (unlabel A) x d)"
     when "\<theta> x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 D = absc d"
     and "\<forall>t u. insert\<langle>t,u\<rangle> \<in> set (unlabel A) \<longrightarrow> (\<exists>y s. t = Var y \<and> u = Fun (Set s) [])"
     and "\<forall>t u. delete\<langle>t,u\<rangle> \<in> set (unlabel A) \<longrightarrow> (\<exists>y s. t = Var y \<and> u = Fun (Set s) [])"
     and "\<forall>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<theta> x \<cdot> \<I> = \<theta> y \<cdot> \<I> \<longrightarrow> x = y"
     and "\<forall>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<exists>n. \<theta> y \<cdot> \<I> = Fun (Val n) []"
     and x: "\<theta> x \<cdot> \<I> = Fun (Val n) []"
     and D: "\<forall>d \<in> set D. \<exists>s. snd d = Fun (Set s) []"
     for A::"('fun,'atom,'sets,'lbl) prot_strand" and x \<theta> D n d
     using that(2,3,4,5)
   proof (induction A rule: List.rev_induct)
     case (snoc a A)
     then obtain l b where a: "a = (l,b)" by (metis surj_pair)
 
     have IH: "\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n = absdbupd (unlabel A) x d"
       using snoc unlabel_append[of A "[a]"] a x
       by (simp del: unlabel_append)
 
     have b_prems: "\<forall>y \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p b. \<theta> x \<cdot> \<I> = \<theta> y \<cdot> \<I> \<longrightarrow> x = y"
                   "\<forall>y \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p b. \<exists>n. \<theta> y \<cdot> \<I> = Fun (Val n) []"
       using snoc.prems(3,4) a by (simp_all add: unlabel_def)
 
     have *: "filter is_Update (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) =
              filter is_Update (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
             "filter is_Update (unlabel (A@[a])) = filter is_Update (unlabel A)"
       when "\<not>is_Update b"
       using that a
       by (cases b, simp_all add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def unlabel_def subst_apply_labeled_stateful_strand_def)+
 
     note ** = IH a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_append[of A "[a]" \<theta>]
 
     note *** = * absdbupd_filter[of "unlabel (A@[a])"]
                absdbupd_filter[of "unlabel A"]
                db\<^sub>s\<^sub>s\<^sub>t_filter[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"]
                db\<^sub>s\<^sub>s\<^sub>t_filter[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"]
 
     note **** = **(2,3) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc[of A a \<theta>]
                 unlabel_append[of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>" "[dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]"]
                 db\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" "unlabel [dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]" \<I> D]
 
     have "\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n = absdbupd (unlabel (A@[a])) x d" using ** ***
     proof (cases b)
       case (Insert t t')
       then obtain y s m where y: "t = Var y" "t' = Fun (Set s) []" "\<theta> y \<cdot> \<I> = Fun (Val m) []"
         using snoc.prems(1) b_prems(2) a by (fastforce simp add: unlabel_def)
       hence a': "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D =
                  List.insert ((Fun (Val m) [], Fun (Set s) [])) (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<I> D)"
                 "unlabel [dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>] = [insert\<langle>\<theta> y, Fun (Set s) []\<rangle>]"
                 "unlabel [a] = [insert\<langle>Var y, Fun (Set s) []\<rangle>]"
         using **** Insert by simp_all
 
       show ?thesis
       proof (cases "x = y")
         case True
         hence "\<theta> x \<cdot> \<I> = \<theta> y \<cdot> \<I>" by simp
         hence "\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n =
                insert s (\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n)"
           by (metis (no_types, lifting) y(3) a'(1) x dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst to_abs_list_insert')
         thus ?thesis using True IH a'(3) absdbupd_append[of "unlabel A"] by (simp add: unlabel_def)
       next
         case False
         hence "\<theta> x \<cdot> \<I> \<noteq> \<theta> y \<cdot> \<I>" using b_prems(1) y Insert by simp
         hence "\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n = \<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n"
           by (metis (no_types, lifting) y(3) a'(1) x dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst to_abs_list_insert)
         thus ?thesis using False IH a'(3) absdbupd_append[of "unlabel A"] by (simp add: unlabel_def)
       qed
     next
       case (Delete t t')
       then obtain y s m where y: "t = Var y" "t' = Fun (Set s) []" "\<theta> y \<cdot> \<I> = Fun (Val m) []"
         using snoc.prems(2) b_prems(2) a by (fastforce simp add: unlabel_def)
       hence a': "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D =
                  List.removeAll ((Fun (Val m) [], Fun (Set s) [])) (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<I> D)"
                 "unlabel [dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>] = [delete\<langle>\<theta> y, Fun (Set s) []\<rangle>]"
                 "unlabel [a] = [delete\<langle>Var y, Fun (Set s) []\<rangle>]"
         using **** Delete by simp_all
 
       have "\<exists>s S. snd d = Fun (Set s) []" when "d \<in> set (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<I> D)" for d
         using snoc.prems(1,2) db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_ex[OF that _ _ D] by (simp add: unlabel_def)
       moreover {
         fix t::"('fun,'atom,'sets,'lbl) prot_term"
           and D::"(('fun,'atom,'sets,'lbl) prot_term \<times> ('fun,'atom,'sets,'lbl) prot_term) list"
         assume "\<forall>d \<in> set D. \<exists>s. snd d = Fun (Set s) []"
         hence "removeAll (t, Fun (Set s) []) D = filter (\<lambda>d. \<nexists>S. d = (t, Fun (Set s) S)) D"
           by (induct D) auto
       } ultimately have a'':
           "List.removeAll ((Fun (Val m) [], Fun (Set s) [])) (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<I> D) =
            filter (\<lambda>d. \<nexists>S. d = (Fun (Val m) [], Fun (Set s) S)) (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<I> D)"
         by simp
 
       show ?thesis
       proof (cases "x = y")
         case True
         hence "\<theta> x \<cdot> \<I> = \<theta> y \<cdot> \<I>" by simp
         hence "\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n =
                (\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n) - {s}"
           using y(3) a'' a'(1) x by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst to_abs_list_remove_all')
         thus ?thesis using True IH a'(3) absdbupd_append[of "unlabel A"] by (simp add: unlabel_def)
       next
         case False
         hence "\<theta> x \<cdot> \<I> \<noteq> \<theta> y \<cdot> \<I>" using b_prems(1) y Delete by simp
         hence "\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n = \<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n"
           by (metis (no_types, lifting) y(3) a'(1) x dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst to_abs_list_remove_all)
         thus ?thesis using False IH a'(3) absdbupd_append[of "unlabel A"] by (simp add: unlabel_def)
       qed
     qed simp_all
     thus ?case by (simp add: x)
   qed (simp add: that(1))
 
   have 3: "x = y"
     when xy: "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>" "x \<in> fv_transaction T" "y \<in> fv_transaction T"
     for x y
   proof -
     have "x \<notin> set (transaction_fresh T) \<Longrightarrow> y \<notin> set (transaction_fresh T) \<Longrightarrow> ?thesis"
       using xy admissible_transaction_strand_sem_fv_ineq[OF T_adm \<I>_is_T_model[unfolded T'_def]]
       by fast
     moreover {
       assume *: "x \<in> set (transaction_fresh T)" "y \<in> set (transaction_fresh T)"
       hence "\<Gamma>\<^sub>v x = TAtom Value" "\<Gamma>\<^sub>v y = TAtom Value"
         using T_fresh_vars_value_typed by (blast, blast)
       then obtain xn yn where "\<sigma> x = Fun (Val xn) []" "\<sigma> y = Fun (Val yn) []"
         using * transaction_fresh_subst_sends_to_val[OF \<sigma>] by meson
       hence "\<sigma> x = \<sigma> y" using that(1) \<xi>_empty by (simp add: subst_compose)
       moreover have "inj_on \<sigma> (subst_domain \<sigma>)" "x \<in> subst_domain \<sigma>" "y \<in> subst_domain \<sigma>"
         using * \<sigma> unfolding transaction_fresh_subst_def by auto
       ultimately have ?thesis unfolding inj_on_def by blast
     } moreover have False when "x \<in> set (transaction_fresh T)" "y \<notin> set (transaction_fresh T)"
       using that(2) xy T_no_bvars admissible_transaction_Value_vars[OF bspec[OF P T], of y]
             transaction_prop4[OF \<A>_reach T \<I>[unfolded T'_def] \<xi> \<sigma> \<alpha> P P_occ that(1), of y]
       by auto
     moreover have False when "x \<notin> set (transaction_fresh T)" "y \<in> set (transaction_fresh T)"
       using that(1) xy T_no_bvars admissible_transaction_Value_vars[OF bspec[OF P T], of x]
             transaction_prop4[OF \<A>_reach T \<I>[unfolded T'_def] \<xi> \<sigma> \<alpha> P P_occ that(2), of x]
       by fastforce
     ultimately show ?thesis by metis
   qed
 
   have 4: "\<exists>y s. t = Var y \<and> u = Fun (Set s) []"
     when "insert\<langle>t,u\<rangle> \<in> set (unlabel (transaction_strand T))" for t u
     using that admissible_transaction_strand_step_cases(3)[OF T_adm] T_wf
     by blast
 
   have 5: "\<exists>y s. t = Var y \<and> u = Fun (Set s) []"
     when "delete\<langle>t,u\<rangle> \<in> set (unlabel (transaction_strand T))" for t u
     using that admissible_transaction_strand_step_cases(3)[OF T_adm] T_wf
     by blast
 
   have 6: "\<exists>n. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = Fun (Val n) []" when "y \<in> fv_transaction T" for y
     using that by (simp add: T_vars_vals)
 
   have "list_all wellformed_transaction P" "list_all admissible_transaction_updates P"
     using P(1) Ball_set[of P admissible_transaction'] Ball_set[of P wellformed_transaction]
           Ball_set[of P admissible_transaction_updates]
           admissible_transaction_is_wellformed_transaction(1,3)
     by fastforce+
   hence 7: "\<exists>s. snd d = Fun (Set s) []" when "d \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)" for d
     using that reachable_constraints_db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_args_empty[OF \<A>_reach]
     unfolding admissible_transaction_updates_def by (cases d) simp
 
   have "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' = absc (upd \<delta> x)"
     when x: "x \<in> fv_transaction T" "fst x = TAtom Value" for x
   proof -
     have "(\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<I> (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>))
            = absc (absdbupd (unlabel (transaction_strand T)) x (\<delta> x))"
       using 2[of "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" x "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>" "\<delta> x" "transaction_strand T"]
             3[OF _ x(1)] 4 5 6[OF that(1)] 6 7 x \<delta>(2)
       unfolding all_defs by blast
     thus ?thesis
       using x db\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] absdbupd_wellformed_transaction[OF T_wf]
       unfolding all_defs db\<^sub>s\<^sub>s\<^sub>t_def by force
   qed
   thus ?thesis using \<delta> \<Gamma>\<^sub>v_TAtom''(2) unfolding all_defs by blast
 qed
 
 lemma transaction_prop6:
   fixes T \<xi> \<sigma> \<alpha> \<A> \<I> T' a0 a0'
   defines "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     and "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
     and "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<I>)"
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and T: "T \<in> set P"
     and \<I>: "welltyped_constraint_model \<I> (\<A>@T')"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and FP:
       "analyzed (timpl_closure_set (set FP) (set TI))"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
       "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
     and OCC:
       "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
       "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
       "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
     and TI:
       "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     and P:
       "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ:
       "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and step: "list_all (transaction_check (FP, OCC, TI)) P"
   shows "\<forall>t \<in> timpl_closure_set (\<alpha>\<^sub>i\<^sub>k \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>).
           timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t" (is ?A)
     and "timpl_closure_set (\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>) \<subseteq> absc ` set OCC" (is ?B)
     and "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T). is_Fun (t \<cdot> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0') \<longrightarrow>
           timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t \<cdot> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0'" (is ?C)
     and "\<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
           (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> absc ` set OCC" (is ?D)
 proof -
   define comp0 where
     "comp0 \<equiv> abs_substs_fun ` set (transaction_check_comp (\<lambda>_ _. True) (FP, OCC, TI) T)"
   define check0 where "check0 \<equiv> transaction_check (FP, OCC, TI) T"
 
   define upd where "upd \<equiv> \<lambda>\<delta> x. absdbupd (unlabel (transaction_updates T)) x (\<delta> x)"
 
   define \<theta> where "\<theta> \<equiv> \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x"
 
   note T_adm = bspec[OF P T]
   note T_occ = bspec[OF P_occ T]
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
 
   have \<theta>_prop: "\<theta> \<sigma> x = absc (\<sigma> x)" when "\<Gamma>\<^sub>v x = TAtom Value" for \<sigma> x
     using that \<Gamma>\<^sub>v_TAtom''(2)[of x] unfolding \<theta>_def by simp
 
    \<comment> \<open>The set-membership status of all value constants in T under \<open>\<I>\<close>, \<open>\<sigma>\<close>, \<open>\<alpha>\<close> are covered by the check\<close>
   have 0: "\<exists>\<delta> \<in> comp0. \<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
             (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 = absc (\<delta> x) \<and>
             (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' = absc (upd \<delta> x)"
     using transaction_prop5[OF \<A>_reach T \<I>[unfolded T'_def] \<xi> \<sigma> \<alpha> FP OCC TI P P_occ step]
     unfolding a0_def a0'_def T'_def upd_def comp0_def
     by blast
 
   \<comment> \<open>All set-membership changes are covered by the term implication graph\<close>
   have 1: "(\<delta> x, upd \<delta> x) \<in> (set TI)\<^sup>+"
     when "\<delta> \<in> comp0" "\<delta> x \<noteq> upd \<delta> x" "x \<in> fv_transaction T" "x \<notin> set (transaction_fresh T)"
     for x \<delta> 
     using T that step Ball_set[of P "transaction_check (FP, OCC, TI)"]
           transaction_prop1[of \<delta> "\<lambda>_ _. True" FP OCC TI T x] TI
     unfolding upd_def comp0_def transaction_check_def
     by blast
 
   \<comment> \<open>All set-membership changes are covered by the fixed point\<close>
   have 2: (* "\<delta> x \<in> set OCC" *) "upd \<delta> x \<in> set OCC"
     when "\<delta> \<in> comp0" "x \<in> fv_transaction T" "fst x = TAtom Value" for x \<delta>
     using T that step Ball_set[of P "transaction_check (FP, OCC, TI)"]
           T_adm T_occ FP OCC TI transaction_prop2[of \<delta> "\<lambda>_ _. True" FP OCC TI T x]
     unfolding upd_def comp0_def transaction_check_def
     by blast
   
   obtain \<delta> where \<delta>:
       "\<delta> \<in> comp0"
       "\<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
         (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 = absc (\<delta> x) \<and>
         (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' = absc (upd \<delta> x)"
     using 0 by moura
 
   have "\<exists>x. ab = (\<delta> x, upd \<delta> x) \<and> x \<in> fv_transaction T - set (transaction_fresh T) \<and> \<delta> x \<noteq> upd \<delta> x"
     when ab: "ab \<in> \<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>" for ab
   proof -
     obtain a b where ab': "ab = (a,b)" by (metis surj_pair)
     then obtain x where x:
         "a \<noteq> b" "x \<in> fv_transaction T" "x \<notin> set (transaction_fresh T)"
         "absc a = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0" "absc b = (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0'"
       using ab unfolding abs_term_implications_def a0_def a0'_def T'_def by blast
     hence "absc a = absc (\<delta> x)" "absc b = absc (upd \<delta> x)"
       using \<delta>(2) admissible_transaction_Value_vars[OF bspec[OF P T] x(2)]
       by metis+
     thus ?thesis using x ab' by blast
   qed
   hence \<alpha>\<^sub>t\<^sub>i_TI_subset: "\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I> \<subseteq> {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}" using 1[OF \<delta>(1)] by blast
   
   have "timpl_closure_set (timpl_closure_set (set FP) (set TI)) (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>) \<turnstile>\<^sub>c t"
     when t: "t \<in> timpl_closure_set (\<alpha>\<^sub>i\<^sub>k \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>)" for t
     using timpl_closure_set_is_timpl_closure_union[of "\<alpha>\<^sub>i\<^sub>k \<A> \<I>" "\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>"]
           intruder_synth_timpl_closure_set FP(3) t
     by blast
   thus ?A
     using ideduct_synth_mono[OF _ timpl_closure_set_mono[OF
             subset_refl[of "timpl_closure_set (set FP) (set TI)"]
             \<alpha>\<^sub>t\<^sub>i_TI_subset]]
           timpl_closure_set_timpls_trancl_eq'[of "timpl_closure_set (set FP) (set TI)" "set TI"]
     unfolding timpl_closure_set_idem
     by force
 
   have "timpl_closure_set (\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>) \<subseteq>
         timpl_closure_set (absc ` set OCC) {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     using timpl_closure_set_mono[OF _ \<alpha>\<^sub>t\<^sub>i_TI_subset] OCC(3) by blast
   thus ?B using OCC(2) timpl_closure_set_timpls_trancl_subset' by blast
 
   have "transaction_check_post (FP, OCC, TI) T \<delta>"
     using T \<delta>(1) step
     unfolding transaction_check_def transaction_check'_def comp0_def list_all_iff
     by fastforce
   hence 3: "timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t \<cdot> \<theta> (upd \<delta>)"
     when "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "is_Fun (t \<cdot> \<theta> (upd \<delta>))" for t
     using that
     unfolding transaction_check_post_def upd_def \<theta>_def
               intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI, symmetric]
     by fastforce
 
   have 4: "\<forall>x \<in> fv t. (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>) x \<cdot>\<^sub>\<alpha> a0' = \<theta> (upd \<delta>) x"
     when "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" for t
     using wellformed_transaction_send_receive_fv_subset(2)[OF T_wf that]
           \<delta>(2) subst_compose[of "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" \<I>] \<theta>_prop
           admissible_transaction_Value_vars[OF bspec[OF P T]]
     by fastforce
   
   have 5: "\<nexists>n T. Fun (Val n) T \<in> subterms t" when "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" for t
     using that admissible_transactions_no_Value_consts'[OF T_adm] trms_transaction_unfold[of T]
     by blast
 
   show ?D using 2[OF \<delta>(1)] \<delta>(2) \<Gamma>\<^sub>v_TAtom''(2) unfolding a0'_def T'_def by blast
 
   show ?C using 3 abs_term_subst_eq'[OF 4 5] by simp
 qed
 
 lemma reachable_constraints_covered_step:
   fixes \<A>::"('fun,'atom,'sets,'lbl) prot_constr"
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and T: "T \<in> set P"
     and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>))"
     and \<xi>: "transaction_decl_subst \<xi> T"
     and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     and FP:
       "analyzed (timpl_closure_set (set FP) (set TI))"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
       "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
       "ground (set FP)"
     and OCC:
       "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
       "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
       "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
     and TI:
       "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     and P:
       "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ:
       "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and transactions_covered: "list_all (transaction_check (FP, OCC, TI)) P"
   shows "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>.
           timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t" (is ?A)
     and "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) \<I> \<subseteq> absc ` set OCC" (is ?B)
 proof -
   note step_props =
     transaction_prop6[OF \<A>_reach T \<I> \<xi> \<sigma> \<alpha> FP(1,2,3) OCC TI P P_occ transactions_covered]
 
   define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   define a0 where "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
   define a0' where "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<I>)"
 
   define vals where "vals \<equiv> \<lambda>S::('fun,'atom,'sets,'lbl) prot_constr.
       {t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>. \<exists>n. t = Fun (Val n) []}"
 
   define vals_sym where "vals_sym \<equiv> \<lambda>S::('fun,'atom,'sets,'lbl) prot_constr.
       {t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S). (\<exists>n. t = Fun (Val n) []) \<or> (\<exists>m. t = Var (TAtom Value,m))}"
 
   have \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" by (metis \<I> welltyped_constraint_model_def)
 
   have \<I>_grounds: "fv (t \<cdot> \<I>) = {}" for t
     using \<I> interpretation_grounds[of \<I>]
     unfolding welltyped_constraint_model_def constraint_model_def by auto
 
   have wt_\<sigma>\<alpha>\<I>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>)" and wt_\<sigma>\<alpha>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     using \<I>_wt wt_subst_compose transaction_decl_fresh_renaming_substs_wt[OF \<xi> \<sigma> \<alpha>]
     by (blast, blast)
 
   have "\<forall>T\<in>set P. bvars_transaction T = {}"
     using P admissible_transactionE(4) by metis
   hence \<A>_no_bvars: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
     using reachable_constraints_no_bvars[OF \<A>_reach] by metis
 
   have \<I>_vals: "\<exists>n. \<I> (TAtom Value, m) = Fun (Val n) []"
     when "(TAtom Value, m) \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" for m
     using constraint_model_Value_term_is_Val'[
             OF \<A>_reach welltyped_constraint_model_prefix[OF \<I>] P P_occ]
           \<A>_no_bvars vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"] that
     by blast
 
   have vals_sym_vals: "t \<cdot> \<I> \<in> vals \<A>" when t: "t \<in> vals_sym \<A>" for t
   proof (cases t)
     case (Var x)
     then obtain m where *: "x = (TAtom Value,m)" using t unfolding vals_sym_def by blast
     moreover have "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" using t unfolding vals_sym_def by blast
     hence "t \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "\<exists>n. \<I> (Var Value, m) = Fun (Val n) []"
       using Var * \<I>_vals[of m] var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t[of x "unlabel \<A>"]
             \<Gamma>\<^sub>v_TAtom[of Value m] reachable_constraints_Value_vars_are_fv[OF \<A>_reach P(1), of x]
       by blast+
     ultimately show ?thesis using Var unfolding vals_def by auto
   next
     case (Fun f T)
     then obtain n where "f = Val n" "T = []" using t unfolding vals_sym_def by blast
     moreover have "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" using t unfolding vals_sym_def by blast
     hence "t \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using Fun by blast
     ultimately show ?thesis using Fun unfolding vals_def by auto
   qed
 
   have vals_vals_sym: "\<exists>s. s \<in> vals_sym \<A> \<and> t = s \<cdot> \<I>" when "t \<in> vals \<A>" for t
     using that constraint_model_Val_is_Value_term[OF \<I>]
     unfolding vals_def vals_sym_def by fast
 
   note T_adm = bspec[OF P T]
   note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
 
   have 0:
       "\<alpha>\<^sub>i\<^sub>k (\<A>@T') \<I> = (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0' \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0'"
       "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s (\<A>@T') \<I> = vals \<A> \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0' \<union> vals T' \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0'"
     by (metis abs_intruder_knowledge_append a0'_def,
         metis abs_value_constants_append[of \<A> T' \<I>] a0'_def vals_def)
 
   have 1: "(ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0' =
            (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0'"
     by (metis T'_def dual_transaction_ik_is_transaction_send''[OF T_wf])
 
   have 2: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<inter> subst_domain \<xi> = {}"
           "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<inter> subst_domain \<sigma> = {}"
           "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<inter> subst_domain \<alpha> = {}"
     using admissible_transactionE(4)[OF T_adm] by blast+
 
   have "vals T' \<subseteq> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` fv_transaction T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
   proof
     fix t assume "t \<in> vals T'"
     then obtain s n where s:
         "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" "t = s \<cdot> \<I>" "t = Fun (Val n) []"
       unfolding vals_def by fast
     then obtain u where u:
         "u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"
         "s = u \<cdot> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
       using transaction_decl_fresh_renaming_substs_trms[OF \<xi> \<sigma> \<alpha> 2]
             trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
       unfolding T'_def by blast
 
-    have *: "t = u \<cdot> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>)" by (metis subst_subst_compose s(2) u(2)) 
+    have *: "t = u \<cdot> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>)" using s(2) u(2) subst_subst_compose by simp
     then obtain x where x: "u = Var x"
       using s(3) admissible_transactions_no_Value_consts(1)[OF T_adm u(1)] by (cases u) force+
     hence **: "x \<in> vars_transaction T"
       by (metis u(1) var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t)
 
     have "\<Gamma>\<^sub>v x = TAtom Value"
       using * x s(3) wt_subst_trm''[OF wt_\<sigma>\<alpha>\<I>, of u]
       by simp
     thus "t \<in> (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` fv_transaction T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
       using admissible_transaction_Value_vars_are_fv[OF T_adm **] x *
-            subst_apply_term.simps(1)[of x "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>"]
+            eval_term.simps(1)[of _ x "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>"]
             subst_comp_set_image[of "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" \<I> "fv_transaction T"]
       by blast
   qed
   hence 3: "vals T' \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0' \<subseteq> ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` fv_transaction T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0'"
     by (simp add: abs_apply_terms_def image_mono)
 
   have "t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set (\<alpha>\<^sub>i\<^sub>k \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>)"
     when "t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" for t
     using that abs_in[OF imageI[OF that]]
           \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_ik[OF \<A>_reach T \<I> \<xi> \<sigma> \<alpha> P P_occ]
           timpl_closure_set_mono[of "{t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0}" "\<alpha>\<^sub>i\<^sub>k \<A> \<I>" "\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>"
                                     "\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>"]
     unfolding a0_def a0'_def T'_def abs_intruder_knowledge_def by fast
   hence A: "\<alpha>\<^sub>i\<^sub>k (\<A>@T') \<I> \<subseteq>
               timpl_closure_set (\<alpha>\<^sub>i\<^sub>k \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>) \<union>
               (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0'"
     using 0(1) 1 by (auto simp add: abs_apply_terms_def)
 
   have "t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0} (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>)"
     when t: "t \<in> vals_sym \<A>" for t
   proof -
     have "(\<exists>n. t = Fun (Val n) [] \<and> t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<or>
           (\<exists>n. t = Var (TAtom Value,n) \<and> (TAtom Value,n) \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
       (is "?P \<or> ?Q")
       using t var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t[of _ "unlabel \<A>"]
             \<Gamma>\<^sub>v_TAtom[of Value] reachable_constraints_Value_vars_are_fv[OF \<A>_reach P(1)]
       unfolding vals_sym_def by fast
     thus ?thesis
     proof
       assume ?P
       then obtain n where n: "t = Fun (Val n) []" "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" by moura
       thus ?thesis 
         using \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_Val[OF \<A>_reach T \<I> \<xi> \<sigma> \<alpha> P P_occ, of n]
         unfolding a0_def a0'_def T'_def by fastforce
     next
       assume ?Q
       thus ?thesis
         using \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_Var[OF \<A>_reach T \<I> \<xi> \<sigma> \<alpha> P P_occ]
         unfolding a0_def a0'_def T'_def by fastforce
     qed
   qed
   moreover have "t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 \<in> \<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>"
     when "t \<in> vals_sym \<A>" for t
     using that abs_in vals_sym_vals
     unfolding a0_def abs_value_constants_def vals_sym_def vals_def
     by (metis (mono_tags, lifting))
   ultimately have "t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set (\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>)"
     when t: "t \<in> vals_sym \<A>" for t
     using t timpl_closure_set_mono[of "{t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0}" "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>" "\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>"
                                       "\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>"]
     by blast
   hence "t \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set (\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>)"
     when t: "t \<in> vals \<A>" for t
     using vals_vals_sym[OF t] by blast
   hence B: "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s (\<A>@T') \<I> \<subseteq>
               timpl_closure_set (\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) \<I>) \<union>
               ((\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) ` fv_transaction T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0'"
     using 0(2) 3
     by (simp add: abs_apply_terms_def image_subset_iff)
 
   have 4: "fv (t \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I> \<cdot>\<^sub>\<alpha> a) = {}" for t a
     using \<I>_grounds[of "t \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] abs_fv[of "t \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I>" a]
     by argo
 
   have "is_Fun (t \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0')" for t
     using 4[of t a0'] by force
   thus ?A
     using A step_props(1,3)
     unfolding T'_def a0_def a0'_def abs_apply_terms_def
     by blast
 
   show ?B
     using B step_props(2,4) admissible_transaction_Value_vars[OF bspec[OF P T]]
     by (auto simp add: T'_def a0_def a0'_def abs_apply_terms_def)
 qed
 
 lemma reachable_constraints_covered:
   assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
     and \<I>: "welltyped_constraint_model \<I> \<A>"
     and FP:
       "analyzed (timpl_closure_set (set FP) (set TI))"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
       "ground (set FP)"
     and OCC:
       "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
       "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
     and TI:
       "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     and P:
       "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ:
       "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and transactions_covered: "list_all (transaction_check (FP, OCC, TI)) P"
   shows "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
     and "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
 using \<A>_reach \<I>
 proof (induction rule: reachable_constraints.induct)
   case init
   { case 1 show ?case by (simp add: abs_intruder_knowledge_def) }
   { case 2 show ?case by (simp add: abs_value_constants_def) }
 next
   case (step \<A> T \<xi> \<sigma> \<alpha>)
   { case 1
     hence "welltyped_constraint_model \<I> \<A>"
       by (metis welltyped_constraint_model_prefix)
     hence IH: "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
               "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
       using step.IH by metis+
     show ?case
       using reachable_constraints_covered_step[
               OF step.hyps(1,2) "1.prems" step.hyps(3-5) FP(1,2) IH(1)
                  FP(3) OCC IH(2) TI P P_occ transactions_covered]
       by metis
   }
   { case 2
     hence "welltyped_constraint_model \<I> \<A>"
       by (metis welltyped_constraint_model_prefix)
     hence IH: "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
               "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
       using step.IH by metis+
     show ?case
       using reachable_constraints_covered_step[
               OF step.hyps(1,2) "2.prems" step.hyps(3-5) FP(1,2) IH(1)
                  FP(3) OCC IH(2) TI P P_occ transactions_covered]
       by metis
   }
 qed
 
 lemma attack_in_fixpoint_if_attack_in_ik:
   fixes FP::"('fun,'atom,'sets,'lbl) prot_terms"
   assumes "\<forall>t \<in> IK \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a. FP \<turnstile>\<^sub>c t"
     and "attack\<langle>n\<rangle> \<in> IK"
   shows "attack\<langle>n\<rangle> \<in> FP"
 proof -
   have "attack\<langle>n\<rangle> \<cdot>\<^sub>\<alpha> a \<in> IK \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a" by (rule abs_in[OF assms(2)])
   hence "FP \<turnstile>\<^sub>c attack\<langle>n\<rangle> \<cdot>\<^sub>\<alpha> a" using assms(1) by blast
   moreover have "attack\<langle>n\<rangle> \<cdot>\<^sub>\<alpha> a = attack\<langle>n\<rangle>" by simp
   ultimately have "FP \<turnstile>\<^sub>c attack\<langle>n\<rangle>" by metis
   thus ?thesis using ideduct_synth_priv_const_in_ik[of FP "Attack n"] by simp
 qed
 
 lemma attack_in_fixpoint_if_attack_in_timpl_closure_set:
   fixes FP::"('fun,'atom,'sets,'lbl) prot_terms"
   assumes "attack\<langle>n\<rangle> \<in> timpl_closure_set FP TI"
   shows "attack\<langle>n\<rangle> \<in> FP"
 proof -
   have "\<forall>f \<in> funs_term (attack\<langle>n\<rangle>). \<not>is_Abs f" by auto
   thus ?thesis using timpl_closure_set_no_Abs_in_set[OF assms] by blast
 qed
 
 theorem prot_secure_if_fixpoint_covered_typed:
   assumes FP:
       "analyzed (timpl_closure_set (set FP) (set TI))"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
       "ground (set FP)"
     and OCC:
       "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
       "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
     and TI:
       "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     and P:
       "\<forall>T \<in> set P. admissible_transaction T"
       "has_initial_value_producing_transaction P"
     and transactions_covered: "list_all (transaction_check (FP, OCC, TI)) (map add_occurs_msgs P)"
     and attack_notin_FP: "attack\<langle>n\<rangle> \<notin> set FP"
     and \<A>: "\<A> \<in> reachable_constraints P"
   shows "\<nexists>\<I>. welltyped_constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])" (is "\<nexists>\<I>. ?Q \<I>")
 proof
   assume "\<exists>\<I>. ?Q \<I>"
   then obtain \<I> \<B> where
         \<B>: "\<B> \<in> reachable_constraints (map add_occurs_msgs P)"
     and \<I>: "welltyped_constraint_model \<I> (\<B>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
     using add_occurs_msgs_soundness[OF P \<A>]
     unfolding list_all_iff by blast
 
   have P':
       "\<forall>T \<in> set (map add_occurs_msgs P). admissible_transaction' T"
       "\<forall>T \<in> set (map add_occurs_msgs P). admissible_transaction_occurs_checks T"
     using P add_occurs_msgs_admissible_occurs_checks[OF admissible_transactionE'(1)] by auto
 
   have 0: "attack\<langle>n\<rangle> \<notin> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     using welltyped_constraint_model_prefix[OF \<I>]
           reachable_constraints_covered(1)[OF \<B> _ FP OCC TI P' transactions_covered]
           attack_in_fixpoint_if_attack_in_ik[
             of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<I>)" "timpl_closure_set (set FP) (set TI)" n]
           attack_in_fixpoint_if_attack_in_timpl_closure_set
           attack_notin_FP
     unfolding abs_intruder_knowledge_def by blast
 
   have 1: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> attack\<langle>n\<rangle>"
     using \<I> strand_sem_append_stateful[of "{}" "{}" "unlabel \<B>" _ \<I>]
     unfolding welltyped_constraint_model_def constraint_model_def by force
 
   show False
     using 0 private_const_deduct[OF _ 1]
           reachable_constraints_receive_attack_if_attack'(1)[
             OF \<B> P'(1) welltyped_constraint_model_prefix[OF \<I>] 1]
     by simp
 qed
 
 end
 
 
 subsection \<open>Theorem: A Protocol is Secure if it is Covered by a Fixed-Point\<close>
 context stateful_protocol_model
 begin
 
 theorem prot_secure_if_fixpoint_covered:
   fixes P
   assumes FP:
       "analyzed (timpl_closure_set (set FP) (set TI))"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
       "ground (set FP)"
     and OCC:
       "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
       "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
     and TI:
       "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     and M:
       "has_all_wt_instances_of \<Gamma> (\<Union>T \<in> set P. trms_transaction T) N"
       "finite N"
       "tfr\<^sub>s\<^sub>e\<^sub>t N"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and P:
       "\<forall>T \<in> set P. admissible_transaction T"
       "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
       "has_initial_value_producing_transaction P"
     and transactions_covered: "list_all (transaction_check (FP, OCC, TI)) (map add_occurs_msgs P)"
     and attack_notin_FP: "attack\<langle>n\<rangle> \<notin> set FP"
     and A: "\<A> \<in> reachable_constraints P"
   shows "\<nexists>\<I>. constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
     (is "\<nexists>\<I>. constraint_model \<I> ?A")
 proof
   assume "\<exists>\<I>. constraint_model \<I> ?A"
   then obtain \<I> where "constraint_model \<I> ?A" by moura
   then obtain \<I>\<^sub>\<tau> where I: "welltyped_constraint_model \<I>\<^sub>\<tau> ?A"
     using reachable_constraints_typing_result[OF M P(1,2) A] by blast
 
   note a = FP OCC TI P(1,3) transactions_covered attack_notin_FP A
 
   show False
     using prot_secure_if_fixpoint_covered_typed[OF a] I
     by force
 qed
 
 end
 
 subsection \<open>Alternative Protocol-Coverage Check\<close>
 context stateful_protocol_model
 begin
 
 context
 begin
 
 private lemma transaction_check_variant_soundness_aux0:
   assumes S: "S \<equiv> unlabel (transaction_strand T)"
     and xs: "xs \<equiv> filter (\<lambda>x. x \<notin> set (transaction_fresh T) \<and> fst x = TAtom Value) (fv_list\<^sub>s\<^sub>s\<^sub>t S)"
     and x: "fst x = Var Value" "x \<in> fv_transaction T" "x \<notin> set (transaction_fresh T)"
   shows "x \<in> set xs"
 using x fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
 unfolding xs S by auto
 
 private lemma transaction_check_variant_soundness_aux1:
   fixes T FP S C xs OCC negs poss as
   assumes C: "C \<equiv> unlabel (transaction_checks T)"
     and S: "S \<equiv> unlabel (transaction_strand T)"
     and xs: "xs \<equiv> filter (\<lambda>x. x \<notin> set (transaction_fresh T) \<and> fst x = TAtom Value) (fv_list\<^sub>s\<^sub>s\<^sub>t S)"
     and poss: "poss \<equiv> transaction_poschecks_comp C"
     and negs: "negs \<equiv> transaction_negchecks_comp C"
     and as: "as \<equiv> map (\<lambda>x. (x, set (filter (\<lambda>ab. poss x \<subseteq> ab \<and> negs x \<inter> ab = {}) OCC))) xs"
     and f: "f \<equiv> \<lambda>x. case List.find (\<lambda>p. fst p = x) as of Some p \<Rightarrow> snd p | None \<Rightarrow> {}"
     and x: "x \<in> set xs"
   shows "f x = set (filter (\<lambda>ab. poss x \<subseteq> ab \<and> negs x \<inter> ab = {}) OCC)"
 proof -
   define g where "g \<equiv> \<lambda>x. set (filter (\<lambda>ab. poss x \<subseteq> ab \<and> negs x \<inter> ab = {}) OCC)"
   define gs where "gs \<equiv> map (\<lambda>x. (x, g x)) xs"
 
   have 1: "(x, g x) \<in> set gs" using x unfolding gs_def by simp
   
   have 2: "distinct xs" unfolding xs fv_list\<^sub>s\<^sub>s\<^sub>t_def by auto
   
   have "\<exists>i < length xs. xs ! i = x \<and> (\<forall>j < i. xs ! j \<noteq> x)" when x: "x \<in> set xs" for x
   proof (rule ex1E[OF distinct_Ex1[OF 2 x]])
     fix i assume i: "i < length xs \<and> xs ! i = x" and "\<forall>j. j < length xs \<and> xs ! j = x \<longrightarrow> j = i"
     hence "\<forall>j < length xs. xs ! j = x \<longrightarrow> j = i" by blast
     hence "\<forall>j < i. xs ! j = x \<longrightarrow> j = i" using i by auto
     hence "\<forall>j < i. xs ! j \<noteq> x" by blast 
     thus ?thesis using i by blast
   qed
   hence "\<exists>i < length gs. gs ! i = (x, g x) \<and> (\<forall>j < i. gs ! j \<noteq> (x, g x))"
     using 1 unfolding gs_def by fastforce
   hence "\<exists>i < length gs. fst (gs ! i) = x \<and> (x, g x) = gs ! i \<and> (\<forall>j < i. fst (gs ! j) \<noteq> x)"
     using nth_map[of _ xs "\<lambda>x. (x, g x)"] length_map[of "\<lambda>x. (x, g x)" xs]
     unfolding gs_def by (metis (no_types, lifting) fstI min.strict_order_iff min_less_iff_conj)
   hence "List.find (\<lambda>p. fst p = x) gs = Some (x, g x)"
     using find_Some_iff[of "\<lambda>p. fst p = x" gs "(x, g x)"] by blast
   thus ?thesis
     unfolding f as gs_def g_def by force
 qed
 
 private lemma transaction_check_variant_soundness_aux2:
   fixes T FP S C xs OCC negs poss as
   assumes C: "C \<equiv> unlabel (transaction_checks T)"
     and S: "S \<equiv> unlabel (transaction_strand T)"
     and xs: "xs \<equiv> filter (\<lambda>x. x \<notin> set (transaction_fresh T) \<and> fst x = TAtom Value) (fv_list\<^sub>s\<^sub>s\<^sub>t S)"
     and poss: "poss \<equiv> transaction_poschecks_comp C"
     and negs: "negs \<equiv> transaction_negchecks_comp C"
     and as: "as \<equiv> map (\<lambda>x. (x, set (filter (\<lambda>ab. poss x \<subseteq> ab \<and> negs x \<inter> ab = {}) OCC))) xs"
     and f: "f \<equiv> \<lambda>x. case List.find (\<lambda>p. fst p = x) as of Some p \<Rightarrow> snd p | None \<Rightarrow> {}"
     and x: "x \<notin> set xs"
   shows "f x = {}"
 proof -
   define g where "g \<equiv> \<lambda>x. set (filter (\<lambda>ab. poss x \<subseteq> ab \<and> negs x \<inter> ab = {}) OCC)"
   define gs where "gs \<equiv> map (\<lambda>x. (x, g x)) xs"
 
   have "(x, y) \<notin> set gs" for y using x unfolding gs_def by force
   thus ?thesis
     using find_None_iff[of "\<lambda>p. fst p = x" gs]
     unfolding f as gs_def g_def by fastforce
 qed
 
 private lemma synth_abs_substs_constrs_rel_if_synth_abs_substs_constrs:
   fixes T OCC negs poss
   defines "\<theta> \<equiv> \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x"
     and "ts \<equiv> trms_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_receive T))"
   assumes ts_wf: "\<forall>t \<in> set ts. wf\<^sub>t\<^sub>r\<^sub>m t"
     and FP_ground: "ground (set FP)"
     and FP_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
   shows "synth_abs_substs_constrs_rel FP OCC TI ts (synth_abs_substs_constrs (FP,OCC,TI) T)"
 proof -
   let ?R = "synth_abs_substs_constrs_rel FP OCC TI"
   let ?D = "synth_abs_substs_constrs_aux FP OCC TI"
 
   have *: "?R [t] (?D t)" when "wf\<^sub>t\<^sub>r\<^sub>m t" for t using that
   proof (induction t)
     case (Var x) thus ?case
       using synth_abs_substs_constrs_rel.SolveValueVar[of "?D (Var x)" OCC x TI FP]
       by fastforce
   next
     case (Fun f ss)
     let ?xs = "fv (Fun f ss)"
     let ?lst = "map (match_abss OCC TI (Fun f ss)) FP"
 
     define flt where
       "flt = (\<lambda>\<delta>::(('fun,'atom,'sets,'lbl) prot_var \<Rightarrow> 'sets set set) option. \<delta> \<noteq> None)"
     define \<Delta> where "\<Delta> = map the (filter flt (map (match_abss OCC TI (Fun f ss)) FP))"
     define \<theta>1 where "\<theta>1 = fun_point_Union (set \<Delta>)"
     define \<theta>2 where "\<theta>2 = fun_point_Inter (?D ` set ss)"
 
     have f: "arity f = length ss" using wf_trm_arity[OF Fun.prems] by simp 
 
     have IH: "?R [s] (?D s)" when s: "s \<in> set ss" for s
       using Fun.IH[OF s wf_trm_subterm[OF Fun.prems Fun_param_is_subterm[OF s]]] s
       by force
 
     have \<Delta>3: "\<forall>\<delta>. \<delta> \<in> set \<Delta> \<longleftrightarrow> (\<exists>s \<in> set FP. match_abss OCC TI (Fun f ss) s = Some \<delta>)"
         (is "\<forall>\<delta>. \<delta> \<in> set \<Delta> \<longleftrightarrow> ?P \<delta>")
     proof (intro allI iffI)
       fix \<delta> assume "\<delta> \<in> set \<Delta>"
       then obtain u where "u \<in> set FP" "match_abss OCC TI (Fun f ss) u = Some \<delta>"
         unfolding \<Delta>_def flt_def by fastforce
       thus "?P \<delta>" by blast
     next
       fix \<delta> assume "?P \<delta>"
       then obtain u where u: "u \<in> set FP" "match_abss OCC TI (Fun f ss) u = Some \<delta>" by blast
 
       have "Some \<delta> \<in> set ?lst" using u unfolding flt_def by force
       hence "Some \<delta> \<in> set (filter flt ?lst)" unfolding flt_def by force
       moreover have "\<exists>\<theta>. d = Some \<theta>" when d: "d \<in> set (filter flt ?lst)" for d
         using d unfolding flt_def by simp
       ultimately have "\<delta> \<in> set (map the (filter flt ?lst))" by force
       thus "\<delta> \<in> set \<Delta>" unfolding \<Delta>_def by blast
     qed
 
     show ?case
     proof (cases "ss = []")
       case True
       note ss = this
       show ?thesis
       proof (cases "\<not>public f \<and> Fun f ss \<notin> set FP")
         case True thus ?thesis
           using synth_abs_substs_constrs_rel.SolvePrivConstNotin[of f FP OCC TI]
           unfolding ss by force
       next
         case False thus ?thesis
           using f synth_abs_substs_constrs_rel.SolvePubConst[of f FP OCC TI]
                 synth_abs_substs_constrs_rel.SolvePrivConstIn[of f FP OCC TI]
           unfolding ss by auto
       qed
     next
       case False
       note ss = this
       hence f': "arity f > 0" using f by auto
       have IH': "?R ss (fun_point_Inter (?D ` set ss))"
         using IH synth_abs_substs_constrs_rel.SolveCons[OF ss, of FP OCC TI ?D] by blast
 
       have "?D (Fun f ss) = (
               fun_point_union (fun_point_Union_list \<Delta>) (fun_point_Inter_list (map ?D ss)))"
         using ss synth_abs_substs_constrs_aux.simps(2)[of FP OCC TI f ss]
         unfolding Let_def \<Delta>_def flt_def by argo
       hence "?D (Fun f ss) = fun_point_union \<theta>1 \<theta>2"
         using fun_point_Inter_set_eq[of "map ?D ss"] fun_point_Union_set_eq[of \<Delta>]
         unfolding \<theta>1_def \<theta>2_def by simp
       thus ?thesis
         using synth_abs_substs_constrs_rel.SolveComposed[
                 OF f' f[symmetric] \<Delta>3 \<theta>1_def IH']
         unfolding \<theta>2_def by argo
     qed
   qed
 
   note l0 = synth_abs_substs_constrs_rel.SolveNil[of FP OCC TI]
   note d0 = synth_abs_substs_constrs_def ts_def
 
   note l1 = * ts_wf synth_abs_substs_constrs_rel.SolveCons[of ts FP OCC TI ?D]
   note d1 = d0 Let_def fun_point_Inter_set_eq[symmetric] fun_point_Inter_def
 
   show ?thesis
   proof (cases "ts = []")
     case True thus ?thesis using l0 unfolding d0 by simp
   next
     case False thus ?thesis using l1 unfolding d1 by auto
   qed
 qed
 
 private function (sequential) match_abss'_timpls_transform
 ::"('c set \<times> 'c set) list \<Rightarrow>
    ('a,'b,'c,'d) prot_subst \<Rightarrow>
    ('a,'b,'c,'d) prot_term \<Rightarrow>
    ('a,'b,'c,'d) prot_term \<Rightarrow>
    (('a,'b,'c,'d) prot_var \<Rightarrow> 'c set set) option"
 where
   "match_abss'_timpls_transform TI \<delta> (Var x) (Fun (Abs a) _) = (
     if \<exists>b ts. \<delta> x = Fun (Abs b) ts \<and> (a = b \<or> (a,b) \<in> set TI)
     then Some ((\<lambda>_. {})(x := {a}))
     else None)"
 | "match_abss'_timpls_transform TI \<delta> (Fun f ts) (Fun g ss) = (
     if f = g \<and> length ts = length ss
     then map_option fun_point_Union_list (those (map2 (match_abss'_timpls_transform TI \<delta>) ts ss))
     else None)"
 | "match_abss'_timpls_transform _ _ _ _ = None"
 by pat_completeness auto
 termination
 proof -
   let ?m = "measures [size \<circ> fst \<circ> snd \<circ> snd]"
 
   have 0: "wf ?m" by simp
 
   show ?thesis
     apply (standard, use 0 in fast)
     by (metis (no_types) comp_def fst_conv snd_conv measures_less Fun_zip_size_lt(1))
 qed
 
 private lemma match_abss'_timpls_transform_Var_inv:
   assumes "match_abss'_timpls_transform TI \<delta> (Var x) (Fun (Abs a) ts) = Some \<sigma>"
   shows "\<exists>b ts. \<delta> x = Fun (Abs b) ts \<and> (a = b \<or> (a, b) \<in> set TI)"
    and "\<sigma> = ((\<lambda>_. {})(x := {a}))"
 using assms match_abss'_timpls_transform.simps(1)[of TI \<delta> x a ts]
 by (metis option.distinct(1), metis option.distinct(1) option.inject)
 
 private lemma match_abss'_timpls_transform_Fun_inv:
   assumes "match_abss'_timpls_transform TI \<delta> (Fun f ts) (Fun g ss) = Some \<sigma>"
   shows "f = g" (is ?A)
     and "length ts = length ss" (is ?B)
     and "\<exists>\<theta>. Some \<theta> = those (map2 (match_abss'_timpls_transform TI \<delta>) ts ss) \<and> \<sigma> = fun_point_Union_list \<theta>" (is ?C)
     and "\<forall>(t,s) \<in> set (zip ts ss). \<exists>\<sigma>'. match_abss'_timpls_transform TI \<delta> t s = Some \<sigma>'" (is ?D)
 proof -
   note 0 = assms match_abss'_timpls_transform.simps(2)[of TI \<delta> f ts g ss] option.distinct(1)
   show ?A by (metis 0)
   show ?B by (metis 0)
   show ?C by (metis (no_types, opaque_lifting) 0 map_option_eq_Some)
   thus ?D using map2_those_Some_case[of "match_abss'_timpls_transform TI \<delta>" ts ss] by fastforce
 qed
 
 private lemma match_abss'_timpl_transform_nonempty_is_fv:
   assumes "match_abss'_timpls_transform TI \<delta> s t = Some \<sigma>"
     and "\<sigma> x \<noteq> {}"
   shows "x \<in> fv s"
 using assms
 proof (induction s t arbitrary: TI \<delta> \<sigma> rule: match_abss'_timpls_transform.induct)
   case (1 TI \<delta> y a ts) show ?case
     using match_abss'_timpls_transform_Var_inv[OF "1.prems"(1)] "1.prems"(2)
     by fastforce
 next
   case (2 TI \<delta> f ts g ss)
   note prems = "2.prems"
   note IH = "2.IH"
 
   obtain \<theta> where \<theta>:
           "Some \<theta> = those (map2 (match_abss'_timpls_transform TI \<delta>) ts ss)"
           "\<sigma> = fun_point_Union_list \<theta>"
       and fg: "f = g" "length ts = length ss"
     using match_abss'_timpls_transform_Fun_inv[OF prems(1)] by fast
 
   have "\<exists>\<sigma> \<in> set \<theta>. \<sigma> x \<noteq> {}"
     using fg(2) prems \<theta> unfolding fun_point_Union_list_def by auto
   then obtain t' s' \<sigma> where ts':
       "(t',s') \<in> set (zip ts ss)" "match_abss'_timpls_transform TI \<delta> t' s' = Some \<sigma>" "\<sigma> x \<noteq> {}"
     using those_map2_SomeD[OF \<theta>(1)[symmetric]] by blast
 
   show ?case
     using ts'(3) IH[OF conjI[OF fg] ts'(1) _ ts'(2)] set_zip_leftD[OF ts'(1)] by force
 qed auto
 
 private lemma match_abss'_timpls_transformI:
   fixes s t::"('a,'b,'c,'d) prot_term"
     and \<delta>::"('a,'b,'c,'d) prot_subst"
     and \<sigma>::"('a,'b,'c,'d) prot_var \<Rightarrow> 'c set set"
   assumes TI: "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     and \<delta>: "timpls_transformable_to TI t (s \<cdot> \<delta>)"
     and \<sigma>: "match_abss' s t = Some \<sigma>"
     and t: "fv t = {}"
     and s: "\<forall>f \<in> funs_term s. \<not>is_Abs f"
            "\<forall>x \<in> fv s. \<exists>a. \<delta> x = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s"
   shows "match_abss'_timpls_transform TI \<delta> s t = Some \<sigma>"
 using \<delta> \<sigma> t s
 proof (induction t arbitrary: s \<delta> \<sigma>)
   case (Fun f ts)
   note prems = Fun.prems
   note IH = Fun.IH
   show ?case
   proof (cases s)
     case (Var x)
     obtain a b where a: "f = Abs a" "\<sigma> = (\<lambda>_. {})(x := {a})" and b: "\<delta> x = \<langle>b\<rangle>\<^sub>a\<^sub>b\<^sub>s"
       using match_abss'_Var_inv[OF prems(2)[unfolded Var]] prems(5)[unfolded Var]
       by auto
     thus ?thesis
       using prems(1) timpls_transformable_to_inv(3)[of TI f ts "Abs b" "[]"]
       unfolding Var by auto
   next
     case (Fun g ss)
-    note 0 = timpls_transformable_to_inv[OF prems(1)[unfolded Fun subst_apply_term.simps(2)]]
+    note 0 = timpls_transformable_to_inv[OF prems(1)[unfolded Fun eval_term.simps(2)]]
     note 1 = match_abss'_Fun_inv[OF prems(2)[unfolded Fun]]
 
     obtain \<theta> where \<theta>: "those (map2 match_abss' ss ts) = Some \<theta>" "\<sigma> = fun_point_Union_list \<theta>"
       using 1(3) by force
 
     have "timpls_transformable_to TI t' (s' \<cdot> \<delta>)" "\<exists>\<sigma>'. match_abss' s' t' = Some \<sigma>'"
       when "(t',s') \<in> set (zip ts ss)" for s' t'
       by (metis 0(2) nth_map[of _ ss] zip_arg_index[OF that],
           use that 1(4) in_set_zip_swap[of t' s' ts ss] in fast)
     hence IH': "match_abss'_timpls_transform TI \<delta> s' t' = Some \<sigma>'"
       when "(t',s') \<in> set (zip ts ss)" "match_abss' s' t' = Some \<sigma>'" for s' t' \<sigma>'
       using that IH[of t' s' \<delta> \<sigma>'] prems(3-) unfolding Fun
       by (metis (no_types, lifting) set_zip_leftD set_zip_rightD subsetI subset_empty term.set_intros(2) term.set_intros(4)) 
     
     have "those (map2 (match_abss'_timpls_transform TI \<delta>) ss ts) = Some \<theta>"
       using IH' \<theta>(1) 1(4) in_set_zip_swap[of _ _ ss ts]
             those_Some_iff[of "map2 match_abss' ss ts" \<theta>]
             those_Some_iff[of "map2 (match_abss'_timpls_transform TI \<delta>) ss ts" \<theta>]
       by auto
     thus ?thesis using \<theta>(2) 1(1,2) Fun by simp
   qed
 qed simp
 
 lemma timpls_transformable_to_match_abss'_nonempty_disj':
   fixes s t::"('a,'b,'c,'d) prot_term"
     and \<delta>::"('a,'b,'c,'d) prot_subst"
     and \<sigma>::"('a,'b,'c,'d) prot_var \<Rightarrow> 'c set set"
   assumes TI: "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     and \<delta>: "timpls_transformable_to TI t (s \<cdot> \<delta>)"
     and \<sigma>: "match_abss' s t = Some \<sigma>"
     and x: "x \<in> fv s"
     and t: "fv t = {}"
     and s: "\<forall>f \<in> funs_term s. \<not>is_Abs f"
            "\<forall>x \<in> fv s. \<exists>a. \<delta> x = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s"
     and a: "\<delta> x = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s"
   shows "\<forall>b \<in> \<sigma> x. (b,a) \<in> (set TI)\<^sup>*" (is "?P \<sigma> x")
 proof -
   note 0 = match_abss'_subst_disj_nonempty[OF TI]
 
   have 1: "s \<cdot> \<delta> \<in> timpl_closure t (set TI)"
     using timpls_transformable_to_iff_in_timpl_closure[OF TI] \<delta> by blast
 
   have 2: "match_abss'_timpls_transform TI \<delta> s t = Some \<sigma>"
     using match_abss'_timpls_transformI[OF TI \<delta> \<sigma> t s] by simp
 
   show "?P \<sigma> x" using 2 TI x t s a
   proof (induction TI \<delta> s t arbitrary: \<sigma> rule: match_abss'_timpls_transform.induct)
     case (1 TI \<delta> y c ts) thus ?case
       using match_abss'_timpls_transform_Var_inv[OF "1.prems"(1)] by auto
   next
     case (2 TI \<delta> f ts g ss)
     obtain \<theta> where fg: "f = g" "length ts = length ss"
         and \<theta>: "Some \<theta> = those (map2 (match_abss'_timpls_transform TI \<delta>) ts ss)"
                "\<sigma> = fun_point_Union_list \<theta>"
                "\<forall>(t, s)\<in>set (zip ts ss). \<exists>\<sigma>'. match_abss'_timpls_transform TI \<delta> t s = Some \<sigma>'"
       using match_abss'_timpls_transform_Fun_inv[OF "2.prems"(1)] by blast
 
     have "(b,a) \<in> (set TI)\<^sup>*" when \<theta>': "\<theta>' \<in> set \<theta>" "b \<in> \<theta>' x" for \<theta>' b
     proof -
       obtain t' s' where t':
           "(t',s') \<in> set (zip ts ss)" "match_abss'_timpls_transform TI \<delta> t' s' = Some \<theta>'"
         using those_map2_SomeD[OF \<theta>(1)[symmetric] \<theta>'(1)] by blast
 
       have *: "fv s' = {}" "\<forall>f \<in> funs_term t'. \<not>is_Abs f" "\<forall>x \<in> fv t'. \<exists>a. \<delta> x = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s"
         using "2.prems"(4-6) set_zip_leftD[OF t'(1)] set_zip_rightD[OF t'(1)]
         by (fastforce, fastforce, fastforce)
 
       have **: "x \<in> fv t'"
         using \<theta>'(2) match_abss'_timpl_transform_nonempty_is_fv[OF t'(2)] by blast
 
       show ?thesis
         using \<theta>'(2) "2.IH"[OF conjI[OF fg] t'(1) _ t'(2) "2.prems"(2) ** * "2.prems"(7)] by blast
     qed
     thus ?case using \<theta>(1) unfolding \<theta>(2) fun_point_Union_list_def by simp
   qed auto
 qed
 
 lemma timpls_transformable_to_match_abss'_nonempty_disj:
   fixes s t::"('a,'b,'c,'d) prot_term"
     and \<delta>::"('a,'b,'c,'d) prot_subst"
     and \<sigma>::"('a,'b,'c,'d) prot_var \<Rightarrow> 'c set set"
   assumes TI: "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     and \<delta>: "timpls_transformable_to TI t (s \<cdot> \<delta>)"
     and \<sigma>: "match_abss' s t = Some \<sigma>"
     and x: "x \<in> fv s"
     and t: "fv t = {}"
     and s: "\<forall>f \<in> funs_term s. \<not>is_Abs f"
            "\<forall>x \<in> fv s. \<exists>a. \<delta> x = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s"
   shows "\<Inter>(ticl_abs TI ` \<sigma> x) \<noteq> {}"
 proof -
   have 0: "(a,b) \<in> (set TI)\<^sup>*" when y: "y \<in> fv s" "a \<in> \<sigma> y" "\<delta> y = \<langle>b\<rangle>\<^sub>a\<^sub>b\<^sub>s" for a b y
     using timpls_transformable_to_match_abss'_nonempty_disj'[OF TI \<delta> \<sigma> y(1) t s y(3)] y(2) by blast
 
   obtain b where b: "\<delta> x = \<langle>b\<rangle>\<^sub>a\<^sub>b\<^sub>s" using x s(2) by blast
 
   have "b \<in> ticl_abs TI a" when a: "a \<in> \<sigma> x" for a
     using 0[OF x a b] unfolding ticl_abs_iff[OF TI] by blast
   thus ?thesis by blast
 qed
 
 lemma timpls_transformable_to_subst_subterm:
   fixes s t::"(('a,'b,'c,'d) prot_fun, 'v) term"
     and \<delta> \<sigma>::"(('a,'b,'c,'d) prot_fun, 'v) subst"
   assumes "timpls_transformable_to TI (t \<cdot> \<delta>) (t \<cdot> \<sigma>)"
     and "s \<sqsubseteq> t"
   shows "timpls_transformable_to TI (s \<cdot> \<delta>) (s \<cdot> \<sigma>)"
 using assms
 proof (induction "t \<cdot> \<delta>" "t \<cdot> \<sigma>" arbitrary: t rule: timpls_transformable_to.induct)
   case (1 TI x y) thus ?case by (cases t) auto
 next
   case (2 TI f T g S)
   note prems = "2.prems"
   note hyps = "2.hyps"(2-)
   note IH = "2.hyps"(1)
 
   show ?case
   proof (cases "s = t")
     case False
     then obtain h U u where t: "t = Fun h U" "u \<in> set U" "s \<sqsubseteq> u"
       using prems(2) by (cases t) auto
     then obtain i where i: "i < length U" "U ! i = u"
       by (metis in_set_conv_nth)
 
     have "timpls_transformable_to TI (u \<cdot> \<delta>) (u \<cdot> \<sigma>)"
       using t i prems(1) timpls_transformable_to_inv(2)[of TI h "U \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>" h "U \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma>" i] by simp
     thus ?thesis using IH hyps t by auto
   qed (use prems in auto)
 qed simp_all
 
 lemma timpls_transformable_to_subst_match_case:
   assumes "timpls_transformable_to TI s (t \<cdot> \<theta>)"
     and "fv s = {}"
     and "\<forall>f \<in> funs_term t. \<not>is_Abs f"
     and "distinct (fv_list t)"
     and "\<forall>x \<in> fv t. \<exists>a. \<theta> x = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s"
   shows "\<exists>\<delta>. s = t \<cdot> \<delta>"
 using assms
 proof (induction s "t \<cdot> \<theta>" arbitrary: t rule: timpls_transformable_to.induct)
   case (2 TI f T g S)
   note prems = "2.prems"
   note hyps = "2.hyps"(2-)
   note IH = "2.hyps"(1)
 
   show ?case
   proof (cases t)
     case (Var x)
     then obtain a where a: "t \<cdot> \<theta> = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s" using prems(5) by fastforce
     show ?thesis
       using hyps timpls_transformable_to_inv'[OF prems(1)[unfolded a]]
       unfolding Var by force
   next
     case (Fun h U)
     have g: "g = h" and S: "S = U \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>"
       using hyps unfolding Fun by simp_all
 
     note 0 = distinct_fv_list_Fun_param[OF prems(4)[unfolded Fun]]
 
     have 1: "\<forall>f \<in> funs_term u. \<not>is_Abs f" when u: "u \<in> set U" for u
       using prems(3) u unfolding Fun by fastforce
 
     have 2: "fv t' = {}" when t': "t' \<in> set T" for t'
       using t' prems(2) by simp
 
     have 3: "\<forall>x \<in> fv u. \<exists>a. \<theta> x = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s" when u: "u \<in> set U" for u
       using u prems(5) unfolding Fun by simp
 
     have "\<not>is_Abs f"
       using prems(3) timpls_transformable_to_inv(3)[OF prems(1)[unfolded hyps[symmetric] S g]]
       unfolding Fun by auto
     hence f: "f = h" and T: "length T = length U"
       using prems(1) timpls_transformable_to_inv(1,3)[of TI f T h "U \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>"]
       unfolding Fun by fastforce+
 
     define \<Delta> where "\<Delta> \<equiv> \<lambda>i. if i < length T then SOME \<delta>. T ! i = U ! i \<cdot> \<delta> else undefined"
 
     have "timpls_transformable_to TI (T ! i) (U ! i \<cdot> \<theta>)" when i: "i < length T" for i
       using prems(1)[unfolded Fun] T i timpls_transformable_to_inv(2)[of TI f T h "U \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>" i]
       by auto
     hence "\<exists>\<delta>. T ! i = U ! i \<cdot> \<delta>" when i: "i < length T" for i
       using i T IH[OF _ _ _ 2 1 0 3, of "T ! i" "U ! i"]
       unfolding Fun g S by simp
     hence \<Delta>: "T ! i = U ! i \<cdot> \<Delta> i" when i: "i < length T" for i
       using i someI2[of "\<lambda>\<delta>. T ! i = U ! i \<cdot> \<delta>" _ "\<lambda>\<delta>. T ! i = U ! i \<cdot> \<delta>"]
       unfolding \<Delta>_def by fastforce
 
     define \<delta> where "\<delta> \<equiv> \<lambda>x. if \<exists>i < length T. x \<in> fv (U ! i)
                             then \<Delta> (SOME i. i < length T \<and> x \<in> fv (U ! i)) x
                             else undefined"
 
     have "T ! i = U ! i \<cdot> \<delta>" when i: "i < length T" for i
     proof -
       have "j = i"
         when x: "x \<in> fv (U ! i)" and j: "j < length T" "x \<in> fv (U ! j)" for j x
         using x i j T distinct_fv_list_idx_fv_disjoint[OF prems(4)[unfolded Fun], of h U]
         by (metis (no_types, lifting) disjoint_iff_not_equal neqE term.dual_order.refl)
       hence "\<delta> x = \<Delta> i x" when x: "x \<in> fv (U ! i)" for x
         using x i some_equality[of "\<lambda>i. i < length T \<and> x \<in> fv (U ! i)" i]
         unfolding \<delta>_def by (metis (no_types, lifting))
       thus ?thesis by (metis \<Delta> i term_subst_eq)
     qed
     hence "T = U \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>" by (metis (no_types, lifting) T length_map nth_equalityI nth_map)
     hence "Fun f T = Fun f U \<cdot> \<delta>" by simp
     thus ?thesis using Fun f by fast
   qed
 qed simp_all
 
 lemma timpls_transformable_to_match_abss'_case:
   assumes "timpls_transformable_to TI s (t \<cdot> \<theta>)"
     and "fv s = {}"
     and "\<forall>f \<in> funs_term t. \<not>is_Abs f"
     and "\<forall>x \<in> fv t. \<exists>a. \<theta> x = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s"
   shows "\<exists>\<delta>. match_abss' t s = Some \<delta>"
 using assms
 proof (induction s "t \<cdot> \<theta>" arbitrary: t rule: timpls_transformable_to.induct)
   case (2 TI f T g S)
   note prems = "2.prems"
   note hyps = "2.hyps"(2-)
   note IH = "2.hyps"(1)
 
   show ?case
   proof (cases t)
     case (Var x)
     then obtain a where a: "t \<cdot> \<theta> = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s" using prems(4) by fastforce
     thus ?thesis
       using timpls_transformable_to_inv'(4)[OF prems(1)[unfolded a]] 
       by (metis (no_types) Var is_Abs_def term.sel(2) match_abss'.simps(1))
   next
     case (Fun h U)
     have g: "g = h" and S: "S = U \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>"
       using hyps unfolding Fun by simp_all
 
     have 1: "\<forall>f \<in> funs_term u. \<not>is_Abs f" when u: "u \<in> set U" for u
       using prems(3) u unfolding Fun by fastforce
 
     have 2: "fv t' = {}" when t': "t' \<in> set T" for t'
       using t' prems(2) by simp
 
     have 3: "\<forall>x \<in> fv u. \<exists>a. \<theta> x = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s" when u: "u \<in> set U" for u
       using u prems(4) unfolding Fun by simp
 
     have "\<not>is_Abs f"
       using prems(3) timpls_transformable_to_inv(3)[OF prems(1)[unfolded hyps[symmetric] S g]]
       unfolding Fun by auto
     hence f: "f = h" and T: "length T = length U"
       using prems(1) timpls_transformable_to_inv(1,3)[of TI f T h "U \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>"]
       unfolding Fun by fastforce+
 
     define \<Delta> where "\<Delta> \<equiv> \<lambda>i.
       if i < length T
       then SOME \<delta>. match_abss' (U ! i) (T ! i) = Some \<delta>
       else undefined"
 
     have "timpls_transformable_to TI (T ! i) (U ! i \<cdot> \<theta>)" when i: "i < length T" for i
       using prems(1)[unfolded Fun] T i timpls_transformable_to_inv(2)[of TI f T h "U \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>" i]
       by auto
     hence "\<exists>\<delta>. match_abss' (U ! i) (T ! i) = Some \<delta>" when i: "i < length T" for i
       using i T IH[OF _ _ _ 2 1 3, of "T ! i" "U ! i"]
       unfolding Fun g S by simp
     hence "match_abss' (U ! i) (T ! i) = Some (\<Delta> i)" when i: "i < length T" for i
       using i someI2[of "\<lambda>\<delta>. match_abss' (U ! i) (T ! i) = Some \<delta>" _
                         "\<lambda>\<delta>. match_abss' (U ! i) (T ! i) = Some \<delta>"]
       unfolding \<Delta>_def by fastforce
     thus ?thesis
       using match_abss'_FunI[OF _ T] unfolding Fun f by auto
   qed
 qed simp_all
 
 lemma timpls_transformable_to_match_abss_case:
   assumes TI: "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
     and "timpls_transformable_to TI s (t \<cdot> \<theta>)"
     and "fv s = {}"
     and "\<forall>f \<in> funs_term t. \<not>is_Abs f"
     and "\<forall>x \<in> fv t. \<exists>a. \<theta> x = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s"
   shows "\<exists>\<delta>. match_abss OCC TI t s = Some \<delta>"
 proof -
   obtain \<delta> where \<delta>: "match_abss' t s = Some \<delta>"
     using timpls_transformable_to_match_abss'_case[OF assms(2-)] by blast
 
   show ?thesis
     using \<delta> timpls_transformable_to_match_abss'_nonempty_disj[OF assms(1,2) \<delta> _ assms(3-5)]
     unfolding match_abss_def by simp
 qed
 
 private lemma transaction_check_variant_soundness_aux3:
   fixes T FP S C xs OCC negs poss as
   defines "\<theta> \<equiv> \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x"
     and "C \<equiv> unlabel (transaction_checks T)"
     and "S \<equiv> unlabel (transaction_strand T)"
     and "ts \<equiv> trms_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_receive T))"
     and "xs \<equiv> filter (\<lambda>x. x \<notin> set (transaction_fresh T) \<and> fst x = TAtom Value) (fv_list\<^sub>s\<^sub>s\<^sub>t S)"
   assumes TI0: "\<forall>(a,b) \<in> set TI. \<forall>(c,d) \<in> set TI. b = c \<and> a \<noteq> d \<longrightarrow> (a,d) \<in> set TI"
                "\<forall>(a,b) \<in> set TI. a \<noteq> b"
     and OCC: "\<forall>t \<in> set FP. \<forall>a. Abs a \<in> funs_term t \<longrightarrow> a \<in> set OCC"
     and FP_ground: "ground (set FP)"
     and x: "x \<in> set xs"
     and xs: "\<forall>x. x \<in> set xs \<longrightarrow> \<delta> x \<in> set OCC"
             "\<forall>x. x \<in> set xs \<longrightarrow> poss x \<subseteq> \<delta> x"
             "\<forall>x. x \<in> set xs \<longrightarrow> \<delta> x \<inter> negs x = {}"
             "\<forall>x. x \<notin> set xs \<longrightarrow> \<delta> x = {}"
     and ts: "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<delta>)"
             "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). \<forall>f \<in> funs_term t. \<not>is_Abs f"
             "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)). fst x = TAtom Value"
     and C: "\<forall>a x s. \<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> set C \<longrightarrow> s \<in> \<delta> x"
            "\<forall>x s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> set C \<longrightarrow> s \<notin> \<delta> x"
     and \<sigma>: "synth_abs_substs_constrs_rel FP OCC TI ts \<sigma>"
   shows "\<delta> x \<in> \<sigma> x"
 proof -
   note defs = assms(1-5)
 
   note TI = trancl_eqI'[OF TI0]
 
   have \<delta>x0: "\<delta> x \<in> set OCC" "poss x \<subseteq> \<delta> x" "\<delta> x \<inter> negs x = {}" using x xs by (blast,blast,blast)
 
   have ts0: "\<forall>t \<in> set ts. intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<delta>)"
     using ts(1) trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t unfolding ts_def by blast
 
   have ts1: "\<not>Fun (Abs n) S \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts" for n S
     using ts(2) funs_term_Fun_subterm'
     unfolding ts_def trms_transaction_unfold trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t[symmetric] is_Abs_def
     by fastforce
 
   have ts2: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts). fst x = TAtom Value"
     using ts(3)
     unfolding ts_def trms_transaction_unfold trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t[symmetric]
     by fastforce
 
   show ?thesis using \<sigma> ts0 ts1 ts2
   proof (induction rule: synth_abs_substs_constrs_rel.induct)
     case (SolvePrivConstNotin c)
     hence "intruder_synth_mod_timpls FP TI (Fun c [])" by force
     hence "list_ex (\<lambda>t. timpls_transformable_to TI t (Fun c [])) FP"
       using SolvePrivConstNotin.hyps(1,2) by simp
     then obtain t where t: "t \<in> set FP" "timpls_transformable_to TI t (Fun c [])"
       unfolding list_ex_iff by blast
 
     have "\<not>is_Abs c"
       using SolvePrivConstNotin.prems(2)[of _ "[]"]
       by (metis in_subterms_Union is_Abs_def list.set_intros(1))
     hence "t = Fun c []"
       using t(2) timpls_transformable_to_inv[of TI] by (cases t) auto
     thus ?case using t(1) SolvePrivConstNotin.hyps(3) by fast
   next
     case (SolveValueVar \<theta>1 y)
     have "list_ex (\<lambda>t. timpls_transformable_to TI t \<langle>\<delta> y\<rangle>\<^sub>a\<^sub>b\<^sub>s) FP"
       using SolveValueVar.prems(1-3) unfolding \<theta>_def by simp
     then obtain t where t: "t \<in> set FP" "timpls_transformable_to TI t \<langle>\<delta> y\<rangle>\<^sub>a\<^sub>b\<^sub>s"
       unfolding list_ex_iff by blast
 
     obtain a where a: "t = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s" "a = \<delta> y \<or> (a, \<delta> y) \<in> set TI"
     proof -
       obtain ft tst where ft: "t = Fun ft tst"
         using t(2) timpls_transformable_to_inv_Var(1)[of TI _ "\<langle>\<delta> y\<rangle>\<^sub>a\<^sub>b\<^sub>s"]
         by (cases t) auto
       
       have "tst = []" "is_Abs ft" "the_Abs ft = \<delta> y \<or> (the_Abs ft, \<delta> y) \<in> set TI"
         using timpls_transformable_to_inv'(2,4,5)[OF t(2)[unfolded ft]]
         by (simp, force, force)
       thus thesis using that[of "the_Abs ft"] ft by force 
     qed
 
     have "a \<in> set OCC"
       using t(1)[unfolded a(1)] OCC by auto
     thus ?case
       using \<delta>x0(1) t(1)[unfolded a(1)] a(2)
       unfolding SolveValueVar.hyps(1) ticl_abss_def ticl_abs_def
       by force
   next
     case (SolveComposed g us \<Delta> \<theta>1 \<theta>2) show ?case
     proof (cases "\<forall>t \<in> set us. intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<delta>)")
       case True
       hence "\<delta> x \<in> \<theta>2 x"
         using SolveComposed.IH SolveComposed.prems(2,3)
               distinct_fv_list_Fun_param[of g us] 
         by auto
       thus ?thesis unfolding fun_point_union_def by simp
     next
       case False
       hence "list_ex (\<lambda>t. timpls_transformable_to TI t (Fun g us \<cdot> \<theta> \<delta>)) FP"
         using SolveComposed.prems(1) intruder_synth_mod_timpls.simps(2)[of FP TI g "us \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta> \<delta>"]
         unfolding list_all_iff by auto
       then obtain t where t: "t \<in> set FP" "timpls_transformable_to TI t (Fun g us \<cdot> \<theta> \<delta>)"
         unfolding list_ex_iff by blast
 
       have t_ground: "fv t = {}"
         using t(1) FP_ground by simp
 
       have g_no_abs: "\<not>is_Abs f" when f: "f \<in> funs_term (Fun g us)" for f
       proof -
         obtain fts where "Fun f fts \<sqsubseteq> Fun g us" using funs_term_Fun_subterm[OF f] by blast
         thus ?thesis using SolveComposed.prems(2)[of _ fts] by (cases f) auto
       qed
 
       have g_\<theta>_abs: "\<exists>a. \<theta> \<delta> y = \<langle>a\<rangle>\<^sub>a\<^sub>b\<^sub>s" when y: "y \<in> fv (Fun g us)" for y
         using y SolveComposed.prems(3) unfolding \<theta>_def by fastforce
       
       obtain \<delta>' where \<delta>': "match_abss OCC TI (Fun g us) t = Some \<delta>'"
         using g_no_abs g_\<theta>_abs timpls_transformable_to_match_abss_case[OF TI t(2) t_ground ]
         by blast
 
       let ?h1 = "\<lambda>\<delta> x. if x \<in> fv (Fun g us) then \<delta> x else set OCC"
       let ?h2 = "\<lambda>\<delta> x. \<Inter>(ticl_abs TI ` \<delta> x)"
 
       obtain \<delta>'' where \<delta>'':
           "match_abss' (Fun g us) t = Some \<delta>''" "\<delta>' = ?h1 (?h2 \<delta>'')"
           "\<forall>x \<in> fv (Fun g us). \<delta>' x \<noteq> {} \<and> \<delta>' x \<noteq> {}"
         using match_abssD[OF \<delta>'] by blast
 
       have \<delta>'_\<Delta>: "\<delta>' \<in> \<Delta>"
         using t(1) \<delta>' SolveComposed.hyps(3) by metis
 
       have "\<delta> x \<in> ticl_abs TI a" when a: "a \<in> \<delta>'' x" and x_in_g: "x \<in> fv (Fun g us)" for a
       proof -
         have "fst x = TAtom Value" using x_in_g SolveComposed.prems(3) by auto
         hence "\<theta> \<delta> x = \<langle>\<delta> x\<rangle>\<^sub>a\<^sub>b\<^sub>s" unfolding \<theta>_def by simp
         hence "(a, \<delta> x) \<in> (set TI)\<^sup>*"
           using timpls_transformable_to_match_abss'_nonempty_disj'[
                   OF TI t(2) \<delta>''(1) x_in_g t_ground]
                 g_no_abs g_\<theta>_abs a
           by fastforce
         thus "\<delta> x \<in> ticl_abs TI a" unfolding ticl_abs_iff[OF TI] by force
       qed
       hence "\<delta> x \<in> \<delta>' x" when x_in_g: "x \<in> fv (Fun g us)"
         using \<delta>''(2,3) x_in_g unfolding \<delta>''(1) by simp
       hence "\<delta> x \<in> \<delta>' x" using match_abss_OCC_if_not_fv[OF \<delta>'] \<delta>x0(1) by blast
       hence "\<delta> x \<in> \<theta>1 x"
         using \<delta>'_\<Delta> \<delta>x0(1) unfolding SolveComposed.hyps(4,5) fun_point_Union_def by auto
       thus ?thesis unfolding fun_point_union_def by simp
     qed
   qed (auto simp add: \<delta>x0 fun_point_Inter_def)
 qed
 
 private lemma transaction_check_variant_soundness_aux4:
   fixes T FP S C xs OCC negs poss as
   defines "\<theta> \<equiv> \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x"
     and "C \<equiv> unlabel (transaction_checks T)"
     and "S \<equiv> unlabel (transaction_strand T)"
     and "xas \<equiv> (the_Abs \<circ> the_Fun) ` set (filter (\<lambda>t. is_Fun t \<and> is_Abs (the_Fun t)) FP)"
     and "ts \<equiv> trms_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_receive T))"
     and "xs \<equiv> filter (\<lambda>x. x \<notin> set (transaction_fresh T) \<and> fst x = TAtom Value) (fv_list\<^sub>s\<^sub>s\<^sub>t S)"
     and "poss \<equiv> transaction_poschecks_comp C"
     and "negs \<equiv> transaction_negchecks_comp C"
     and "as \<equiv> map (\<lambda>x. (x, set (filter (\<lambda>ab. poss x \<subseteq> ab \<and> negs x \<inter> ab = {}) OCC))) xs"
     and "f \<equiv> \<lambda>x. case List.find (\<lambda>p. fst p = x) as of Some p \<Rightarrow> snd p | None \<Rightarrow> {}"
   assumes T_adm: "admissible_transaction' T"
     and TI0: "\<forall>(a,b) \<in> set TI. \<forall>(c,d) \<in> set TI. b = c \<and> a \<noteq> d \<longrightarrow> (a,d) \<in> set TI"
              "\<forall>(a,b) \<in> set TI. a \<noteq> b"
     and OCC: "\<forall>t \<in> set FP. \<forall>a. Abs a \<in> funs_term t \<longrightarrow> a \<in> set OCC"
     and FP_ground: "ground (set FP)"
     and FP_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
     and "x \<in> set xs"
     and "\<forall>x. x \<in> set xs \<longrightarrow> \<delta> x \<in> set OCC"
     and "\<forall>x. x \<in> set xs \<longrightarrow> poss x \<subseteq> \<delta> x"
     and "\<forall>x. x \<in> set xs \<longrightarrow> \<delta> x \<inter> negs x = {}"
     and "\<forall>x. x \<notin> set xs \<longrightarrow> \<delta> x = {}"
     and "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<delta>)"
     and "\<forall>a x s. \<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> set C \<longrightarrow> s \<in> \<delta> x"
     and "\<forall>x s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> set C \<longrightarrow> s \<notin> \<delta> x"
   shows "\<delta> x \<in> synth_abs_substs_constrs (FP,OCC,TI) T x"
 proof -
   let ?FPT = "(FP,OCC,TI)"
   let ?P = "\<lambda>s u. let \<delta> = mgu s u
                    in \<delta> \<noteq> None \<longrightarrow> (\<forall>x \<in> fv s. is_Fun (the \<delta> x) \<longrightarrow> is_Abs (the_Fun (the \<delta> x)))"
 
   define \<theta>0 where "\<theta>0 \<equiv> \<lambda>x.
     if fst x = TAtom Value \<and> x \<in> fv_transaction T \<and> x \<notin> set (transaction_fresh T)
     then {ab \<in> set OCC. poss x \<subseteq> ab \<and> negs x \<inter> ab = {}} else {}"
 
   define g where "g \<equiv> \<lambda>x. set (filter (\<lambda>ab. poss x \<subseteq> ab \<and> negs x \<inter> ab = {}) OCC)"
   define gs where "gs \<equiv> map (\<lambda>x. (x, g x)) xs"
 
   note defs = assms(3-10) \<theta>0_def
   note assm = assms(11-)[unfolded defs]
 
   have ts0: "\<forall>t \<in> set ts. wf\<^sub>t\<^sub>r\<^sub>m t"
     using admissible_transaction_is_wellformed_transaction(4)[OF T_adm]
     unfolding admissible_transaction_terms_def wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric]
               ts_def trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t[symmetric]
               trms_transaction_unfold
     by fast
 
   have ts1: "\<forall>t \<in> set ts. \<forall>f \<in> funs_term t. \<not>is_Abs f"
     using protocol_transactions_no_abss[OF T_adm] funs_term_Fun_subterm
           trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)
     unfolding ts_def trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t[symmetric] is_Abs_def transaction_strand_def
     by (metis (no_types, opaque_lifting) in_subterms_Union in_subterms_subset_Union subset_iff)
   
   have ts2: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts). fst x = TAtom Value"
     using admissible_transaction_Value_vars[OF T_adm]
           wellformed_transaction_send_receive_fv_subset(1)[
             OF admissible_transaction_is_wellformed_transaction(1)[OF T_adm]]
     unfolding ts_def trms_transaction_unfold trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t[symmetric] \<Gamma>\<^sub>v_TAtom''(2)
     by fastforce
 
   have "f x = \<theta>0 x" for x
   proof (cases "fst x = Var Value \<and> x \<in> fv_transaction T \<and> x \<notin> set (transaction_fresh T)")
     case True
     hence "\<theta>0 x = {ab \<in> set OCC. poss x \<subseteq> ab \<and> negs x \<inter> ab = {}}" unfolding \<theta>0_def by argo
     thus ?thesis
       using True transaction_check_variant_soundness_aux0[OF S_def xs_def, of x]
             transaction_check_variant_soundness_aux1[
               OF C_def S_def xs_def poss_def negs_def as_def f_def, of x]
       by simp
   next
     case False
     hence 0: "\<theta>0 x = {}" unfolding \<theta>0_def by argo
 
     have "x \<notin> set xs"
       using False fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
       unfolding xs_def S_def by fastforce
     hence "List.find (\<lambda>p. fst p = x) gs = None"
       using find_None_iff[of "\<lambda>p. fst p = x" gs] unfolding gs_def by simp
     hence "f x = {}"
       unfolding f_def as_def gs_def g_def by force
     thus ?thesis using 0 by simp
   qed
   thus ?thesis
     using synth_abs_substs_constrs_rel_if_synth_abs_substs_constrs[
             OF _ FP_ground FP_wf, of T, unfolded trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t ts_def[symmetric], OF ts0]
           transaction_check_variant_soundness_aux3[
             OF TI0 OCC FP_ground assm(7-11),
             of "synth_abs_substs_constrs ?FPT T",
             unfolded trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t ts_def[symmetric],
             OF assm(12)[unfolded \<theta>_def trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t ts_def[symmetric]]
                ts1 ts2 assm(13-)[unfolded C_def]]
     unfolding defs synth_abs_substs_constrs_def Let_def by blast
 qed
 
 private lemma transaction_check_variant_soundness_aux5:
   fixes FP OCC TI T S C
   defines "msgcs \<equiv> \<lambda>x a. a \<in> synth_abs_substs_constrs (FP,OCC,TI) T x"
     and "S \<equiv> unlabel (transaction_strand T)"
     and "C \<equiv> unlabel (transaction_checks T)"
     and "xs \<equiv> filter (\<lambda>x. x \<notin> set (transaction_fresh T) \<and> fst x = TAtom Value) (fv_list\<^sub>s\<^sub>s\<^sub>t S)"
     and "poss \<equiv> transaction_poschecks_comp C"
     and "negs \<equiv> transaction_negchecks_comp C"
   assumes T_adm: "admissible_transaction' T"
     and TI: "\<forall>(a,b) \<in> set TI. \<forall>(c,d) \<in> set TI. b = c \<and> a \<noteq> d \<longrightarrow> (a,d) \<in> set TI"
             "\<forall>(a,b) \<in> set TI. a \<noteq> b"
     and OCC: "\<forall>t \<in> set FP. \<forall>a. Abs a \<in> funs_term t \<longrightarrow> a \<in> set OCC"
     and FP: "ground (set FP)"
             "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
     and \<delta>: "\<delta> \<in> abs_substs_fun ` set (abs_substs_set xs OCC poss negs (\<lambda>_ _. True))"
            "transaction_check_pre (FP,OCC,TI) T \<delta>"
   shows "\<delta> \<in> abs_substs_fun ` set (abs_substs_set xs OCC poss negs msgcs)"
 proof -
   have 0: "\<delta> x \<in> set OCC" "poss x \<subseteq> \<delta> x" "\<delta> x \<inter> negs x = {}" when x: "x \<in> set xs" for x
     using abs_substs_abss_bounded[OF \<delta>(1) x] by simp_all
 
   have 1: "\<delta> x = {}" when x: "x \<notin> set xs" for x
     by (rule abs_substs_abss_bounded'[OF \<delta>(1) x])
 
   have 2: "msgcs x (\<delta> x)" when x: "x \<in> set xs" for x
     using 0 1 x transaction_check_variant_soundness_aux4[OF T_adm TI OCC FP, of x \<delta>]
           transaction_check_pre_ReceiveE[OF \<delta>(2)] transaction_check_pre_InSetE[OF \<delta>(2)]
           transaction_check_pre_NotInSetE[OF \<delta>(2)]
     unfolding msgcs_def xs_def C_def S_def negs_def poss_def by fast
 
   show ?thesis
     using abs_substs_has_abs[of xs \<delta> OCC poss negs msgcs] 0 1 2 by blast
 qed
 
 theorem transaction_check_variant_soundness:
   assumes P_adm: "\<forall>T \<in> set P. admissible_transaction' T"
     and TI: "\<forall>(a,b) \<in> set TI. \<forall>(c,d) \<in> set TI. b = c \<and> a \<noteq> d \<longrightarrow> (a,d) \<in> set TI"
             "\<forall>(a,b) \<in> set TI. a \<noteq> b"
     and OCC: "\<forall>t \<in> set FP. \<forall>a. Abs a \<in> funs_term t \<longrightarrow> a \<in> set OCC"
     and FP: "ground (set FP)"
             "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
     and T_in: "T \<in> set P"
     and T_check: "transaction_check_coverage_rcv (FP,OCC,TI) T"
   shows "transaction_check (FP,OCC,TI) T"
 proof -
   have 0: "admissible_transaction' T"
     using P_adm T_in by blast
 
   show ?thesis
     using T_check transaction_check_variant_soundness_aux5[OF 0 TI OCC FP]
     unfolding transaction_check_def transaction_check'_def transaction_check_coverage_rcv_def
               transaction_check_comp_def list_all_iff Let_def
     by force
 qed
 
 end
 
 end
 
 
 subsection \<open>Automatic Fixed-Point Computation\<close>
 context stateful_protocol_model
 begin
 
 fun reduce_fixpoint' where
   "reduce_fixpoint' FP _ [] = FP"
 | "reduce_fixpoint' FP TI (t#M) = (
   let FP' = List.removeAll t FP
   in if intruder_synth_mod_timpls FP' TI t then FP' else reduce_fixpoint' FP TI M)"
 
 definition reduce_fixpoint where
   "reduce_fixpoint FP TI \<equiv>
     let f = \<lambda>FP. reduce_fixpoint' FP TI FP
     in while (\<lambda>M. set (f M) \<noteq> set M) f FP"
 
 definition compute_fixpoint_fun' where
   "compute_fixpoint_fun' P (n::nat option) enable_traces \<Delta> S0 \<equiv>
     let P' = map add_occurs_msgs P;
 
         sy = intruder_synth_mod_timpls;
 
         FP' = \<lambda>S. fst (fst S);
         TI' = \<lambda>S. snd (fst S);
         OCC' = \<lambda>S. remdups (
           (map (\<lambda>t. the_Abs (the_Fun (args t ! 1)))
                (filter (\<lambda>t. is_Fun t \<and> the_Fun t = OccursFact) (FP' S)))@
           (map snd (TI' S)));
 
         equal_states = \<lambda>S S'. set (FP' S) = set (FP' S') \<and> set (TI' S) = set (TI' S');
 
         trace' = \<lambda>S. snd S;
 
         close = \<lambda>M f. let g = remdups \<circ> f in while (\<lambda>A. set (g A) \<noteq> set A) g M;
         close' = \<lambda>M f. let g = remdups \<circ> f in while (\<lambda>A. set (g A) \<noteq> set A) g M;
         trancl_minus_refl = \<lambda>TI.
           let aux = \<lambda>ts p. map (\<lambda>q. (fst p,snd q)) (filter ((=) (snd p) \<circ> fst) ts)
           in filter (\<lambda>p. fst p \<noteq> snd p) (close' TI (\<lambda>ts. concat (map (aux ts) ts)@ts));
         snd_Ana = \<lambda>N M TI. let N' = filter (\<lambda>t. \<forall>k \<in> set (fst (Ana t)). sy M TI k) N in
           filter (\<lambda>t. \<not>sy M TI t)
                  (concat (map (\<lambda>t. filter (\<lambda>s. s \<in> set (snd (Ana t))) (args t)) N'));
         Ana_cl = \<lambda>FP TI.
           close FP (\<lambda>M. (M@snd_Ana M M TI));
         TI_cl = \<lambda>FP TI.
           close FP (\<lambda>M. (M@filter (\<lambda>t. \<not>sy M TI t)
                                   (concat (map (\<lambda>m. concat (map (\<lambda>(a,b). \<langle>a --\<guillemotright> b\<rangle>\<langle>m\<rangle>) TI)) M))));
         Ana_cl' = \<lambda>FP TI.
           let K = \<lambda>t. set (fst (Ana t));
               flt = \<lambda>M t. (\<exists>k \<in> K t. \<not>sy M TI k) \<and> (\<exists>k \<in> K t. \<exists>f \<in> funs_term k. is_Abs f);
               N = \<lambda>M. comp_timpl_closure_list (filter (flt M) M) TI
           in close FP (\<lambda>M. M@snd_Ana (N M) M TI);
 
         \<Delta>' = \<lambda>S. \<Delta> (FP' S, OCC' S, TI' S);
         result = \<lambda>S T \<delta>.
           let not_fresh = \<lambda>x. x \<notin> set (transaction_fresh T);
               xs = filter not_fresh (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)));
               u = \<lambda>\<delta> x. absdbupd (unlabel (transaction_strand T)) x (\<delta> x)
           in (remdups (filter (\<lambda>t. \<not>sy (FP' S) (TI' S) t)
                               (concat (map (\<lambda>ts. the_msgs ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (absc \<circ> u \<delta>))
                                            (filter is_Send (unlabel (transaction_send T)))))),
               remdups (filter (\<lambda>s. fst s \<noteq> snd s) (map (\<lambda>x. (\<delta> x, u \<delta> x)) xs)));
         result_tuple = \<lambda>S T \<delta>. (result S T (abs_substs_fun \<delta>), if enable_traces then \<delta> else []);
         update_state = \<lambda>S. if list_ex (\<lambda>t. is_Fun t \<and> is_Attack (the_Fun t)) (FP' S) then S
           else let results = map (\<lambda>T. map (result_tuple S T) (\<Delta>' S T)) P';
                    newtrace_flt = (\<lambda>n. let x = map fst (results ! n); y = map fst x; z = map snd x
                     in set (concat y) - set (FP' S) \<noteq> {} \<or> set (concat z) - set (TI' S) \<noteq> {});
                    trace =
                     if enable_traces
                     then trace' S@[concat (map (\<lambda>i. map (\<lambda>a. (i,snd a)) (results ! i))
                                                (filter newtrace_flt [0..<length results]))]
                     else [];
                    U = map fst (concat results);
                    V = ((remdups (concat (map fst U)@FP' S),
                          remdups (filter (\<lambda>x. fst x \<noteq> snd x) (concat (map snd U)@TI' S))),
                         trace);
                    W = ((Ana_cl (TI_cl (FP' V) (TI' V)) (TI' V),
                          trancl_minus_refl (TI' V)),
                         trace' V)
           in if \<not>equal_states W S then W
           else ((Ana_cl' (FP' W) (TI' W), TI' W), trace' W);
 
         S = ((\<lambda>h. case n of None \<Rightarrow> while (\<lambda>S. \<not>equal_states S (h S)) h | Some m \<Rightarrow> h ^^ m)
              update_state S0)
     in ((reduce_fixpoint (FP' S) (TI' S), OCC' S, TI' S), trace' S)"
 
 definition compute_fixpoint_fun where
   "compute_fixpoint_fun P \<equiv>
     let P' = remdups (filter (\<lambda>T. transaction_updates T \<noteq> [] \<or> transaction_send T \<noteq> []) P);
         f = (\<lambda>FPT T. let msgcs = synth_abs_substs_constrs FPT T
                     in transaction_check_comp (\<lambda>x a. a \<in> msgcs x) FPT T)
     in fst (compute_fixpoint_fun' P' None False f (([],[]),[]))"
 
 definition compute_fixpoint_with_trace where
   "compute_fixpoint_with_trace P \<equiv>
     compute_fixpoint_fun' P None True (transaction_check_comp (\<lambda>_ _. True)) (([],[]),[])"
 
 definition compute_fixpoint_from_trace where
   "compute_fixpoint_from_trace P trace \<equiv>
     let P' = map add_occurs_msgs P;
         \<Delta> = \<lambda>FPT T.
           let pre_check = transaction_check_pre FPT T;
               \<delta>s = map snd (filter (\<lambda>(i,as). P' ! i = T) (concat trace))
           in filter (\<lambda>\<delta>. pre_check (abs_substs_fun \<delta>)) \<delta>s;
         f = compute_fixpoint_fun' \<circ> map (nth P);
         g = \<lambda>L FPT. fst ((f L (Some 1) False \<Delta> ((fst FPT,snd (snd FPT)),[])))
     in fold g (map (map fst) trace) ([],[],[])"
 
 definition compute_reduced_attack_trace where
   "compute_reduced_attack_trace P trace \<equiv>
     let attack_in_fixpoint = list_ex (\<lambda>t. \<exists>f \<in> funs_term t. is_Attack f) \<circ> fst;
         is_attack_trace = attack_in_fixpoint \<circ> compute_fixpoint_from_trace P;
   
         trace' =
           let is_attack_transaction =
                 list_ex is_Fun_Attack \<circ> concat \<circ> map the_msgs \<circ>
                 filter is_Send \<circ> unlabel \<circ> transaction_send;
               trace' =
                 if trace = [] then []
                 else butlast trace@[filter (is_attack_transaction \<circ> nth P \<circ> fst) (last trace)]
            in trace';
     
         iter = \<lambda>trace_prev trace_rest elem (prev,rest).
           let next =
             if is_attack_trace (trace_prev@(prev@rest)#trace_rest)
             then prev
             else prev@[elem]
           in (next, tl rest);
         iter' = \<lambda>trace_part (trace_prev,trace_rest).
           let updated = foldr (iter trace_prev (tl trace_rest)) trace_part ([],tl (rev trace_part))
           in (trace_prev@[rev (fst updated)], tl trace_rest);
     
         reduced_trace = fst (fold iter' trace' ([],trace'))
     in concat reduced_trace"
 
 end
 
 
 subsection \<open>Locales for Protocols Proven Secure through Fixed-Point Coverage\<close>
 type_synonym ('f,'a,'s,'l) fixpoint_triple =
   "('f,'a,'s,'l) prot_term list \<times> 's set list \<times> ('s set \<times> 's set) list"
 
 context stateful_protocol_model
 begin
 
 definition "attack_notin_fixpoint (FPT::('fun,'atom,'sets,'lbl) fixpoint_triple) \<equiv>
   list_all (\<lambda>t. \<forall>f \<in> funs_term t. \<not>is_Attack f) (fst FPT)"
 
 definition "protocol_covered_by_fixpoint (FPT::('fun,'atom,'sets,'lbl) fixpoint_triple) P \<equiv>
   list_all (transaction_check FPT)
            (filter (\<lambda>T. transaction_updates T \<noteq> [] \<or> transaction_send T \<noteq> [])
                    (map add_occurs_msgs P))"
 
 definition "protocol_covered_by_fixpoint_coverage_rcv (FPT::('fun,'atom,'sets,'lbl) fixpoint_triple) P \<equiv>
   list_all (transaction_check_coverage_rcv FPT)
            (filter (\<lambda>T. transaction_updates T \<noteq> [] \<or> transaction_send T \<noteq> [])
                    (map add_occurs_msgs P))"
 
 definition "analyzed_fixpoint (FPT::('fun,'atom,'sets,'lbl) fixpoint_triple) \<equiv>
   let (FP, _, TI) = FPT
   in analyzed_closed_mod_timpls FP TI"
 
 definition "wellformed_protocol_SMP_set (P::('fun,'atom,'sets,'lbl) prot) N \<equiv>
   has_all_wt_instances_of \<Gamma> (\<Union>T \<in> set P. trms_transaction T) (set N) \<and>
   comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> (set N) \<and>
   list_all (\<lambda>T. list_all (comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<Gamma> Pair) (unlabel (transaction_strand T))) P"
 
 (* TODO: try to avoid checking the "list_all is_*" conditions here... *)
 definition "wellformed_protocol'' (P::('fun,'atom,'sets,'lbl) prot) N \<equiv>
   let f = \<lambda>T. transaction_fresh T = [] \<longrightarrow> transaction_updates T \<noteq> [] \<or> transaction_send T \<noteq> []
   in list_all (\<lambda>T. list_all is_Receive (unlabel (transaction_receive T)) \<and>
                    list_all is_Check_or_Assignment (unlabel (transaction_checks T)) \<and>
                    list_all is_Update (unlabel (transaction_updates T)) \<and>
                    list_all is_Send (unlabel (transaction_send T)))
               P \<and>
      list_all admissible_transaction (filter f P) \<and>
      wellformed_protocol_SMP_set P N"
 
 definition "wellformed_protocol' (P::('fun,'atom,'sets,'lbl) prot) N \<equiv>
   wellformed_protocol'' P N \<and>
   has_initial_value_producing_transaction P"
 
 definition "wellformed_protocol (P::('fun,'atom,'sets,'lbl) prot) \<equiv>
   let f = \<lambda>M. remdups (concat (map subterms_list M@map (fst \<circ> Ana) M));
       N0 = remdups (concat (map (trms_list\<^sub>s\<^sub>s\<^sub>t \<circ> unlabel \<circ> transaction_strand) P));
       N = while (\<lambda>A. set (f A) \<noteq> set A) f N0
   in wellformed_protocol' P N"
 
 definition "wellformed_fixpoint' (FPT::('fun,'atom,'sets,'lbl) fixpoint_triple) \<equiv>
   let (FP, OCC, TI) = FPT; OCC' = set OCC
   in list_all (\<lambda>t. wf\<^sub>t\<^sub>r\<^sub>m' arity t \<and> fv t = {}) FP \<and>
      list_all (\<lambda>a. a \<in> OCC') (map snd TI) \<and>
      list_all (\<lambda>t. \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> the_Abs f \<in> OCC') FP"
 
 definition "wellformed_term_implication_graph (FPT::('fun,'atom,'sets,'lbl) fixpoint_triple) \<equiv>
   let (_, _, TI) = FPT
   in list_all (\<lambda>(a,b). list_all (\<lambda>(c,d). b = c \<and> a \<noteq> d \<longrightarrow> List.member TI (a,d)) TI) TI \<and>
      list_all (\<lambda>p. fst p \<noteq> snd p) TI"
 
 definition "wellformed_fixpoint (FPT::('fun,'atom,'sets,'lbl) fixpoint_triple) \<equiv>
   wellformed_fixpoint' FPT \<and> wellformed_term_implication_graph FPT"
 
 lemma wellformed_protocol_SMP_set_mono:
   assumes "wellformed_protocol_SMP_set P S"
     and "set P' \<subseteq> set P"
   shows "wellformed_protocol_SMP_set P' S"
 using assms 
 unfolding wellformed_protocol_SMP_set_def comp_tfr\<^sub>s\<^sub>e\<^sub>t_def has_all_wt_instances_of_def
           wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s'_def list_all_iff
 by fast
 
 lemma wellformed_protocol''_mono:
   assumes "wellformed_protocol'' P S"
     and "set P' \<subseteq> set P"
   shows "wellformed_protocol'' P' S"
 using assms wellformed_protocol_SMP_set_mono[of P S P']
 unfolding wellformed_protocol''_def list_all_iff by auto
 
 lemma wellformed_protocol'_mono:
   assumes "wellformed_protocol' P S"
     and "set P' \<subseteq> set P"
     and "has_initial_value_producing_transaction P'"
   shows "wellformed_protocol' P' S"
 using assms wellformed_protocol_SMP_set_mono[of P S P'] wellformed_protocol''_mono
 unfolding wellformed_protocol'_def by blast
 
 lemma protocol_covered_by_fixpoint_if_protocol_covered_by_fixpoint_coverage_rcv:
   assumes P: "wellformed_protocol'' P P_SMP"
     and FPT: "wellformed_fixpoint FPT"
     and covered: "protocol_covered_by_fixpoint_coverage_rcv FPT P"
   shows "protocol_covered_by_fixpoint FPT P"
 proof -
   obtain FP OCC TI where FPT': "FPT = (FP,OCC,TI)" by (metis surj_pair)
 
   note defs = FPT' wellformed_protocol''_def wellformed_fixpoint_def wellformed_fixpoint'_def
               wellformed_term_implication_graph_def Let_def
               wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric] wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric] 
               member_def case_prod_unfold list_all_iff
 
   let ?f = "\<lambda>T. transaction_fresh T = [] \<longrightarrow> transaction_updates T \<noteq> [] \<or> transaction_send T \<noteq> []"
 
   have TI: "\<forall>(a,b) \<in> set TI. \<forall>(c,d) \<in> set TI. b = c \<and> a \<noteq> d \<longrightarrow> (a,d) \<in> set TI"
               "\<forall>(a,b) \<in> set TI. a \<noteq> b"
       and OCC: "\<forall>t \<in> set FP. \<forall>a. Abs a \<in> funs_term t \<longrightarrow> a \<in> set OCC"
       and FP: "ground (set FP)"
               "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
     using FPT unfolding defs by (simp, simp, fastforce, simp, simp)
 
   have P_adm: "\<forall>T \<in> set (filter ?f (map add_occurs_msgs P)). admissible_transaction' T"
     using P add_occurs_msgs_admissible_occurs_checks(1)[OF admissible_transactionE'(1)]
     unfolding defs add_occurs_msgs_updates_send_filter_iff'[of P, symmetric] by auto
 
   show ?thesis
     using covered transaction_check_variant_soundness[OF P_adm TI OCC FP]
     unfolding protocol_covered_by_fixpoint_def protocol_covered_by_fixpoint_coverage_rcv_def
               FPT' list_all_iff
     by fastforce
 qed
 
 lemma protocol_covered_by_fixpoint_if_protocol_covered_by_fixpoint_coverage_rcv':
   assumes P: "wellformed_protocol'' P P_SMP"
     and P': "set P' \<subseteq> set P"
     and FPT: "wellformed_fixpoint FPT"
     and covered: "protocol_covered_by_fixpoint_coverage_rcv FPT P'"
   shows "protocol_covered_by_fixpoint FPT P'"
 using protocol_covered_by_fixpoint_if_protocol_covered_by_fixpoint_coverage_rcv[OF _ FPT covered]
       wellformed_protocol''_mono[OF P P']
 by simp
 
 lemma protocol_covered_by_fixpoint_trivial_case:
   assumes "list_all (\<lambda>T. transaction_updates T = [] \<and> transaction_send T = [])
                     (map add_occurs_msgs P)"
   shows "protocol_covered_by_fixpoint FPT P"
 using assms
 by (simp add: list_all_iff transaction_check_trivial_case protocol_covered_by_fixpoint_def)
 
 lemma protocol_covered_by_fixpoint_empty[simp]:
   "protocol_covered_by_fixpoint FPT []"
 by (simp add: protocol_covered_by_fixpoint_def)
 
 lemma protocol_covered_by_fixpoint_Cons[simp]:
   "protocol_covered_by_fixpoint FPT (T#P) \<longleftrightarrow>
     transaction_check FPT (add_occurs_msgs T) \<and> protocol_covered_by_fixpoint FPT P"
 using transaction_check_trivial_case[of "add_occurs_msgs T"]
 unfolding protocol_covered_by_fixpoint_def case_prod_unfold by simp
 
 lemma protocol_covered_by_fixpoint_append[simp]:
   "protocol_covered_by_fixpoint FPT (P1@P2) \<longleftrightarrow>
    protocol_covered_by_fixpoint FPT P1 \<and> protocol_covered_by_fixpoint FPT P2"
 by (simp add: protocol_covered_by_fixpoint_def case_prod_unfold)
 
 lemma protocol_covered_by_fixpoint_I1[intro]:
   assumes "list_all (protocol_covered_by_fixpoint FPT) P"
   shows "protocol_covered_by_fixpoint FPT (concat P)"
 using assms by (auto simp add: protocol_covered_by_fixpoint_def list_all_iff)
 
 lemma protocol_covered_by_fixpoint_I2[intro]:
   assumes "protocol_covered_by_fixpoint FPT P1"
     and "protocol_covered_by_fixpoint FPT P2"
   shows "protocol_covered_by_fixpoint FPT (P1@P2)"
 using assms by (auto simp add: protocol_covered_by_fixpoint_def)
 
 lemma protocol_covered_by_fixpoint_I3:
   assumes "\<forall>T \<in> set P. \<forall>\<delta>::('fun,'atom,'sets,'lbl) prot_var \<Rightarrow> 'sets set.
     transaction_check_pre FPT (add_occurs_msgs T) \<delta> \<longrightarrow>
     transaction_check_post FPT (add_occurs_msgs T) \<delta>"
   shows "protocol_covered_by_fixpoint FPT P"
 using assms
 unfolding protocol_covered_by_fixpoint_def transaction_check_def transaction_check'_def
           transaction_check_comp_def list_all_iff Let_def case_prod_unfold
           Product_Type.fst_conv Product_Type.snd_conv
 by fastforce
 
 lemmas protocol_covered_by_fixpoint_intros =
   protocol_covered_by_fixpoint_I1
   protocol_covered_by_fixpoint_I2
   protocol_covered_by_fixpoint_I3
 
 lemma prot_secure_if_prot_checks:
   fixes P::"('fun,'atom,'sets,'lbl) prot_transaction list"
     and FP_OCC_TI:: "('fun,'atom,'sets,'lbl) fixpoint_triple"
   assumes attack_notin_fixpoint: "attack_notin_fixpoint FP_OCC_TI"
     and transactions_covered: "protocol_covered_by_fixpoint FP_OCC_TI P"
     and analyzed_fixpoint: "analyzed_fixpoint FP_OCC_TI"
     and wellformed_protocol: "wellformed_protocol' P N"
     and wellformed_fixpoint: "wellformed_fixpoint FP_OCC_TI"
   shows "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>. constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
     (is "?secure P")
 proof -
   define FP where "FP \<equiv> let (FP,_,_) = FP_OCC_TI in FP"
   define OCC where "OCC \<equiv> let (_,OCC,_) = FP_OCC_TI in OCC"
   define TI where "TI \<equiv> let (_,_,TI) = FP_OCC_TI in TI"
 
   define f where "f \<equiv> \<lambda>T::('fun,'atom,'sets,'lbl) prot_transaction.
     transaction_fresh T = [] \<longrightarrow> transaction_updates T \<noteq> [] \<or> transaction_send T \<noteq> []"
 
   define g where "g \<equiv> \<lambda>T::('fun,'atom,'sets,'lbl) prot_transaction.
     transaction_fresh T = [] \<longrightarrow>
       list_ex (\<lambda>a. is_Update (snd a) \<or> is_Send (snd a)) (transaction_strand T)"
 
   note wellformed_prot_defs =
     wellformed_protocol'_def wellformed_protocol''_def wellformed_protocol_SMP_set_def
 
   have attack_notin_FP: "attack\<langle>n\<rangle> \<notin> set FP"
     using attack_notin_fixpoint[unfolded attack_notin_fixpoint_def]
     unfolding list_all_iff FP_def by force
 
   have 1: "\<forall>(a,b) \<in> set TI. \<forall>(c,d) \<in> set TI. b = c \<and> a \<noteq> d \<longrightarrow> (a,d) \<in> set TI"
     using wellformed_fixpoint
     unfolding wellformed_fixpoint_def wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric] Let_def TI_def
               list_all_iff member_def case_prod_unfold
               wellformed_term_implication_graph_def
     by auto
 
   have 0: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
     and 2: "\<forall>(a,b) \<in> set TI. a \<noteq> b"
     and 3: "snd ` set TI \<subseteq> set OCC"
     and 4: "\<forall>t \<in> set FP. \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
     and 5: "ground (set FP)"
     using wellformed_fixpoint
     unfolding wellformed_fixpoint_def wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric] is_Abs_def the_Abs_def
               list_all_iff Let_def case_prod_unfold set_map FP_def OCC_def TI_def
               wellformed_fixpoint'_def wellformed_term_implication_graph_def
     by (fast, fast, blast, fastforce, simp)
 
   have 8: "finite (set N)"
     and 9: "has_all_wt_instances_of \<Gamma> (\<Union>T \<in> set (filter g P). trms_transaction T) (set N)"
     and 10: "tfr\<^sub>s\<^sub>e\<^sub>t (set N)"
     and 11: "\<forall>T \<in> set (filter f P). list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
     and 12: "\<forall>T \<in> set (filter f P). admissible_transaction T"
     using wellformed_protocol[unfolded wellformed_prot_defs]
           tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[of "set N"]
     unfolding Let_def list_all_iff wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric] tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p[symmetric]
               has_all_wt_instances_of_def f_def[symmetric]
     by (fast, fastforce, fast, fastforce, fast)
 
   have 13: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set N)"
     using wellformed_protocol[unfolded wellformed_prot_defs]
           finite_SMP_representationD
     unfolding wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric] wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s'_def comp_tfr\<^sub>s\<^sub>e\<^sub>t_def list_all_iff Let_def by fast
 
   have 14: "has_initial_value_producing_transaction (filter g P)"
     using wellformed_protocol has_initial_value_producing_transaction_update_send_ex_filter
     unfolding wellformed_protocol'_def Let_def g_def by blast
 
   note TI0 = trancl_eqI'[OF 1 2]
 
   have "analyzed (timpl_closure_set (set FP) (set TI))"
     using analyzed_fixpoint[unfolded analyzed_fixpoint_def]
           analyzed_closed_mod_timpls_is_analyzed_timpl_closure_set[OF TI0 0]
     unfolding FP_def TI_def
     by force
   note FP0 = this 0 5
 
   note OCC0 = funs_term_OCC_TI_subset(1)[OF 4 3]
               timpl_closure_set_supset'[OF funs_term_OCC_TI_subset(2)[OF 4 3]]
 
   note M0 = 9 8 10 13
 
   have "f T \<longleftrightarrow> g T" when T: "T \<in> set P" for T
   proof -
     have *: "list_all stateful_strand_step.is_Receive (unlabel (transaction_receive T))"
             "list_all is_Check_or_Assignment (unlabel (transaction_checks T))"
             "list_all is_Update (unlabel (transaction_updates T))"
             "list_all stateful_strand_step.is_Send (unlabel (transaction_send T))"
       using T wellformed_protocol
       unfolding wellformed_protocol_def wellformed_prot_defs Let_def list_all_iff
       by (fast, fast, fast, fast)
 
     show ?thesis
       using transaction_updates_send_ex_iff[OF *]
       unfolding f_def g_def by (metis (no_types, lifting) list_ex_cong)
   qed
   hence 15: "\<forall>T \<in> set (filter g P). list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
     and 16: "\<forall>T \<in> set (filter g P). admissible_transaction T"
     using 11 12 by auto
 
   have "list_all (transaction_check (FP, OCC, TI)) (map add_occurs_msgs (filter g P))"
     using transactions_covered[unfolded protocol_covered_by_fixpoint_def]
           transaction_check_trivial_case[of _ FP_OCC_TI]
     unfolding FP_def OCC_def TI_def list_all_iff Let_def case_prod_unfold
     by auto
   note P0 = 16 15 14 this attack_notin_FP
 
   show ?thesis
     using prot_secure_if_fixpoint_covered[OF FP0 OCC0 TI0 M0 P0]
           reachable_constraints_secure_if_filter_secure_case[unfolded g_def[symmetric]]
     by fast
 qed
 
 lemma prot_secure_if_prot_checks_coverage_rcv:
   fixes P::"('fun,'atom,'sets,'lbl) prot_transaction list"
     and FP_OCC_TI:: "('fun,'atom,'sets,'lbl) fixpoint_triple"
   assumes attack_notin_fixpoint: "attack_notin_fixpoint FP_OCC_TI"
     and transactions_covered: "protocol_covered_by_fixpoint_coverage_rcv FP_OCC_TI P"
     and analyzed_fixpoint: "analyzed_fixpoint FP_OCC_TI"
     and wellformed_protocol: "wellformed_protocol' P N"
     and wellformed_fixpoint: "wellformed_fixpoint FP_OCC_TI"
   shows "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>. constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
 using prot_secure_if_prot_checks[
         OF attack_notin_fixpoint _
            analyzed_fixpoint wellformed_protocol wellformed_fixpoint]
       protocol_covered_by_fixpoint_if_protocol_covered_by_fixpoint_coverage_rcv[
         OF _ wellformed_fixpoint transactions_covered]
       wellformed_protocol[unfolded wellformed_protocol'_def]
 by blast
 
 end
 
 locale secure_stateful_protocol =
   pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
   for arity\<^sub>f::"'fun \<Rightarrow> nat"
     and arity\<^sub>s::"'sets \<Rightarrow> nat"
     and public\<^sub>f::"'fun \<Rightarrow> bool"
     and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets,'lbl) prot_fun, nat) term list \<times> nat list)"
     and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
     and label_witness1::"'lbl"
     and label_witness2::"'lbl"
   +
   fixes P::"('fun,'atom,'sets,'lbl) prot_transaction list"
     and FP_OCC_TI:: "('fun,'atom,'sets,'lbl) fixpoint_triple"
     and P_SMP::"('fun,'atom,'sets,'lbl) prot_term list"
   assumes attack_notin_fixpoint: "pm.attack_notin_fixpoint FP_OCC_TI"
     and transactions_covered: "pm.protocol_covered_by_fixpoint FP_OCC_TI P"
     and analyzed_fixpoint: "pm.analyzed_fixpoint FP_OCC_TI"
     and wellformed_protocol: "pm.wellformed_protocol' P P_SMP"
     and wellformed_fixpoint: "pm.wellformed_fixpoint FP_OCC_TI"
 begin
 
 theorem protocol_secure:
   "\<forall>\<A> \<in> pm.reachable_constraints P. \<nexists>\<I>. pm.constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
 by (rule pm.prot_secure_if_prot_checks[OF
             attack_notin_fixpoint transactions_covered
             analyzed_fixpoint wellformed_protocol wellformed_fixpoint])
 
 corollary protocol_welltyped_secure:
   "\<forall>\<A> \<in> pm.reachable_constraints P. \<nexists>\<I>. pm.welltyped_constraint_model \<I> (\<A>@[(l, send\<langle>[attack\<langle>n\<rangle>]\<rangle>)])"
 using protocol_secure unfolding pm.welltyped_constraint_model_def by fast
 
 end
 
 locale secure_stateful_protocol' =
   pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
   for arity\<^sub>f::"'fun \<Rightarrow> nat"
     and arity\<^sub>s::"'sets \<Rightarrow> nat"
     and public\<^sub>f::"'fun \<Rightarrow> bool"
     and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets,'lbl) prot_fun, nat) term list \<times> nat list)"
     and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
     and label_witness1::"'lbl"
     and label_witness2::"'lbl"
   +
   fixes P::"('fun,'atom,'sets,'lbl) prot_transaction list"
     and FP_OCC_TI:: "('fun,'atom,'sets,'lbl) fixpoint_triple"
   assumes attack_notin_fixpoint': "pm.attack_notin_fixpoint FP_OCC_TI"
     and transactions_covered': "pm.protocol_covered_by_fixpoint FP_OCC_TI P"
     and analyzed_fixpoint': "pm.analyzed_fixpoint FP_OCC_TI"
     and wellformed_protocol': "pm.wellformed_protocol P"
     and wellformed_fixpoint': "pm.wellformed_fixpoint FP_OCC_TI"
 begin
 
 sublocale secure_stateful_protocol
   arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P
   FP_OCC_TI
   "let f = \<lambda>M. remdups (concat (map subterms_list M@map (fst \<circ> pm.Ana) M));
        N0 = remdups (concat (map (trms_list\<^sub>s\<^sub>s\<^sub>t \<circ> unlabel \<circ> transaction_strand) P))
    in while (\<lambda>A. set (f A) \<noteq> set A) f N0"
 apply unfold_locales
 using attack_notin_fixpoint' transactions_covered' analyzed_fixpoint'
       wellformed_protocol'[unfolded pm.wellformed_protocol_def Let_def] wellformed_fixpoint'
 unfolding Let_def by blast+
 
 end
 
 locale secure_stateful_protocol'' =
   pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
   for arity\<^sub>f::"'fun \<Rightarrow> nat"
     and arity\<^sub>s::"'sets \<Rightarrow> nat"
     and public\<^sub>f::"'fun \<Rightarrow> bool"
     and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets,'lbl) prot_fun, nat) term list \<times> nat list)"
     and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
     and label_witness1::"'lbl"
     and label_witness2::"'lbl"
   +
   fixes P::"('fun,'atom,'sets,'lbl) prot_transaction list"
   assumes checks: "let FPT = pm.compute_fixpoint_fun P
     in pm.attack_notin_fixpoint FPT \<and> pm.protocol_covered_by_fixpoint FPT P \<and>
        pm.analyzed_fixpoint FPT \<and> pm.wellformed_protocol P \<and> pm.wellformed_fixpoint FPT"
 begin
 
 sublocale secure_stateful_protocol'
   arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P "pm.compute_fixpoint_fun P"
 using checks[unfolded Let_def case_prod_unfold] by unfold_locales meson+
 
 end
 
 locale secure_stateful_protocol''' =
   pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
   for arity\<^sub>f::"'fun \<Rightarrow> nat"
     and arity\<^sub>s::"'sets \<Rightarrow> nat"
     and public\<^sub>f::"'fun \<Rightarrow> bool"
     and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets,'lbl) prot_fun, nat) term list \<times> nat list)"
     and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
     and label_witness1::"'lbl"
     and label_witness2::"'lbl"
   +
   fixes P::"('fun,'atom,'sets,'lbl) prot_transaction list"
     and FP_OCC_TI:: "('fun,'atom,'sets,'lbl) fixpoint_triple"
     and P_SMP::"('fun,'atom,'sets,'lbl) prot_term list"
   assumes checks': "let P' = P; FPT = FP_OCC_TI; P'_SMP = P_SMP
                     in pm.attack_notin_fixpoint FPT \<and>
                        pm.protocol_covered_by_fixpoint FPT P' \<and>
                        pm.analyzed_fixpoint FPT \<and>
                        pm.wellformed_protocol' P' P'_SMP \<and>
                        pm.wellformed_fixpoint FPT"
 begin
 
 sublocale secure_stateful_protocol
   arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P FP_OCC_TI P_SMP
 using checks'[unfolded Let_def case_prod_unfold] by unfold_locales meson+
 
 end
 
 locale secure_stateful_protocol'''' =
   pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
   for arity\<^sub>f::"'fun \<Rightarrow> nat"
     and arity\<^sub>s::"'sets \<Rightarrow> nat"
     and public\<^sub>f::"'fun \<Rightarrow> bool"
     and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets,'lbl) prot_fun, nat) term list \<times> nat list)"
     and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
     and label_witness1::"'lbl"
     and label_witness2::"'lbl"
   +
   fixes P::"('fun,'atom,'sets,'lbl) prot_transaction list"
     and FP_OCC_TI:: "('fun,'atom,'sets,'lbl) fixpoint_triple"
   assumes checks'': "let P' = P; FPT = FP_OCC_TI
                      in pm.attack_notin_fixpoint FPT \<and>
                         pm.protocol_covered_by_fixpoint FPT P' \<and>
                         pm.analyzed_fixpoint FPT \<and>
                         pm.wellformed_protocol P' \<and>
                         pm.wellformed_fixpoint FPT"
 begin
 
 sublocale secure_stateful_protocol'
   arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P FP_OCC_TI
 using checks''[unfolded Let_def case_prod_unfold] by unfold_locales meson+
 
 end
 
 locale secure_stateful_protocol_coverage_rcv =
   pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
   for arity\<^sub>f::"'fun \<Rightarrow> nat"
     and arity\<^sub>s::"'sets \<Rightarrow> nat"
     and public\<^sub>f::"'fun \<Rightarrow> bool"
     and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets,'lbl) prot_fun, nat) term list \<times> nat list)"
     and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
     and label_witness1::"'lbl"
     and label_witness2::"'lbl"
   +
   fixes P::"('fun,'atom,'sets,'lbl) prot_transaction list"
     and FP_OCC_TI:: "('fun,'atom,'sets,'lbl) fixpoint_triple"
     and P_SMP::"('fun,'atom,'sets,'lbl) prot_term list"
   assumes attack_notin_fixpoint_coverage_rcv: "pm.attack_notin_fixpoint FP_OCC_TI"
     and transactions_covered_coverage_rcv: "pm.protocol_covered_by_fixpoint_coverage_rcv FP_OCC_TI P"
     and analyzed_fixpoint_coverage_rcv: "pm.analyzed_fixpoint FP_OCC_TI"
     and wellformed_protocol_coverage_rcv: "pm.wellformed_protocol' P P_SMP"
     and wellformed_fixpoint_coverage_rcv: "pm.wellformed_fixpoint FP_OCC_TI"
 begin
 
 sublocale secure_stateful_protocol
   arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P
   FP_OCC_TI P_SMP
 using pm.protocol_covered_by_fixpoint_if_protocol_covered_by_fixpoint_coverage_rcv[
         OF _ wellformed_fixpoint_coverage_rcv transactions_covered_coverage_rcv]
       attack_notin_fixpoint_coverage_rcv analyzed_fixpoint_coverage_rcv
       wellformed_protocol_coverage_rcv wellformed_fixpoint_coverage_rcv
       wellformed_protocol_coverage_rcv[unfolded pm.wellformed_protocol'_def]
 by unfold_locales meson+
 
 end
 
 locale secure_stateful_protocol_coverage_rcv' =
   pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
   for arity\<^sub>f::"'fun \<Rightarrow> nat"
     and arity\<^sub>s::"'sets \<Rightarrow> nat"
     and public\<^sub>f::"'fun \<Rightarrow> bool"
     and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets,'lbl) prot_fun, nat) term list \<times> nat list)"
     and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
     and label_witness1::"'lbl"
     and label_witness2::"'lbl"
   +
   fixes P::"('fun,'atom,'sets,'lbl) prot_transaction list"
     and FP_OCC_TI:: "('fun,'atom,'sets,'lbl) fixpoint_triple"
   assumes attack_notin_fixpoint_coverage_rcv': "pm.attack_notin_fixpoint FP_OCC_TI"
     and transactions_covered_coverage_rcv': "pm.protocol_covered_by_fixpoint_coverage_rcv FP_OCC_TI P"
     and analyzed_fixpoint_coverage_rcv': "pm.analyzed_fixpoint FP_OCC_TI"
     and wellformed_protocol_coverage_rcv': "pm.wellformed_protocol P"
     and wellformed_fixpoint_coverage_rcv': "pm.wellformed_fixpoint FP_OCC_TI"
 begin
 
 sublocale secure_stateful_protocol_coverage_rcv
   arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P
   FP_OCC_TI
   "let f = \<lambda>M. remdups (concat (map subterms_list M@map (fst \<circ> pm.Ana) M));
        N0 = remdups (concat (map (trms_list\<^sub>s\<^sub>s\<^sub>t \<circ> unlabel \<circ> transaction_strand) P))
    in while (\<lambda>A. set (f A) \<noteq> set A) f N0"
 apply unfold_locales
 using attack_notin_fixpoint_coverage_rcv' transactions_covered_coverage_rcv' analyzed_fixpoint_coverage_rcv'
       wellformed_protocol_coverage_rcv'[unfolded pm.wellformed_protocol_def Let_def] wellformed_fixpoint_coverage_rcv'
 unfolding Let_def by blast+
 
 end
 
 locale secure_stateful_protocol_coverage_rcv'' =
   pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
   for arity\<^sub>f::"'fun \<Rightarrow> nat"
     and arity\<^sub>s::"'sets \<Rightarrow> nat"
     and public\<^sub>f::"'fun \<Rightarrow> bool"
     and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets,'lbl) prot_fun, nat) term list \<times> nat list)"
     and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
     and label_witness1::"'lbl"
     and label_witness2::"'lbl"
   +
   fixes P::"('fun,'atom,'sets,'lbl) prot_transaction list"
   assumes checks_coverage_rcv: "let FPT = pm.compute_fixpoint_fun P
     in pm.attack_notin_fixpoint FPT \<and> pm.protocol_covered_by_fixpoint_coverage_rcv FPT P \<and>
        pm.analyzed_fixpoint FPT \<and> pm.wellformed_protocol P \<and> pm.wellformed_fixpoint FPT"
 begin
 
 sublocale secure_stateful_protocol_coverage_rcv'
   arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P "pm.compute_fixpoint_fun P"
 using checks_coverage_rcv[unfolded Let_def case_prod_unfold] by unfold_locales meson+
 
 end
 
 locale secure_stateful_protocol_coverage_rcv''' =
   pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
   for arity\<^sub>f::"'fun \<Rightarrow> nat"
     and arity\<^sub>s::"'sets \<Rightarrow> nat"
     and public\<^sub>f::"'fun \<Rightarrow> bool"
     and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets,'lbl) prot_fun, nat) term list \<times> nat list)"
     and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
     and label_witness1::"'lbl"
     and label_witness2::"'lbl"
   +
   fixes P::"('fun,'atom,'sets,'lbl) prot_transaction list"
     and FP_OCC_TI:: "('fun,'atom,'sets,'lbl) fixpoint_triple"
     and P_SMP::"('fun,'atom,'sets,'lbl) prot_term list"
   assumes checks_coverage_rcv': "let P' = P; FPT = FP_OCC_TI; P'_SMP = P_SMP
                          in pm.attack_notin_fixpoint FPT \<and>
                             pm.protocol_covered_by_fixpoint_coverage_rcv FPT P' \<and>
                             pm.analyzed_fixpoint FPT \<and>
                             pm.wellformed_protocol' P' P'_SMP \<and>
                             pm.wellformed_fixpoint FPT"
 begin
 
 sublocale secure_stateful_protocol_coverage_rcv
   arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P FP_OCC_TI P_SMP
 using checks_coverage_rcv'[unfolded Let_def case_prod_unfold] by unfold_locales meson+
 
 end
 
 locale secure_stateful_protocol_coverage_rcv'''' =
   pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
   for arity\<^sub>f::"'fun \<Rightarrow> nat"
     and arity\<^sub>s::"'sets \<Rightarrow> nat"
     and public\<^sub>f::"'fun \<Rightarrow> bool"
     and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets,'lbl) prot_fun, nat) term list \<times> nat list)"
     and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
     and label_witness1::"'lbl"
     and label_witness2::"'lbl"
   +
   fixes P::"('fun,'atom,'sets,'lbl) prot_transaction list"
     and FP_OCC_TI:: "('fun,'atom,'sets,'lbl) fixpoint_triple"
   assumes checks_coverage_rcv'': "let P' = P; FPT = FP_OCC_TI
                           in pm.attack_notin_fixpoint FPT \<and>
                              pm.protocol_covered_by_fixpoint_coverage_rcv FPT P' \<and>
                              pm.analyzed_fixpoint FPT \<and>
                              pm.wellformed_protocol P' \<and>
                              pm.wellformed_fixpoint FPT"
 begin
 
 sublocale secure_stateful_protocol_coverage_rcv'
   arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P FP_OCC_TI
 using checks_coverage_rcv''[unfolded Let_def case_prod_unfold] by unfold_locales meson+
 
 end
 
 
 subsection \<open>Automatic Protocol Composition\<close>
 context stateful_protocol_model
 begin
 
 definition welltyped_leakage_free_protocol where
   "welltyped_leakage_free_protocol S P \<equiv>
     let f = \<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>) = {}};
         Sec = (f (set S)) - {m. {} \<turnstile>\<^sub>c m}
     in \<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>\<^sub>\<tau> s.
       (\<exists>l ts. suffix [(l, receive\<langle>ts\<rangle>)] \<A>) \<and> s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>\<^sub>\<tau> \<and>
       welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>\<star>, send\<langle>[s]\<rangle>\<rangle>])"
 
 definition wellformed_composable_protocols where
   "wellformed_composable_protocols (P::('fun,'atom,'sets,'lbl) prot list) N \<equiv>
     let
       Ts = concat P;
       steps = remdups (concat (map transaction_strand Ts));
       MP0 = \<Union>T \<in> set Ts. trms_transaction T \<union> pair' Pair ` setops_transaction T
     in
       list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) N \<and>
       has_all_wt_instances_of \<Gamma> MP0 (set N) \<and>
       comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> (set N) \<and>
       list_all (comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<Gamma> Pair \<circ> snd) steps \<and>
       list_all admissible_transaction_terms Ts \<and>
       list_all (list_all (\<lambda>x. \<Gamma>\<^sub>v x = TAtom Value \<or> (is_Var (\<Gamma>\<^sub>v x) \<and> is_Atom (the_Var (\<Gamma>\<^sub>v x)))) \<circ>
                 transaction_fresh)
                Ts \<and>
       list_all (\<lambda>T. \<forall>x \<in> vars_transaction T. \<not>TAtom AttackType \<sqsubseteq> \<Gamma>\<^sub>v x) Ts \<and>
       list_all (\<lambda>T. \<forall>x \<in> vars_transaction T. \<forall>f \<in> funs_term (\<Gamma>\<^sub>v x). f \<noteq> Pair \<and> f \<noteq> OccursFact)
                Ts \<and>
       list_all (list_all (\<lambda>s. is_Send (snd s) \<and> length (the_msgs (snd s)) = 1 \<and>
                               is_Fun_Attack (hd (the_msgs (snd s))) \<longrightarrow>
                                 the_Attack_label (the_Fun (hd (the_msgs (snd s)))) = fst s) \<circ>
                 transaction_strand)
                Ts \<and>
       list_all (\<lambda>r. (\<exists>f \<in> \<Union>(funs_term ` (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd r))). f = OccursFact \<or> f = OccursSec) \<longrightarrow>
                       (is_Receive (snd r) \<or> is_Send (snd r)) \<and> fst r = \<star> \<and>
                       (\<forall>t \<in> set (the_msgs (snd r)).
                         (OccursFact \<in> funs_term t \<or> OccursSec \<in> funs_term t) \<longrightarrow>
                           is_Fun t \<and> length (args t) = 2 \<and> t = occurs (args t ! 1) \<and>
                           is_Var (args t ! 1) \<and> (\<Gamma> (args t ! 1) = TAtom Value)))
                steps"
 
 definition wellformed_composable_protocols' where
   "wellformed_composable_protocols' (P::('fun,'atom,'sets,'lbl) prot list) \<equiv>
     let
       Ts = concat P
     in
       list_all wellformed_transaction Ts \<and>
       list_all (list_all
                   (\<lambda>p. let (x,cs) = p in
                         is_Var (\<Gamma>\<^sub>v x) \<and> is_Atom (the_Var (\<Gamma>\<^sub>v x)) \<and>
                         (\<forall>c \<in> cs. \<Gamma>\<^sub>v x = \<Gamma> (Fun (Fu c) []::('fun,'atom,'sets,'lbl) prot_term))) \<circ>
                 (\<lambda>T. transaction_decl T ()))
                Ts"
 
 definition composable_protocols where
   "composable_protocols (P::('fun,'atom,'sets,'lbl) prot list) Ms S \<equiv>
     let
       steps = concat (map transaction_strand (concat P));
       M_fun = (\<lambda>l. case find ((=) l \<circ> fst) Ms of Some M \<Rightarrow> set (snd M) | None \<Rightarrow> {})
     in comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> Pair steps M_fun (set S)"
 
 lemma composable_protocols_par_comp_constr:
   fixes S f
   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>) = {}}"
     and "Sec \<equiv> (f (set S)) - {m. intruder_synth {} m}"
   assumes Ps_pc: "wellformed_composable_protocols Ps N"
                  "wellformed_composable_protocols' Ps"
                  "composable_protocols Ps Ms S"
   shows "\<forall>\<A> \<in> reachable_constraints (concat Ps). \<forall>\<I>. constraint_model \<I> \<A> \<longrightarrow>
             (\<exists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> \<A> \<and>
                   ((\<forall>n. welltyped_constraint_model \<I>\<^sub>\<tau> (proj n \<A>)) \<or>
                    (\<exists>\<A>' l t. prefix \<A>' \<A> \<and> suffix [(l, receive\<langle>t\<rangle>)] \<A>' \<and>
                               strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' Sec \<I>\<^sub>\<tau>)))"
     (is "\<forall>\<A> \<in> _. \<forall>_. _ \<longrightarrow> ?Q \<A> \<I>")
 proof (intro allI ballI impI)
   fix \<A> \<I>
   assume \<A>: "\<A> \<in> reachable_constraints (concat Ps)" and \<I>: "constraint_model \<I> \<A>"
 
   let ?Ts = "concat Ps"
   let ?steps = "concat (map transaction_strand ?Ts)"
   let ?MP0 = "\<Union>T \<in> set ?Ts. trms_transaction T \<union> pair' Pair ` setops_transaction T"
   let ?M_fun = "\<lambda>l. case find ((=) l \<circ> fst) Ms of Some M \<Rightarrow> set (snd M) | None \<Rightarrow> {}"
 
   have M:
       "has_all_wt_instances_of \<Gamma> ?MP0 (set N)"
       "finite (set N)" "tfr\<^sub>s\<^sub>e\<^sub>t (set N)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set N)"
     using Ps_pc tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[of "set N"]
     unfolding composable_protocols_def wellformed_composable_protocols_def
               Let_def list_all_iff wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric]
     by fast+
 
   have P:
       "\<forall>T \<in> set ?Ts. wellformed_transaction T"
       "\<forall>T \<in> set ?Ts. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
       "\<forall>T \<in> set ?Ts. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
       "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> Pair ?steps ?M_fun (set S)"
     using Ps_pc tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p
     unfolding wellformed_composable_protocols_def wellformed_composable_protocols'_def
               composable_protocols_def Let_def list_all_iff unlabel_def wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric]
               admissible_transaction_terms_def
     by (meson, meson, fastforce, blast)
 
   show "?Q \<A> \<I>"
     using reachable_constraints_par_comp_constr[OF M P \<A> \<I>]
     unfolding Sec_def f_def by fast
 qed
 
 context
 begin
 private lemma reachable_constraints_no_leakage_alt_aux:
   fixes P lbls L
   defines "lbls \<equiv> \<lambda>T. map (the_LabelN o fst) (filter (Not o has_LabelS) (transaction_strand T))"
     and "L \<equiv> set (remdups (concat (map lbls P)))"
   assumes l: "l \<notin> L"
   shows "map (transaction_proj l) P = map transaction_star_proj P"
 proof -
   have 0: "\<not>list_ex (has_LabelN l) (transaction_strand T)" when "T \<in> set P" for T
     using that l unfolding L_def lbls_def list_ex_iff by force
 
   have 1: "\<not>list_ex (has_LabelN l) (transaction_strand T)"
     when T: "T \<in> set (map (transaction_proj l) P)" for T
   proof -
     obtain T' where T': "T' \<in> set P" "T = transaction_proj l T'" using T by auto
     show ?thesis
       using T'(2) 0[OF T'(1)] proj_set_subset[of l "transaction_strand T'"]
             transaction_strand_proj[of l T'] 
       unfolding list_ex_iff by fastforce
   qed
 
   have "list_all has_LabelS (transaction_strand T)"
     when "T \<in> set (map (transaction_proj l) P)" for T
     using that 1[OF that] transaction_proj_idem[of l]
           transaction_strand_proj[of l "transaction_proj l T"]
           has_LabelS_proj_iff_not_has_LabelN[of l "transaction_strand (transaction_proj l T)"]
     by (metis (no_types) ex_map_conv)
   thus ?thesis
     using transaction_star_proj_ident_iff transaction_proj_member
           transaction_star_proj_negates_transaction_proj(1)
     by (metis (mono_tags, lifting) map_eq_conv) 
 qed
 
 private lemma reachable_constraints_star_no_leakage:
   fixes Sec P lbls k
   defines "no_leakage \<equiv> \<lambda>\<A>. \<nexists>\<I>\<^sub>\<tau> \<A>' s.
       prefix \<A>' \<A> \<and> (\<exists>l ts. suffix [(l, receive\<langle>ts\<rangle>)] \<A>') \<and> s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau> \<and>
       welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>'@[(k,send\<langle>[s]\<rangle>)])"
   assumes Sec: "\<forall>s \<in> Sec. \<not>{} \<turnstile>\<^sub>c s" "ground Sec"
   shows "\<forall>\<A> \<in> reachable_constraints (map transaction_star_proj P). no_leakage \<A>"
 proof
   fix A assume A: "A \<in> reachable_constraints (map transaction_star_proj P)"
 
   have A': "\<forall>(l,a) \<in> set A. l = \<star>"
     using reachable_constraints_preserves_labels[OF A] transaction_star_proj_has_star_labels
     unfolding list_all_iff by fastforce
 
   show "no_leakage A"
     using constr_sem_stateful_star_proj_no_leakage[OF Sec(2) A']
           unlabel_append[of A] singleton_lst_proj(4)[of k]
     unfolding no_leakage_def welltyped_constraint_model_def constraint_model_def by fastforce
 qed
 
 private lemma reachable_constraints_no_leakage_alt:
   fixes Sec P lbls k
   defines "no_leakage \<equiv> \<lambda>\<A>. \<nexists>\<I>\<^sub>\<tau> \<A>' s.
       prefix \<A>' \<A> \<and> (\<exists>l ts. suffix [(l, receive\<langle>ts\<rangle>)] \<A>') \<and> s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau> \<and>
       welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>'@[(k,send\<langle>[s]\<rangle>)])"
     and "lbls \<equiv> \<lambda>T. map (the_LabelN o fst) (filter (Not o has_LabelS) (transaction_strand T))"
     and "L \<equiv> set (remdups (concat (map lbls P)))"
   assumes Sec: "\<forall>s \<in> Sec. \<not>{} \<turnstile>\<^sub>c s" "ground Sec"
     and lbl: "\<forall>l \<in> L. \<forall>\<A> \<in> reachable_constraints (map (transaction_proj l) P). no_leakage \<A>"
   shows "\<forall>l. \<forall>\<A> \<in> reachable_constraints (map (transaction_proj l) P). \<nexists>\<I>\<^sub>\<tau> \<A>'.
               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>l' ts. suffix [(l', receive\<langle>ts\<rangle>)] \<A>') \<and> strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' Sec \<I>\<^sub>\<tau>"
 proof (intro allI ballI)
   fix l \<A>
   assume \<A>: "\<A> \<in> reachable_constraints (map (transaction_proj l) P)"
 
   let ?Q = "\<lambda>\<I>\<^sub>\<tau> \<A>'.
     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>l' t. suffix [(l', receive\<langle>t\<rangle>)] \<A>') \<and> strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' Sec \<I>\<^sub>\<tau>"
 
   show "\<nexists>\<I>\<^sub>\<tau> \<A>'. ?Q \<I>\<^sub>\<tau> \<A>'"
   proof
     assume "\<exists>\<I>\<^sub>\<tau> \<A>'. ?Q \<I>\<^sub>\<tau> \<A>'"
     then obtain \<I>\<^sub>\<tau> \<A>' t n l' ts' 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>)" and
         \<A>': "prefix \<A>' \<A>" "suffix [(l', receive\<langle>ts'\<rangle>)] \<A>'" and
         t: "t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>" and
         n: "constr_sem_stateful \<I>\<^sub>\<tau> (proj_unl n \<A>'@[send\<langle>[t]\<rangle>])"
       unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by blast
     hence 0: "welltyped_constraint_model \<I>\<^sub>\<tau> (proj n \<A>'@[(m,send\<langle>[t]\<rangle>)])" for m
       unfolding welltyped_constraint_model_def constraint_model_def by fastforce
 
     have t_Sec: "\<not>{} \<turnstile>\<^sub>c t" "t \<cdot> \<I>\<^sub>\<tau> = t"
       using t Sec subst_ground_ident[of t \<I>\<^sub>\<tau>] by auto
 
     obtain B k' s where B:
         "constr_sem_stateful \<I>\<^sub>\<tau> (proj_unl n B@[send\<langle>[t]\<rangle>])"
         "prefix (proj n B) (proj n \<A>)" "suffix [(k', receive\<langle>s\<rangle>)] (proj n B)"
         "t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n B) \<I>\<^sub>\<tau>"
       using constr_sem_stateful_proj_priv_term_prefix_obtain[OF \<A>'(1) n t t_Sec]
       by metis
     hence 1: "welltyped_constraint_model \<I>\<^sub>\<tau> (proj n B@[(m,send\<langle>[t]\<rangle>)])" for m
       using 0 unfolding welltyped_constraint_model_def constraint_model_def by fastforce
 
     note 2 = reachable_constraints_transaction_proj_proj_eq
     note 3 = reachable_constraints_transaction_proj_star_proj
     note 4 = reachable_constraints_no_leakage_alt_aux
 
     note star_case = 0 t t_Sec(1) reachable_constraints_star_no_leakage[OF Sec]
                      \<A>'(2) 3[OF \<A>] prefix_proj(1)[OF \<A>'(1)]
                      suffix_proj(1)[OF \<A>'(2)] declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj_eq
 
     note lbl_case = 0 t(1) \<A> \<A>' lbl 2(2)[OF \<A> \<A>'(1)]
 
     show False
     proof (cases "l = n")
       case True thus ?thesis
       proof (cases "l \<in> L")
         case False
         hence "map (transaction_proj l) P = map transaction_star_proj P"
           using 4 unfolding L_def lbls_def by fast
         thus ?thesis
           using lbl_case(1-4,7) star_case(4,5) True by metis
       qed (metis lbl_case no_leakage_def)
     next
       case False
       hence "no_leakage (proj n \<A>)" using star_case(4,6) unfolding no_leakage_def by fast
       thus ?thesis by (metis B(2-4) 1 no_leakage_def)
     qed
   qed
 qed
 
 private lemma reachable_constraints_no_leakage_alt'_aux1:
   fixes P::"('a,'b,'c,'d) prot_transaction list"
   defines "f \<equiv> list_all ((list_all (Not \<circ> has_LabelS)) \<circ> tl \<circ> transaction_send)"
   assumes P: "f P"
   shows "f (map (transaction_proj l) P)"
     and "f (map transaction_star_proj P)"
 proof -
   let ?g = "\<lambda>T. tl (transaction_send T)"
   have "set (?g (transaction_proj l T)) \<subseteq> set (?g T)" (is "?A \<subseteq> ?C")
     and "set (?g (transaction_star_proj T)) \<subseteq> set (?g T)" (is "?B \<subseteq> ?C")
     for T::"('a,'b,'c,'d) prot_transaction"
   proof -
     obtain T1 T2 T3 T4 T5 T6 where T: "T = Transaction T1 T2 T3 T4 T5 T6" by (cases T) simp
     have "transaction_send (transaction_proj l T) = proj l (transaction_send T)"
          "transaction_send (transaction_star_proj T) = filter has_LabelS (transaction_send T)"
       using transaction_proj.simps[of l T1 T2 T3 T4 T5 T6]
             transaction_star_proj.simps[of T1 T2 T3 T4 T5 T6]
       unfolding T proj_def Let_def by auto
     hence "set (?g (transaction_proj l T)) \<subseteq> set (proj l (?g T))"
           "set (?g (transaction_star_proj T)) \<subseteq> set (filter has_LabelS (?g T))"
       unfolding proj_def
       by (metis (no_types, lifting) filter.simps(2) list.collapse list.sel(2,3)
                                     list.set_sel(2) subsetI)+
     thus "?A \<subseteq> ?C" "?B \<subseteq> ?C" using T unfolding proj_def by auto
   qed
   thus "f (map (transaction_proj l) P)" "f (map transaction_star_proj P)"
     using P unfolding f_def list_all_iff by fastforce+
 qed
 
 private lemma reachable_constraints_no_leakage_alt'_aux2:
   fixes P
   defines "f \<equiv> \<lambda>T.
     list_all is_Receive (unlabel (transaction_receive T)) \<and>
     list_all is_Check_or_Assignment (unlabel (transaction_checks T)) \<and>
     list_all is_Update (unlabel (transaction_updates T)) \<and>
     list_all is_Send (unlabel (transaction_send T))"
   assumes P: "list_all f P"
   shows "list_all f (map (transaction_proj l) P)" (is ?A)
     and "list_all f (map transaction_star_proj P)" (is ?B)
 proof -
   have "f (transaction_proj l T)" (is ?A')
     and "f (transaction_star_proj T)" (is ?B')
     when T_in: "T \<in> set P" for T
   proof -
     obtain T1 T2 T3 T4 T5 T6 where T: "T = Transaction T1 T2 T3 T4 T5 T6" by (cases T)
     have "f T" using P T_in unfolding list_all_iff by simp
     thus ?A' ?B'
       unfolding f_def T unlabel_def proj_def Let_def list_all_iff
                 transaction_proj.simps[of l T1 T2 T3 T4 T5 T6]
                 transaction_star_proj.simps[of T1 T2 T3 T4 T5 T6]
       by auto
   qed
   thus ?A ?B unfolding list_all_iff by auto
 qed
 
 private lemma reachable_constraints_no_leakage_alt':
   fixes Sec P lbls k
   defines "no_leakage \<equiv> \<lambda>\<A>. \<nexists>\<I>\<^sub>\<tau> \<A>' s.
       prefix \<A>' \<A> \<and> (\<exists>l ts. suffix [(l, receive\<langle>ts\<rangle>)] \<A>') \<and> s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau> \<and>
       welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>'@[(k,send\<langle>[s]\<rangle>)])"
     and "no_leakage' \<equiv> \<lambda>\<A>. \<nexists>\<I>\<^sub>\<tau> s.
       (\<exists>l ts. suffix [(l, receive\<langle>ts\<rangle>)] \<A>) \<and> s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>\<^sub>\<tau> \<and>
       welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[(k,send\<langle>[s]\<rangle>)])"
   assumes P: "list_all wellformed_transaction P"
              "list_all ((list_all (Not \<circ> has_LabelS)) \<circ> tl \<circ> transaction_send) P"
     and Sec: "\<forall>s \<in> Sec. \<not>{} \<turnstile>\<^sub>c s" "ground Sec"
     and lbl: "\<forall>l \<in> L. \<forall>\<A> \<in> reachable_constraints (map (transaction_proj l) P). no_leakage' \<A>"
   shows "\<forall>l \<in> L. \<forall>\<A> \<in> reachable_constraints (map (transaction_proj l) P). no_leakage \<A>" (is ?A)
     and "\<forall>\<A> \<in> reachable_constraints (map transaction_star_proj P). no_leakage \<A>" (is ?B)
 proof -
   define f where "f \<equiv> \<lambda>T::('fun,'atom,'sets,'lbl) prot_transaction.
     list_all is_Receive (unlabel (transaction_receive T)) \<and>
     list_all is_Check_or_Assignment (unlabel (transaction_checks T)) \<and>
     list_all is_Update (unlabel (transaction_updates T)) \<and>
     list_all is_Send (unlabel (transaction_send T))"
 
   define g where "(g::('fun,'atom,'sets,'lbl) prot_transaction \<Rightarrow> bool) \<equiv> 
     list_all (Not \<circ> has_LabelS) \<circ> tl \<circ> transaction_send"
 
   have P': "list_all f P"
     using P(1) unfolding wellformed_transaction_def f_def list_all_iff by fastforce
 
   note 0 = reachable_constraints_no_leakage_alt'_aux1[OF P(2), unfolded g_def[symmetric]]
 
   note 1 = reachable_constraints_no_leakage_alt'_aux2[
             OF P'[unfolded f_def], unfolded f_def[symmetric]]
 
   note 2 = reachable_constraints_aligned_prefix_ex[unfolded f_def[symmetric] g_def[symmetric]]
 
   have 3: "\<forall>\<A> \<in> reachable_constraints (map transaction_star_proj P). no_leakage' \<A>"
     using reachable_constraints_star_no_leakage[OF Sec] unfolding no_leakage'_def by blast
 
   show ?A
   proof (intro ballI)
     fix l \<A> assume l: "l \<in> L" and \<A>: "\<A> \<in> reachable_constraints (map (transaction_proj l) P)"
     show "no_leakage \<A>"
     proof (rule ccontr)
       assume "\<not>no_leakage \<A>"
       then obtain \<I>\<^sub>\<tau> \<A>' s where \<A>':
           "prefix \<A>' \<A>" "\<exists>l ts. suffix [(l, receive\<langle>ts\<rangle>)] \<A>'" "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>"
           "welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>'@[(k, send\<langle>[s]\<rangle>)])"
         unfolding no_leakage_def by blast
 
       have s: "\<not>{} \<turnstile>\<^sub>c s" "fv s = {}" using \<A>'(3) Sec by auto
 
       have \<I>\<^sub>\<tau>: "constr_sem_stateful \<I>\<^sub>\<tau> (unlabel \<A>'@[send\<langle>[s]\<rangle>])"
               "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>" "interpretation\<^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 \<A>'(4) unfolding welltyped_constraint_model_def constraint_model_def by auto
 
       show False
         using 2[OF 1(1) 0(1) s \<A> \<A>'(1,2) \<I>\<^sub>\<tau>(1)] l lbl \<A>'(3) \<I>\<^sub>\<tau>(2,3,4)
               singleton_lst_proj(4)[of k "send\<langle>[s]\<rangle>"] unlabel_append[of _ "[(k, send\<langle>[s]\<rangle>)]"]
         unfolding no_leakage'_def welltyped_constraint_model_def constraint_model_def by metis
     qed
   qed
 
   show ?B
   proof (intro ballI)
     fix \<A> assume \<A>: "\<A> \<in> reachable_constraints (map transaction_star_proj P)"
     show "no_leakage \<A>"
     proof (rule ccontr)
       assume "\<not>no_leakage \<A>"
       then obtain \<I>\<^sub>\<tau> \<A>' s where \<A>':
           "prefix \<A>' \<A>" "\<exists>l ts. suffix [(l, receive\<langle>ts\<rangle>)] \<A>'" "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>"
           "welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>'@[(k, send\<langle>[s]\<rangle>)])"
         unfolding no_leakage_def by blast
 
       have s: "\<not>{} \<turnstile>\<^sub>c s" "fv s = {}" using \<A>'(3) Sec by auto
 
       have \<I>\<^sub>\<tau>: "constr_sem_stateful \<I>\<^sub>\<tau> (unlabel \<A>'@[send\<langle>[s]\<rangle>])"
               "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>" "interpretation\<^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 \<A>'(4) unfolding welltyped_constraint_model_def constraint_model_def by auto
 
       show False
         using 2[OF 1(2) 0(2) s \<A> \<A>'(1,2) \<I>\<^sub>\<tau>(1)] 3 \<A>'(3) \<I>\<^sub>\<tau>(2,3,4)
               singleton_lst_proj(4)[of k "send\<langle>[s]\<rangle>"] unlabel_append[of _ "[(k, send\<langle>[s]\<rangle>)]"]
         unfolding no_leakage'_def welltyped_constraint_model_def constraint_model_def by metis
     qed
   qed
 qed
 
 lemma composable_protocols_par_comp_prot_alt:
   fixes S f Sec lbls Ps
   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>) = {}}"
     and "Sec \<equiv> (f (set S)) - {m. {} \<turnstile>\<^sub>c m}"
     and "lbls \<equiv> \<lambda>T. map (the_LabelN o fst) (filter (Not o has_LabelS) (transaction_strand T))"
     and "L \<equiv> set (remdups (concat (map lbls (concat Ps))))"
     and "no_leakage \<equiv> \<lambda>\<A>. \<nexists>\<I>\<^sub>\<tau> \<A>' s.
       prefix \<A>' \<A> \<and> (\<exists>l ts. suffix [(l, receive\<langle>ts\<rangle>)] \<A>') \<and> s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau> \<and>
       welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>'@[\<langle>\<star>, send\<langle>[s]\<rangle>\<rangle>])"
   assumes Ps_pc: "wellformed_composable_protocols Ps N"
                  "wellformed_composable_protocols' Ps"
                  "composable_protocols Ps Ms S"
     and component_secure:
           "\<forall>\<A> \<in> reachable_constraints (map (transaction_proj l) (concat Ps)). \<nexists>\<I>.
               welltyped_constraint_model \<I> (\<A>@[\<langle>l, send\<langle>[attack\<langle>ln l\<rangle>]\<rangle>\<rangle>])"
     and no_leakage:
           "\<forall>l \<in> L. \<forall>\<A> \<in> reachable_constraints (map (transaction_proj l) (concat Ps)). no_leakage \<A>"
   shows "\<forall>\<A> \<in> reachable_constraints (concat Ps). \<nexists>\<I>.
             constraint_model \<I> (\<A>@[\<langle>l, send\<langle>[attack\<langle>ln l\<rangle>]\<rangle>\<rangle>])"
 proof
   fix \<A>
   assume \<A>: "\<A> \<in> reachable_constraints (concat Ps)"
   let ?att = "[\<langle>l, send\<langle>[attack\<langle>ln l\<rangle>]\<rangle>\<rangle>]"
 
   define Q where "Q \<equiv> \<lambda>\<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>)"
 
   define R where "R \<equiv> \<lambda>\<A> \<I>\<^sub>\<tau>.
     \<exists>\<A>' l t. prefix \<A>' \<A> \<and> suffix [(l, receive\<langle>t\<rangle>)] \<A>' \<and> strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' Sec \<I>\<^sub>\<tau>"
 
   define M where "M \<equiv> \<Union>T\<in>set (concat Ps). trms_transaction T \<union> pair' Pair ` setops_transaction T"
 
   have Sec: "\<forall>s \<in> Sec. \<not>{} \<turnstile>\<^sub>c s" "ground Sec" unfolding Sec_def f_def by auto
 
   have par_comp':
       "\<forall>\<A> \<in> reachable_constraints (concat Ps). \<forall>\<I>. constraint_model \<I> \<A> \<longrightarrow>
          (\<exists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> \<A> \<and>
               ((\<forall>n. welltyped_constraint_model \<I>\<^sub>\<tau> (proj n \<A>)) \<or> R \<A> \<I>\<^sub>\<tau>))"
     using \<A> composable_protocols_par_comp_constr[OF Ps_pc] unfolding Sec_def f_def R_def by fast
 
   have "\<forall>l. \<forall>\<A> \<in> reachable_constraints (map (transaction_proj l) (concat Ps)). \<nexists>\<I>\<^sub>\<tau>. Q \<I>\<^sub>\<tau> \<and> R \<A> \<I>\<^sub>\<tau>"
     using reachable_constraints_no_leakage_alt[OF
             Sec no_leakage[unfolded no_leakage_def L_def lbls_def]]
     unfolding Q_def R_def by blast
   hence no_leakage':
       "\<forall>\<A> \<in> reachable_constraints (concat Ps). \<nexists>\<I>\<^sub>\<tau>. Q \<I>\<^sub>\<tau> \<and> R \<A> \<I>\<^sub>\<tau>"
     using reachable_constraints_component_leaks_if_composed_leaks[OF Sec, of "concat Ps"
             "\<lambda>\<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>)"]
     unfolding Q_def R_def by blast
 
   have M: "has_all_wt_instances_of \<Gamma> M (set N)" "finite (set N)" "tfr\<^sub>s\<^sub>e\<^sub>t (set N)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set N)"
    and P: "\<forall>T \<in> set (concat Ps). wellformed_transaction T"
           "\<forall>T \<in> set (concat Ps). admissible_transaction_terms T"
           "\<forall>T \<in> set (concat Ps). \<forall>x \<in> vars_transaction T. \<not>TAtom AttackType \<sqsubseteq> \<Gamma>\<^sub>v x"
           "\<forall>T \<in> set (concat Ps). \<forall>s \<in> set (transaction_strand T).
               is_Send (snd s) \<and> length (the_msgs (snd s)) = 1 \<and>
               is_Fun_Attack (hd (the_msgs (snd s))) \<longrightarrow>
                 the_Attack_label (the_Fun (hd (the_msgs (snd s)))) = fst s"
           "\<forall>T \<in> set (concat Ps). list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
     using Ps_pc(1,2) tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p
     unfolding wellformed_composable_protocols_def wellformed_composable_protocols'_def
               list_all_iff Let_def M_def wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s'_def wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code unlabel_def \<Gamma>\<^sub>v_TAtom''(1,2)
     by (force, force, fast, fast, fast, fast, fast, simp, simp)
 
   have P_fresh: "\<forall>T \<in> set (concat Ps). \<forall>x \<in> set (transaction_fresh T).
                   \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
       (is "\<forall>T \<in> ?P. \<forall>x \<in> ?frsh T. ?Q x")
   proof (intro ballI)
     fix T x assume T: "T \<in> ?P" "x \<in> ?frsh T"
     hence "\<Gamma>\<^sub>v x = TAtom Value \<or> (is_Var (\<Gamma>\<^sub>v x) \<and> is_Atom (the_Var (\<Gamma>\<^sub>v x)))"
       using Ps_pc(1) unfolding wellformed_composable_protocols_def list_all_iff Let_def by fastforce
     thus "?Q x" by (metis prot_atom.is_Atom_def term.collapse(1))
   qed
 
   have P': "\<forall>T \<in> set (concat Ps). wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
     using P(2) admissible_transaction_terms_def by fast
 
   have "\<not>welltyped_constraint_model \<I> (\<A>@?att)" for \<I>
   proof
     assume "welltyped_constraint_model \<I> (\<A>@?att)"
     hence \<I>: "welltyped_constraint_model \<I> \<A>" "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> attack\<langle>ln l\<rangle>"
       using strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" "unlabel ?att"]
             unlabel_append[of \<A> ?att]
       unfolding welltyped_constraint_model_def constraint_model_def by auto
 
     obtain \<I>\<^sub>\<tau> where \<I>\<^sub>\<tau>:
         "welltyped_constraint_model \<I>\<^sub>\<tau> \<A>"
         "welltyped_constraint_model \<I>\<^sub>\<tau> (proj l \<A>)"
       using \<A> \<I> no_leakage' par_comp'
       unfolding Q_def welltyped_constraint_model_def constraint_model_def by metis
 
     have "\<langle>l, receive\<langle>[attack\<langle>ln l\<rangle>]\<rangle>\<rangle> \<in> set \<A>"
       using reachable_constraints_receive_attack_if_attack(3)[OF \<A> P(1-2) P_fresh P(3) \<I> P(4)]
       by auto
     hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>\<^sub>\<tau> \<turnstile> attack\<langle>ln l\<rangle>"
       using in_proj_set[of l "receive\<langle>[attack\<langle>ln l\<rangle>]\<rangle>" \<A>] in_ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t_iff[of "attack\<langle>ln l\<rangle>" "proj l \<A>"]
             intruder_deduct.Axiom[of "attack\<langle>ln l\<rangle>" "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>\<^sub>\<tau>"]
       by fastforce
     hence "welltyped_constraint_model \<I>\<^sub>\<tau> (proj l \<A>@?att)"
       using \<I>\<^sub>\<tau> strand_sem_append_stateful[of "{}" "{}" "unlabel (proj l \<A>)" "unlabel ?att" \<I>\<^sub>\<tau>]
       unfolding welltyped_constraint_model_def constraint_model_def by auto
     thus False
       using component_secure reachable_constraints_transaction_proj[OF \<A>, of l] by simp
   qed
   thus "\<nexists>\<I>. constraint_model \<I> (\<A>@?att)"
     using reachable_constraints_typing_result'[OF M_def M P(1) P' P(5) \<A>] by blast
 qed
 
 lemma composable_protocols_par_comp_prot:
   fixes S f Sec lbls Ps
   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>) = {}}"
     and "Sec \<equiv> (f (set S)) - {m. {} \<turnstile>\<^sub>c m}"
     and "lbls \<equiv> \<lambda>T. map (the_LabelN o fst) (filter (Not o has_LabelS) (transaction_strand T))"
     and "L \<equiv> set (remdups (concat (map lbls (concat Ps))))"
     and "no_leakage \<equiv> \<lambda>\<A>. \<nexists>\<I>\<^sub>\<tau> s.
       (\<exists>l ts. suffix [(l, receive\<langle>ts\<rangle>)] \<A>) \<and> s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>\<^sub>\<tau> \<and>
       welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>\<star>, send\<langle>[s]\<rangle>\<rangle>])"
   assumes Ps_pc: "wellformed_composable_protocols Ps N"
                  "wellformed_composable_protocols' Ps"
                  "composable_protocols Ps Ms S"
                  "list_all ((list_all (Not \<circ> has_LabelS)) \<circ> tl \<circ> transaction_send) (concat Ps)"
     and component_secure:
           "\<forall>\<A> \<in> reachable_constraints (map (transaction_proj l) (concat Ps)). \<nexists>\<I>.
               welltyped_constraint_model \<I> (\<A>@[\<langle>l, send\<langle>[attack\<langle>ln l\<rangle>]\<rangle>\<rangle>])"
     and no_leakage:
           "\<forall>l \<in> L. \<forall>\<A> \<in> reachable_constraints (map (transaction_proj l) (concat Ps)). no_leakage \<A>"
   shows "\<forall>\<A> \<in> reachable_constraints (concat Ps). \<nexists>\<I>.
             constraint_model \<I> (\<A>@[\<langle>l, send\<langle>[attack\<langle>ln l\<rangle>]\<rangle>\<rangle>])"
 proof -
   have P': "list_all wellformed_transaction (concat Ps)"
     using Ps_pc(2) unfolding wellformed_composable_protocols'_def by meson
 
   have Sec: "\<forall>s \<in> Sec. \<not>{} \<turnstile>\<^sub>c s" "ground Sec" unfolding Sec_def f_def by auto
 
   note 0 = composable_protocols_par_comp_prot_alt[
             OF Ps_pc(1-3) component_secure, unfolded lbls_def[symmetric] L_def[symmetric]]
 
   note 1 = reachable_constraints_no_leakage_alt'[
             OF P' Ps_pc(4) Sec no_leakage[unfolded no_leakage_def]]
 
   show ?thesis using 0 1 unfolding f_def Sec_def by argo
 qed
 
 lemma composable_protocols_par_comp_prot':
   assumes P_defs:
       "Pc = concat Ps"
       "set Ps_with_stars =
         (\<lambda>n. map (transaction_proj n) Pc) `
           set (remdups (concat
                 (map (\<lambda>T. map (the_LabelN \<circ> fst) (filter (Not \<circ> has_LabelS) (transaction_strand T)))
                   Pc)))"
     and Ps_wellformed:
       "list_all (list_all (Not \<circ> has_LabelS) \<circ> tl \<circ> transaction_send) Pc"
       "wellformed_composable_protocols Ps N"
       "wellformed_composable_protocols' Ps"
       "composable_protocols Ps Ms S"
     and Ps_no_leakage:
       "list_all (welltyped_leakage_free_protocol S) Ps_with_stars"
     and P_def:
       "P = map (transaction_proj n) Pc"
     and P_wt_secure:
       "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>.
         welltyped_constraint_model \<I> (\<A>@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])"
   shows "\<forall>\<A> \<in> reachable_constraints Pc. \<nexists>\<I>.
           constraint_model \<I> (\<A>@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])"
 by (rule composable_protocols_par_comp_prot[
           OF Ps_wellformed(2,3,4,1)[unfolded P_defs(1)]
              P_wt_secure[unfolded P_def[unfolded P_defs(1)]]
              transaction_proj_ball_subst[
                OF P_defs(2)[unfolded P_defs(1)]
                   Ps_no_leakage(1)[
                     unfolded list_all_iff welltyped_leakage_free_protocol_def Let_def]],
           unfolded P_defs(1)[symmetric]])
 
 end
 
 context
 begin
 
 lemma welltyped_constraint_model_leakage_model_swap:
   fixes I \<alpha> \<delta>::"('fun,'atom,'sets,'lbl) prot_subst" and s
   assumes A: "welltyped_constraint_model I (A@[\<langle>\<star>, send\<langle>[s \<cdot> \<delta>]\<rangle>\<rangle>])"
     and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
     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> = fv s" "ground (subst_range \<delta>)"
   obtains J
     where "welltyped_constraint_model J (A@[\<langle>\<star>, send\<langle>[s \<cdot> \<delta>]\<rangle>\<rangle>])"
     and "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J \<turnstile> s \<cdot> \<alpha> \<cdot> J"
 proof
   note defs = welltyped_constraint_model_def constraint_model_def
   note \<delta>_s = subst_fv_dom_ground_if_ground_img[OF equalityD2[OF \<delta>(3)] \<delta>(4)]
   note \<alpha>' = transaction_renaming_subst_is_renaming(2)[OF \<alpha>]
             inj_on_subset[OF transaction_renaming_subst_is_injective[OF \<alpha>]
                              subset_UNIV[of "fv s"]]
             transaction_renaming_subst_var_obtain(2)[OF \<alpha>, of _ s]
             transaction_renaming_subst_is_renaming(6)[OF \<alpha>, of s]
             transaction_renaming_subst_vars_disj(8)[OF \<alpha>]
             transaction_renaming_subst_wt[OF \<alpha>]
 
   define \<alpha>inv where "\<alpha>inv \<equiv> subst_var_inv \<alpha> (fv s)"
   define \<delta>' where "\<delta>' \<equiv> rm_vars (UNIV - fv (s \<cdot> \<alpha>)) (\<alpha>inv \<circ>\<^sub>s \<delta>)"
   define J where "J \<equiv> \<lambda>x. if x \<in> fv (s \<cdot> \<alpha>) then \<delta>' x else I x"
 
   have \<alpha>_invertible: "s = s \<cdot> \<alpha> \<circ>\<^sub>s \<alpha>inv"
     using \<alpha>'(1) inj_var_ran_subst_is_invertible'[of \<alpha> s] inj_on_subset[OF \<alpha>'(2)]
     unfolding \<alpha>inv_def by blast
 
   have \<delta>'_domain: "subst_domain \<delta>' = fv (s \<cdot> \<alpha>)"
   proof -
     have "x \<in> subst_domain (\<alpha>inv \<circ>\<^sub>s \<delta>)" when x: "x \<in> fv (s \<cdot> \<alpha>)" for x
     proof -
       obtain y where y: "y \<in> fv s" "\<alpha> y = Var x"
         using \<alpha>'(3)[OF x] by blast
   
       have "y \<in> subst_domain \<delta>" using y(1) \<delta>(3) by blast
       moreover have "(\<alpha>inv \<circ>\<^sub>s \<delta>) x = \<delta> y"
         using y \<alpha>'(3)[OF x] \<alpha>_invertible
               vars_term_subset_subst_eq[of "Var y" s "\<alpha> \<circ>\<^sub>s \<alpha>inv" Var]
         unfolding \<delta>'_def \<alpha>inv_def
-        by (metis (no_types, lifting) fv_subst_subset subst_apply_term.simps(1)
+        by (metis (no_types, lifting) fv_subst_subset eval_term.simps(1)
                   subst_apply_term_empty subst_compose) 
       ultimately show ?thesis using \<delta>(4) by fastforce
     qed
     thus ?thesis using rm_vars_dom[of "UNIV - fv (s \<cdot> \<alpha>)" "\<alpha>inv \<circ>\<^sub>s \<delta>"] unfolding \<delta>'_def by blast
   qed
 
   have \<delta>'_range: "fv t = {}" when t: "t \<in> (subst_range \<delta>')" for t
   proof -
     obtain x where "x \<in> fv (s \<cdot> \<alpha>)" "\<delta>' x = t" using t \<delta>'_domain by auto
     thus ?thesis
       by (metis (no_types, lifting) \<delta>'_def subst_compose_def \<delta>(3,4) \<alpha>_invertible fv_subst_subset
             subst_fv_dom_ground_if_ground_img subst_subst_compose Diff_iff)
   qed
 
   have J0: "x \<in> fv (s \<cdot> \<alpha>) \<Longrightarrow> J x = \<delta>' x"
            "x \<notin> fv (s \<cdot> \<alpha>) \<Longrightarrow> J x = I x" for x
     unfolding J_def by (cases "x \<in> fv (s \<cdot> \<alpha>)") (simp_all add: subst_compose)
 
   have J1: "subst_range J \<subseteq> subst_range \<delta>' \<union> subst_range I"
   proof
     fix t assume "t \<in> subst_range J"
     then obtain x where x: "x \<in> subst_domain J" "J x = t" by auto
     hence "t = \<delta>' x \<Longrightarrow> x \<in> subst_domain \<delta>'" "t = I x \<Longrightarrow> x \<in> subst_domain I"
       by (metis subst_domI subst_dom_vars_in_subst)+
     thus "t \<in> subst_range \<delta>' \<union> subst_range I" using x(2) J0[of x] by auto
   qed
   
   have "x \<notin> fv (s \<cdot> \<alpha>)" when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[\<langle>\<star>, send\<langle>[s \<cdot> \<delta>]\<rangle>\<rangle>])" for x
     using x \<delta>_s \<alpha>'(4) \<alpha>'(5) by auto
   hence "I x = J x" when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[\<langle>\<star>, send\<langle>[s \<cdot> \<delta>]\<rangle>\<rangle>])" for x
     using x unfolding J_def \<delta>'_def by auto
   hence "constr_sem_stateful J (unlabel (A@[\<langle>\<star>, send\<langle>[s \<cdot> \<delta>]\<rangle>\<rangle>]))"
     using A strand_sem_model_swap[of "unlabel (A@[\<langle>\<star>, send\<langle>[s \<cdot> \<delta>]\<rangle>\<rangle>])" I J "{}" "{}"]
     unfolding defs by blast
   moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t J"
     using A subst_var_inv_wt[OF \<alpha>'(6), of "fv s"]
           wt_subst_trm''[OF \<delta>(1)] subst_compose[of "subst_var_inv \<alpha> (fv s)" \<delta>]
     unfolding defs J_def \<delta>'_def \<alpha>inv_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by presburger
   moreover have "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t J"
   proof -
     have "fv t = {}" when t: "t \<in> (subst_range J)" for t
       using t A J1 \<delta>'_range unfolding defs by auto
     moreover have "x \<in> subst_domain J" for x
     proof (cases "x \<in> fv (s \<cdot> \<alpha>)")
       case True thus ?thesis using J0(1)[of x] \<delta>'_domain unfolding subst_domain_def by auto
     next
       case False
       have "subst_domain I = UNIV" using A unfolding defs by fast
       thus ?thesis using J0(2)[OF False] unfolding subst_domain_def by auto
     qed
     ultimately show ?thesis by auto
   qed
   moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>')"
     using wf_trms_subst_compose[OF subst_var_inv_wf_trms[of \<alpha> "fv s"] \<delta>(2)]
     unfolding \<delta>'_def \<alpha>inv_def by force
   hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range J)" using A J1 unfolding defs by fast
   ultimately show "welltyped_constraint_model J (A@[\<langle>\<star>, send\<langle>[s \<cdot> \<delta>]\<rangle>\<rangle>])" unfolding defs by blast
   hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J \<turnstile> s \<cdot> \<delta>"
     using \<delta>_s strand_sem_append_stateful[of "{}" "{}" "unlabel A" "[send\<langle>[s \<cdot> \<delta>]\<rangle>]" J]
     unfolding defs by (simp add: subst_ground_ident)
   moreover have "s \<cdot> \<alpha> \<cdot> J = s \<cdot> \<delta>"
   proof -
     have "J x = \<delta>' x" when x: "x \<in> fv (s \<cdot> \<alpha>)" for x using x unfolding J_def by argo
     hence "s \<cdot> \<alpha> \<cdot> J = s \<cdot> \<alpha> \<cdot> \<delta>'" using subst_agreement[of "s \<cdot> \<alpha>" J \<delta>'] by force
     thus ?thesis
-      using \<alpha>_invertible unfolding \<delta>'_def
-      by (metis rm_vars_subst_eq' subst_subst_compose)
+      using \<alpha>_invertible unfolding \<delta>'_def rm_vars_subst_eq'[symmetric] by (metis subst_subst_compose)
   qed
   hence "s \<cdot> \<alpha> \<cdot> J = s \<cdot> \<delta>" by auto
   ultimately show "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J \<turnstile> s \<cdot> \<alpha> \<cdot> J" by argo
 qed
 
 lemma welltyped_leakage_free_protocol_pointwise:
   "welltyped_leakage_free_protocol S P \<longleftrightarrow> list_all (\<lambda>s. welltyped_leakage_free_protocol [s] P) S"
 unfolding welltyped_leakage_free_protocol_def list_all_iff Let_def by fastforce
 
 lemma welltyped_leakage_free_no_deduct_constI:
   fixes c
   defines "s \<equiv> Fun c []::('fun,'atom,'sets,'lbl) prot_term"
   assumes s: "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>\<star>, send\<langle>[s]\<rangle>\<rangle>])"
   shows "welltyped_leakage_free_protocol [s] P"
 using s unfolding welltyped_leakage_free_protocol_def s_def by auto
 
 lemma welltyped_leakage_free_pub_termI:
   assumes s: "{} \<turnstile>\<^sub>c s"
   shows "welltyped_leakage_free_protocol [s] P"
 proof -
   define Q where "Q \<equiv> \<lambda>M 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>) = {}"
   define f where "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. Q M t \<delta>}"
   define Sec where "Sec \<equiv> f (set [s]) - {m. {} \<turnstile>\<^sub>c m}"
 
   have 0: "fv s = {}" using s pgwt_ground pgwt_is_empty_synth by blast 
   have 1: "s \<cdot> \<delta> = s" for \<delta> by (rule subst_ground_ident[OF 0])
   have 2: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)"
     using wt_subst_Var wf_trm_subst_range_Var by (blast,blast)
   
   have "f (set [s]) = {s}"
   proof
     show "f (set [s]) \<subseteq> {s}" using 0 1 unfolding f_def Q_def by auto 
 
     have "Q {s} s Var" using 0 2 unfolding Q_def by auto
     thus "{s} \<subseteq> f (set [s])" using 1[of Var] unfolding f_def by force
   qed
   hence "Sec = {}" using s unfolding Sec_def by simp
   thus ?thesis unfolding welltyped_leakage_free_protocol_def Let_def Sec_def f_def Q_def by blast
 qed
 
 lemma welltyped_leakage_free_pub_constI:
   assumes c: "public\<^sub>f c" "arity\<^sub>f c = 0"
   shows "welltyped_leakage_free_protocol [\<langle>c\<rangle>\<^sub>c] P"
 using c welltyped_leakage_free_pub_termI[OF intruder_synth.ComposeC[of "[]" "Fu c" "{}"]] by simp
 
 lemma welltyped_leakage_free_long_term_secretI:
   fixes n
   defines
       "Tatt \<equiv> \<lambda>s'. Transaction (\<lambda>(). []) [] [\<langle>n, receive\<langle>[s']\<rangle>\<rangle>] [] [] [\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>]"
   assumes P_wt_secure:
       "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>.
         welltyped_constraint_model \<I> (\<A>@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])"
     and s_long_term_secret:
       "\<exists>\<theta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> inj_on \<theta> (fv s) \<and> \<theta> ` fv s \<subseteq> range Var \<and> Tatt (s \<cdot> \<theta>) \<in> set P"
   shows "welltyped_leakage_free_protocol [s] P"
 proof (rule ccontr)
   define Q where "Q \<equiv> \<lambda>M 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>) = {}"
   define f where "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. Q M t \<delta>}"
   define Sec where "Sec \<equiv> f (set [s]) - {m. {} \<turnstile>\<^sub>c m}"
 
   note defs = Sec_def f_def Q_def
   note defs' = welltyped_constraint_model_def constraint_model_def
 
   assume "\<not>welltyped_leakage_free_protocol [s] P"
   then obtain A I s' where A:
       "A \<in> reachable_constraints P" "s' \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I"
       "welltyped_constraint_model I (A@[\<langle>\<star>, send\<langle>[s']\<rangle>\<rangle>])"
     unfolding welltyped_leakage_free_protocol_def defs by fastforce
 
   obtain \<theta> where \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "\<theta> ` fv s \<subseteq> range Var" "inj_on \<theta> (fv s)" "Tatt (s \<cdot> \<theta>) \<in> set P"
     using s_long_term_secret by blast
 
   obtain \<delta> where \<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> = fv (s \<cdot> \<theta>)" "ground (subst_range \<delta>)"
     "s' = s \<cdot> \<theta> \<cdot> \<delta>"
   proof -
     obtain \<delta> where *: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "fv s' = {}" "s' = s \<cdot> \<delta>"
       using A(2) unfolding defs by auto
 
     define \<sigma> where "\<sigma> \<equiv> subst_var_inv \<theta> (fv s) \<circ>\<^sub>s \<delta>"
     define \<delta>' where "\<delta>' \<equiv> rm_vars (UNIV - fv (s \<cdot> \<theta>)) \<sigma>"
 
     have **: "s' = s \<cdot> \<theta> \<cdot> \<sigma>"
       using *(4) inj_var_ran_subst_is_invertible[OF \<theta>(3,2)]
       unfolding \<sigma>_def by simp
     
     have "s' = s \<cdot> \<theta> \<cdot> \<delta>'"
       using ** rm_vars_subst_eq'[of "s \<cdot> \<theta>" \<sigma>]
       unfolding \<delta>'_def by simp
     moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>"
       using \<theta>(1) *(1) subst_var_inv_wt wt_subst_compose
       unfolding \<sigma>_def by presburger
     hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>'" using wt_subst_rm_vars unfolding \<delta>'_def by blast
     moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
       using wf_trms_subst_compose[OF subst_var_inv_wf_trms *(2)] unfolding \<sigma>_def by blast
     hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>')" using wf_trms_subst_rm_vars'[of \<sigma>] unfolding \<delta>'_def by blast
     moreover have "fv (s \<cdot> \<theta>) \<subseteq> subst_domain \<sigma>"
       using *(3) ** ground_term_subst_domain_fv_subset unfolding \<sigma>_def by blast
     hence "subst_domain \<delta>' = fv (s \<cdot> \<theta>)"
       using rm_vars_dom[of "UNIV - fv (s \<cdot> \<theta>)" \<sigma>] unfolding \<delta>'_def by blast
     moreover have "ground (subst_range \<delta>')"
     proof -
       { fix t assume "t \<in> subst_range \<delta>'"
         then obtain x where "x \<in> fv (s \<cdot> \<theta>)" "\<delta>' x = t"
           using \<open>subst_domain \<delta>' = fv (s \<cdot> \<theta>)\<close> by auto
         hence "t \<sqsubseteq> s \<cdot> \<theta> \<cdot> \<delta>'" by (meson subst_mono_fv)
         hence "fv t = {}" using \<open>s' = s \<cdot> \<theta> \<cdot> \<delta>'\<close> *(3) ground_subterm by blast
       } thus ?thesis by force
     qed
     ultimately show thesis using that[of \<delta>'] by fast
   qed
 
   have \<xi>: "transaction_decl_subst Var (Tatt t)"
     and \<sigma>: "transaction_fresh_subst Var (Tatt t) (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
     for t
     unfolding transaction_decl_subst_def transaction_fresh_subst_def Tatt_def by simp_all
 
   obtain \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
     where \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
     unfolding transaction_renaming_subst_def by blast
 
   obtain J where J:
       "welltyped_constraint_model J (A@[\<langle>\<star>, send\<langle>[s \<cdot> \<theta> \<cdot> \<delta>]\<rangle>\<rangle>])" "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J \<turnstile> s \<cdot> \<theta> \<cdot> \<alpha> \<cdot> J"
     using welltyped_constraint_model_leakage_model_swap[OF A(3)[unfolded \<delta>(5)] \<alpha> \<delta>(1-4)] by blast
 
   define T where "T = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand (Tatt (s \<cdot> \<theta>)) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<alpha>)"
   define B where "B \<equiv> A@T"
 
   have "transaction_receive (Tatt t) = [\<langle>n, receive\<langle>[t]\<rangle>\<rangle>]"
        "transaction_checks (Tatt t) = []"
        "transaction_updates (Tatt t) = []"
        "transaction_send (Tatt t) = [\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>]"
     for t
     unfolding Tatt_def by simp_all
   hence T_def': "T = [\<langle>n, send\<langle>[s \<cdot> \<theta> \<cdot> \<alpha>]\<rangle>\<rangle>, \<langle>n, receive\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>]"
     using subst_lsst_append[of "transaction_receive (Tatt (s \<cdot> \<theta>))" _ \<alpha>]
           subst_lsst_singleton[of "ln n" "receive\<langle>[s \<cdot> \<theta>]\<rangle>" \<alpha>]
           subst_lsst_singleton[of "ln n" "send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>" \<alpha>]
     unfolding transaction_strand_def T_def by fastforce
   
   have B0: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t J \<turnstile> attack\<langle>ln n\<rangle>"
     using in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of "attack\<langle>ln n\<rangle>" "unlabel T"]
     unfolding B_def T_def' by (force intro!: intruder_deduct.Axiom)
 
   have B1: "B \<in> reachable_constraints P"
     using reachable_constraints.step[OF A(1) \<theta>(4) \<xi> \<sigma> \<alpha>]
     unfolding B_def T_def by simp
 
   have "welltyped_constraint_model J B"
     using J strand_sem_append_stateful[of "{}" "{}" "unlabel A" _ J]
     unfolding defs' B_def T_def' by fastforce
   hence B2: "welltyped_constraint_model J (B@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])"
     using B0 strand_sem_append_stateful[of "{}" "{}" "unlabel B" "[send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>]" J]
     unfolding defs' B_def by auto
 
   show False using P_wt_secure B1 B2 by blast
 qed
 
 lemma welltyped_leakage_free_value_constI:
   assumes P:
       "\<forall>T \<in> set P. wellformed_transaction T"
       "\<forall>T \<in> set P. admissible_transaction_terms T"
       "\<forall>T \<in> set P. transaction_decl T () = []"
       "\<forall>T \<in> set P. bvars_transaction T = {}"
     and P_fresh_declass:
       "\<forall>T \<in> set P. transaction_fresh T \<noteq> [] \<longrightarrow>
         (transaction_send T \<noteq> [] \<and> (let (l,a) = hd (transaction_send T)
           in l = \<star> \<and> is_Send a \<and> Var ` set (transaction_fresh T) \<subseteq> set (the_msgs a)))"
   shows "welltyped_leakage_free_protocol [\<langle>m: value\<rangle>\<^sub>v] P"
 proof (rule ccontr)
   define Q where "Q \<equiv> \<lambda>M 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>) = {}"
   define f where "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. Q M t \<delta>}"
   define Sec where "Sec \<equiv> f (set [\<langle>m: value\<rangle>\<^sub>v]) - {m. {} \<turnstile>\<^sub>c m}"
 
   note defs = Sec_def f_def Q_def
   note defs' = welltyped_constraint_model_def constraint_model_def
 
   assume "\<not>welltyped_leakage_free_protocol [\<langle>m: value\<rangle>\<^sub>v] P"
   then obtain A I s where A:
       "A \<in> reachable_constraints P" "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I"
       "welltyped_constraint_model I (A@[\<langle>\<star>, send\<langle>[s]\<rangle>\<rangle>])"
     unfolding welltyped_leakage_free_protocol_def defs by fastforce
 
   have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> s \<cdot> I" using welltyped_constraint_model_deduct_split[OF A(3)] by simp
   moreover have "s \<cdot> I = s" using A(2) unfolding defs by fast
   ultimately have s_deduct: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I) \<turnstile> s" by (metis ik\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst)
 
   note I0 = welltyped_constraint_model_prefix[OF A(3)]
 
   have I1: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" using A(3) unfolding defs' by blast
 
   obtain f ts \<delta> where f: "s = Fun f ts" "s = \<langle>m: value\<rangle>\<^sub>v \<cdot> \<delta>" "\<not>{} \<turnstile>\<^sub>c s" "s \<notin> declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I"
       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>)" "fv s = {}"
     using A(2) unfolding defs by (cases s) auto
 
   have s1: "\<Gamma> s = TAtom Value"
     by (metis \<Gamma>.simps(1) \<Gamma>\<^sub>v_TAtom f(2) wt_subst_trm''[OF \<delta>(1)]) 
 
   have s2: "wf\<^sub>t\<^sub>r\<^sub>m s"
     using f(2) \<delta>(2) by force
   
   have s3: "ts = []"
     using f(1) s1 s2 const_type_inv_wf by blast
 
   obtain sn where sn: "s = Fun (Val sn) []"
     using s1 f(3) \<Gamma>_Fu_simps(4) \<Gamma>_Set_simps(3) unfolding f(1) s3 by (cases f) auto
 
   have "s \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
     using private_fun_deduct_in_ik'[OF s_deduct[unfolded sn]]
     by (metis sn public.simps(3) ik\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst)
   hence s4: "s \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
     using constraint_model_Val_const_in_constr_prefix[OF A(1) I0 P(1,2)]
     unfolding sn by presburger
 
   obtain B T \<xi> \<sigma> \<alpha> where B:
       "prefix (B@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) A"
       "B \<in> reachable_constraints P" "T \<in> set P" "transaction_decl_subst \<xi> T"
       "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
       "s \<in> subst_range \<sigma>"
     using constraint_model_Value_in_constr_prefix_fresh_action'[OF A(1) P(2-) s4[unfolded sn]] sn
     by blast
 
   obtain Tts Tsnds sx
     where T: "transaction_send T = \<langle>\<star>, send\<langle>Tts\<rangle>\<rangle>#Tsnds" "Var ` set (transaction_fresh T) \<subseteq> set Tts"
       and sx: "Var sx \<in> set Tts" "\<sigma> sx = s"
     using P_fresh_declass B(3,5,7)
     unfolding transaction_fresh_subst_def is_Send_def
     by (cases "transaction_send T") (fastforce,fastforce)
 
   have \<xi>_elim: "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> = \<sigma> \<circ>\<^sub>s \<alpha>"
     using admissible_transaction_decl_subst_empty'[OF bspec[OF P(3) B(3)] B(4)]
     by simp
 
   have s5: "s \<in> set (Tts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s I)"
     using sx unfolding \<xi>_elim sn by force
 
   have s6: "\<langle>\<star>, receive\<langle>Tts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s I\<rangle>\<rangle> \<in> set (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)"
   proof -
     have "\<langle>\<star>, send\<langle>Tts\<rangle>\<rangle> \<in> set (transaction_send T)"
       using T(1) by simp
     hence "\<langle>\<star>, send\<langle>Tts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>\<rangle>\<rangle> \<in> set (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" for \<delta>
       unfolding subst_apply_labeled_stateful_strand_def by force
     hence "\<langle>\<star>, send\<langle>Tts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>\<rangle>\<rangle> \<in> set (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" for \<delta>
       using transaction_strand_subst_subsets(4)[of T \<delta>] by fast
     hence *: "\<langle>\<star>, receive\<langle>Tts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>\<rangle>\<rangle> \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>))" for \<delta>
       using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(1)[of \<star> "Tts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>"] by blast
 
     have "\<langle>\<star>, receive\<langle>Tts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>\<rangle>\<rangle> \<in> set A"
       using B(1) *[of "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] unfolding prefix_def by force
     thus ?thesis
       unfolding subst_apply_labeled_stateful_strand_def by force
   qed
 
   show False
     using s6 f(4) ideduct_mono[OF Axiom[OF s5], of "\<Union>{set ts|ts. \<langle>\<star>,receive\<langle>ts\<rangle>\<rangle> \<in> set (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)}"]
     unfolding declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by blast
 qed
 
 lemma welltyped_leakage_free_priv_constI:
   fixes c
   defines "s \<equiv> Fun c []::('fun,'atom,'sets,'lbl) prot_term"
   assumes c: "\<not>public c" "arity c = 0" "\<Gamma> s = TAtom ca" "ca \<noteq> Value"
     and P: "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T. is_Var (\<Gamma>\<^sub>v x)"
            "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T \<union> set (transaction_fresh T). \<Gamma> s \<noteq> \<Gamma>\<^sub>v x"
            "\<forall>T \<in> set P. \<forall>t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). s \<notin> set (snd (Ana t))"
            "\<forall>T \<in> set P. s \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
            "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = \<langle>a\<rangle>\<^sub>\<tau>\<^sub>a)"
            "\<forall>T \<in> set P. wellformed_transaction T"
    shows "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>\<star>, send\<langle>[s]\<rangle>\<rangle>])"
           (is "\<forall>\<A> \<in> ?R. ?P \<A>")
      and "welltyped_leakage_free_protocol [s] P"
 proof -
   show "\<forall>\<A> \<in> ?R. ?P \<A>"
   proof
     fix A assume A: "A \<in> reachable_constraints P"
   
     define Q where "Q \<equiv> \<lambda>M 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>) = {}"
     define f where "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. Q M t \<delta>}"
     define Sec where "Sec \<equiv> f (set [s]) - {m. {} \<turnstile>\<^sub>c m}"
     
     define f' where "f' \<equiv> \<lambda>(T,\<xi>,\<sigma>::('fun,'atom,'sets,'lbl) prot_subst,\<alpha>).
                               dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
     define g' where "g' \<equiv> concat \<circ> map f'"
 
     let ?P_s_cases = "\<lambda>M. s \<in> M \<or> (\<exists>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t M. s \<in> set (snd (Ana m)))"
     let ?P_s_cases' = "\<lambda>M \<delta>. s \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<or> (\<exists>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>. s \<in> set (snd (Ana m)))"
 
     note defs = Sec_def f_def Q_def
     note defs' = welltyped_constraint_model_def constraint_model_def
   
     show "?P A"
     proof (rule ccontr)
       assume "\<not>?P A"
       then obtain I where I: "welltyped_constraint_model I (A@[\<langle>\<star>, send\<langle>[s]\<rangle>\<rangle>])" by blast
   
       obtain Ts where Ts:
           "A = g' Ts" "\<forall>B. prefix B Ts \<longrightarrow> g' B \<in> reachable_constraints P"
           "\<forall>B T \<xi> \<sigma> \<alpha>. prefix (B@[(T,\<xi>,\<sigma>,\<alpha>)]) Ts \<longrightarrow>
                 T \<in> set P \<and> transaction_decl_subst \<xi> T \<and>
                 transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g' B)) \<and>
                 transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (g' B))"
         using reachable_constraints_as_transaction_lists[OF A(1)] unfolding g'_def f'_def by blast
     
       have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> s \<cdot> I" and I_s: "s \<cdot> I = s"
         using welltyped_constraint_model_deduct_split[OF I]
         unfolding s_def by simp_all
       hence s_deduct: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I) \<turnstile> s" "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> s"
         by (metis ik\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst, metis)
     
       have I_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I"
           and I_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
           and I_grounds: "ground (subst_range I)"
           and I_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I"
         using I unfolding defs' by (blast,blast,blast,blast)
     
       have Sec_unfold: "Sec = {s}"
       proof
         have "\<not>{} \<turnstile>\<^sub>c s" using ideduct_synth_priv_const_in_ik[OF _ c(1)] unfolding s_def by blast
         thus "{s} \<subseteq> Sec" unfolding defs s_def by fastforce
       qed (auto simp add: defs s_def)
     
       have s2: "wf\<^sub>t\<^sub>r\<^sub>m s"
         using c(1,2) unfolding s_def by fastforce
     
       have A_ik_fv: "\<exists>a. \<Gamma>\<^sub>v x = TAtom a \<and> a \<noteq> ca" when x: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" for x
       proof -
         obtain T where T: "T \<in> set P" "\<Gamma>\<^sub>v x \<in> \<Gamma>\<^sub>v ` fv_transaction T"
           using fv_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[OF x] reachable_constraints_var_types_in_transactions(1)[OF A P(5)]
           by fast
         then obtain y where y: "y \<in> vars_transaction T" "\<Gamma>\<^sub>v y = \<Gamma>\<^sub>v x"
           using vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"] by fastforce
         then obtain a where a: "\<Gamma>\<^sub>v y = TAtom a" using P(1) T(1) by blast
         hence "\<Gamma>\<^sub>v x = TAtom a" "\<Gamma> s \<noteq> \<Gamma>\<^sub>v x" "\<Gamma> s = TAtom ca" using y P(2) T(1) c(3) by auto
         thus ?thesis by force
       qed
     
       have I_s_x: "\<not>s \<sqsubseteq> I x" when x: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" for x
       proof -
         obtain a where a: "\<Gamma>\<^sub>v x = TAtom a" "a \<noteq> ca" using A_ik_fv[OF x] by blast
         hence a': "\<Gamma> (I x) = TAtom a" using wt_subst_trm''[OF I_wt, of "Var x"] by simp
         
         obtain f ts where f: "I x = Fun f ts"
           by (meson empty_fv_exists_fun interpretation_grounds_all[OF I_interp])
         hence ts: "ts = []"
           using I_wf const_type_inv_wf[OF a'[unfolded f]] by fastforce
     
         have "c \<noteq> f" using f[unfolded ts] a a' c(3)[unfolded s_def] by force
         thus ?thesis using f ts unfolding s_def by simp
       qed
     
       have A_ik_I_const: "\<exists>f. arity f = 0 \<and> I x = Fun f []" when x: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" for x
         using x A_ik_fv I_wt empty_fv_exists_fun[OF interpretation_grounds_all[OF I_interp, of x]]
               wf_trm_subst_rangeD[OF I_wf, of x] const_type_inv const_type_inv_wf
         by (metis (no_types, lifting) \<Gamma>.simps(1) wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
       hence A_ik_subst: "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) = subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
         using subterms_subst''[of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" I] by blast
     
       have sublmm1: "s \<in> set (snd (Ana m))"
         when m: "m \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M" "s \<in> set (snd (Ana (m \<cdot> \<delta>)))"
           and M: "\<And>y. y \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<Longrightarrow> \<not>s \<sqsubseteq> \<delta> y"
         for m M \<delta>
       proof -
         have m_fun: "is_Fun m"
           using m M Ana_subterm' vars_iff_subtermeq_set
-          unfolding s_def is_Var_def by (metis subst_apply_term.simps(1))
+          unfolding s_def is_Var_def by (metis eval_term.simps(1))
         
         obtain f K R ts i where f:
             "m = \<langle>f ts\<rangle>\<^sub>t" "arity\<^sub>f f = length ts" "arity\<^sub>f f > 0" "Ana\<^sub>f f = (K, R)"
           and i: "i < length R" "s = ts ! (R ! i) \<cdot> \<delta>"
           and R_i: "\<forall>i < length R. map ((!) ts) R ! i = ts ! (R ! i) \<and> R ! i < length ts"
         proof -
           obtain f ts K R where f:
               "m \<cdot> \<delta> = \<langle>f ts\<rangle>\<^sub>t" "arity\<^sub>f f = length ts" "arity\<^sub>f f > 0"
               "Ana\<^sub>f f = (K, R)" "Ana (m \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) ts, map ((!) ts) R)"
             using m(2) Ana_nonempty_inv[of "m \<cdot> \<delta>"] by force
       
           obtain ts' where m': "m = \<langle>f ts'\<rangle>\<^sub>t" "ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>"
             using f(1) m_fun by auto
       
           have R_i: "map ((!) ts) R ! i = ts ! (R ! i)" "R ! i < length ts"
             when i: "i < length R" for i
             using i Ana\<^sub>f_assm2_alt[OF f(4), of "R ! i"] f(2) by simp_all
           then obtain i where i: "s = ts ! (R ! i)" "i < length R"
             by (metis (no_types, lifting) m(2) f(5) in_set_conv_nth length_map snd_conv)
       
           have ts': "arity\<^sub>f f = length ts'" "length ts = length ts'" using m'(2) f(2) by simp_all
       
           have s': "s = ts' ! (R ! i) \<cdot> \<delta>" using R_i(2)[OF i(2)] i(1) unfolding ts'(2) m'(2) by simp
       
           show thesis using that f m' R_i ts' s' i by auto
         qed
     
         have "s = ts ! (R ! i)"
         proof (cases "ts ! (R ! i)")
           case (Var x)
           hence "Var x \<in> set ts" using R_i i nth_mem by fastforce
           hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t M" using m(1) f(1) fv_subterms_set by fastforce
           thus ?thesis using i M Var by fastforce
         qed (use i s_def in fastforce)
         thus "s \<in> set (snd (Ana m))" using f(1) Ana_Fu_intro[OF f(2-4)] i(1) by simp
       qed
     
       have "\<not>s \<sqsubseteq> \<delta> y"
         when m: "m \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "s \<in> set (snd (Ana (m \<cdot> \<delta>)))"
           and T: "T \<in> set P" and \<delta>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
           and \<delta>_ran: "\<And>t. t \<in> subst_range \<delta> \<Longrightarrow> (\<exists>c. t = Fun c [] \<and> arity c = 0) \<or> (\<exists>x. t = Var x)"
           and y: "y \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))"
         for m T \<delta> y
       proof
         assume "s \<sqsubseteq> \<delta> y"
         hence "\<Gamma>\<^sub>v y = \<Gamma> s" using wt_subst_trm''[OF \<delta>_wt, of "Var y"] \<delta>_ran[of "\<delta> y"] by fastforce
         moreover have "y \<in> vars_transaction T"
           using y trms\<^sub>s\<^sub>s\<^sub>t_fv_vars\<^sub>s\<^sub>s\<^sub>t_subset unfolding vars_transaction_unfold[of T] by fastforce
         ultimately show False using P(2) T by force
       qed
       hence sublmm2: "s \<in> set (snd (Ana m))"
         when m: "m \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "s \<in> set (snd (Ana (m \<cdot> \<delta>)))"
           and T: "T \<in> set P" and \<delta>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
           and \<delta>_ran: "\<And>t. t \<in> subst_range \<delta> \<Longrightarrow> (\<exists>c. t = Fun c [] \<and> arity c = 0) \<or> (\<exists>x. t = Var x)"
         for m T \<delta>
         using sublmm1[OF m] m T \<delta>_wt \<delta>_ran by blast
 
       have "s \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<or> (\<exists>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t I. s \<in> set (snd (Ana m)))"
         using private_const_deduct[OF c(1) s_deduct(2)[unfolded s_def]]
               I_s_x const_mem_subst_cases[of c] A_ik_subst
         unfolding s_def by blast
       hence "?P_s_cases (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" using sublmm1[of _ "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"] I_s_x by blast
       then obtain T \<xi> \<sigma> \<alpha> where T: "(T,\<xi>,\<sigma>,\<alpha>) \<in> set Ts" "?P_s_cases (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (f' (T,\<xi>,\<sigma>,\<alpha>)))"
         using ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t_concat[of "map f' Ts"] Ts(1)[unfolded g'_def] by fastforce
     
       obtain B where "prefix (B@[(T, \<xi>, \<sigma>, \<alpha>)]) Ts" by (metis T(1) prefix_snoc_in_iff)
       hence T_in_P: "T \<in> set P"
           and T_wf: "wellformed_transaction T"
           and \<xi>: "transaction_decl_subst \<xi> T"
           and \<sigma>: "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (concat (map f' B)))"
           and \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (concat (map f' B)))"
         using P(6) Ts(3)[unfolded g'_def] unfolding comp_def by (metis,metis,metis,metis,metis)
     
       note \<xi>\<sigma>\<alpha>_wt = transaction_decl_fresh_renaming_substs_wt[OF \<xi> \<sigma> \<alpha>]
       note \<xi>\<sigma>\<alpha>_ran = transaction_decl_fresh_renaming_substs_range'(1)[OF \<xi> \<sigma> \<alpha>]
     
       have "subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>) = subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" for M
         using \<xi>\<sigma>\<alpha>_ran subterms_subst''[of _ "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"] by (meson subst_imgI)
       hence s_cases: "?P_s_cases' (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) (\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
         using T(2) dual_transaction_ik_is_transaction_send'[OF T_wf, of "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
         unfolding f'_def by auto
     
       from s_cases show False
       proof
         assume "s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
         then obtain t where t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "s = t \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>" by moura
         have "s \<noteq> t" using P(4) T_in_P t(1) by blast
         then obtain x where x: "t = Var x" using t(2) unfolding s_def by (cases t) auto
         
         have "\<Gamma>\<^sub>v x = \<Gamma> s" using x t(2) wt_subst_trm''[OF \<xi>\<sigma>\<alpha>_wt, of "Var x"] by simp
         moreover have "x \<in> vars_transaction T"
           using t(1) trms\<^sub>s\<^sub>s\<^sub>t_fv_vars\<^sub>s\<^sub>s\<^sub>t_subset unfolding x vars_transaction_unfold[of T] by fastforce
         ultimately show False using P(2) T_in_P by force
       qed (use sublmm2[OF _ _ T_in_P \<xi>\<sigma>\<alpha>_wt \<xi>\<sigma>\<alpha>_ran] P(3) T_in_P in blast)
     qed
   qed
   thus "welltyped_leakage_free_protocol [s] P"
     using welltyped_leakage_free_no_deduct_constI[of P c]
     unfolding s_def by blast
 qed
 
 lemma welltyped_leakage_free_priv_constI':
   assumes c: "\<not>public\<^sub>f c" "arity\<^sub>f c = 0" "\<Gamma>\<^sub>f c = Some ca"
     and P:
       "\<forall>T \<in> set P. wellformed_transaction T"
       "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T \<union> set (transaction_fresh T). \<Gamma> \<langle>c\<rangle>\<^sub>c \<noteq> \<Gamma>\<^sub>v x"
       "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T. is_Var (\<Gamma>\<^sub>v x)"
       "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = \<langle>a\<rangle>\<^sub>\<tau>\<^sub>a)"
       "\<forall>T \<in> set P. \<forall>t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). \<langle>c\<rangle>\<^sub>c \<notin> set (snd (Ana t))"
       "\<forall>T \<in> set P. \<langle>c\<rangle>\<^sub>c \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
    shows "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>\<star>, send\<langle>[\<langle>c\<rangle>\<^sub>c]\<rangle>\<rangle>])"
      and "welltyped_leakage_free_protocol [\<langle>c\<rangle>\<^sub>c] P"
 using c welltyped_leakage_free_priv_constI[OF _ _ _ _ P(3,2,5,6,4,1), of "Atom ca"]
 by (force, force)
 
 lemma welltyped_leakage_free_set_constI:
   assumes P:
       "\<forall>T \<in> set P. wellformed_transaction T"
       "\<forall>T \<in> set P. \<forall>f \<in> \<Union>(funs_term ` (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))). \<not>is_Set f"
       "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T \<union> set (transaction_fresh T). \<Gamma>\<^sub>v x \<noteq> TAtom SetType"
       "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T. is_Var (\<Gamma>\<^sub>v x)"
       "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = \<langle>a\<rangle>\<^sub>\<tau>\<^sub>a)"
     and c: "arity\<^sub>s c = 0"
   shows "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>\<star>, send\<langle>[\<langle>c\<rangle>\<^sub>s]\<rangle>\<rangle>])"
     and "welltyped_leakage_free_protocol [\<langle>c\<rangle>\<^sub>s] P"
 proof -
   have c'': "\<langle>c\<rangle>\<^sub>s \<notin> subterms t"
     when T: "T \<in> set P" and t: "t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" for T t
     using t bspec[OF P(2) T] subtermeq_imp_funs_term_subset[of t]
           funs_term_Fun_subterm'[of "Set c" "[]::('fun,'atom,'sets,'lbl) prot_term list"]
     by fastforce
 
   have P':
       "\<forall>T \<in> set P. \<forall>t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). \<langle>c\<rangle>\<^sub>s \<notin> set (snd (Ana t))"
       "\<forall>T \<in> set P. \<langle>c\<rangle>\<^sub>s \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
     subgoal using Ana_subterm' c'' by fast
     subgoal using c'' by fast
     done
 
   have P'':
       "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T \<union> set (transaction_fresh T). \<Gamma> \<langle>c\<rangle>\<^sub>s \<noteq> \<Gamma>\<^sub>v x"
     using P(3) \<Gamma>_consts_simps(4)[OF c] by fastforce
 
   show "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>\<star>, send\<langle>[\<langle>c\<rangle>\<^sub>s]\<rangle>\<rangle>])"
        "welltyped_leakage_free_protocol [\<langle>c\<rangle>\<^sub>s] P"
     using c welltyped_leakage_free_priv_constI[OF _ _ _ _ P(4) P'' P' P(5,1), of SetType]
     by (force, force)
 qed
 
 lemma welltyped_leakage_free_occurssec_constI:
   defines "s \<equiv> Fun OccursSec []"
   assumes P:
       "\<forall>T \<in> set P. wellformed_transaction T"
       "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T \<union> set (transaction_fresh T). \<Gamma>\<^sub>v x \<noteq> TAtom OccursSecType"
       "\<forall>T \<in> set P. \<forall>t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). Fun OccursSec [] \<notin> set (snd (Ana t))"
       "\<forall>T \<in> set P. Fun OccursSec [] \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
       "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T. is_Var (\<Gamma>\<^sub>v x)"
       "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = \<langle>a\<rangle>\<^sub>\<tau>\<^sub>a)"
   shows "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>\<star>, send\<langle>[s]\<rangle>\<rangle>])"
     and "welltyped_leakage_free_protocol [s] P"
 proof -
   have P':
       "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T \<union> set (transaction_fresh T). \<Gamma> (Fun OccursSec []) \<noteq> \<Gamma>\<^sub>v x"
     using P(2) by auto
 
   show "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>\<star>, send\<langle>[s]\<rangle>\<rangle>])"
        "welltyped_leakage_free_protocol [s] P"
     using welltyped_leakage_free_priv_constI[OF _ _ _ _ P(5) P' P(3,4,6,1), of OccursSecType]
     unfolding s_def by auto
 qed
 
 lemma welltyped_leakage_free_occurs_factI:
   assumes P: "\<forall>T \<in> set P. admissible_transaction' T"
     and P_occ: "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
     and P_occ_star:
       "\<forall>T \<in> set P. \<forall>r \<in> set (transaction_send T).
         OccursFact \<in> \<Union>(funs_term ` (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd r))) \<longrightarrow> fst r = \<star>"
   shows "welltyped_leakage_free_protocol [occurs x] P"
 proof -
   define Q where "Q \<equiv> \<lambda>M 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>) = {}"
   define f where "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. Q M t \<delta>}"
   define Sec where "Sec \<equiv> f (set [occurs x]) - {m. {} \<turnstile>\<^sub>c m}"
 
   define f' where "f' \<equiv> \<lambda>(T,\<xi>,\<sigma>::('fun,'atom,'sets,'lbl) prot_subst,\<alpha>).
                             dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   define g' where "g' \<equiv> concat \<circ> map f'"
 
   note defs = Sec_def f_def Q_def
   note defs' = welltyped_constraint_model_def constraint_model_def
 
   show ?thesis
   proof (rule ccontr)
     assume "\<not>welltyped_leakage_free_protocol [occurs x] P"
     then obtain A I k where A:
         "A \<in> reachable_constraints P" "occurs k \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I"
         "welltyped_constraint_model I (A@[\<langle>\<star>, send\<langle>[occurs k]\<rangle>\<rangle>])"
       unfolding welltyped_leakage_free_protocol_def defs by fastforce
 
     note A' = welltyped_constraint_model_prefix[OF A(3)]
 
     have occ_I: "occurs k \<cdot> I = occurs k" using A(2) unfolding defs by auto
     hence occ_in_ik: "occurs k \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "occurs k \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
       using welltyped_constraint_model_deduct_split(2)[OF A(3)]
             reachable_constraints_occurs_fact_deduct_in_ik[OF A(1) A' P P_occ, of k]
       by (argo, argo)
     then obtain l ts where ts: "(l,receive\<langle>ts\<rangle>) \<in> set A" "occurs k \<in> set ts"
       using in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of "occurs k" "unlabel A"] unfolding unlabel_def by moura
 
     obtain T a B \<alpha> \<sigma> \<xi>
       where B: "prefix (B@f' (T,\<xi>,\<sigma>,\<alpha>)) A"
         and T: "T \<in> set P" "transaction_decl_subst \<xi> T"
                "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
                "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
         and a: "a \<in> set (transaction_strand T)" "fst (l,receive\<langle>ts\<rangle>) = fst a"
                "(l,receive\<langle>ts\<rangle>) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
       using reachable_constraints_transaction_action_obtain[OF A(1) ts(1), of thesis]
       unfolding f'_def by simp
 
     obtain ts' where ts': "a = (l,send\<langle>ts'\<rangle>)" "ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
       using surj_pair[of a] a(2,3) by (cases "snd a") force+
 
     obtain t where t: "t \<in> set ts'" "occurs k = t \<cdot> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
       using ts(2) unfolding ts'(2) by force
 
     have occ_t: "OccursFact \<in> funs_term t"
     proof (cases t)
       case (Var y) thus ?thesis
-        using t(2) subst_apply_term.simps(1)[of y "\<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"]
-              transaction_decl_fresh_renaming_substs_range'(1)[OF T(2-), of "occurs k"]
+        using t(2) transaction_decl_fresh_renaming_substs_range'(1)[OF T(2-), of "occurs k"]
         by fastforce
     qed (use t(2) in simp)
 
     have P_wf: "\<forall>T \<in> set P. wellformed_transaction T"
       using P admissible_transaction_is_wellformed_transaction(1) by blast
 
     have l: "l = \<star>"
       using wellformed_transaction_strand_memberD(8)[OF bspec[OF P_wf T(1)] a(1)[unfolded ts'(1)]]
             t(1) T(1) P_occ_star occ_t
       unfolding ts'(1) by fastforce
 
     have "occurs k \<in> \<Union>{set ts |ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)}"
       using subst_lsst_memI[OF ts(1), of I] subst_set_map[OF ts(2), of I]
       unfolding occ_I l by auto
     thus False using A(2) unfolding declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by simp
   qed
 qed
 
 lemma welltyped_leakage_free_setop_pairI:
   assumes P:
       "\<forall>T \<in> set P. wellformed_transaction T"
       "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = \<langle>a\<rangle>\<^sub>\<tau>\<^sub>a)"
       "\<forall>T \<in> set P. \<forall>f \<in> \<Union>(funs_term ` (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))). \<not>is_Set f"
       "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
       "\<forall>T \<in> set P. transaction_decl T () = []"
       "\<forall>T \<in> set P. admissible_transaction_terms T"
     and c: "arity\<^sub>s c = 0"
   shows "welltyped_leakage_free_protocol [pair (x, \<langle>c\<rangle>\<^sub>s)] P"
 proof -
   define Q where "Q \<equiv> \<lambda>M 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>) = {}"
   define f where "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. Q M t \<delta>}"
   define Sec where "Sec \<equiv> f (set [pair (x, \<langle>c\<rangle>\<^sub>s)]) - {m. {} \<turnstile>\<^sub>c m}"
 
   define f' where "f' \<equiv> \<lambda>(T,\<xi>,\<sigma>::('fun,'atom,'sets,'lbl) prot_subst,\<alpha>).
                             dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   define g' where "g' \<equiv> concat \<circ> map f'"
 
   note defs = Sec_def f_def Q_def
   note defs' = welltyped_constraint_model_def constraint_model_def
 
   have P':
       "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T \<union> set (transaction_fresh T). \<Gamma>\<^sub>v x \<noteq> TAtom SetType"
       "\<forall>T \<in> set P. \<forall>x \<in> vars_transaction T. is_Var (\<Gamma>\<^sub>v x)"
       "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = \<langle>a\<rangle>\<^sub>\<tau>\<^sub>a)"
     subgoal using P(2,4) by fastforce
     subgoal using P(2) by fastforce
     subgoal using P(4) by fast
     done
 
   note 0 = welltyped_leakage_free_set_constI(1)[OF P(1,3) P' c]
 
   show ?thesis
   proof (rule ccontr)
     assume "\<not>welltyped_leakage_free_protocol [pair (x, \<langle>c\<rangle>\<^sub>s)] P"
     then obtain A I k where A:
         "A \<in> reachable_constraints P" "pair (k, \<langle>c\<rangle>\<^sub>s) \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I"
         "welltyped_constraint_model I (A@[\<langle>\<star>, send\<langle>[pair (k, \<langle>c\<rangle>\<^sub>s)]\<rangle>\<rangle>])"
       unfolding welltyped_leakage_free_protocol_def defs pair_def by fastforce
 
     note A' = welltyped_constraint_model_prefix[OF A(3)]
 
     have "pair (k, \<langle>c\<rangle>\<^sub>s) \<cdot> I = pair (k, \<langle>c\<rangle>\<^sub>s)" using A(2) unfolding defs by auto
     hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> pair (k, \<langle>c\<rangle>\<^sub>s)"
       using welltyped_constraint_model_deduct_split(2)[OF A(3)] by argo
     then obtain n where n: "intruder_deduct_num (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) n (pair (k, \<langle>c\<rangle>\<^sub>s))"
       using deduct_num_if_deduct by fast
 
     have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)" "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<subseteq> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
       using A(3) ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset unfolding defs' by simp_all
     hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<subseteq> SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" by blast
     hence "Pair \<notin> \<Union>(funs_term ` (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I))"
       using reachable_constraints_no_Pair_fun'[OF A(1) P(4-6)] P by blast
     hence 1: "\<not>pair (k, \<langle>c\<rangle>\<^sub>s) \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
       using funs_term_Fun_subterm'[of Pair] unfolding pair_def by auto
     
     have 2: "pair (k, \<langle>c\<rangle>\<^sub>s) \<notin> set (snd (Ana m))" when m: "m \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I" for m
       using m 1 term.dual_order.trans Ana_subterm'[of "pair (k, \<langle>c\<rangle>\<^sub>s)" m] by auto
 
     have "\<not>ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> \<langle>c\<rangle>\<^sub>s"
       using 0 A(1) A' welltyped_constraint_model_deduct_iff[of I A \<star> "\<langle>c\<rangle>\<^sub>s"] by force
     moreover have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> \<langle>c\<rangle>\<^sub>s"
       using 1 2 deduct_inv[OF n] deduct_if_deduct_num[of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I" _ "\<langle>c\<rangle>\<^sub>s"]
       unfolding pair_def by auto
     ultimately show False by blast
   qed
 qed
 
 lemma welltyped_leakage_free_short_term_secretI:
   fixes c x y f n d l l'
   defines "s \<equiv> \<langle>f [\<langle>c\<rangle>\<^sub>c, \<langle>x: value\<rangle>\<^sub>v]\<rangle>\<^sub>t"
     and "Tatt \<equiv> Transaction (\<lambda>(). []) []
           [\<langle>\<star>, receive\<langle>[occurs \<langle>y: value\<rangle>\<^sub>v]\<rangle>\<rangle>,
            (l, receive\<langle>[\<langle>f [\<langle>c\<rangle>\<^sub>c, \<langle>y: value\<rangle>\<^sub>v]\<rangle>\<^sub>t]\<rangle>)]
           [(l', \<langle>\<langle>y: value\<rangle>\<^sub>v not in \<langle>d\<rangle>\<^sub>s\<rangle>)]
           []
           [\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>]"
   assumes P:
       "\<forall>T \<in> set P. admissible_transaction' T"
       "\<forall>T \<in> set P. admissible_transaction_occurs_checks T"
       "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = \<langle>a\<rangle>\<^sub>\<tau>\<^sub>a)"
     and subterms_sec:
       "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>\<star>, send\<langle>[\<langle>c\<rangle>\<^sub>c]\<rangle>\<rangle>])"
     and P_sec:
       "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>\<^sub>\<tau>.
         welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])"
     and P_Tatt: "Tatt \<in> set P"
     and P_d:
       "\<forall>T \<in> set P. \<forall>a \<in> set (transaction_updates T).
         is_Insert (snd a) \<and> the_set_term (snd a) = \<langle>d\<rangle>\<^sub>s \<longrightarrow>
           transaction_send T \<noteq> [] \<and> (let (l,b) = hd (transaction_send T)
             in l = \<star> \<and> is_Send b \<and> \<langle>f [\<langle>c\<rangle>\<^sub>c, the_elem_term (snd a)]\<rangle>\<^sub>t \<in> set (the_msgs b))"
   shows "welltyped_leakage_free_protocol [s] P"
 proof -
   define Q where "Q \<equiv> \<lambda>M 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>) = {}"
   define Sec where "Sec \<equiv> {t \<cdot> \<delta> | t \<delta>. Q (set [s]) t \<delta>} - {m. {} \<turnstile>\<^sub>c m}"
 
   define f' where "f' \<equiv> \<lambda>(T,\<xi>,\<sigma>::('fun,'atom,'sets,'lbl) prot_subst,\<alpha>).
                             dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   define g' where "g' \<equiv> concat \<circ> map f'"
 
   note defs = Sec_def Q_def
   note defs' = welltyped_constraint_model_def constraint_model_def
 
   show ?thesis
   proof (rule ccontr)
     assume "\<not>welltyped_leakage_free_protocol [s] P"
     then obtain A I k where A:
         "A \<in> reachable_constraints P" "\<langle>f [\<langle>c\<rangle>\<^sub>c, k]\<rangle>\<^sub>t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I"
         "welltyped_constraint_model I (A@[\<langle>\<star>, send\<langle>[\<langle>f [\<langle>c\<rangle>\<^sub>c, k]\<rangle>\<^sub>t]\<rangle>\<rangle>])"
       unfolding welltyped_leakage_free_protocol_def defs s_def by fastforce
 
     have I: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
       using A(3) unfolding defs' by (blast,blast,blast)
 
     note A' = welltyped_constraint_model_prefix[OF A(3)]
 
     have "strand_sem_stateful {} {} (unlabel A) I"
       using A' unfolding defs' by simp
     hence A'': "strand_sem_stateful {} {} (unlabel A) (I(z := k))"
       when z: "z \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" for z
       using z strand_sem_model_swap[of "unlabel A" I "I(z := k)" "{}" "{}"] by auto
 
     obtain \<delta> where \<delta>:
         "\<delta> (the_Var \<langle>x: value\<rangle>\<^sub>v) = k" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
         "fv (\<delta> (the_Var \<langle>x: value\<rangle>\<^sub>v)) = {}"
       using A(2) unfolding defs s_def by auto
     
     have k: "\<Gamma> k = TAtom Value" "fv k = {}" "wf\<^sub>t\<^sub>r\<^sub>m k"
       subgoal using \<delta>(1) wt_subst_trm''[OF \<delta>(2), of "\<langle>x: value\<rangle>\<^sub>v"] by simp
       subgoal using \<delta>(1,4) by blast
       subgoal using \<delta>(1,3) by force
       done
     then obtain fk where fk: "k = Fun fk []"
       using const_type_inv_wf by (cases k) auto
 
     have fk': "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> \<langle>f [\<langle>c\<rangle>\<^sub>c, k]\<rangle>\<^sub>t"
       using fk welltyped_constraint_model_deduct_split(2)[OF A(3)] by auto
 
     have "\<not>welltyped_constraint_model I (A@[\<langle>\<star>, send\<langle>[\<langle>c\<rangle>\<^sub>c]\<rangle>\<rangle>])"
       using subterms_sec(1) A(1) by blast
     hence "\<not>ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> \<langle>c\<rangle>\<^sub>c"
       using A' strand_sem_append_stateful[of "{}" "{}" "unlabel A" "unlabel [\<langle>\<star>, send\<langle>[\<langle>c\<rangle>\<^sub>c]\<rangle>\<rangle>]" I]
       unfolding defs' by auto
     hence "\<langle>f [\<langle>c\<rangle>\<^sub>c, k]\<rangle>\<^sub>t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
       using fk' deduct_inv'[OF fk'] by force
     moreover have "k \<sqsubseteq> \<langle>f [\<langle>c\<rangle>\<^sub>c, k]\<rangle>\<^sub>t" by simp
     ultimately have k_in_ik: "k \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
       using in_subterms_subset_Union by blast
     hence "k \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<or> (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A). k \<sqsubseteq> I x)"
       using const_subterms_subst_cases[of fk I "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"]
       unfolding fk by fast
     hence "fk \<in> \<Union>(funs_term ` ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<or> (\<exists>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. k \<sqsubseteq> I x)"
       unfolding fk by (meson UN_iff funs_term_Fun_subterm' fv_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t )
     hence "fk \<in> \<Union>(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<or> (\<exists>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. k \<sqsubseteq> I x)"
       using ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset by blast
     moreover have "\<Gamma>\<^sub>v x = TAtom Value" when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" for x
       using x reachable_constraints_var_types_in_transactions(1)[OF A(1) P(3)]
             P(1,2) admissible_transaction_Value_vars
       by force
     ultimately have "fk \<in> \<Union>(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<or> (\<exists>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<Gamma>\<^sub>v x = TAtom Value \<and> k \<sqsubseteq> I x)"
       by blast
     hence "fk \<in> \<Union>(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<or> (\<exists>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<Gamma>\<^sub>v x = TAtom Value \<and> I x = k)"
       using I(1,3) wf_trm_TComp_subterm wf_trm_subst_rangeD
       unfolding fk wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by (metis \<Gamma>.simps(1) term.distinct(1))
     then obtain kn where kn: "fk = Val kn"
       using reachable_constraints_val_funs_private[OF A(1) P(1), of fk]
             constraint_model_Value_term_is_Val[OF A(1) A' P(1,2)]
             Fun_Value_type_inv[OF k(1)[unfolded fk]]
       unfolding fk is_PubConstValue_def by (cases fk) force+
 
     obtain \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
       where \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
       unfolding transaction_renaming_subst_def by blast
 
     obtain y' yn' where y':
         "\<alpha> (the_Var \<langle>y: value\<rangle>\<^sub>v) = Var y'" "y \<noteq> yn'" "Var y' = \<langle>yn': value\<rangle>\<^sub>v"
       using transaction_renaming_subst_is_renaming(1,2)[OF \<alpha>] by force
 
     define B where "B \<equiv> A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand Tatt \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<alpha>)"
     define J where "J \<equiv> I(y' := k)"
 
     have "y' \<in> range_vars \<alpha>"
       using y'(1) transaction_renaming_subst_is_renaming(3)[OF \<alpha>]
       by (metis (no_types, lifting) in_mono subst_fv_imgI term.set_intros(3))
     hence y'': "y' \<notin> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
       using transaction_renaming_subst_vars_disj(6)[OF \<alpha>] by blast
 
     have 0: "(k,\<langle>d\<rangle>\<^sub>s) \<notin> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I)"
     proof
       assume a: "(k,\<langle>d\<rangle>\<^sub>s) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I)"
       obtain l t t' where t: "(l,insert\<langle>t,t'\<rangle>) \<in> set A" "t \<cdot> I = k" "t' \<cdot> I = \<langle>d\<rangle>\<^sub>s"
         using db\<^sub>s\<^sub>s\<^sub>t_in_cases[OF a[unfolded db\<^sub>s\<^sub>s\<^sub>t_def]] unfolding unlabel_def by auto
 
       obtain T b B \<alpha> \<sigma> \<xi> where T:
           "prefix (B@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) A"
           "T \<in> set P" "transaction_decl_subst \<xi> T"
           "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
           "b \<in> set (transaction_strand T)" "(l, insert\<langle>t,t'\<rangle>) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
           "fst (l, insert\<langle>t,t'\<rangle>) = fst b"
         using reachable_constraints_transaction_action_obtain[OF A(1) t(1)] by metis
 
       define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
       obtain b' where "b = (l,b')"
         using T(8) by (cases b) simp
       then obtain tb tb'
           where b': "b = (l,insert\<langle>tb,tb'\<rangle>)"
             and tb: "t = tb \<cdot> \<theta>"
             and tb': "t' = tb' \<cdot> \<theta>"
         using T(7) unfolding \<theta>_def by (cases b') auto
 
       note T_adm = bspec[OF P(1) T(2)]
       note T_wf = admissible_transaction_is_wellformed_transaction(1,3)[OF T_adm]
 
       have b: "b \<in> set (transaction_updates T)"
         using transaction_strand_memberD[OF T(6)[unfolded b']]
               wellformed_transaction_cases[OF T_wf(1)]
         unfolding b' by blast
 
       have "\<exists>n. tb = \<langle>n: value\<rangle>\<^sub>v" and *: "tb' = \<langle>d\<rangle>\<^sub>s"
         using tb tb' T(6) t(3) transaction_inserts_are_Value_vars[OF T_wf, of tb tb']
         unfolding b' unlabel_def by (force,force)
 
       have "is_Insert (snd b)" "the_set_term (snd b) = \<langle>d\<rangle>\<^sub>s" "the_elem_term (snd b) = tb"
         unfolding b' * by simp_all
       hence "transaction_send T \<noteq> []"
             "let (l, a) = hd (transaction_send T)
              in l = \<star> \<and> is_Send a \<and> \<langle>f [\<langle>c\<rangle>\<^sub>c, tb]\<rangle>\<^sub>t \<in> set (the_msgs a)"
         using P_d T(2) b by (fast,fast)
       hence "\<exists>ts. \<langle>\<star>,send\<langle>ts\<rangle>\<rangle> \<in> set (transaction_send T) \<and> \<langle>f [\<langle>c\<rangle>\<^sub>c, tb]\<rangle>\<^sub>t \<in> set ts"
         unfolding is_Send_def by (cases "transaction_send T") auto
       then obtain ts where ts: "\<langle>\<star>,send\<langle>ts\<rangle>\<rangle> \<in> set (transaction_strand T)" "\<langle>f [\<langle>c\<rangle>\<^sub>c, tb]\<rangle>\<^sub>t \<in> set ts"
         unfolding transaction_strand_def by auto
       
       have "\<langle>\<star>,receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<rangle> \<in> set A" "\<langle>f [\<langle>c\<rangle>\<^sub>c, t]\<rangle>\<^sub>t \<in> set (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)"
         using subst_lsst_memI[OF ts(1), of \<theta>] subst_set_map[OF ts(2), of \<theta>]
               dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(1)[of \<star> "ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>" "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
               set_mono_prefix[OF T(1)[unfolded \<theta>_def[symmetric]]]
         unfolding tb by auto
       hence "\<langle>f [\<langle>c\<rangle>\<^sub>c, k]\<rangle>\<^sub>t \<in> \<Union>{set ts |ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)}"
         using t(2) subst_lsst_memI[of "\<langle>\<star>,receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<rangle>" A I] by force
       thus False
         using A(2) unfolding declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
     qed
 
     have "y' \<notin> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
       using y'' fv_ik_subset_vars_sst'[of "unlabel A"] by blast 
     hence 1: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J"
       unfolding J_def by (metis (no_types, lifting) fv_subset image_cong in_mono repl_invariance)
 
     have "(k,\<langle>d\<rangle>\<^sub>s) \<notin> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I {}"
       using 0 db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel A" I "[]"]
       unfolding db\<^sub>s\<^sub>s\<^sub>t_def by force
     hence "(k,\<langle>d\<rangle>\<^sub>s) \<notin> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) J {}"
       using y'' vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel A"]
             db\<^sub>s\<^sub>s\<^sub>t_subst_swap[of "unlabel A" I J "[]"]
             db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel A" _ "[]"]
       unfolding db\<^sub>s\<^sub>s\<^sub>t_def J_def by (metis (no_types, lifting) Un_iff empty_set fun_upd_other)
     hence "((Var y' \<cdot> J, \<langle>d\<rangle>\<^sub>s \<cdot> J) \<notin> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) J {})"
       unfolding J_def fk by simp
     hence "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J) (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) J {})
             (unlabel [\<langle>n, \<langle>Var y' not in \<langle>d\<rangle>\<^sub>s\<rangle>\<rangle>]) J"
       using stateful_strand_sem_NegChecks_no_bvars(1)[
               of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J" "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) J {}" "Var y'" "\<langle>d\<rangle>\<^sub>s" J]
       by simp
     hence 2: "strand_sem_stateful {} {} (unlabel (A@[\<langle>n, \<langle>Var y' not in \<langle>d\<rangle>\<^sub>s\<rangle>\<rangle>])) J"
       using A'' y' y'' vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel A"]
             strand_sem_append_stateful[
               of "{}" "{}" "unlabel A" "unlabel [\<langle>n, \<langle>Var y' not in \<langle>d\<rangle>\<^sub>s\<rangle>\<rangle>]" J]
       unfolding J_def by simp
 
     have B: "B \<in> reachable_constraints P"
       using reachable_constraints.step[OF A(1) P_Tatt _ _ \<alpha>, of Var Var]
       unfolding B_def Tatt_def transaction_decl_subst_def transaction_fresh_subst_def by simp
 
     have Tatt': "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand Tatt \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<alpha>) =
                   [\<langle>\<star>, send\<langle>[occurs (Var y')]\<rangle>\<rangle>,
                    (l, send\<langle>[\<langle>f [\<langle>c\<rangle>\<^sub>c, Var y']\<rangle>\<^sub>t]\<rangle>),
                    (l', \<langle>Var y' not in \<langle>d\<rangle>\<^sub>s\<rangle>),
                    \<langle>n, receive\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>]"
       using y'
       unfolding Tatt_def transaction_strand_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def
       by auto
 
     have J: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t J" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t J" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range J)"
       unfolding J_def
       subgoal using wt_subst_subst_upd[OF I(1)] k(1) y'(3) by simp 
       subgoal by (metis I(2) k(2) fun_upd_apply interpretation_grounds_all interpretation_substI)
       subgoal using I(3) k(3) by fastforce
       done
 
     have 3: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J \<turnstile> \<langle>f [\<langle>c\<rangle>\<^sub>c, Var y']\<rangle>\<^sub>t \<cdot> J"
       using 1 fk fk' unfolding J_def by auto
 
     have 4: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J \<turnstile> occurs (Var y') \<cdot> J"
       using reachable_constraints_occurs_fact_ik_case'[
                 OF A(1) P(1,2) constraint_model_Val_const_in_constr_prefix'[
                                 OF A(1) A' P(1) k_in_ik[unfolded fk kn]]]
             intruder_deduct.Axiom[of "occurs k" "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J"]
       unfolding J_def fk kn by fastforce
 
     have "strand_sem_stateful {} {} (unlabel A) J"
       using 2 strand_sem_append_stateful by force
     hence "strand_sem_stateful {} {}
             (unlabel (A@[\<langle>\<star>, send\<langle>[occurs (Var y')]\<rangle>\<rangle>,
                          \<langle>n, send\<langle>[\<langle>f [\<langle>c\<rangle>\<^sub>c, Var y']\<rangle>\<^sub>t]\<rangle>\<rangle>,
                          \<langle>n, \<langle>Var y' not in \<langle>d\<rangle>\<^sub>s\<rangle>\<rangle>])) J"
       using 2 3 4 strand_sem_append_stateful[of "{}" "{}" _ _ J]
       unfolding unlabel_def ik\<^sub>s\<^sub>s\<^sub>t_def by force
     hence "strand_sem_stateful {} {} (unlabel (B@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])) J"
       using strand_sem_receive_send_append[of "{}" "{}" _ J "attack\<langle>ln n\<rangle>"]
             strand_sem_append_stateful[of "{}" "{}" _ _ J]
       unfolding B_def Tatt' by simp
     hence "welltyped_constraint_model J (B@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])"
       using B J unfolding defs' by blast
     thus False using B(1) P_sec by blast
   qed
 qed
 
 lemma welltyped_leakage_free_short_term_secretI':
   fixes c x y f n d l l' \<tau>
   defines "s \<equiv> \<langle>f [\<langle>c\<rangle>\<^sub>c, Var (TAtom \<tau>,x)]\<rangle>\<^sub>t"
     and "Tatt \<equiv> Transaction (\<lambda>(). []) []
           [(l, receive\<langle>[\<langle>f [\<langle>c\<rangle>\<^sub>c, Var (TAtom \<tau>,y)]\<rangle>\<^sub>t]\<rangle>)]
           [(l', \<langle>Var (TAtom \<tau>,y) not in \<langle>d\<rangle>\<^sub>s\<rangle>)]
           []
           [\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>]"
   assumes P:
       "\<forall>T \<in> set P. wellformed_transaction T"
       "\<forall>T \<in> set P. \<forall>x \<in> set (unlabel (transaction_updates T)).
         is_Update x \<longrightarrow> is_Fun (the_set_term x)"
     and subterms_sec:
       "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>\<star>, send\<langle>[\<langle>c\<rangle>\<^sub>c]\<rangle>\<rangle>])"
     and P_sec:
       "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>\<^sub>\<tau>.
         welltyped_constraint_model \<I>\<^sub>\<tau> (\<A>@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])"
     and P_Tatt: "Tatt \<in> set P"
     and P_d:
       "\<forall>T \<in> set P. \<forall>a \<in> set (transaction_updates T).
         is_Insert (snd a) \<and> the_set_term (snd a) = \<langle>d\<rangle>\<^sub>s \<longrightarrow>
           transaction_send T \<noteq> [] \<and> (let (l,b) = hd (transaction_send T)
             in l = \<star> \<and> is_Send b \<and> \<langle>f [\<langle>c\<rangle>\<^sub>c, the_elem_term (snd a)]\<rangle>\<^sub>t \<in> set (the_msgs b))"
   shows "welltyped_leakage_free_protocol [s] P"
 proof -
   define Q where "Q \<equiv> \<lambda>M 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>) = {}"
   define Sec where "Sec \<equiv> {t \<cdot> \<delta> | t \<delta>. Q (set [s]) t \<delta>} - {m. {} \<turnstile>\<^sub>c m}"
 
   define f' where "f' \<equiv> \<lambda>(T,\<xi>,\<sigma>::('fun,'atom,'sets,'lbl) prot_subst,\<alpha>).
                             dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)"
   define g' where "g' \<equiv> concat \<circ> map f'"
 
   note defs = Sec_def Q_def
   note defs' = welltyped_constraint_model_def constraint_model_def
 
   show ?thesis
   proof (rule ccontr)
     assume "\<not>welltyped_leakage_free_protocol [s] P"
     then obtain A I k where A:
         "A \<in> reachable_constraints P" "\<langle>f [\<langle>c\<rangle>\<^sub>c, k]\<rangle>\<^sub>t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I"
         "welltyped_constraint_model I (A@[\<langle>\<star>, send\<langle>[\<langle>f [\<langle>c\<rangle>\<^sub>c, k]\<rangle>\<^sub>t]\<rangle>\<rangle>])"
       unfolding welltyped_leakage_free_protocol_def defs s_def by fastforce
 
     have I: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
       using A(3) unfolding defs' by (blast,blast,blast)
 
     note A' = welltyped_constraint_model_prefix[OF A(3)]
 
     have "strand_sem_stateful {} {} (unlabel A) I"
       using A' unfolding defs' by simp
     hence A'': "strand_sem_stateful {} {} (unlabel A) (I(z := k))"
       when z: "z \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" for z
       using z strand_sem_model_swap[of "unlabel A" I "I(z := k)" "{}" "{}"] by auto
 
     obtain \<delta> where \<delta>:
         "\<delta> (TAtom \<tau>,x) = k" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "fv (\<delta> (TAtom \<tau>,x)) = {}"
       using A(2) unfolding defs s_def by auto
     
     have k: "\<Gamma> k = TAtom \<tau>" "fv k = {}" "wf\<^sub>t\<^sub>r\<^sub>m k"
       subgoal using \<delta>(1) wt_subst_trm''[OF \<delta>(2), of "Var (TAtom \<tau>,x)"] by simp
       subgoal using \<delta>(1,4) by blast
       subgoal using \<delta>(1,3) by force
       done
     then obtain fk where fk: "k = Fun fk []"
       using const_type_inv_wf by (cases k) auto
 
     have fk': "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> \<langle>f [\<langle>c\<rangle>\<^sub>c, k]\<rangle>\<^sub>t"
       using fk welltyped_constraint_model_deduct_split(2)[OF A(3)] by auto
 
     obtain \<alpha>::"('fun,'atom,'sets,'lbl) prot_subst"
       where \<alpha>: "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
       unfolding transaction_renaming_subst_def by blast
 
     obtain y' yn' where y': "\<alpha> (TAtom \<tau>,y) = Var y'" "y \<noteq> yn'" "y' = (TAtom \<tau>,yn')"
       using transaction_renaming_subst_is_renaming(1,2)[OF \<alpha>] by force
 
     define B where "B \<equiv> A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand Tatt \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<alpha>)"
     define J where "J \<equiv> I(y' := k)"
 
     have "y' \<in> range_vars \<alpha>"
       using y'(1) transaction_renaming_subst_is_renaming(3)[OF \<alpha>]
       by (metis (no_types, lifting) in_mono subst_fv_imgI term.set_intros(3))
     hence y'': "y' \<notin> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
       using transaction_renaming_subst_vars_disj(6)[OF \<alpha>] by blast
 
     have 0: "(k,\<langle>d\<rangle>\<^sub>s) \<notin> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I)"
     proof
       assume a: "(k,\<langle>d\<rangle>\<^sub>s) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I)"
       obtain l t t' where t: "(l,insert\<langle>t,t'\<rangle>) \<in> set A" "t \<cdot> I = k" "t' \<cdot> I = \<langle>d\<rangle>\<^sub>s"
         using db\<^sub>s\<^sub>s\<^sub>t_in_cases[OF a[unfolded db\<^sub>s\<^sub>s\<^sub>t_def]] unfolding unlabel_def by auto
 
       obtain T b B \<alpha> \<sigma> \<xi> where T:
           "prefix (B@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>)) A"
           "T \<in> set P" "transaction_decl_subst \<xi> T"
           "transaction_fresh_subst \<sigma> T (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" "transaction_renaming_subst \<alpha> P (vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
           "b \<in> set (transaction_strand T)" "(l, insert\<langle>t,t'\<rangle>) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
           "fst (l, insert\<langle>t,t'\<rangle>) = fst b"
         using reachable_constraints_transaction_action_obtain[OF A(1) t(1)] by metis
 
       define \<theta> where "\<theta> \<equiv> \<xi> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<alpha>"
 
       obtain b' where "b = (l,b')"
         using T(8) by (cases b) simp
       then obtain tb tb'
           where b': "b = (l,insert\<langle>tb,tb'\<rangle>)"
             and tb: "t = tb \<cdot> \<theta>"
             and tb': "t' = tb' \<cdot> \<theta>"
         using T(7) unfolding \<theta>_def by (cases b') auto
 
       note T_wf = bspec[OF P(1) T(2)] bspec[OF P(2) T(2)]
 
       have b: "b \<in> set (transaction_updates T)"
         using transaction_strand_memberD[OF T(6)[unfolded b']]
               wellformed_transaction_cases[OF T_wf(1)]
         unfolding b' by blast
 
       have "is_Fun tb'"
         using bspec[OF P(2) T(2)]
               wellformed_transaction_strand_unlabel_memberD(6)[
                     OF T_wf(1) unlabel_in[OF T(6)[unfolded b']]]
         by fastforce
       hence *: "tb' = \<langle>d\<rangle>\<^sub>s"
         using t(3) unfolding b' tb' by force
 
       have "is_Insert (snd b)" "the_set_term (snd b) = \<langle>d\<rangle>\<^sub>s" "the_elem_term (snd b) = tb"
         unfolding b' * by simp_all
       hence "transaction_send T \<noteq> []"
             "let (l, a) = hd (transaction_send T)
              in l = \<star> \<and> is_Send a \<and> \<langle>f [\<langle>c\<rangle>\<^sub>c, tb]\<rangle>\<^sub>t \<in> set (the_msgs a)"
         using P_d T(2) b by (fast,fast)
       hence "\<exists>ts. \<langle>\<star>,send\<langle>ts\<rangle>\<rangle> \<in> set (transaction_send T) \<and> \<langle>f [\<langle>c\<rangle>\<^sub>c, tb]\<rangle>\<^sub>t \<in> set ts"
         unfolding is_Send_def by (cases "transaction_send T") auto
       then obtain ts where ts: "\<langle>\<star>,send\<langle>ts\<rangle>\<rangle> \<in> set (transaction_strand T)" "\<langle>f [\<langle>c\<rangle>\<^sub>c, tb]\<rangle>\<^sub>t \<in> set ts"
         unfolding transaction_strand_def by auto
       
       have "\<langle>\<star>,receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<rangle> \<in> set A" "\<langle>f [\<langle>c\<rangle>\<^sub>c, t]\<rangle>\<^sub>t \<in> set (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)"
         using subst_lsst_memI[OF ts(1), of \<theta>] subst_set_map[OF ts(2), of \<theta>]
               dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(1)[of \<star> "ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>" "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
               set_mono_prefix[OF T(1)[unfolded \<theta>_def[symmetric]]]
         unfolding tb by auto
       hence "\<langle>f [\<langle>c\<rangle>\<^sub>c, k]\<rangle>\<^sub>t \<in> \<Union>{set ts |ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)}"
         using t(2) subst_lsst_memI[of "\<langle>\<star>,receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<rangle>" A I] by force
       thus False
         using A(2) unfolding declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
     qed
 
     have "y' \<notin> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
       using y'' fv_ik_subset_vars_sst'[of "unlabel A"] by blast 
     hence 1: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J"
       unfolding J_def by (metis (no_types, lifting) fv_subset image_cong in_mono repl_invariance)
 
     have "(k,\<langle>d\<rangle>\<^sub>s) \<notin> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) I {}"
       using 0 db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel A" I "[]"]
       unfolding db\<^sub>s\<^sub>s\<^sub>t_def by force
     hence "(k,\<langle>d\<rangle>\<^sub>s) \<notin> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) J {}"
       using y'' vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel A"]
             db\<^sub>s\<^sub>s\<^sub>t_subst_swap[of "unlabel A" I J "[]"]
             db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel A" _ "[]"]
       unfolding db\<^sub>s\<^sub>s\<^sub>t_def J_def by (metis (no_types, lifting) Un_iff empty_set fun_upd_other)
     hence "((Var y' \<cdot> J, \<langle>d\<rangle>\<^sub>s \<cdot> J) \<notin> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) J {})"
       unfolding J_def fk by simp
     hence "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J) (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) J {})
             (unlabel [\<langle>n, \<langle>Var y' not in \<langle>d\<rangle>\<^sub>s\<rangle>\<rangle>]) J"
       using stateful_strand_sem_NegChecks_no_bvars(1)[
               of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J" "dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel A) J {}" "Var y'" "\<langle>d\<rangle>\<^sub>s" J]
       by simp
     hence 2: "strand_sem_stateful {} {} (unlabel (A@[\<langle>n, \<langle>Var y' not in \<langle>d\<rangle>\<^sub>s\<rangle>\<rangle>])) J"
       using A'' y' y'' vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel A"]
             strand_sem_append_stateful[
               of "{}" "{}" "unlabel A" "unlabel [\<langle>n, \<langle>Var y' not in \<langle>d\<rangle>\<^sub>s\<rangle>\<rangle>]" J]
       unfolding J_def by simp
 
     have B: "B \<in> reachable_constraints P"
       using reachable_constraints.step[OF A(1) P_Tatt _ _ \<alpha>, of Var Var]
       unfolding B_def Tatt_def transaction_decl_subst_def transaction_fresh_subst_def by simp
 
     have Tatt': "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand Tatt \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<alpha>) =
                   [(l, send\<langle>[\<langle>f [\<langle>c\<rangle>\<^sub>c, Var y']\<rangle>\<^sub>t]\<rangle>),
                    (l', \<langle>Var y' not in \<langle>d\<rangle>\<^sub>s\<rangle>),
                    \<langle>n, receive\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>]"
       using y'
       unfolding Tatt_def transaction_strand_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def
       by auto
 
     have J: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t J" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t J" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range J)"
       unfolding J_def
       subgoal using wt_subst_subst_upd[OF I(1)] k(1) y'(3) by simp 
       subgoal by (metis I(2) k(2) fun_upd_apply interpretation_grounds_all interpretation_substI)
       subgoal using I(3) k(3) by fastforce
       done
 
     have 3: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t J \<turnstile> \<langle>f [\<langle>c\<rangle>\<^sub>c, Var y']\<rangle>\<^sub>t \<cdot> J"
       using 1 fk fk' unfolding J_def by auto
 
     have "strand_sem_stateful {} {} (unlabel A) J"
       using 2 strand_sem_append_stateful by force
     hence "strand_sem_stateful {} {}
             (unlabel (A@[\<langle>n, send\<langle>[\<langle>f [\<langle>c\<rangle>\<^sub>c, Var y']\<rangle>\<^sub>t]\<rangle>\<rangle>,
                          \<langle>n, \<langle>Var y' not in \<langle>d\<rangle>\<^sub>s\<rangle>\<rangle>])) J"
       using 2 3 strand_sem_append_stateful[of "{}" "{}" _ _ J]
       unfolding unlabel_def ik\<^sub>s\<^sub>s\<^sub>t_def by force
     hence "strand_sem_stateful {} {} (unlabel (B@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])) J"
       using strand_sem_receive_send_append[of "{}" "{}" _ J "attack\<langle>ln n\<rangle>"]
             strand_sem_append_stateful[of "{}" "{}" _ _ J]
       unfolding B_def Tatt' by simp
     hence "welltyped_constraint_model J (B@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])"
       using B J unfolding defs' by blast
     thus False using B(1) P_sec by blast
   qed
 qed
 
 definition welltyped_leakage_free_invkey_conditions' where
   "welltyped_leakage_free_invkey_conditions' invfun privfunsec declassifiedset S n P \<equiv>
     let f = \<lambda>s. is_Var s \<and> fst (the_Var s) = TAtom Value;
         g = \<lambda>s. is_Fun s \<and> args s = [] \<and> is_Set (the_Fun s) \<and>
                 arity\<^sub>s (the_Set (the_Fun s)) = 0;
         h = \<lambda>s. is_Fun s \<and> args s = [] \<and> is_Fu (the_Fun s) \<and>
                 public\<^sub>f (the_Fu (the_Fun s)) \<and> arity\<^sub>f (the_Fu (the_Fun s)) = 0
     in (\<forall>s\<in>set S.
           f s \<or>
           (is_Fun s \<and> the_Fun s = Pair \<and> length (args s) = 2 \<and> g (args s ! 1)) \<or>
           g s \<or> h s \<or> s = \<langle>privfunsec\<rangle>\<^sub>c \<or> s = Fun OccursSec [] \<or>
           (is_Fun s \<and> the_Fun s = OccursFact \<and> length (args s) = 2 \<and>
            args s ! 0 = Fun OccursSec []) \<or>
           (is_Fun s \<and> the_Fun s = Fu invfun \<and> length (args s) = 2 \<and>
            args s ! 0 = \<langle>privfunsec\<rangle>\<^sub>c \<and> f (args s ! 1)) \<or>
           (is_Fun s \<and> is_Fu (the_Fun s) \<and> fv s = {} \<and>
            Transaction (\<lambda>(). []) [] [\<langle>n, receive\<langle>[s]\<rangle>\<rangle>] [] [] [\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>]\<in>set P)) \<and>
        (\<not>public\<^sub>f privfunsec \<and> arity\<^sub>f privfunsec = 0 \<and> \<Gamma>\<^sub>f privfunsec \<noteq> None) \<and>
        (\<forall>T\<in>set P. transaction_fresh T \<noteq> [] \<longrightarrow>
          transaction_send T \<noteq> [] \<and>
          (let (l, a) = hd (transaction_send T)
           in l = \<star> \<and> is_Send a \<and> Var ` set (transaction_fresh T) \<subseteq> set (the_msgs a))) \<and>
        (\<forall>T\<in>set P. \<forall>x\<in>vars_transaction T. is_Var (\<Gamma>\<^sub>v x)) \<and>
        (\<forall>T\<in>set P. \<forall>x\<in>set (transaction_fresh T). \<Gamma>\<^sub>v x = Var Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = \<langle>a\<rangle>\<^sub>\<tau>\<^sub>a)) \<and>
        (\<forall>T\<in>set P. \<forall>f\<in>\<Union>(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). \<not>is_Set f) \<and>
        (\<forall>T\<in>set P. \<forall>r\<in>set (transaction_send T).
           OccursFact \<in> \<Union>(funs_term ` trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd r)) \<longrightarrow> has_LabelS r) \<and>
        (\<forall>T\<in>set P. \<forall>t\<in>subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)).
           \<langle>privfunsec\<rangle>\<^sub>c \<notin> set (snd (Ana t))) \<and>
        (\<forall>T\<in>set P. \<langle>privfunsec\<rangle>\<^sub>c \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<and>
        (\<forall>T\<in>set P. \<forall>a\<in>set (transaction_updates T).
             is_Insert (snd a) \<and> the_set_term (snd a) = \<langle>declassifiedset\<rangle>\<^sub>s \<longrightarrow>
               transaction_send T \<noteq> [] \<and>
               (let (l, b) = hd (transaction_send T)
                in l = \<star> \<and> is_Send b \<and>
                   \<langle>invfun [\<langle>privfunsec\<rangle>\<^sub>c, the_elem_term (snd a)]\<rangle>\<^sub>t \<in> set (the_msgs b)))"
 
 definition welltyped_leakage_free_invkey_conditions where
   "welltyped_leakage_free_invkey_conditions invfun privfunsec declassifiedset S n P \<equiv>
     let Tatt = \<lambda>R. Transaction (\<lambda>(). []) []
                     (R@[\<langle>n, receive\<langle>[\<langle>invfun [\<langle>privfunsec\<rangle>\<^sub>c, \<langle>0: value\<rangle>\<^sub>v]\<rangle>\<^sub>t]\<rangle>\<rangle>])
                     [\<langle>\<star>, \<langle>\<langle>0: value\<rangle>\<^sub>v not in \<langle>declassifiedset\<rangle>\<^sub>s\<rangle>\<rangle>]
                     []
                     [\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>]
     in welltyped_leakage_free_invkey_conditions' invfun privfunsec declassifiedset S n P \<and>
        has_initial_value_producing_transaction P \<and>
        (if Tatt [\<langle>\<star>, receive\<langle>[occurs \<langle>0: value\<rangle>\<^sub>v]\<rangle>\<rangle>] \<in> set P
         then \<forall>T\<in>set P. admissible_transaction' T \<and> admissible_transaction_occurs_checks T
         else Tatt [] \<in> set P \<and>
              (\<forall>T\<in>set P. wellformed_transaction T) \<and>
              (\<forall>T\<in>set P. admissible_transaction_terms T) \<and>
              (\<forall>T\<in>set P. bvars_transaction T = {}) \<and>
              (\<forall>T\<in>set P. transaction_decl T () = []) \<and>
              (\<forall>T\<in>set P. \<forall>x\<in>set (transaction_fresh T). let \<tau> = fst x
                 in \<tau> = TAtom Value \<and> \<tau> \<noteq> \<Gamma> \<langle>privfunsec\<rangle>\<^sub>c) \<and>
              (\<forall>T\<in>set P. \<forall>x\<in>vars_transaction T. let \<tau> = fst x
                 in is_Var \<tau> \<and> (the_Var \<tau> = Value \<or> is_Atom (the_Var \<tau>)) \<and> \<tau> \<noteq> \<Gamma> \<langle>privfunsec\<rangle>\<^sub>c) \<and>
              (\<forall>T\<in>set P. \<forall>t\<in>subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)).
                 Fun OccursSec [] \<notin> set (snd (Ana t))) \<and>
              (\<forall>T\<in>set P. Fun OccursSec [] \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<and>
              (\<forall>T\<in>set P. \<forall>x\<in>set (unlabel (transaction_updates T)).
                 is_Update x \<longrightarrow> is_Fun (the_set_term x)) \<and>
              (\<forall>s\<in>set S. is_Fun s \<longrightarrow> the_Fun s \<noteq> OccursFact))"
 
 lemma welltyped_leakage_free_invkeyI:
   assumes P_wt_secure: "\<forall>\<A> \<in> reachable_constraints P.
                          \<nexists>\<I>. welltyped_constraint_model \<I> (\<A>@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])"
     and a: "welltyped_leakage_free_invkey_conditions invfun privsec declassset S n P"
   shows "welltyped_leakage_free_protocol S P"
 proof -
   let ?Tatt' = "\<lambda>R C. Transaction (\<lambda>(). []) [] R C [] [\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>]
                         ::('fun,'atom,'sets,'lbl) prot_transaction"
   let ?Tatt = "\<lambda>R. ?Tatt' (R@[\<langle>n, receive\<langle>[\<langle>invfun [\<langle>privsec\<rangle>\<^sub>c, \<langle>0: value\<rangle>\<^sub>v]\<rangle>\<^sub>t]\<rangle>\<rangle>])
                           [\<langle>\<star>, \<langle>\<langle>0: value\<rangle>\<^sub>v not in \<langle>declassset\<rangle>\<^sub>s\<rangle>\<rangle>]"
   
   define Tatt1 where "Tatt1 \<equiv> ?Tatt [\<langle>\<star>, receive\<langle>[occurs \<langle>0: value\<rangle>\<^sub>v]\<rangle>\<rangle>]"
   define Tatt2 where "Tatt2 \<equiv> ?Tatt []"
   define Tatt_lts where "Tatt_lts \<equiv> \<lambda>s. ?Tatt' [\<langle>n, receive\<langle>[s]\<rangle>\<rangle>] []"
 
   note defs = welltyped_leakage_free_invkey_conditions_def Let_def
 
   note defs' = defs welltyped_leakage_free_invkey_conditions'_def
 
   note Tatts = Tatt1_def Tatt2_def Tatt_lts_def
 
   obtain at where 0: "\<not>public\<^sub>f privsec" "arity\<^sub>f privsec = 0" "\<Gamma>\<^sub>f privsec = Some at"
     using a unfolding defs' by fast
 
   have *: "\<forall>T\<in>set P. admissible_transaction' T" "\<forall>T\<in>set P. admissible_transaction_occurs_checks T"
     when "Tatt1 \<in> set P"
     using a that unfolding defs Tatts by (meson,meson)
 
   have **: "Tatt1 \<in> set P \<or> Tatt2 \<in> set P" using a unfolding defs Tatts by argo
 
   have ***:
     "\<forall>T\<in>set P. \<forall>x\<in>set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<and> \<Gamma>\<^sub>v x \<noteq> \<Gamma> \<langle>privsec\<rangle>\<^sub>c"
     "\<forall>T\<in>set P. \<forall>x\<in>vars_transaction T. \<exists>a. \<Gamma>\<^sub>v x = TAtom a \<and>
           (a = Value \<or> (\<exists>b. a = Atom b)) \<and> TAtom a \<noteq> \<Gamma> \<langle>privsec\<rangle>\<^sub>c"
     when "Tatt1 \<notin> set P"
     subgoal using a that \<Gamma>\<^sub>v_TAtom''(2) unfolding defs Tatts by metis
     subgoal
       using a that \<Gamma>\<^sub>v_TAtom''(1,2)
       unfolding defs Tatts[symmetric] is_Atom_def is_Var_def by fastforce
     done
 
   have ****: "s \<noteq> occurs x"
     when "Tatt1 \<notin> set P" "s \<in> set S" for s x
     using a that ** unfolding defs Tatts the_Fun_def by fastforce
 
   have 1:
       "\<forall>T\<in>set P. transaction_fresh T \<noteq> [] \<longrightarrow>
         transaction_send T \<noteq> [] \<and>
         (let (l, a) = hd (transaction_send T)
          in l = \<star> \<and> is_Send a \<and> Var ` set (transaction_fresh T) \<subseteq> set (the_msgs a))"
       "\<forall>T\<in>set P. \<forall>x\<in>vars_transaction T. is_Var (\<Gamma>\<^sub>v x)"
       "\<forall>T\<in>set P. \<forall>x\<in>set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = \<langle>a\<rangle>\<^sub>\<tau>\<^sub>a)"
       "\<forall>T\<in>set P. \<forall>f\<in>\<Union>(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). \<not>is_Set f"
       "\<forall>T\<in>set P. \<forall>r\<in>set (transaction_send T).
         OccursFact \<in> \<Union>(funs_term ` trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd r)) \<longrightarrow> has_LabelS r"
       "\<forall>T\<in>set P. \<forall>t\<in>subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). \<langle>privsec\<rangle>\<^sub>c \<notin> set (snd (Ana t))"
       "\<forall>T\<in>set P. \<langle>privsec\<rangle>\<^sub>c \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
       "\<forall>T\<in>set P. \<forall>a\<in>set (transaction_updates T).
         is_Insert (snd a) \<and> the_set_term (snd a) = \<langle>declassset\<rangle>\<^sub>s \<longrightarrow>
         transaction_send T \<noteq> [] \<and>
         (let (l, b) = hd (transaction_send T)
          in l = \<star> \<and> is_Send b \<and>
             \<langle>invfun [\<langle>privsec\<rangle>\<^sub>c, the_elem_term (snd a)]\<rangle>\<^sub>t \<in> set (the_msgs b))"
     using a unfolding defs' by (meson,meson,meson,meson,meson,meson,meson,meson)
 
   have 2:
       "\<forall>T\<in>set P. wellformed_transaction T"
       "\<forall>T\<in>set P. \<forall>x\<in>vars_transaction T \<union> set (transaction_fresh T). \<Gamma> \<langle>privsec\<rangle>\<^sub>c \<noteq> \<Gamma>\<^sub>v x"
       "\<forall>T\<in>set P. admissible_transaction_terms T"
       "\<forall>T\<in>set P. \<forall>x\<in>set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
       "\<forall>T\<in>set P. transaction_decl T () = []"
       "\<forall>T\<in>set P. \<forall>x\<in>vars_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = \<langle>a\<rangle>\<^sub>\<tau>\<^sub>a)"
       "\<forall>T\<in>set P. \<forall>x\<in>vars_transaction T \<union> set (transaction_fresh T). \<Gamma>\<^sub>v x \<noteq> TAtom SetType"
       "\<forall>T\<in>set P. \<forall>x\<in>vars_transaction T \<union> set (transaction_fresh T). \<Gamma>\<^sub>v x \<noteq> TAtom OccursSecType"
       "\<forall>T\<in>set P. \<forall>t\<in>subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). Fun OccursSec [] \<notin> set (snd (Ana t))"
       "\<forall>T\<in>set P. Fun OccursSec [] \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
       "\<forall>T\<in>set P. bvars_transaction T = {}"
       "\<forall>T\<in>set P. \<forall>x\<in>set (unlabel (transaction_updates T)). is_Update x \<longrightarrow> is_Fun (the_set_term x)"
     subgoal using a * unfolding defs by (metis admissible_transaction_is_wellformed_transaction(1))
     subgoal
       apply (cases "Tatt1 \<in> set P")
       subgoal using a * admissible_transactionE(2,3) \<Gamma>_Fu_simps(4) unfolding defs Tatts by force
       subgoal using a \<Gamma>_Fu_simps(4) unfolding defs Tatts by fastforce
       done
     subgoal using a * admissible_transaction_is_wellformed_transaction(4) unfolding defs by metis
     subgoal using a * admissible_transactionE(2) unfolding defs Tatts[symmetric] by fastforce
     subgoal using a * admissible_transactionE(1) unfolding defs Tatts[symmetric] by metis
     subgoal using * *** admissible_transactionE(3) by fast
     subgoal using * *** admissible_transactionE(2,3) by (cases "Tatt1 \<in> set P") (force, fastforce)
     subgoal using * *** admissible_transactionE(2,3) by (cases "Tatt1 \<in> set P") (force, fastforce)
     subgoal using a * admissible_transaction_occurs_checksE6 unfolding defs by metis
     subgoal using a * admissible_transaction_occurs_checksE5 unfolding defs by metis
     subgoal
       using a * admissible_transaction_no_bvars(2)
       unfolding defs Tatts[symmetric] by fastforce
     subgoal
       using a * admissible_transaction_is_wellformed_transaction(3)
       unfolding defs Tatts[symmetric] admissible_transaction_updates_def by fastforce
     done
 
   have Tatt_lts_case:
       "\<exists>\<theta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> inj_on \<theta> (fv s) \<and> \<theta> ` fv s \<subseteq> range Var \<and>
            ?Tatt' [\<langle>n, receive\<langle>[s \<cdot> \<theta>]\<rangle>\<rangle>] [] \<in> set P"
     when s: "fv s = {}" "Tatt_lts s \<in> set P" for s
   proof -
     have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" "inj_on Var (fv s)" "Var ` fv s \<subseteq> range Var" "s \<cdot> Var = s"
       using s(1) by simp_all
     thus ?thesis using s(2) unfolding Tatts by metis
   qed
 
   have Tatt1_case:
       "?Tatt' [\<langle>\<star>, receive\<langle>[occurs \<langle>0: value\<rangle>\<^sub>v]\<rangle>\<rangle>, \<langle>n, receive\<langle>[\<langle>invfun [\<langle>privsec\<rangle>\<^sub>c, \<langle>0: value\<rangle>\<^sub>v]\<rangle>\<^sub>t]\<rangle>\<rangle>] 
               [\<langle>\<star>, \<langle>\<langle>0: value\<rangle>\<^sub>v not in \<langle>declassset\<rangle>\<^sub>s\<rangle>\<rangle>] \<in> set P"
       when "Tatt1 \<in> set P"
     using that unfolding Tatts by auto
 
   have Tatt2_case:
       "?Tatt' [\<langle>n, receive\<langle>[\<langle>invfun [\<langle>privsec\<rangle>\<^sub>c, \<langle>0: value\<rangle>\<^sub>v]\<rangle>\<^sub>t]\<rangle>\<rangle>] 
               [\<langle>\<star>, \<langle>\<langle>0: value\<rangle>\<^sub>v not in \<langle>declassset\<rangle>\<^sub>s\<rangle>\<rangle>] \<in> set P"
     when "Tatt2 \<in> set P"
     using that unfolding Tatts by auto
 
   note 3 = pair_def case_prod_conv
   note 4 = welltyped_leakage_free_priv_constI'[OF 0(1-3) 2(1,2) 1(2,3,6,7)]
   note 5 = welltyped_leakage_free_setop_pairI[OF 2(1,6) 1(4) 2(4,5,3), unfolded 3]
            welltyped_leakage_free_set_constI(2)[OF 2(1) 1(4) 2(7) 1(2,3), unfolded 3]
            welltyped_leakage_free_pub_constI
            4(2)
            welltyped_leakage_free_occurssec_constI(2)[OF 2(1,8-10) 1(2,3)]
            welltyped_leakage_free_value_constI[OF 2(1,3,5,11) 1(1)]
            welltyped_leakage_free_short_term_secretI'[
              OF 2(1,12) 4(1) P_wt_secure Tatt2_case 1(8)]
 
            welltyped_leakage_free_long_term_secretI[OF P_wt_secure Tatt_lts_case]
 
            welltyped_leakage_free_short_term_secretI[
              OF * 1(3) 4(1) P_wt_secure Tatt1_case 1(8)]
            welltyped_leakage_free_occurs_factI[OF * 1(5)]
 
            ** ****
 
   have 6: "is_Fun s \<and> length (args s) = 2 \<longleftrightarrow> (\<exists>f t u. s = Fun f [t, u])"
     for s::"('fun,'atom,'sets,'lbl) prot_term"
     by auto
 
   define pubconst_cond where
     "pubconst_cond \<equiv> \<lambda>s::('fun,'atom,'sets,'lbl) prot_term.
       is_Fun s \<and> args s = [] \<and> is_Fu (the_Fun s) \<and>
       public\<^sub>f (the_Fu (the_Fun s)) \<and> arity\<^sub>f (the_Fu (the_Fun s)) = 0"
 
   define valuevar_cond where
     "valuevar_cond \<equiv> \<lambda>s::('fun,'atom,'sets,'lbl) prot_term.
       is_Var s \<and> fst (the_Var s) = TAtom Value"
 
   define setconst_cond where
     "setconst_cond \<equiv> \<lambda>s::('fun,'atom,'sets,'lbl) prot_term.
       is_Fun s \<and> args s = [] \<and> is_Set (the_Fun s) \<and> arity\<^sub>s (the_Set (the_Fun s)) = 0"
 
   define setop_pair_cond where
     "setop_pair_cond \<equiv> \<lambda>s. 
       is_Fun s \<and> the_Fun s = Pair \<and> length (args s) = 2 \<and> setconst_cond (args s ! 1)"
 
   define occursfact_cond where
     "occursfact_cond \<equiv> \<lambda>s::('fun,'atom,'sets,'lbl) prot_term.
       is_Fun s \<and> the_Fun s = OccursFact \<and> length (args s) = 2 \<and>
       args s ! 0 = Fun OccursSec []"
 
   define invkey_cond where
     "invkey_cond \<equiv> \<lambda>s.
       is_Fun s \<and> the_Fun s = Fu invfun \<and> length (args s) = 2 \<and>
       args s ! 0 = \<langle>privsec\<rangle>\<^sub>c \<and> valuevar_cond (args s ! 1)"
 
   define ground_lts_cond where
     "ground_lts_cond \<equiv> \<lambda>s. is_Fun s \<and> is_Fu (the_Fun s) \<and> fv s = {} \<and> Tatt_lts s \<in> set P"
 
   note cond_defs =
     pubconst_cond_def valuevar_cond_def setconst_cond_def setop_pair_cond_def
     occursfact_cond_def invkey_cond_def ground_lts_cond_def
 
   have "(\<exists>m. s = \<langle>m: value\<rangle>\<^sub>v) \<longleftrightarrow> valuevar_cond s"
        "(\<exists>x c. arity\<^sub>s c = 0 \<and> s = Fun Pair [x, \<langle>c\<rangle>\<^sub>s]) \<longleftrightarrow> setop_pair_cond s"
        "(\<exists>c. arity\<^sub>s c = 0 \<and> s = \<langle>c\<rangle>\<^sub>s) \<longleftrightarrow> setconst_cond s"
        "(\<exists>c. public\<^sub>f c \<and> arity\<^sub>f c = 0 \<and> s = \<langle>c\<rangle>\<^sub>c) \<longleftrightarrow> pubconst_cond s"
        "(\<exists>x. s = occurs x) \<longleftrightarrow> occursfact_cond s"
        "(\<exists>x. s = \<langle>invfun [\<langle>privsec\<rangle>\<^sub>c, \<langle>x: value\<rangle>\<^sub>v]\<rangle>\<^sub>t) \<longleftrightarrow> invkey_cond s"
        "(\<exists>f ts. s = \<langle>f ts\<rangle>\<^sub>t \<and> fv s = {} \<and> Tatt_lts s \<in> set P) \<longleftrightarrow> ground_lts_cond s"
     for s::"('fun,'atom,'sets,'lbl) prot_term"
     unfolding is_Set_def the_Set_def is_Fu_def cond_defs
     by (fastforce,use 6[of s] in fastforce,fastforce,force,fastforce,fastforce,fastforce)
   moreover have
       "(\<forall>s \<in> set S. valuevar_cond s \<or> setop_pair_cond s \<or> setconst_cond s \<or> pubconst_cond s \<or>
                     s = \<langle>privsec\<rangle>\<^sub>c \<or> s = Fun OccursSec [] \<or> occursfact_cond s \<or> invkey_cond s \<or>
                     ground_lts_cond s) \<and>
        (\<not>public\<^sub>f privsec \<and> arity\<^sub>f privsec = 0 \<and> \<Gamma>\<^sub>f privsec \<noteq> None)"
     using a unfolding defs' cond_defs Tatts by meson
   ultimately have 7:
       "\<forall>s \<in> set S.
         (\<exists>x c. arity\<^sub>s c = 0 \<and> s = Fun Pair [x, \<langle>c\<rangle>\<^sub>s]) \<or>
         (\<exists>c. arity\<^sub>s c = 0 \<and> s = \<langle>c\<rangle>\<^sub>s) \<or>
         (\<exists>c. public\<^sub>f c \<and> arity\<^sub>f c = 0 \<and> s = \<langle>c\<rangle>\<^sub>c) \<or>
         s = \<langle>privsec\<rangle>\<^sub>c \<or> s = Fun OccursSec [] \<or>
         (\<exists>m. s = \<langle>m: value\<rangle>\<^sub>v) \<or>
         (\<exists>x. s = occurs x) \<or>
         (\<exists>x. s = \<langle>invfun [\<langle>privsec\<rangle>\<^sub>c, \<langle>x: value\<rangle>\<^sub>v]\<rangle>\<^sub>t) \<or>
         (\<exists>f ts. s = \<langle>f ts\<rangle>\<^sub>t \<and> fv s = {} \<and> Tatt_lts s \<in> set P)"
     unfolding Let_def by fastforce
 
   show ?thesis
     by (rule iffD2[OF welltyped_leakage_free_protocol_pointwise]; unfold list_all_iff; intro ballI)
        (use bspec[OF 7] 5 in blast)
 qed
 
 end
 
 end
 
 locale composable_stateful_protocols =
   pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
   for arity\<^sub>f::"'fun \<Rightarrow> nat"
     and arity\<^sub>s::"'sets \<Rightarrow> nat"
     and public\<^sub>f::"'fun \<Rightarrow> bool"
     and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets,nat) prot_fun, nat) term list \<times> nat list)"
     and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
     and label_witness1::"nat"
     and label_witness2::"nat"
   +
   fixes Pc::"('fun,'atom,'sets,nat) prot_transaction list"
     and Ps Ps_with_star_projs::"('fun,'atom,'sets,nat) prot_transaction list list"
     and Pc_SMP Sec_symbolic::"('fun,'atom,'sets,nat) prot_term list"
     and Ps_GSMPs::"(nat \<times> ('fun,'atom,'sets,nat) prot_term list) list"
   assumes Pc_def: "Pc = concat Ps"
     and Ps_with_star_projs_def: "let Pc' = Pc; L = [0..<length Ps] in
           Ps_with_star_projs = map (\<lambda>n. (map (transaction_proj n) Pc')) L \<and>
           set L = set (remdups (concat (
                           map (\<lambda>T. map (the_LabelN \<circ> fst)
                                        (filter (Not \<circ> has_LabelS) (transaction_strand T)))
                               Pc')))"
     and Pc_wellformed_composable:
           "list_all (list_all (Not \<circ> has_LabelS) \<circ> tl \<circ> transaction_send) Pc"
           "pm.wellformed_composable_protocols Ps Pc_SMP"
           "pm.wellformed_composable_protocols' Ps"
           "pm.composable_protocols Ps Ps_GSMPs Sec_symbolic"
 begin
 
 theorem composed_protocol_preserves_component_goals:
   assumes components_leakage_free:
       "list_all (pm.welltyped_leakage_free_protocol Sec_symbolic) Ps_with_star_projs"
     and n_def: "n < length Ps_with_star_projs"
     and P_def: "P = Ps_with_star_projs ! n"
     and P_welltyped_secure:
       "\<forall>\<A> \<in> pm.reachable_constraints P. \<nexists>\<I>.
           pm.welltyped_constraint_model \<I> (\<A>@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])"
   shows "\<forall>\<A> \<in> pm.reachable_constraints Pc. \<nexists>\<I>.
           pm.constraint_model \<I> (\<A>@[\<langle>n, send\<langle>[attack\<langle>ln n\<rangle>]\<rangle>\<rangle>])"
 proof -
   note 0 = Ps_with_star_projs_def[unfolded Let_def]
 
   have 1:
       "set Ps_with_star_projs =
           (\<lambda>n. map (transaction_proj n) Pc) `
             set (remdups (concat (map (\<lambda>T. map (the_LabelN \<circ> fst)
                                                (filter (Not \<circ> has_LabelS) (transaction_strand T)))
                                       Pc)))"
     by (metis (mono_tags, lifting) 0 image_set)
 
   have 2: "Ps_with_star_projs ! n = map (transaction_proj n) Pc"
     using conjunct1[OF 0] n_def by fastforce
 
   show ?thesis
     by (rule pm.composable_protocols_par_comp_prot'[
                   OF Pc_def 1 Pc_wellformed_composable
                      components_leakage_free 2 P_welltyped_secure[unfolded P_def]])
 qed
 
 end
 
 end
diff --git a/thys/First_Order_Terms/Subterm_and_Context.thy b/thys/First_Order_Terms/Subterm_and_Context.thy
--- a/thys/First_Order_Terms/Subterm_and_Context.thy
+++ b/thys/First_Order_Terms/Subterm_and_Context.thy
@@ -1,603 +1,603 @@
 section \<open>Subterms and Contexts\<close>
 
 text \<open>
   We define the (proper) sub- and superterm relations on first order terms,
   as well as contexts (you can think of contexts as terms with exactly one hole,
   where we can plug-in another term).
   Moreover, we establish several connections between these concepts as well as
   to other concepts such as substitutions.
 \<close>
 
 theory Subterm_and_Context
   imports
     Term
     "Abstract-Rewriting.Abstract_Rewriting"
 begin
 
 subsection \<open>Subterms\<close>
 
 text \<open>The \<^emph>\<open>superterm\<close> relation.\<close>
 inductive_set
   supteq :: "(('f, 'v) term \<times> ('f, 'v) term) set"
   where
     refl [simp, intro]: "(t, t) \<in> supteq" |
     subt [intro]: "u \<in> set ss \<Longrightarrow> (u, t) \<in> supteq \<Longrightarrow> (Fun f ss, t) \<in> supteq"
 
 text \<open>The \<^emph>\<open>proper superterm\<close> relation.\<close>
 inductive_set
   supt :: "(('f, 'v) term \<times> ('f, 'v) term) set"
   where
     arg [simp, intro]: "s \<in> set ss \<Longrightarrow> (Fun f ss, s) \<in> supt" |
     subt [intro]: "s \<in> set ss \<Longrightarrow> (s, t) \<in> supt \<Longrightarrow> (Fun f ss, t) \<in> supt"
 
 hide_const suptp supteqp
 hide_fact
   suptp.arg suptp.cases suptp.induct suptp.intros suptp.subt suptp_supt_eq
 hide_fact
   supteqp.cases supteqp.induct supteqp.intros supteqp.refl supteqp.subt supteqp_supteq_eq
 
 hide_fact (open) supt.arg supt.subt supteq.refl supteq.subt
 
 
 subsubsection \<open>Syntactic Sugar\<close>
 
 text \<open>Infix syntax.\<close>
 abbreviation "supt_pred s t \<equiv> (s, t) \<in> supt"
 abbreviation "supteq_pred s t \<equiv> (s, t) \<in> supteq"
 abbreviation (input) "subt_pred s t \<equiv> supt_pred t s"
 abbreviation (input) "subteq_pred s t \<equiv> supteq_pred t s"
 
 notation
   supt ("{\<rhd>}") and
   supt_pred ("(_/ \<rhd> _)" [56, 56] 55) and
   subt_pred (infix "\<lhd>" 55) and
   supteq ("{\<unrhd>}") and
   supteq_pred ("(_/ \<unrhd> _)" [56, 56] 55) and
   subteq_pred (infix "\<unlhd>" 55)
 
 abbreviation subt ("{\<lhd>}") where "{\<lhd>} \<equiv> {\<rhd>}\<inverse>"
 abbreviation subteq ("{\<unlhd>}") where "{\<unlhd>} \<equiv> {\<unrhd>}\<inverse>"
 
 text \<open>Quantifier syntax.\<close>
 
 syntax
   "_All_supteq" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3\<forall>_\<unrhd>_./ _)" [0, 0, 10] 10)
   "_Ex_supteq" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3\<exists>_\<unrhd>_./ _)" [0, 0, 10] 10)
   "_All_supt" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3\<forall>_\<rhd>_./ _)" [0, 0, 10] 10)
   "_Ex_supt" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3\<exists>_\<rhd>_./ _)" [0, 0, 10] 10)
 
 "_All_subteq" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3\<forall>_\<unlhd>_./ _)" [0, 0, 10] 10)
 "_Ex_subteq" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3\<exists>_\<unlhd>_./ _)" [0, 0, 10] 10)
 "_All_subt" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3\<forall>_\<lhd>_./ _)" [0, 0, 10] 10)
 "_Ex_subt" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3\<exists>_\<lhd>_./ _)" [0, 0, 10] 10)
 
 (* for parsing *)
 translations
   "\<forall>x\<unrhd>y. P" \<rightharpoonup> "\<forall>x. x \<unrhd> y \<longrightarrow> P"
   "\<exists>x\<unrhd>y. P" \<rightharpoonup> "\<exists>x. x \<unrhd> y \<and> P"
   "\<forall>x\<rhd>y. P" \<rightharpoonup> "\<forall>x. x \<rhd> y \<longrightarrow> P"
   "\<exists>x\<rhd>y. P" \<rightharpoonup> "\<exists>x. x \<rhd> y \<and> P"
 
 "\<forall>x\<unlhd>y. P" \<rightharpoonup> "\<forall>x. x \<unlhd> y \<longrightarrow> P"
 "\<exists>x\<unlhd>y. P" \<rightharpoonup> "\<exists>x. x \<unlhd> y \<and> P"
 "\<forall>x\<lhd>y. P" \<rightharpoonup> "\<forall>x. x \<lhd> y \<longrightarrow> P"
 "\<exists>x\<lhd>y. P" \<rightharpoonup> "\<exists>x. x \<lhd> y \<and> P"
 
 (* for printing *)
 print_translation \<open>
 let
   val All_binder = Mixfix.binder_name @{const_syntax All};
   val Ex_binder = Mixfix.binder_name @{const_syntax Ex};
   val impl = @{const_syntax "implies"};
   val conj = @{const_syntax "conj"};
   val supt = @{const_syntax "supt_pred"};
   val supteq = @{const_syntax "supteq_pred"};
 
   val trans =
    [((All_binder, impl, supt), ("_All_supt", "_All_subt")),
     ((All_binder, impl, supteq), ("_All_supteq", "_All_subteq")),
     ((Ex_binder, conj, supt), ("_Ex_supt", "_Ex_subt")),
     ((Ex_binder, conj, supteq), ("_Ex_supteq", "_Ex_subteq"))];
 
   fun matches_bound v t =
      case t of (Const ("_bound", _) $ Free (v', _)) => (v = v')
               | _ => false
   fun contains_var v = Term.exists_subterm (fn Free (x, _) => x = v | _ => false)
   fun mk x c n P = Syntax.const c $ Syntax_Trans.mark_bound_body x $ n $ P
 
   fun tr' q = (q,
     K (fn [Const ("_bound", _) $ Free (v, T), Const (c, _) $ (Const (d, _) $ t $ u) $ P] =>
       (case AList.lookup (=) trans (q, c, d) of
         NONE => raise Match
       | SOME (l, g) =>
           if matches_bound v t andalso not (contains_var v u) then mk (v, T) l u P
           else if matches_bound v u andalso not (contains_var v t) then mk (v, T) g t P
           else raise Match)
      | _ => raise Match));
 in [tr' All_binder, tr' Ex_binder] end
 \<close>
 
 
 subsubsection \<open>Transitivity Reasoning for Subterms\<close>
 
 lemma supt_trans [trans]:
   "s \<rhd> t \<Longrightarrow> t \<rhd> u \<Longrightarrow> s \<rhd> u"
   by (induct s t rule: supt.induct) auto
 
 lemma trans_supt: "trans {\<rhd>}" by (auto simp: trans_def dest: supt_trans)
 
 
 lemma supteq_trans [trans]:
   "s \<unrhd> t \<Longrightarrow> t \<unrhd> u \<Longrightarrow> s \<unrhd> u"
   by (induct s t rule: supteq.induct) (auto)
 
 text \<open>Auxiliary lemmas about term size.\<close>
 lemma size_simp5:
   "s \<in> set ss \<Longrightarrow> s \<rhd> t \<Longrightarrow> size t < size s \<Longrightarrow> size t < Suc (size_list size ss)"
   by (induct ss) auto
 
 lemma size_simp6:
   "s \<in> set ss \<Longrightarrow> s \<unrhd> t \<Longrightarrow> size t \<le> size s \<Longrightarrow> size t \<le> Suc (size_list size ss)"
   by (induct ss) auto
 
 lemma size_simp1:
   "t \<in> set ts \<Longrightarrow> size t < Suc (size_list size ts)"
   by (induct ts) auto
 
 lemma size_simp2:
   "t \<in> set ts \<Longrightarrow> size t < Suc (Suc (size s + size_list size ts))"
   by (induct ts) auto
 
 lemma size_simp3:
   assumes "(x, y) \<in> set (zip xs ys)"
   shows "size x < Suc (size_list size xs)"
   using set_zip_leftD [OF assms]  size_simp1 by auto
 
 lemma size_simp4:
   assumes "(x, y) \<in> set (zip xs ys)"
   shows "size y < Suc (size_list size ys)"
   using set_zip_rightD [OF assms] using size_simp1 by auto
 
 lemmas size_simps =
   size_simp1 size_simp2 size_simp3 size_simp4 size_simp5 size_simp6
 
 declare size_simps [termination_simp]
 
 lemma supt_size:
   "s \<rhd> t \<Longrightarrow> size s > size t"
   by (induct rule: supt.induct) (auto simp: size_simps)
 
 lemma supteq_size:
   "s \<unrhd> t \<Longrightarrow> size s \<ge> size t"
   by (induct rule: supteq.induct) (auto simp: size_simps)
 
 text \<open>Reflexivity and Asymmetry.\<close>
 
 lemma reflcl_supteq [simp]:
   "supteq\<^sup>= = supteq" by auto
 
 lemma trancl_supteq [simp]:
   "supteq\<^sup>+ = supteq"
   by (rule trancl_id) (auto simp: trans_def intro: supteq_trans)
 
 lemma rtrancl_supteq [simp]:
   "supteq\<^sup>* = supteq"
   unfolding trancl_reflcl[symmetric] by auto
 
 lemma eq_supteq: "s = t \<Longrightarrow> s \<unrhd> t" by auto
 
 lemma supt_neqD: "s \<rhd> t \<Longrightarrow> s \<noteq> t" using supt_size by auto
 
 lemma supteq_Var [simp]:
   "x \<in> vars_term t \<Longrightarrow> t \<unrhd> Var x"
 proof (induct t)
   case (Var y) then show ?case by (cases "x = y") auto
 next
   case (Fun f ss) then show ?case by (auto)
 qed
 
 lemmas vars_term_supteq = supteq_Var
 
 lemma term_not_arg [iff]:
   "Fun f ss \<notin> set ss" (is "?t \<notin> set ss")
 proof
   assume "?t \<in> set ss"
   then have "?t \<rhd> ?t" by (auto)
   then have "?t \<noteq> ?t" by (auto dest: supt_neqD)
   then show False by simp
 qed
 
 lemma supt_Fun [simp]:
   assumes "s \<rhd> Fun f ss" (is "s \<rhd> ?t") and "s \<in> set ss"
   shows "False"
 proof -
   from \<open>s \<in> set ss\<close> have "?t \<rhd> s" by (auto)
   then have "size ?t > size s" by (rule supt_size)
   from \<open>s \<rhd> ?t\<close> have "size s > size ?t" by (rule supt_size)
   with \<open>size ?t > size s\<close> show False by simp
 qed
 
 lemma supt_supteq_conv: "s \<rhd> t = (s \<unrhd> t \<and> s \<noteq> t)"
 proof
   assume "s \<rhd> t" then show "s \<unrhd> t \<and> s \<noteq> t"
   proof (induct rule: supt.induct)
     case (subt s ss t f)
     have "s \<unrhd> s" ..
     from \<open>s \<in> set ss\<close> have "Fun f ss \<unrhd> s" by (auto)
     from \<open>s \<unrhd> t \<and> s \<noteq> t\<close> have "s \<unrhd> t" ..
     with \<open>Fun f ss \<unrhd> s\<close> have first: "Fun f ss \<unrhd> t" by (rule supteq_trans)
     from \<open>s \<in> set ss\<close> and \<open>s \<rhd> t\<close> have "Fun f ss \<rhd> t" ..
     then have second: "Fun f ss \<noteq> t" by (auto dest: supt_neqD)
     from first and second show "Fun f ss \<unrhd> t \<and> Fun f ss \<noteq> t" by auto
   qed (auto simp: size_simps)
 next
   assume "s \<unrhd> t \<and> s \<noteq> t"
   then have "s \<unrhd> t" and "s \<noteq> t" by auto
   then show "s \<rhd> t" by (induct) (auto)
 qed
 
 lemma supt_not_sym: "s \<rhd> t \<Longrightarrow> \<not> (t \<rhd> s)"
 proof
   assume "s \<rhd> t" and "t \<rhd> s" then have "s \<rhd> s" by (rule supt_trans)
   then show False unfolding supt_supteq_conv by simp
 qed
 
 lemma supt_irrefl[iff]: "\<not> t \<rhd> t"
   using supt_not_sym[of t t] by auto
 
 lemma irrefl_subt: "irrefl {\<lhd>}" by (auto simp: irrefl_def)
 
 lemma supt_imp_supteq: "s \<rhd> t \<Longrightarrow> s \<unrhd> t"
   unfolding supt_supteq_conv by auto
 
 lemma supt_supteq_not_supteq: "s \<rhd> t = (s \<unrhd> t \<and> \<not> (t \<unrhd> s))"
   using supt_not_sym unfolding supt_supteq_conv by auto
 
 lemma supteq_supt_conv: "(s \<unrhd> t) = (s \<rhd> t \<or> s = t)" by (auto simp: supt_supteq_conv)
 
 lemma supteq_antisym:
   assumes "s \<unrhd> t" and "t \<unrhd> s" shows "s = t"
   using assms unfolding supteq_supt_conv by (auto simp: supt_not_sym)
 
 text \<open>The subterm relation is an order on terms.\<close>
 interpretation subterm: order "(\<unlhd>)" "(\<lhd>)"
   by (unfold_locales)
     (rule supt_supteq_not_supteq, auto intro: supteq_trans supteq_antisym supt_supteq_not_supteq)
 
 
 text \<open>More transitivity rules.\<close>
 lemma supt_supteq_trans[trans]:
   "s \<rhd> t \<Longrightarrow> t \<unrhd> u \<Longrightarrow> s \<rhd> u"
   by (metis subterm.le_less_trans)
 
 lemma supteq_supt_trans[trans]:
   "s \<unrhd> t \<Longrightarrow> t \<rhd> u \<Longrightarrow> s \<rhd> u"
   by (metis subterm.less_le_trans)
 
 declare subterm.le_less_trans[trans]
 declare subterm.less_le_trans[trans]
 
 lemma suptE [elim]: "s \<rhd> t \<Longrightarrow> (s \<unrhd> t \<Longrightarrow> P) \<Longrightarrow> (s \<noteq> t \<Longrightarrow> P) \<Longrightarrow> P"
   by (auto simp: supt_supteq_conv)
 
 lemmas suptI [intro] =
   subterm.dual_order.not_eq_order_implies_strict
 
 lemma supt_supteq_set_conv:
   "{\<rhd>} = {\<unrhd>} - Id"
   using supt_supteq_conv [to_set] by auto
 
 lemma supteq_supt_set_conv:
   "{\<unrhd>} = {\<rhd>}\<^sup>="
   by (auto simp: supt_supteq_conv)
 
 lemma supteq_imp_vars_term_subset:
   "s \<unrhd> t \<Longrightarrow> vars_term t \<subseteq> vars_term s"
   by (induct rule: supteq.induct) auto
 
 lemma set_supteq_into_supt [simp]:
   assumes "t \<in> set ts" and "t \<unrhd> s"
   shows "Fun f ts \<rhd> s"
 proof -
   from \<open>t \<unrhd> s\<close> have "t = s \<or> t \<rhd> s" by auto
   then show ?thesis
   proof
     assume "t = s"
     with \<open>t \<in> set ts\<close> show ?thesis by auto
   next
     assume "t \<rhd> s"
     from supt.subt[OF \<open>t \<in> set ts\<close> this] show ?thesis .
   qed
 qed
 
 text \<open>The superterm relation is strongly normalizing.\<close>
 lemma SN_supt:
   "SN {\<rhd>}"
   unfolding SN_iff_wf by (rule wf_subset) (auto intro: supt_size)
 
 lemma supt_not_refl[elim!]:
   assumes "t \<rhd> t" shows False
 proof -
   from assms have "t \<noteq> t" by auto
   then show False by simp
 qed
 
 lemma supteq_not_supt [elim]:
   assumes "s \<unrhd> t" and "\<not> (s \<rhd> t)"
   shows "s = t"
   using assms by (induct) auto
 
 lemma supteq_not_supt_conv [simp]:
   "{\<unrhd>} - {\<rhd>} = Id" by auto
 
 lemma supteq_subst [simp, intro]:
   assumes "s \<unrhd> t" shows "s \<cdot> \<sigma> \<unrhd> t \<cdot> \<sigma>"
   using assms
 proof (induct rule: supteq.induct)
   case (subt u ss t f)
   from \<open>u \<in> set ss\<close> have "u \<cdot> \<sigma> \<in> set (map (\<lambda>t. t \<cdot> \<sigma>) ss)" "u \<cdot> \<sigma> \<unrhd> u \<cdot> \<sigma>" by auto
-  then have "Fun f ss \<cdot> \<sigma> \<unrhd> u \<cdot> \<sigma>" unfolding subst_apply_term.simps by blast
+  then have "Fun f ss \<cdot> \<sigma> \<unrhd> u \<cdot> \<sigma>" unfolding eval_term.simps by blast
   from this and \<open>u \<cdot> \<sigma> \<unrhd> t \<cdot> \<sigma>\<close> show ?case by (rule supteq_trans)
 qed auto
 
 lemma supt_subst [simp, intro]:
   assumes "s \<rhd> t" shows "s \<cdot> \<sigma> \<rhd> t \<cdot> \<sigma>"
   using assms
 proof (induct rule: supt.induct)
   case (arg s ss f)
   then have "s \<cdot> \<sigma> \<in> set (map (\<lambda>t. t \<cdot> \<sigma>) ss)" by simp
-  then show ?case unfolding subst_apply_term.simps by (rule supt.arg)
+  then show ?case unfolding eval_term.simps by (rule supt.arg)
 next
   case (subt u ss t f)
   from \<open>u \<in> set ss\<close> have "u \<cdot> \<sigma> \<in> set (map (\<lambda>t. t \<cdot> \<sigma>) ss)" by simp
-  then have "Fun f ss \<cdot> \<sigma> \<rhd> u \<cdot> \<sigma>" unfolding subst_apply_term.simps by (rule supt.arg)
+  then have "Fun f ss \<cdot> \<sigma> \<rhd> u \<cdot> \<sigma>" unfolding eval_term.simps by (rule supt.arg)
   with \<open>u \<cdot> \<sigma> \<rhd> t \<cdot> \<sigma>\<close> show ?case by (metis supt_trans)
 qed
 
 
 lemma subterm_induct:
   assumes "\<And>t. \<forall>s\<lhd>t. P s \<Longrightarrow> P t"
   shows [case_names subterm]: "P t"
   by (rule wf_induct[OF wf_measure[of size], of P t], rule assms, insert supt_size, auto)
 
 
 subsection \<open>Contexts\<close>
 
 text \<open>A \<^emph>\<open>context\<close> is a term containing exactly one \<^emph>\<open>hole\<close>.\<close>
 datatype (funs_ctxt: 'f, vars_ctxt: 'v) ctxt =
   Hole ("\<box>") |
   More 'f "('f, 'v) term list" "('f, 'v) ctxt" "('f, 'v) term list"
 
 text \<open>
   We also say that we apply a context~@{term C} to a term~@{term t} when we
   replace the hole in a @{term C} by @{term t}.
 \<close>
 fun ctxt_apply_term :: "('f, 'v) ctxt \<Rightarrow> ('f, 'v) term \<Rightarrow> ('f, 'v) term" ("_\<langle>_\<rangle>" [1000, 0] 1000)
   where
     "\<box>\<langle>s\<rangle> = s" |
     "(More f ss1 C ss2)\<langle>s\<rangle> = Fun f (ss1 @ C\<langle>s\<rangle> # ss2)"
 
 lemma ctxt_eq [simp]:
   "(C\<langle>s\<rangle> = C\<langle>t\<rangle>) = (s = t)" by (induct C) auto
 
 fun ctxt_compose :: "('f, 'v) ctxt \<Rightarrow> ('f, 'v) ctxt \<Rightarrow> ('f, 'v) ctxt" (infixl "\<circ>\<^sub>c" 75)
   where
     "\<box> \<circ>\<^sub>c D = D" |
     "(More f ss1 C ss2) \<circ>\<^sub>c D = More f ss1 (C \<circ>\<^sub>c D) ss2"
 
 interpretation ctxt_monoid_mult: monoid_mult "\<box>" "(\<circ>\<^sub>c)"
 proof
   fix C D E :: "('f, 'v) ctxt"
   show "C \<circ>\<^sub>c D \<circ>\<^sub>c E = C \<circ>\<^sub>c (D \<circ>\<^sub>c E)" by (induct C) simp_all
   show "\<box> \<circ>\<^sub>c C = C" by simp
   show "C \<circ>\<^sub>c \<box> = C" by (induct C) simp_all
 qed
 
 instantiation ctxt :: (type, type) monoid_mult
 begin
 definition [simp]: "1 = \<box>"
 definition [simp]: "(*) = (\<circ>\<^sub>c)"
 instance by (intro_classes) (simp_all add: ac_simps)
 end
 
 lemma ctxt_ctxt_compose [simp]: "(C \<circ>\<^sub>c D)\<langle>t\<rangle> = C\<langle>D\<langle>t\<rangle>\<rangle>" by (induct C) simp_all
 
 lemmas ctxt_ctxt = ctxt_ctxt_compose [symmetric]
 
 text \<open>Applying substitutions to contexts.\<close>
 fun subst_apply_ctxt :: "('f, 'v) ctxt \<Rightarrow> ('f, 'v, 'w) gsubst \<Rightarrow> ('f, 'w) ctxt" (infixl "\<cdot>\<^sub>c" 67)
   where
     "\<box> \<cdot>\<^sub>c \<sigma> = \<box>" |
     "(More f ss1 D ss2) \<cdot>\<^sub>c \<sigma> = More f (map (\<lambda>t. t \<cdot> \<sigma>) ss1) (D \<cdot>\<^sub>c \<sigma>) (map (\<lambda>t. t \<cdot> \<sigma>) ss2)"
 
 lemma subst_apply_term_ctxt_apply_distrib [simp]:
   "C\<langle>t\<rangle> \<cdot> \<mu> = (C \<cdot>\<^sub>c \<mu>)\<langle>t \<cdot> \<mu>\<rangle>"
   by (induct C) auto
 
 lemma subst_compose_ctxt_compose_distrib [simp]:
   "(C \<circ>\<^sub>c D) \<cdot>\<^sub>c \<sigma> = (C \<cdot>\<^sub>c \<sigma>) \<circ>\<^sub>c (D \<cdot>\<^sub>c \<sigma>)"
   by (induct C) auto
 
 lemma ctxt_compose_subst_compose_distrib [simp]:
   "C \<cdot>\<^sub>c (\<sigma> \<circ>\<^sub>s \<tau>) = (C \<cdot>\<^sub>c \<sigma>) \<cdot>\<^sub>c \<tau>"
   by (induct C) (auto)
 
 
 subsection \<open>The Connection between Contexts and the Superterm Relation\<close>
 
 lemma ctxt_imp_supteq [simp]:
   shows "C\<langle>t\<rangle> \<unrhd> t" by (induct C) auto
 
 lemma supteq_ctxtE[elim]:
   assumes "s \<unrhd> t" obtains C where "s = C\<langle>t\<rangle>"
   using assms proof (induct arbitrary: thesis)
   case (refl s)
   have "s = \<box>\<langle>s\<rangle>" by simp
   from refl[OF this] show ?case .
 next
   case (subt u ss t f)
   then obtain C where "u = C\<langle>t\<rangle>" by auto
   from split_list[OF \<open>u \<in> set ss\<close>] obtain ss1 and ss2 where "ss = ss1 @ u # ss2" by auto
   then have "Fun f ss = (More f ss1 C ss2)\<langle>t\<rangle>" using \<open>u = C\<langle>t\<rangle>\<close> by simp
   with subt show ?case by best
 qed
 
 lemma ctxt_supteq[intro]:
   assumes "s = C\<langle>t\<rangle>" shows "s \<unrhd> t"
 proof (cases C)
   case Hole then show ?thesis using assms by auto
 next
   case (More f ss1 D ss2)
   with assms have s: "s = Fun f (ss1 @ D\<langle>t\<rangle> # ss2)" (is "_ = Fun _ ?ss") by simp
   have "D\<langle>t\<rangle> \<in> set ?ss" by simp
   moreover have "D\<langle>t\<rangle> \<unrhd> t" by (induct D) auto
   ultimately show ?thesis unfolding s ..
 qed
 
 lemma supteq_ctxt_conv: "(s \<unrhd> t) = (\<exists>C. s = C\<langle>t\<rangle>)" by auto
 
 lemma supt_ctxtE[elim]:
   assumes "s \<rhd> t" obtains C where "C \<noteq> \<box>" and "s = C\<langle>t\<rangle>"
   using assms
 proof (induct arbitrary: thesis)
   case (arg s ss f)
   from split_list[OF \<open>s \<in> set ss\<close>] obtain ss1 and ss2 where ss: "ss = ss1 @ s # ss2" by auto
   let ?C = "More f ss1 \<box> ss2"
   have "?C \<noteq> \<box>" by simp
   moreover have "Fun f ss = ?C\<langle>s\<rangle>" by (simp add: ss)
   ultimately show ?case using arg by best
 next
   case (subt s ss t f)
   then obtain C where "C \<noteq> \<box>" and "s = C\<langle>t\<rangle>" by auto
   from split_list[OF \<open>s \<in> set ss\<close>] obtain ss1 and ss2 where ss: "ss = ss1 @ s # ss2" by auto
   have "More f ss1 C ss2 \<noteq> \<box>" by simp
   moreover have "Fun f ss = (More f ss1 C ss2)\<langle>t\<rangle>" using \<open>s = C\<langle>t\<rangle>\<close> by (simp add: ss)
   ultimately show ?case using subt(4) by best
 qed
 
 lemma ctxt_supt[intro 2]:
   assumes "C \<noteq> \<box>" and "s = C\<langle>t\<rangle>" shows "s \<rhd> t"
 proof (cases C)
   case Hole with assms show ?thesis by simp
 next
   case (More f ss1 D ss2)
   with assms have s: "s = Fun f (ss1 @ D\<langle>t\<rangle> # ss2)" by simp
   have "D\<langle>t\<rangle> \<in> set (ss1 @ D\<langle>t\<rangle> # ss2)" by simp
   then have "s \<rhd> D\<langle>t\<rangle>" unfolding s ..
   also have "D\<langle>t\<rangle> \<unrhd> t" by (induct D) auto
   finally show "s \<rhd> t" .
 qed
 
 lemma supt_ctxt_conv: "(s \<rhd> t) = (\<exists>C. C \<noteq> \<box> \<and> s = C\<langle>t\<rangle>)" (is "_ = ?rhs")
 proof
   assume "s \<rhd> t"
   then have "s \<unrhd> t" and "s \<noteq> t" by auto
   from \<open>s \<unrhd> t\<close> obtain C where "s = C\<langle>t\<rangle>" by auto
   with \<open>s \<noteq> t\<close> have "C \<noteq> \<box>" by auto
   with \<open>s = C\<langle>t\<rangle>\<close> show "?rhs" by auto
 next
   assume "?rhs" then show "s \<rhd> t" by auto
 qed
 
 lemma nectxt_imp_supt_ctxt: "C \<noteq> \<box> \<Longrightarrow> C\<langle>t\<rangle> \<rhd> t" by auto
 
 lemma supt_var: "\<not> (Var x \<rhd> u)"
 proof
   assume "Var x \<rhd> u"
   then obtain C where "C \<noteq> \<box>" and "Var x = C\<langle>u\<rangle>" ..
   then show False by (cases C) auto
 qed
 
 lemma supt_const: "\<not> (Fun f [] \<rhd> u)"
 proof
   assume "Fun f [] \<rhd> u"
   then obtain C where "C \<noteq> \<box>" and "Fun f [] = C\<langle>u\<rangle>" ..
   then show False by (cases C) auto
 qed
 
 lemma supteq_var_imp_eq:
   "(Var x \<unrhd> t) = (t = Var x)" (is "_ = (_ = ?x)")
 proof
   assume "t = Var x" then show "Var x \<unrhd> t" by auto
 next
   assume st: "?x \<unrhd> t"
   from st obtain C where "?x = C\<langle>t\<rangle>" by best
   then show "t = ?x" by (cases C) auto
 qed
 
 lemma Var_supt [elim!]:
   assumes "Var x \<rhd> t" shows P
   using assms supt_var[of x t] by simp
 
 lemma Fun_supt [elim]:
   assumes "Fun f ts \<rhd> s" obtains t where "t \<in> set ts" and "t \<unrhd> s"
   using assms by (cases) (auto simp: supt_supteq_conv)
 
 lemma inj_ctxt_apply_term: "inj (ctxt_apply_term C)"
   by (auto simp: inj_on_def)
 
 lemma ctxt_subst_eq: "(\<And>x. x \<in> vars_ctxt C \<Longrightarrow> \<sigma> x = \<tau> x) \<Longrightarrow> C \<cdot>\<^sub>c \<sigma> = C \<cdot>\<^sub>c \<tau>"
 proof (induct C)
   case (More f bef C aft)
   { fix t
     assume t:"t \<in> set bef"
     have "t \<cdot> \<sigma> = t \<cdot> \<tau>" using t More(2) by (auto intro: term_subst_eq)
   }
   moreover
   { fix t
     assume t:"t \<in> set aft"
     have "t \<cdot> \<sigma> = t \<cdot> \<tau>" using t More(2) by (auto intro: term_subst_eq)
   }
   moreover have "C \<cdot>\<^sub>c \<sigma> = C \<cdot>\<^sub>c \<tau>" using More by auto
   ultimately show ?case by auto
 qed auto
 
 
 text \<open>
   A \<^emph>\<open>signature\<close> is a set of function symbol/arity pairs, where the arity of a function symbol,
   denotes the number of arguments it expects.
 \<close>
 type_synonym 'f sig = "('f \<times> nat) set"
 
 text \<open>The set of all function symbol/ arity pairs occurring in a term.\<close>
 fun funas_term :: "('f, 'v) term \<Rightarrow> 'f sig"
   where
     "funas_term (Var _) = {}" |
     "funas_term (Fun f ts) = {(f, length ts)} \<union> \<Union>(set (map funas_term ts))"
 
 
 lemma supt_imp_funas_term_subset:
   assumes "s \<rhd> t"
   shows "funas_term t \<subseteq> funas_term s"
   using assms by induct auto
 
 lemma supteq_imp_funas_term_subset[simp]:
   assumes "s \<unrhd> t"
   shows "funas_term t \<subseteq> funas_term s"
   using assms by induct auto
 
 text \<open>The set of all function symbol/arity pairs occurring in a context.\<close>
 fun funas_ctxt :: "('f, 'v) ctxt \<Rightarrow> 'f sig"
   where
     "funas_ctxt Hole = {}" |
     "funas_ctxt (More f ss1 D ss2) = {(f, Suc (length (ss1 @ ss2)))}
      \<union> funas_ctxt D \<union> \<Union>(set (map funas_term (ss1 @ ss2)))"
 
 lemma funas_term_ctxt_apply [simp]:
   "funas_term (C\<langle>t\<rangle>) = funas_ctxt C \<union> funas_term t"
   by (induct C, auto)
 
 lemma funas_term_subst:
   "funas_term (t \<cdot> \<sigma>) = funas_term t \<union> \<Union>(funas_term ` \<sigma> ` vars_term t)"
   by (induct t) auto
 
 lemma funas_ctxt_compose [simp]:
   "funas_ctxt (C \<circ>\<^sub>c D) = funas_ctxt C \<union> funas_ctxt D"
   by (induct C) auto
 
 lemma funas_ctxt_subst [simp]:
   "funas_ctxt (C \<cdot>\<^sub>c \<sigma>) = funas_ctxt C \<union> \<Union>(funas_term ` \<sigma> ` vars_ctxt C)"
   by (induct C, auto simp: funas_term_subst)
 
 
 end
diff --git a/thys/First_Order_Terms/Term.thy b/thys/First_Order_Terms/Term.thy
--- a/thys/First_Order_Terms/Term.thy
+++ b/thys/First_Order_Terms/Term.thy
@@ -1,749 +1,771 @@
 (*
 Author:  Christian Sternagel <c.sternagel@gmail.com>
 Author:  René Thiemann <rene.thiemann@uibk.ac.at>
 License: LGPL
 *)
 section \<open>First-Order Terms\<close>
 
 theory Term
   imports 
     Main
     "HOL-Library.Multiset"
 begin
 
 datatype (funs_term : 'f, vars_term : 'v) "term" =
   is_Var: Var (the_Var: 'v) |
   Fun 'f (args : "('f, 'v) term list")
 where
   "args (Var _) = []"
 
 abbreviation "is_Fun t \<equiv> \<not> is_Var t"
 
 lemma is_VarE [elim]:
   "is_Var t \<Longrightarrow> (\<And>x. t = Var x \<Longrightarrow> P) \<Longrightarrow> P"
   by (cases t) auto
 
 lemma is_FunE [elim]:
   "is_Fun t \<Longrightarrow> (\<And>f ts. t = Fun f ts \<Longrightarrow> P) \<Longrightarrow> P"
   by (cases t) auto
 
 lemma inj_on_Var[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "inj_on Var A"
   by (rule inj_onI) simp
 
 lemma member_image_the_Var_image_subst: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes is_var_\<sigma>: "\<forall>x. is_Var (\<sigma> x)"
   shows "x \<in> the_Var ` \<sigma> ` V \<longleftrightarrow> Var x \<in> \<sigma> ` V"
   using is_var_\<sigma> image_iff
   by (metis (no_types, opaque_lifting) term.collapse(1) term.sel(1))
 
 lemma image_the_Var_image_subst_renaming_eq: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes is_var_\<sigma>: "\<forall>x. is_Var (\<rho> x)"
   shows "the_Var ` \<rho> ` V = (\<Union>x \<in> V. vars_term (\<rho> x))"
 proof (rule Set.equalityI; rule Set.subsetI)
   from is_var_\<sigma> show "\<And>x. x \<in> the_Var ` \<rho> ` V \<Longrightarrow> x \<in> (\<Union>x\<in>V. vars_term (\<rho> x))"
     using term.set_sel(3) by force
 next
   from is_var_\<sigma> show "\<And>x. x \<in> (\<Union>x\<in>V. vars_term (\<rho> x)) \<Longrightarrow> x \<in> the_Var ` \<rho> ` V"
     by (smt (verit, best) Term.term.simps(17) UN_iff image_eqI singletonD term.collapse(1))
 qed
 
 text \<open>The variables of a term as multiset.\<close>
 fun vars_term_ms :: "('f, 'v) term \<Rightarrow> 'v multiset"
   where
     "vars_term_ms (Var x) = {#x#}" |
     "vars_term_ms (Fun f ts) = \<Sum>\<^sub># (mset (map vars_term_ms ts))"
 
 lemma set_mset_vars_term_ms [simp]:
   "set_mset (vars_term_ms t) = vars_term t"
   by (induct t) auto
 
 
 text \<open>Reorient equations of the form @{term "Var x = t"} and @{term "Fun f ss = t"} to facilitate
   simplification.\<close>
 setup \<open>
   Reorient_Proc.add
     (fn Const (@{const_name Var}, _) $ _ => true | _ => false)
   #> Reorient_Proc.add
     (fn Const (@{const_name Fun}, _) $ _ $ _ => true | _ => false)
 \<close>
 
 simproc_setup reorient_Var ("Var x = t") = \<open>K Reorient_Proc.proc\<close>
 simproc_setup reorient_Fun ("Fun f ss = t") = \<open>K Reorient_Proc.proc\<close>
 
 text \<open>The \emph{root symbol} of a term is defined by:\<close>
 fun root :: "('f, 'v) term \<Rightarrow> ('f \<times> nat) option"
 where
   "root (Var x) = None" |
   "root (Fun f ts) = Some (f, length ts)"
 
 lemma finite_vars_term [simp]:
   "finite (vars_term t)"
   by (induct t) simp_all
 
 lemma finite_Union_vars_term:
   "finite (\<Union>t \<in> set ts. vars_term t)"
   by auto
 
+text \<open>We define the evaluation of terms, under interpretation of function symbols and assignment of
+  variables, as follows:\<close>
+
+fun eval_term ("_\<lbrakk>(2_)\<rbrakk>_" [999,1,100]100) where
+  "I\<lbrakk>Var x\<rbrakk>\<alpha> = \<alpha> x"
+| "I\<lbrakk>Fun f ss\<rbrakk>\<alpha> = I f [I\<lbrakk>s\<rbrakk>\<alpha>. s \<leftarrow> ss]"
+
+notation eval_term ("_\<lbrakk>(2_)\<rbrakk>" [999,1]100)
+
+lemma eval_same_vars:
+  assumes "\<forall>x \<in> vars_term s. \<alpha> x = \<beta> x"
+  shows "I\<lbrakk>s\<rbrakk>\<alpha> = I\<lbrakk>s\<rbrakk>\<beta>"
+  by (insert assms, induct s, auto intro!:map_cong[OF refl] cong[of "I _"])
+
+lemma eval_same_vars_cong:
+  assumes ref: "s = t" and v: "\<And>x. x \<in> vars_term s \<Longrightarrow> \<alpha> x = \<beta> x"
+  shows "I\<lbrakk>s\<rbrakk>\<alpha> = I\<lbrakk>t\<rbrakk>\<beta>"
+  by (fold ref, rule eval_same_vars, auto dest:v)
+
+lemma eval_with_fresh_var: "x \<notin> vars_term s \<Longrightarrow> I\<lbrakk>s\<rbrakk>\<alpha>(x:=a) = I\<lbrakk>s\<rbrakk>\<alpha>"
+  by (auto intro: eval_same_vars)
+
+lemma eval_map_term: "I\<lbrakk>map_term ff fv s\<rbrakk>\<alpha> = (I \<circ> ff)\<lbrakk>s\<rbrakk>(\<alpha> \<circ> fv)"
+  by (induct s, auto intro: cong[of "I _"])
+
+
 text \<open>A substitution is a mapping \<open>\<sigma>\<close> from variables to terms. We call a substitution that
   alters the type of variables a generalized substitution, since it does not have all properties
   that are expected of (standard) substitutions (e.g., there is no empty substitution).\<close>
 type_synonym ('f, 'v, 'w) gsubst = "'v \<Rightarrow> ('f, 'w) term"
 type_synonym ('f, 'v) subst  = "('f, 'v, 'v) gsubst"
 
-fun subst_apply_term :: "('f, 'v) term \<Rightarrow> ('f, 'v, 'w) gsubst \<Rightarrow> ('f, 'w) term" (infixl "\<cdot>" 67)
-  where
-    "Var x \<cdot> \<sigma> = \<sigma> x"
-  | "Fun f ss \<cdot> \<sigma> = Fun f (map (\<lambda>t. t \<cdot> \<sigma>) ss)"
+abbreviation subst_apply_term :: "('f, 'v) term \<Rightarrow> ('f, 'v, 'w) gsubst \<Rightarrow> ('f, 'w) term"  (infixl "\<cdot>" 67)
+  where "subst_apply_term \<equiv> eval_term Fun"
 
 definition
   subst_compose :: "('f, 'u, 'v) gsubst \<Rightarrow> ('f, 'v, 'w) gsubst \<Rightarrow> ('f, 'u, 'w) gsubst"
   (infixl "\<circ>\<^sub>s" 75)
   where
     "\<sigma> \<circ>\<^sub>s \<tau> = (\<lambda>x. (\<sigma> x) \<cdot> \<tau>)"
 
 lemma subst_subst_compose [simp]:
   "t \<cdot> (\<sigma> \<circ>\<^sub>s \<tau>) = t \<cdot> \<sigma> \<cdot> \<tau>"
-  by (induct t \<sigma> rule: subst_apply_term.induct) (simp_all add: subst_compose_def)
+  by (induct t) (simp_all add: subst_compose_def)
 
 lemma subst_compose_assoc:
   "\<sigma> \<circ>\<^sub>s \<tau> \<circ>\<^sub>s \<mu> = \<sigma> \<circ>\<^sub>s (\<tau> \<circ>\<^sub>s \<mu>)"
 proof (rule ext)
   fix x show "(\<sigma> \<circ>\<^sub>s \<tau> \<circ>\<^sub>s \<mu>) x = (\<sigma> \<circ>\<^sub>s (\<tau> \<circ>\<^sub>s \<mu>)) x"
   proof -
     have "(\<sigma> \<circ>\<^sub>s \<tau> \<circ>\<^sub>s \<mu>) x = \<sigma>(x) \<cdot> \<tau> \<cdot> \<mu>" by (simp add: subst_compose_def)
     also have "\<dots> = \<sigma>(x) \<cdot> (\<tau> \<circ>\<^sub>s \<mu>)" by simp
     finally show ?thesis by (simp add: subst_compose_def)
   qed
 qed
 
 lemma subst_apply_term_empty [simp]:
   "t \<cdot> Var = t"
 proof (induct t)
   case (Fun f ts)
   from map_ext [rule_format, of ts _ id, OF Fun] show ?case by simp
 qed simp
 
 interpretation subst_monoid_mult: monoid_mult "Var" "(\<circ>\<^sub>s)"
   by (unfold_locales) (simp add: subst_compose_assoc, simp_all add: subst_compose_def)
 
 lemma term_subst_eq:
   assumes "\<And>x. x \<in> vars_term t \<Longrightarrow> \<sigma> x = \<tau> x"
   shows "t \<cdot> \<sigma> = t \<cdot> \<tau>"
   using assms by (induct t) (auto)
 
 lemma term_subst_eq_rev:
   "t \<cdot> \<sigma> = t \<cdot> \<tau> \<Longrightarrow> \<forall>x \<in> vars_term t. \<sigma> x = \<tau> x"
   by (induct t) simp_all
 
 lemma term_subst_eq_conv:
   "t \<cdot> \<sigma> = t \<cdot> \<tau> \<longleftrightarrow> (\<forall>x \<in> vars_term t. \<sigma> x = \<tau> x)"
-  using term_subst_eq [of t \<sigma> \<tau>] and term_subst_eq_rev [of t \<sigma> \<tau>] by auto
+  by (auto intro!: term_subst_eq term_subst_eq_rev)
 
 lemma subst_term_eqI:
   assumes "(\<And>t. t \<cdot> \<sigma> = t \<cdot> \<tau>)"
   shows "\<sigma> = \<tau>"
   using assms [of "Var x" for x] by (intro ext) simp
 
 definition subst_domain :: "('f, 'v) subst \<Rightarrow> 'v set"
   where
     "subst_domain \<sigma> = {x. \<sigma> x \<noteq> Var x}"
 
 fun subst_range :: "('f, 'v) subst \<Rightarrow> ('f, 'v) term set"
   where
     "subst_range \<sigma> = \<sigma> ` subst_domain \<sigma>"
 
 lemma vars_term_ms_subst [simp]:
   "vars_term_ms (t \<cdot> \<sigma>) =
     (\<Sum>x\<in>#vars_term_ms t. vars_term_ms (\<sigma> x))" (is "_ = ?V t")
 proof (induct t)
   case (Fun f ts)
   have IH: "map (\<lambda> t. vars_term_ms (t \<cdot> \<sigma>)) ts = map (\<lambda> t. ?V t) ts"
     by (rule map_cong[OF refl Fun])
   show ?case by (simp add: o_def IH, induct ts, auto)
 qed simp
 
 lemma vars_term_ms_subst_mono:
   assumes "vars_term_ms s \<subseteq># vars_term_ms t"
   shows "vars_term_ms (s \<cdot> \<sigma>) \<subseteq># vars_term_ms (t \<cdot> \<sigma>)"
 proof -
   from assms[unfolded mset_subset_eq_exists_conv] obtain u where t: "vars_term_ms t = vars_term_ms s + u" by auto
   show ?thesis unfolding vars_term_ms_subst unfolding t by auto
 qed
 
 
 text \<open>The variables introduced by a substitution.\<close>
 definition range_vars :: "('f, 'v) subst \<Rightarrow> 'v set"
 where
   "range_vars \<sigma> = \<Union>(vars_term ` subst_range \<sigma>)"
 
 lemma mem_range_varsI: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "\<sigma> x = Var y" and "x \<noteq> y"
   shows "y \<in> range_vars \<sigma>"
   unfolding range_vars_def UN_iff
 proof (rule bexI[of _ "Var y"])
   show "y \<in> vars_term (Var y)"
     by simp
 next
   from assms show "Var y \<in> subst_range \<sigma>"
     by (simp_all add: subst_domain_def)
 qed
 
 lemma subst_domain_Var [simp]:
   "subst_domain Var = {}"
   by (simp add: subst_domain_def)
 
 lemma subst_range_Var[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "subst_range Var = {}"
   by simp
 
 lemma range_vars_Var[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "range_vars Var = {}"
   by (simp add: range_vars_def)
 
 lemma subst_apply_term_ident: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "vars_term t \<inter> subst_domain \<sigma> = {} \<Longrightarrow> t \<cdot> \<sigma> = t"
 proof (induction t)
   case (Var x)
   thus ?case
     by (simp add: subst_domain_def)
 next
   case (Fun f ts)
   thus ?case
     by (auto intro: list.map_ident_strong)
 qed
 
 lemma vars_term_subst_apply_term: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "vars_term (t \<cdot> \<sigma>) = (\<Union>x \<in> vars_term t. vars_term (\<sigma> x))"
   by (induction t) (auto simp add: insert_Diff_if subst_domain_def)
 
 corollary vars_term_subst_apply_term_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "vars_term (t \<cdot> \<sigma>) \<subseteq> vars_term t - subst_domain \<sigma> \<union> range_vars \<sigma>"
   unfolding vars_term_subst_apply_term
 proof (induction t)
   case (Var x)
   show ?case
     by (cases "\<sigma> x = Var x") (auto simp add: range_vars_def subst_domain_def)
 next
   case (Fun f xs)
   thus ?case by auto
 qed
 
 definition is_renaming :: "('f, 'v) subst \<Rightarrow> bool"
   where
     "is_renaming \<sigma> \<longleftrightarrow> (\<forall>x. is_Var (\<sigma> x)) \<and> inj_on \<sigma> (subst_domain \<sigma>)"
 
 lemma inv_renaming_sound: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes is_var_\<rho>: "\<forall>x. is_Var (\<rho> x)" and "inj \<rho>"
   shows "\<rho> \<circ>\<^sub>s (Var \<circ> (inv (the_Var \<circ> \<rho>))) = Var"
 proof -
   define \<rho>' where "\<rho>' = the_Var \<circ> \<rho>"
   have \<rho>_def: "\<rho> = Var \<circ> \<rho>'"
     unfolding \<rho>'_def using is_var_\<rho> by auto
 
   from is_var_\<rho> \<open>inj \<rho>\<close> have "inj \<rho>'"
     unfolding inj_def \<rho>_def comp_def by fast
   hence "inv \<rho>' \<circ> \<rho>' = id"
     using inv_o_cancel[of \<rho>'] by simp
   hence "Var \<circ> (inv \<rho>' \<circ> \<rho>') = Var"
     by simp
   hence "\<forall>x. (Var \<circ> (inv \<rho>' \<circ> \<rho>')) x = Var x"
     by metis
   hence "\<forall>x. ((Var \<circ> \<rho>') \<circ>\<^sub>s (Var \<circ> (inv \<rho>'))) x = Var x"
     unfolding subst_compose_def by auto
   thus "\<rho> \<circ>\<^sub>s (Var \<circ> (inv \<rho>')) = Var"
     using \<rho>_def by auto
 qed
 
 lemma ex_inverse_of_renaming: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "\<forall>x. is_Var (\<rho> x)" and "inj \<rho>"
   shows "\<exists>\<tau>. \<rho> \<circ>\<^sub>s \<tau> = Var"
   using inv_renaming_sound[OF assms] by blast
 
 lemma vars_term_subst:
   "vars_term (t \<cdot> \<sigma>) = \<Union>(vars_term ` \<sigma> ` vars_term t)"
   by (induct t) simp_all
 
 lemma range_varsE [elim]:
   assumes "x \<in> range_vars \<sigma>"
     and "\<And>t. x \<in> vars_term t \<Longrightarrow> t \<in> subst_range \<sigma> \<Longrightarrow> P"
   shows "P"
   using assms by (auto simp: range_vars_def)
 
 lemma range_vars_subst_compose_subset:
   "range_vars (\<sigma> \<circ>\<^sub>s \<tau>) \<subseteq> (range_vars \<sigma> - subst_domain \<tau>) \<union> range_vars \<tau>" (is "?L \<subseteq> ?R")
 proof
   fix x
   assume "x \<in> ?L"
   then obtain y where "y \<in> subst_domain (\<sigma> \<circ>\<^sub>s \<tau>)"
     and "x \<in> vars_term ((\<sigma> \<circ>\<^sub>s \<tau>) y)" by (auto simp: range_vars_def)
   then show "x \<in> ?R"
   proof (cases)
     assume "y \<in> subst_domain \<sigma>" and "x \<in> vars_term ((\<sigma> \<circ>\<^sub>s \<tau>) y)"
     moreover then obtain v where "v \<in> vars_term (\<sigma> y)"
       and "x \<in> vars_term (\<tau> v)" by (auto simp: subst_compose_def vars_term_subst)
     ultimately show ?thesis
       by (cases "v \<in> subst_domain \<tau>") (auto simp: range_vars_def subst_domain_def)
   qed (auto simp: range_vars_def subst_compose_def subst_domain_def)
 qed
 
 definition "subst x t = Var (x := t)"
 
 lemma subst_simps [simp]:
   "subst x t x = t"
   "subst x (Var x) = Var"
   by (auto simp: subst_def)
 
 lemma subst_subst_domain [simp]:
   "subst_domain (subst x t) = (if t = Var x then {} else {x})"
 proof -
   { fix y
     have "y \<in> {y. subst x t y \<noteq> Var y} \<longleftrightarrow> y \<in> (if t = Var x then {} else {x})"
       by (cases "x = y", auto simp: subst_def) }
   then show ?thesis by (simp add: subst_domain_def)
 qed
 
 lemma subst_subst_range [simp]:
   "subst_range (subst x t) = (if t = Var x then {} else {t})"
   by (cases "t = Var x") (auto simp: subst_domain_def subst_def)
 
 lemma subst_apply_left_idemp [simp]:
   assumes "\<sigma> x = t \<cdot> \<sigma>"
   shows "s \<cdot> subst x t \<cdot> \<sigma> = s \<cdot> \<sigma>"
   using assms by (induct s) (auto simp: subst_def)
 
 lemma subst_compose_left_idemp [simp]:
   assumes "\<sigma> x = t \<cdot> \<sigma>"
   shows "subst x t \<circ>\<^sub>s \<sigma> = \<sigma>"
   by (rule subst_term_eqI) (simp add: assms)
 
 lemma subst_ident [simp]:
   assumes "x \<notin> vars_term t"
   shows "t \<cdot> subst x u = t"
 proof -
   have "t \<cdot> subst x u = t \<cdot> Var"
     by (rule term_subst_eq) (auto simp: assms subst_def)
   then show ?thesis by simp
 qed
 
 lemma subst_self_idemp [simp]:
   "x \<notin> vars_term t \<Longrightarrow> subst x t \<circ>\<^sub>s subst x t = subst x t"
   by (metis subst_simps(1) subst_compose_left_idemp subst_ident)
 
 type_synonym ('f, 'v) terms = "('f, 'v) term set"
 
 text \<open>Applying a substitution to every term of a given set.\<close>
 abbreviation
   subst_apply_set :: "('f, 'v) terms \<Rightarrow> ('f, 'v, 'w) gsubst \<Rightarrow> ('f, 'w) terms" (infixl "\<cdot>\<^sub>s\<^sub>e\<^sub>t" 60)
   where
     "T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<equiv> (\<lambda>t. t \<cdot> \<sigma>) ` T"
 
 text \<open>Composition of substitutions\<close>
 lemma subst_compose: "(\<sigma> \<circ>\<^sub>s \<tau>) x = \<sigma> x \<cdot> \<tau>" by (auto simp: subst_compose_def)
 
 lemmas subst_subst = subst_subst_compose [symmetric]
 
 lemma subst_apply_eq_Var:
   assumes "s \<cdot> \<sigma> = Var x"
   obtains y where "s = Var y" and "\<sigma> y = Var x"
   using assms by (induct s) auto
 
 lemma subst_domain_subst_compose:
   "subst_domain (\<sigma> \<circ>\<^sub>s \<tau>) =
     (subst_domain \<sigma> - {x. \<exists>y. \<sigma> x = Var y \<and> \<tau> y = Var x}) \<union>
     (subst_domain \<tau> - subst_domain \<sigma>)"
   by (auto simp: subst_domain_def subst_compose_def elim: subst_apply_eq_Var)
 
 
 text \<open>A substitution is idempotent iff the variables in its range are disjoint from its domain.
   (See also "Term Rewriting and All That" \<^cite>\<open>\<open>Lemma 4.5.7\<close> in "AllThat"\<close>.)\<close>
 lemma subst_idemp_iff:
   "\<sigma> \<circ>\<^sub>s \<sigma> = \<sigma> \<longleftrightarrow> subst_domain \<sigma> \<inter> range_vars \<sigma> = {}"
 proof
   assume "\<sigma> \<circ>\<^sub>s \<sigma> = \<sigma>"
   then have "\<And>x. \<sigma> x \<cdot> \<sigma> = \<sigma> x \<cdot> Var" by simp (metis subst_compose_def)
   then have *: "\<And>x. \<forall>y\<in>vars_term (\<sigma> x). \<sigma> y = Var y"
     unfolding term_subst_eq_conv by simp
   { fix x y
     assume "\<sigma> x \<noteq> Var x" and "x \<in> vars_term (\<sigma> y)"
     with * [of y] have False by simp }
   then show "subst_domain \<sigma> \<inter> range_vars \<sigma> = {}"
     by (auto simp: subst_domain_def range_vars_def)
 next
   assume "subst_domain \<sigma> \<inter> range_vars \<sigma> = {}"
   then have *: "\<And>x y. \<sigma> x = Var x \<or> \<sigma> y = Var y \<or> x \<notin> vars_term (\<sigma> y)"
     by (auto simp: subst_domain_def range_vars_def)
   have "\<And>x. \<forall>y\<in>vars_term (\<sigma> x). \<sigma> y = Var y"
   proof
     fix x y
     assume "y \<in> vars_term (\<sigma> x)"
     with * [of y x] show "\<sigma> y = Var y" by auto
   qed
   then show "\<sigma> \<circ>\<^sub>s \<sigma> = \<sigma>"
     by (simp add: subst_compose_def term_subst_eq_conv [symmetric])
 qed
 
 lemma subst_compose_apply_eq_apply_lhs: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes
     "range_vars \<sigma> \<inter> subst_domain \<delta> = {}"
     "x \<notin> subst_domain \<delta>"
   shows "(\<sigma> \<circ>\<^sub>s \<delta>) x = \<sigma> x"
 proof (cases "\<sigma> x")
   case (Var y)
   show ?thesis
   proof (cases "x = y")
     case True
     with Var have \<open>\<sigma> x = Var x\<close>
       by simp
     moreover from \<open>x \<notin> subst_domain \<delta>\<close> have "\<delta> x = Var x"
       by (simp add: disjoint_iff subst_domain_def)
     ultimately show ?thesis
       by (simp add: subst_compose_def)
   next
     case False
     have "y \<in> range_vars \<sigma>"
       unfolding range_vars_def UN_iff
     proof (rule bexI)
       show "y \<in> vars_term (Var y)"
         by simp
     next
       from Var False show "Var y \<in> subst_range \<sigma>"
         by (simp_all add: subst_domain_def)
     qed
     hence "y \<notin> subst_domain \<delta>"
       using \<open>range_vars \<sigma> \<inter> subst_domain \<delta> = {}\<close>
       by (simp add: disjoint_iff)
     with Var show ?thesis
       unfolding subst_compose_def
       by (simp add: subst_domain_def)
   qed
 next
   case (Fun f ys)
   hence "Fun f ys \<in> subst_range \<sigma> \<or> (\<forall>y\<in>set ys. y \<in> subst_range \<sigma>)"
     using subst_domain_def by fastforce
   hence "\<forall>x \<in> vars_term (Fun f ys). x \<in> range_vars \<sigma>"
     by (metis UN_I range_vars_def term.distinct(1) term.sel(4) term.set_cases(2))
   hence "Fun f ys \<cdot> \<delta> = Fun f ys \<cdot> Var"
     unfolding term_subst_eq_conv
     using \<open>range_vars \<sigma> \<inter> subst_domain \<delta> = {}\<close>
     by (simp add: disjoint_iff subst_domain_def)
-  hence "Fun f ys \<cdot> \<delta> = Fun f ys"
-    by simp
-  with Fun show ?thesis
+  from this[unfolded subst_apply_term_empty] Fun show ?thesis
     by (simp add: subst_compose_def)
 qed
 
 lemma subst_apply_term_subst_apply_term_eq_subst_apply_term_lhs: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "range_vars \<sigma> \<inter> subst_domain \<delta> = {}" and "vars_term t \<inter> subst_domain \<delta> = {}"
   shows "t \<cdot> \<sigma> \<cdot> \<delta> = t \<cdot> \<sigma>"
 proof -
   from assms have "\<And>x. x \<in> vars_term t \<Longrightarrow> (\<sigma> \<circ>\<^sub>s \<delta>) x = \<sigma> x"
     using subst_compose_apply_eq_apply_lhs by fastforce
   hence "t \<cdot> \<sigma> \<circ>\<^sub>s \<delta> = t \<cdot> \<sigma>"
-    using term_subst_eq_conv[of t "\<sigma> \<circ>\<^sub>s \<delta>" \<sigma>] by metis
+    using term_subst_eq_conv by metis
   thus ?thesis
     by simp
 qed
 
 fun num_funs :: "('f, 'v) term \<Rightarrow> nat"
   where
     "num_funs (Var x) = 0" |
     "num_funs (Fun f ts) = Suc (sum_list (map num_funs ts))"
 
 lemma num_funs_0:
   assumes "num_funs t = 0"
   obtains x where "t = Var x"
   using assms by (induct t) auto
 
 lemma num_funs_subst:
   "num_funs (t \<cdot> \<sigma>) \<ge> num_funs t"
   by (induct t) (simp_all, metis comp_apply sum_list_mono)
 
 lemma sum_list_map_num_funs_subst:
   assumes "sum_list (map (num_funs \<circ> (\<lambda>t. t \<cdot> \<sigma>)) ts) = sum_list (map num_funs ts)"
   shows "\<forall>i < length ts. num_funs (ts ! i \<cdot> \<sigma>) = num_funs (ts ! i)"
   using assms
 proof (induct ts)
   case (Cons t ts)
   then have "num_funs (t \<cdot> \<sigma>) + sum_list (map (num_funs \<circ> (\<lambda>t. t \<cdot> \<sigma>)) ts)
     = num_funs t + sum_list (map num_funs ts)" by (simp add: o_def)
   moreover have "num_funs (t \<cdot> \<sigma>) \<ge> num_funs t" by (metis num_funs_subst)
   moreover have "sum_list (map (num_funs \<circ> (\<lambda>t. t \<cdot> \<sigma>)) ts) \<ge> sum_list (map num_funs ts)"
     using num_funs_subst [of _ \<sigma>] by (induct ts) (auto intro: add_mono)
   ultimately show ?case using Cons by (auto) (case_tac i, auto)
 qed simp
 
 lemma is_Fun_num_funs_less:
   assumes "x \<in> vars_term t" and "is_Fun t"
   shows "num_funs (\<sigma> x) < num_funs (t \<cdot> \<sigma>)"
   using assms
 proof (induct t)
   case (Fun f ts)
   then obtain u where u: "u \<in> set ts" "x \<in> vars_term u" by auto
   then have "num_funs (u \<cdot> \<sigma>) \<le> sum_list (map (num_funs \<circ> (\<lambda>t. t \<cdot> \<sigma>)) ts)"
     by (intro member_le_sum_list) simp
   moreover have "num_funs (\<sigma> x) \<le> num_funs (u \<cdot> \<sigma>)"
     using Fun.hyps [OF u] and u  by (cases u; simp)
   ultimately show ?case by simp
 qed simp
 
 lemma finite_subst_domain_subst:
   "finite (subst_domain (subst x y))"
   by simp
 
 lemma subst_domain_compose:
   "subst_domain (\<sigma> \<circ>\<^sub>s \<tau>) \<subseteq> subst_domain \<sigma> \<union> subst_domain \<tau>"
   by (auto simp: subst_domain_def subst_compose_def)
 
 lemma vars_term_disjoint_imp_unifier:
   fixes \<sigma> :: "('f, 'v, 'w) gsubst"
   assumes "vars_term s \<inter> vars_term t = {}"
     and "s \<cdot> \<sigma> = t \<cdot> \<tau>"
   shows "\<exists>\<mu> :: ('f, 'v, 'w) gsubst. s \<cdot> \<mu> = t \<cdot> \<mu>"
 proof -
   let ?\<mu> = "\<lambda>x. if x \<in> vars_term s then \<sigma> x else \<tau> x"
   have "s \<cdot> \<sigma> = s \<cdot> ?\<mu>"
     unfolding term_subst_eq_conv
     by (induct s) (simp_all)
   moreover have "t \<cdot> \<tau> = t \<cdot> ?\<mu>"
     using assms(1)
     unfolding term_subst_eq_conv
     by (induct s arbitrary: t) (auto)
   ultimately have "s \<cdot> ?\<mu> = t \<cdot> ?\<mu>" using assms(2) by simp
   then show ?thesis by blast
 qed
 
 lemma vars_term_subset_subst_eq:
   assumes "vars_term t \<subseteq> vars_term s"
     and "s \<cdot> \<sigma> = s \<cdot> \<tau>"
   shows "t \<cdot> \<sigma> = t \<cdot> \<tau>"
   using assms by (induct t) (induct s, auto)
 
 
 subsection \<open>Restrict the Domain of a Substitution\<close>
 
 definition restrict_subst_domain where \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "restrict_subst_domain V \<sigma> x \<equiv> (if x \<in> V then \<sigma> x else Var x)"
 
 lemma restrict_subst_domain_empty[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "restrict_subst_domain {} \<sigma> = Var"
   unfolding restrict_subst_domain_def by auto
 
 lemma restrict_subst_domain_Var[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "restrict_subst_domain V Var = Var"
   unfolding restrict_subst_domain_def by auto
 
 lemma subst_domain_restrict_subst_domain[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "subst_domain (restrict_subst_domain V \<sigma>) = V \<inter> subst_domain \<sigma>"
   unfolding restrict_subst_domain_def subst_domain_def by auto
 
 lemma subst_apply_term_restrict_subst_domain: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "vars_term t \<subseteq> V \<Longrightarrow> t \<cdot> restrict_subst_domain V \<sigma> = t \<cdot> \<sigma>"
   by (rule term_subst_eq) (simp add: restrict_subst_domain_def subsetD)
 
 
 subsection \<open>Rename the Domain of a Substitution\<close>
 
 definition rename_subst_domain where \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "rename_subst_domain \<rho> \<sigma> x =
     (if Var x \<in> \<rho> ` subst_domain \<sigma> then
       \<sigma> (the_inv \<rho> (Var x))
     else
       Var x)"
 
 lemma rename_subst_domain_Var_lhs[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "rename_subst_domain Var \<sigma> = \<sigma>"
   by (rule ext) (simp add: rename_subst_domain_def inj_image_mem_iff the_inv_f_f subst_domain_def)
 
 lemma rename_subst_domain_Var_rhs[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "rename_subst_domain \<rho> Var = Var"
   by (rule ext) (simp add: rename_subst_domain_def)
 
 lemma subst_domain_rename_subst_domain_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes is_var_\<rho>: "\<forall>x. is_Var (\<rho> x)"
   shows "subst_domain (rename_subst_domain \<rho> \<sigma>) \<subseteq> the_Var ` \<rho> ` subst_domain \<sigma>"
   by (auto simp add: subst_domain_def rename_subst_domain_def
       member_image_the_Var_image_subst[OF is_var_\<rho>])
 
 lemma subst_range_rename_subst_domain_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "inj \<rho>"
   shows "subst_range (rename_subst_domain \<rho> \<sigma>) \<subseteq> subst_range \<sigma>"
 proof (intro Set.equalityI Set.subsetI)
   fix t assume "t \<in> subst_range (rename_subst_domain \<rho> \<sigma>)"
   then obtain x where
     t_def: "t = rename_subst_domain \<rho> \<sigma> x" and
     "rename_subst_domain \<rho> \<sigma> x \<noteq> Var x"
     by (auto simp: image_iff subst_domain_def)
 
   show "t \<in> subst_range \<sigma>"
   proof (cases \<open>Var x \<in> \<rho> ` subst_domain \<sigma>\<close>)
     case True
     then obtain x' where "\<rho> x' = Var x" and "x' \<in> subst_domain \<sigma>"
       by auto
     then show ?thesis
       using the_inv_f_f[OF \<open>inj \<rho>\<close>, of x']
       by (simp add: t_def rename_subst_domain_def)
   next
     case False
     hence False
       using \<open>rename_subst_domain \<rho> \<sigma> x \<noteq> Var x\<close>
       by (simp add: t_def rename_subst_domain_def)
     thus ?thesis ..
   qed
 qed
 
 lemma range_vars_rename_subst_domain_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "inj \<rho>"
   shows "range_vars (rename_subst_domain \<rho> \<sigma>) \<subseteq> range_vars \<sigma>"
   unfolding range_vars_def
   using subst_range_rename_subst_domain_subset[OF \<open>inj \<rho>\<close>]
   by (metis Union_mono image_mono)
 
 lemma renaming_cancels_rename_subst_domain: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes is_var_\<rho>: "\<forall>x. is_Var (\<rho> x)" and "inj \<rho>" and vars_t: "vars_term t \<subseteq> subst_domain \<sigma>"
   shows "t \<cdot> \<rho> \<cdot> rename_subst_domain \<rho> \<sigma> = t \<cdot> \<sigma>"
   unfolding subst_subst
 proof (intro term_subst_eq ballI)
   fix x assume "x \<in> vars_term t"
   with vars_t have x_in: "x \<in> subst_domain \<sigma>"
     by blast
 
   obtain x' where \<rho>_x: "\<rho> x = Var x'"
     using is_var_\<rho> by (meson is_Var_def)
   with x_in have x'_in: "Var x' \<in> \<rho> ` subst_domain \<sigma>"
     by (metis image_eqI)
 
   have "(\<rho> \<circ>\<^sub>s rename_subst_domain \<rho> \<sigma>) x = \<rho> x \<cdot> rename_subst_domain \<rho> \<sigma>"
     by (simp add: subst_compose_def)
   also have "\<dots> = rename_subst_domain \<rho> \<sigma> x'"
     using \<rho>_x by simp
   also have "\<dots> = \<sigma> (the_inv \<rho> (Var x'))"
     by (simp add: rename_subst_domain_def if_P[OF x'_in])
   also have "\<dots> = \<sigma> (the_inv \<rho> (\<rho> x))"
     by (simp add: \<rho>_x)
   also have "\<dots> = \<sigma> x"
     using \<open>inj \<rho>\<close> by (simp add: the_inv_f_f)
   finally show "(\<rho> \<circ>\<^sub>s rename_subst_domain \<rho> \<sigma>) x = \<sigma> x"
     by simp
 qed
 
 
 subsection \<open>Rename the Domain and Range of a Substitution\<close>
 
 definition rename_subst_domain_range where \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "rename_subst_domain_range \<rho> \<sigma> x =
     (if Var x \<in> \<rho> ` subst_domain \<sigma> then
       ((Var o the_inv \<rho>) \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<rho>) (Var x)
     else
       Var x)"
 
 lemma rename_subst_domain_range_Var_lhs[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "rename_subst_domain_range Var \<sigma> = \<sigma>"
   by (rule ext) (simp add: rename_subst_domain_range_def inj_image_mem_iff the_inv_f_f
       subst_domain_def subst_compose_def)
 
 lemma rename_subst_domain_range_Var_rhs[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "rename_subst_domain_range \<rho> Var = Var"
   by (rule ext) (simp add: rename_subst_domain_range_def)
 
 lemma subst_compose_renaming_rename_subst_domain_range: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<sigma> \<rho> :: "('f, 'v) subst"
   assumes is_var_\<rho>: "\<forall>x. is_Var (\<rho> x)" and "inj \<rho>"
   shows "\<rho> \<circ>\<^sub>s rename_subst_domain_range \<rho> \<sigma> = \<sigma> \<circ>\<^sub>s \<rho>"
 proof (rule ext)
   fix x
   from is_var_\<rho> obtain x' where "\<rho> x = Var x'"
     by (meson is_Var_def is_renaming_def)
   with \<open>inj \<rho>\<close> have inv_\<rho>_x': "the_inv \<rho> (Var x') = x"
     by (metis the_inv_f_f)
 
   show "(\<rho> \<circ>\<^sub>s rename_subst_domain_range \<rho> \<sigma>) x = (\<sigma> \<circ>\<^sub>s \<rho>) x"
   proof (cases "x \<in> subst_domain \<sigma>")
     case True
     hence "Var x' \<in> \<rho> ` subst_domain \<sigma>"
       using \<open>\<rho> x = Var x'\<close> by (metis imageI)
     thus ?thesis
       by (simp add: \<open>\<rho> x = Var x'\<close> rename_subst_domain_range_def subst_compose_def inv_\<rho>_x')
   next
     case False
     hence "Var x' \<notin> \<rho> ` subst_domain \<sigma>"
     proof (rule contrapos_nn)
       assume "Var x' \<in> \<rho> ` subst_domain \<sigma>"
       hence "\<rho> x \<in> \<rho> ` subst_domain \<sigma>"
         unfolding \<open>\<rho> x = Var x'\<close> .
       thus "x \<in> subst_domain \<sigma>"
         unfolding inj_image_mem_iff[OF \<open>inj \<rho>\<close>] .
     qed
     with False \<open>\<rho> x = Var x'\<close> show ?thesis
       by (simp add: subst_compose_def subst_domain_def rename_subst_domain_range_def)
   qed
 qed
 
 corollary subst_apply_term_renaming_rename_subst_domain_range: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   \<comment> \<open>This might be easier to find with @{command find_theorems}.\<close>
   fixes t :: "('f, 'v) term" and \<sigma> \<rho> :: "('f, 'v) subst"
   assumes is_var_\<rho>: "\<forall>x. is_Var (\<rho> x)" and "inj \<rho>"
   shows "t \<cdot> \<rho> \<cdot> rename_subst_domain_range \<rho> \<sigma> = t \<cdot> \<sigma> \<cdot> \<rho>"
   unfolding subst_subst
   unfolding subst_compose_renaming_rename_subst_domain_range[OF assms]
   by (rule refl)
 
 
 text \<open>A term is called \<^emph>\<open>ground\<close> if it does not contain any variables.\<close>
 fun ground :: "('f, 'v) term \<Rightarrow> bool"
   where
     "ground (Var x) \<longleftrightarrow> False" |
     "ground (Fun f ts) \<longleftrightarrow> (\<forall>t \<in> set ts. ground t)"
 
 lemma ground_vars_term_empty:
   "ground t \<longleftrightarrow> vars_term t = {}"
   by (induct t) simp_all
 
 lemma ground_subst [simp]:
   "ground (t \<cdot> \<sigma>) \<longleftrightarrow> (\<forall>x \<in> vars_term t. ground (\<sigma> x))"
   by (induct t) simp_all
 
 lemma ground_subst_apply:
   assumes "ground t"
   shows "t \<cdot> \<sigma> = t"
 proof -
   have "t = t \<cdot> Var" by simp
   also have "\<dots> = t \<cdot> \<sigma>"
     by (rule term_subst_eq, insert assms[unfolded ground_vars_term_empty], auto)
   finally show ?thesis by simp
 qed
 
 text \<open>Just changing the variables in a term\<close>
 
 abbreviation "map_vars_term f \<equiv> term.map_term (\<lambda>x. x) f"
 
 lemma map_vars_term_as_subst:
   "map_vars_term f t = t \<cdot> (\<lambda> x. Var (f x))"
   by (induct t) simp_all
 
 lemma map_vars_term_eq:
   "map_vars_term f s = s \<cdot> (Var \<circ> f)"
 by (induct s) auto
 
 lemma ground_map_vars_term [simp]:
   "ground (map_vars_term f t) = ground t"
   by (induct t) simp_all
 
 lemma map_vars_term_subst [simp]:
   "map_vars_term f (t \<cdot> \<sigma>) = t \<cdot> (\<lambda> x. map_vars_term f (\<sigma> x))"
   by (induct t) simp_all
 
 lemma map_vars_term_compose:
   "map_vars_term m1 (map_vars_term m2 t) = map_vars_term (m1 o m2) t"
   by (induct t) simp_all
 
 lemma map_vars_term_id [simp]:
   "map_vars_term id t = t"
   by (induct t) (auto intro: map_idI)
 
 lemma apply_subst_map_vars_term:
   "map_vars_term m t \<cdot> \<sigma> = t \<cdot> (\<sigma> \<circ> m)"
   by (induct t) (auto)
 
 
 end
diff --git a/thys/First_Order_Terms/Unification.thy b/thys/First_Order_Terms/Unification.thy
--- a/thys/First_Order_Terms/Unification.thy
+++ b/thys/First_Order_Terms/Unification.thy
@@ -1,888 +1,888 @@
 (*
 Author:  Christian Sternagel <c.sternagel@gmail.com>
 Author:  René Thiemann <rene.thiemann@uibk.ac.at>
 License: LGPL
 *)
 subsection \<open>A Concrete Unification Algorithm\<close>
 
 theory Unification
   imports
     Abstract_Unification
     Option_Monad
     Renaming2
 begin
 
 definition
   "decompose s t =
     (case (s, t) of
       (Fun f ss, Fun g ts) \<Rightarrow> if f = g then zip_option ss ts else None
     | _ \<Rightarrow> None)"
 
 lemma decompose_same_Fun[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "decompose (Fun f ss) (Fun f ss) = Some (zip ss ss)"
   by (simp add: decompose_def)
 
 lemma decompose_Some [dest]:
   "decompose (Fun f ss) (Fun g ts) = Some E \<Longrightarrow>
     f = g \<and> length ss = length ts \<and> E = zip ss ts"
   by (cases "f = g") (auto simp: decompose_def)
 
 lemma decompose_None [dest]:
   "decompose (Fun f ss) (Fun g ts) = None \<Longrightarrow> f \<noteq> g \<or> length ss \<noteq> length ts"
   by (cases "f = g") (auto simp: decompose_def)
 
 text \<open>Applying a substitution to a list of equations.\<close>
 definition
   subst_list :: "('f, 'v) subst \<Rightarrow> ('f, 'v) equation list \<Rightarrow> ('f, 'v) equation list"
   where
     "subst_list \<sigma> ys = map (\<lambda>p. (fst p \<cdot> \<sigma>, snd p \<cdot> \<sigma>)) ys"
 
 lemma mset_subst_list [simp]:
   "mset (subst_list (subst x t) ys) = subst_mset (subst x t) (mset ys)"
   by (auto simp: subst_mset_def subst_list_def)
 
 lemma subst_list_append:
   "subst_list \<sigma> (xs @ ys) = subst_list \<sigma> xs @ subst_list \<sigma> ys"
 by (auto simp: subst_list_def)
 
 function (sequential)
   unify ::
     "('f, 'v) equation list \<Rightarrow> ('v \<times> ('f, 'v) term) list \<Rightarrow> ('v \<times> ('f, 'v) term) list option"
 where
   "unify [] bs = Some bs"
 | "unify ((Fun f ss, Fun g ts) # E) bs =
     (case decompose (Fun f ss) (Fun g ts) of
       None \<Rightarrow> None
     | Some us \<Rightarrow> unify (us @ E) bs)"
 | "unify ((Var x, t) # E) bs =
     (if t = Var x then unify E bs
     else if x \<in> vars_term t then None
     else unify (subst_list (subst x t) E) ((x, t) # bs))"
 | "unify ((t, Var x) # E) bs =
     (if x \<in> vars_term t then None
     else unify (subst_list (subst x t) E) ((x, t) # bs))"
   by pat_completeness auto
 termination
   by (standard, rule wf_inv_image [of "unif\<inverse>" "mset \<circ> fst", OF wf_converse_unif])
      (force intro: UNIF1.intros simp: unif_def union_commute)+
 
 lemma unify_append_prefix_same: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "(\<forall>e \<in> set es1. fst e = snd e) \<Longrightarrow> unify (es1 @ es2) bs = unify es2 bs"
 proof (induction "es1 @ es2" bs arbitrary: es1 es2 bs rule: unify.induct)
   case (1 bs)
   thus ?case by simp
 next
   case (2 f ss g ts E bs)
   show ?case
   proof (cases es1)
     case Nil
     thus ?thesis by simp
   next
     case (Cons e es1')
     hence e_def: "e = (Fun f ss, Fun g ts)" and E_def: "E = es1' @ es2"
       using "2" by simp_all
     hence "f = g" and "ss = ts"
       using "2.prems" local.Cons by auto
     hence "unify (es1 @ es2) bs = unify ((zip ts ts @ es1') @ es2) bs"
       by (simp add: Cons e_def)
     also have "\<dots> = unify es2 bs"
     proof (rule "2.hyps"(1))
       show "decompose (Fun f ss) (Fun g ts) = Some (zip ts ts)"
         by (simp add: \<open>f = g\<close> \<open>ss = ts\<close>)
     next
       show "zip ts ts @ E = (zip ts ts @ es1') @ es2"
         by (simp add: E_def)
     next
       show "\<forall>e\<in>set (zip ts ts @ es1'). fst e = snd e"
         using "2.prems" by (auto simp: Cons zip_same)
     qed
     finally show ?thesis .
   qed
 next
   case (3 x t E bs)
   show ?case
   proof (cases es1)
     case Nil
     thus ?thesis by simp
   next
     case (Cons e es1')
     hence e_def: "e = (Var x, t)" and E_def: "E = es1' @ es2"
       using 3 by simp_all
     show ?thesis
     proof (cases "t = Var x")
       case True
       show ?thesis
         using 3(1)[OF True E_def]
         using "3.hyps"(3) "3.prems" local.Cons by fastforce
     next
       case False
       thus ?thesis
         using "3.prems" e_def local.Cons by force
     qed
   qed
 next
   case (4 v va x E bs)
   then show ?case
   proof (cases es1)
     case Nil
     thus ?thesis by simp
   next
     case (Cons e es1')
     hence e_def: "e = (Fun v va, Var x)" and E_def: "E = es1' @ es2"
       using 4 by simp_all
     thus ?thesis
       using "4.prems" local.Cons by fastforce
   qed
 qed
 
 corollary unify_Cons_same: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "fst e = snd e \<Longrightarrow> unify (e # es) bs = unify es bs"
   by (rule unify_append_prefix_same[of "[_]", simplified])
 
 corollary unify_same: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "(\<forall>e \<in> set es. fst e = snd e) \<Longrightarrow> unify es bs = Some bs"
   by (rule unify_append_prefix_same[of _ "[]", simplified])
 
 definition subst_of :: "('v \<times> ('f, 'v) term) list \<Rightarrow> ('f, 'v) subst"
   where
     "subst_of ss = List.foldr (\<lambda>(x, t) \<sigma>. \<sigma> \<circ>\<^sub>s subst x t) ss Var"
 
 text \<open>Computing the mgu of two terms.\<close>
 definition mgu :: "('f, 'v) term \<Rightarrow> ('f, 'v) term \<Rightarrow> ('f, 'v) subst option" where
   "mgu s t =
     (case unify [(s, t)] [] of
       None \<Rightarrow> None
     | Some res \<Rightarrow> Some (subst_of res))"
 
 lemma subst_of_simps [simp]:
   "subst_of [] = Var"
   "subst_of ((x, Var x) # ss) = subst_of ss"
   "subst_of (b # ss) = subst_of ss \<circ>\<^sub>s subst (fst b) (snd b)"
   by (simp_all add: subst_of_def split: prod.splits)
 
 lemma subst_of_append [simp]:
   "subst_of (ss @ ts) = subst_of ts \<circ>\<^sub>s subst_of ss"
   by (induct ss) (auto simp: ac_simps)
 
 text \<open>The concrete algorithm \<open>unify\<close> can be simulated by the inference
   rules of \<open>UNIF\<close>.\<close>
 lemma unify_Some_UNIF:
   assumes "unify E bs = Some cs"
   shows "\<exists>ds ss. cs = ds @ bs \<and> subst_of ds = compose ss \<and> UNIF ss (mset E) {#}"
 using assms
 proof (induction E bs arbitrary: cs rule: unify.induct)
   case (2 f ss g ts E bs)
   then obtain us where "decompose (Fun f ss) (Fun g ts) = Some us"
     and [simp]: "f = g" "length ss = length ts" "us = zip ss ts"
     and "unify (us @ E) bs = Some cs" by (auto split: option.splits)
   from "2.IH" [OF this(1, 5)] obtain xs ys
     where "cs = xs @ bs"
     and [simp]: "subst_of xs = compose ys"
     and *: "UNIF ys (mset (us @ E)) {#}" by auto
   then have "UNIF (Var # ys) (mset ((Fun f ss, Fun g ts) # E)) {#}"
     by (force intro: UNIF1.decomp simp: ac_simps)
   moreover have "cs = xs @ bs" by fact
   moreover have "subst_of xs = compose (Var # ys)" by simp
   ultimately show ?case by blast
 next
   case (3 x t E bs)
   show ?case
   proof (cases "t = Var x")
     assume "t = Var x"
     then show ?case
       using 3 by auto (metis UNIF.step compose_simps(2) UNIF1.trivial)
   next
     assume "t \<noteq> Var x"
     with 3 obtain xs ys
       where [simp]: "cs = (ys @ [(x, t)]) @ bs"
       and [simp]: "subst_of ys = compose xs"
       and "x \<notin> vars_term t"
       and "UNIF xs (mset (subst_list (subst x t) E)) {#}"
         by (cases "x \<in> vars_term t") force+
     then have "UNIF (subst x t # xs) (mset ((Var x, t) # E)) {#}"
       by (force intro: UNIF1.Var_left simp: ac_simps)
     moreover have "cs = (ys @ [(x, t)]) @ bs" by simp
     moreover have "subst_of (ys @ [(x, t)]) = compose (subst x t # xs)" by simp
     ultimately show ?case by blast
   qed
 next
   case (4 f ss x E bs)
   with 4 obtain xs ys
     where [simp]: "cs = (ys @ [(x, Fun f ss)]) @ bs"
     and [simp]: "subst_of ys = compose xs"
     and "x \<notin> vars_term (Fun f ss)"
     and "UNIF xs (mset (subst_list (subst x (Fun f ss)) E)) {#}"
       by (cases "x \<in> vars_term (Fun f ss)") force+
   then have "UNIF (subst x (Fun f ss) # xs) (mset ((Fun f ss, Var x) # E)) {#}"
     by (force intro: UNIF1.Var_right simp: ac_simps)
   moreover have "cs = (ys @ [(x, Fun f ss)]) @ bs" by simp
   moreover have "subst_of (ys @ [(x, Fun f ss)]) = compose (subst x (Fun f ss) # xs)" by simp
   ultimately show ?case by blast
 qed force
 
 lemma unify_sound:
   assumes "unify E [] = Some cs"
   shows "is_imgu (subst_of cs) (set E)"
 proof -
   from unify_Some_UNIF [OF assms] obtain ss
     where "subst_of cs = compose ss"
     and "UNIF ss (mset E) {#}" by auto
   with UNIF_empty_imp_is_mgu_compose [OF this(2)]
     and UNIF_idemp [OF this(2)]
     show ?thesis
       by (auto simp add: is_imgu_def is_mgu_def)
          (metis subst_compose_assoc)
 qed
 
 lemma mgu_sound:
   assumes "mgu s t = Some \<sigma>"
   shows "is_imgu \<sigma> {(s, t)}"
 proof -
   obtain ss where "unify [(s, t)] [] = Some ss"
     and "\<sigma> = subst_of ss"
     using assms by (auto simp: mgu_def split: option.splits)
   then have "is_imgu \<sigma> (set [(s, t)])" by (metis unify_sound)
   then show ?thesis by simp
 qed
 
 text \<open>If \<open>unify\<close> gives up, then the given set of equations
   cannot be reduced to the empty set by \<open>UNIF\<close>.\<close>
 lemma unify_None:
   assumes "unify E ss = None"
   shows "\<exists>E'. E' \<noteq> {#} \<and> (mset E, E') \<in> unif\<^sup>!"
 using assms
 proof (induction E ss rule: unify.induct)
   case (1 bs)
   then show ?case by simp
 next
   case (2 f ss g ts E bs)
   moreover
   { assume *: "decompose (Fun f ss) (Fun g ts) = None"
     have ?case
     proof (cases "unifiable (set E)")
       case True
       then have "(mset E, {#}) \<in> unif\<^sup>*"
         by (simp add: unifiable_imp_empty)
       from unif_rtrancl_mono [OF this, of "{#(Fun f ss, Fun g ts)#}"] obtain \<sigma>
         where "(mset E + {#(Fun f ss, Fun g ts)#}, {#(Fun f ss \<cdot> \<sigma>, Fun g ts \<cdot> \<sigma>)#}) \<in> unif\<^sup>*"
         by (auto simp: subst_mset_def)
       moreover have "{#(Fun f ss \<cdot> \<sigma>, Fun g ts \<cdot> \<sigma>)#} \<in> NF unif"
         using decompose_None [OF *]
         by (auto simp: single_is_union NF_def unif_def elim!: UNIF1.cases)
            (metis length_map)
       ultimately show ?thesis
         by auto (metis normalizability_I add_mset_not_empty)
     next
       case False
       moreover have "\<not> unifiable {(Fun f ss, Fun g ts)}"
         using * by (auto simp: unifiable_def)
       ultimately have "\<not> unifiable (set ((Fun f ss, Fun g ts) # E))" by (auto simp: unifiable_def unifiers_def)
       then show ?thesis by (simp add: not_unifiable_imp_not_empty_NF)
     qed }
   moreover
   { fix us
     assume *: "decompose (Fun f ss) (Fun g ts) = Some us"
       and "unify (us @ E) bs = None"
     from "2.IH" [OF this] obtain E'
       where "E' \<noteq> {#}" and "(mset (us @ E), E') \<in> unif\<^sup>!" by blast
     moreover have "(mset ((Fun f ss, Fun g ts) # E), mset (us @ E)) \<in> unif"
     proof -
       have "g = f" and "length ss = length ts" and "us = zip ss ts"
         using * by auto
       then show ?thesis
         by (auto intro: UNIF1.decomp simp: unif_def ac_simps)
     qed
     ultimately have ?case by auto }
   ultimately show ?case by (auto split: option.splits)
 next
   case (3 x t E bs)
   { assume [simp]: "t = Var x"
     obtain E' where "E' \<noteq> {#}" and "(mset E, E') \<in> unif\<^sup>!" using 3 by auto
     moreover have "(mset ((Var x, t) # E), mset E) \<in> unif"
       by (auto intro: UNIF1.trivial simp: unif_def)
     ultimately have ?case by auto }
   moreover
   { assume *: "t \<noteq> Var x" "x \<notin> vars_term t"
     then obtain E' where "E' \<noteq> {#}"
       and "(mset (subst_list (subst x t) E), E') \<in> unif\<^sup>!" using 3 by auto
     moreover have "(mset ((Var x, t) # E), mset (subst_list (subst x t) E)) \<in> unif"
       using * by (auto intro: UNIF1.Var_left simp: unif_def)
     ultimately have ?case by auto }
   moreover
   { assume *: "t \<noteq> Var x" "x \<in> vars_term t"
     then have "x \<in> vars_term t" "is_Fun t" by auto
     then have "\<not> unifiable {(Var x, t)}" by (rule in_vars_is_Fun_not_unifiable)
     then have **: "\<not> unifiable {(Var x \<cdot> \<sigma>, t \<cdot> \<sigma>)}" for \<sigma> :: "('b, 'a) subst"
       using subst_set_reflects_unifiable [of \<sigma> "{(Var x, t)}"] by (auto simp: subst_set_def)
     have ?case
     proof (cases "unifiable (set E)")
       case True
       then have "(mset E, {#}) \<in> unif\<^sup>*"
         by (simp add: unifiable_imp_empty)
       from unif_rtrancl_mono [OF this, of "{#(Var x, t)#}"] obtain \<sigma>
         where "(mset E + {#(Var x, t)#}, {#(Var x \<cdot> \<sigma>, t \<cdot> \<sigma>)#}) \<in> unif\<^sup>*"
         by (auto simp: subst_mset_def)
       moreover obtain E' where "E' \<noteq> {#}"
         and "({#(Var x \<cdot> \<sigma>, t \<cdot> \<sigma>)#}, E') \<in> unif\<^sup>!"
         using not_unifiable_imp_not_empty_NF and **
           by (metis set_mset_single)
       ultimately show ?thesis by auto
     next
       case False
       moreover have "\<not> unifiable {(Var x, t)}"
         using * by (force simp: unifiable_def)
       ultimately have "\<not> unifiable (set ((Var x, t) # E))" by (auto simp: unifiable_def unifiers_def)
       then show ?thesis
         by (simp add: not_unifiable_imp_not_empty_NF)
     qed }
   ultimately show ?case by blast
 next
   case (4 f ss x E bs)
   define t where "t = Fun f ss"
   { assume *: "x \<notin> vars_term t"
     then obtain E' where "E' \<noteq> {#}"
       and "(mset (subst_list (subst x t) E), E') \<in> unif\<^sup>!" using 4 by (auto simp: t_def)
     moreover have "(mset ((t, Var x) # E), mset (subst_list (subst x t) E)) \<in> unif"
       using * by (auto intro: UNIF1.Var_right simp: unif_def)
     ultimately have ?case by (auto simp: t_def) }
   moreover
   { assume "x \<in> vars_term t"
     then have *: "x \<in> vars_term t" "t \<noteq> Var x" by (auto simp: t_def)
     then have "x \<in> vars_term t" "is_Fun t" by auto
     then have "\<not> unifiable {(Var x, t)}" by (rule in_vars_is_Fun_not_unifiable)
     then have **: "\<not> unifiable {(Var x \<cdot> \<sigma>, t \<cdot> \<sigma>)}" for \<sigma> :: "('b, 'a) subst"
       using subst_set_reflects_unifiable [of \<sigma> "{(Var x, t)}"] by (auto simp: subst_set_def)
     have ?case
     proof (cases "unifiable (set E)")
       case True
       then have "(mset E, {#}) \<in> unif\<^sup>*"
         by (simp add: unifiable_imp_empty)
       from unif_rtrancl_mono [OF this, of "{#(t, Var x)#}"] obtain \<sigma>
         where "(mset E + {#(t, Var x)#}, {#(t \<cdot> \<sigma>, Var x \<cdot> \<sigma>)#}) \<in> unif\<^sup>*"
         by (auto simp: subst_mset_def)
       moreover obtain E' where "E' \<noteq> {#}"
         and "({#(t \<cdot> \<sigma>, Var x \<cdot> \<sigma>)#}, E') \<in> unif\<^sup>!"
         using not_unifiable_imp_not_empty_NF and **
           by (metis unifiable_insert_swap set_mset_single)
       ultimately show ?thesis by (auto simp: t_def)
     next
       case False
       moreover have "\<not> unifiable {(t, Var x)}"
         using * by (simp add: unifiable_def)
       ultimately have "\<not> unifiable (set ((t, Var x) # E))" by (auto simp: unifiable_def unifiers_def)
       then show ?thesis by (simp add: not_unifiable_imp_not_empty_NF t_def)
     qed }
   ultimately show ?case by blast
 qed
 
 lemma unify_complete:
   assumes "unify E bs = None"
   shows "unifiers (set E) = {}"
 proof -
   from unify_None [OF assms] obtain E'
     where "E' \<noteq> {#}" and "(mset E, E') \<in> unif\<^sup>!" by blast
   then have "\<not> unifiable (set E)"
     using irreducible_reachable_imp_not_unifiable by force
   then show ?thesis
     by (auto simp: unifiable_def)
 qed
 
 corollary ex_unify_if_unifiers_not_empty: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "unifiers es \<noteq> {} \<Longrightarrow> set xs = es \<Longrightarrow> \<exists>ys. unify xs [] = Some ys"
   using unify_complete by auto
 
 lemma mgu_complete:
   "mgu s t = None \<Longrightarrow> unifiers {(s, t)} = {}"
 proof -
   assume "mgu s t = None"
   then have "unify [(s, t)] [] = None" by (cases "unify [(s, t)] []", auto simp: mgu_def)
   then have "unifiers (set [(s, t)]) = {}" by (rule unify_complete)
   then show ?thesis by simp
 qed
 
 corollary ex_mgu_if_unifiers_not_empty: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "unifiers {(t,u)} \<noteq> {} \<Longrightarrow> \<exists>\<mu>. mgu t u = Some \<mu>"
   using mgu_complete by auto
 
 corollary ex_mgu_if_subst_apply_term_eq_subst_apply_term: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes t u :: "('f, 'v) Term.term" and \<sigma> :: "('f, 'v) subst"
   assumes t_eq_u: "t \<cdot> \<sigma> = u \<cdot> \<sigma>"
   shows "\<exists>\<mu> :: ('f, 'v) subst. Unification.mgu t u = Some \<mu>"
 proof -
   from t_eq_u have "unifiers {(t, u)} \<noteq> {}"
     unfolding unifiers_def by auto
   thus ?thesis
     by (rule ex_mgu_if_unifiers_not_empty)
 qed
 
 lemma finite_subst_domain_subst_of:
   "finite (subst_domain (subst_of xs))"
 proof (induct xs)
   case (Cons x xs)
   moreover have "finite (subst_domain (subst (fst x) (snd x)))" by (metis finite_subst_domain_subst)
   ultimately show ?case
     using subst_domain_compose [of "subst_of xs" "subst (fst x) (snd x)"]
     by (simp del: subst_subst_domain) (metis finite_subset infinite_Un)
 qed simp
 
 lemma unify_subst_domain: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes unif: "unify E [] = Some xs"
   shows "subst_domain (subst_of xs) \<subseteq> (\<Union>e \<in> set E. vars_term (fst e) \<union> vars_term (snd e))"
 proof -
   from unify_Some_UNIF[OF unif] obtain xs' where
     "subst_of xs = compose xs'" and "UNIF xs' (mset E) {#}"
     by auto
   thus ?thesis
     using UNIF_subst_domain_subset
     by (metis (mono_tags, lifting) multiset.set_map set_mset_mset vars_mset_def)
 qed
 
 lemma mgu_subst_domain:
   assumes "mgu s t = Some \<sigma>"
   shows "subst_domain \<sigma> \<subseteq> vars_term s \<union> vars_term t"
 proof -
   obtain xs where "unify [(s, t)] [] = Some xs" and "\<sigma> = subst_of xs"
     using assms by (simp add: mgu_def split: option.splits)
   thus ?thesis
     using unify_subst_domain by fastforce
 qed
 
 lemma mgu_finite_subst_domain:
   "mgu s t = Some \<sigma> \<Longrightarrow> finite (subst_domain \<sigma>)"
   by (drule mgu_subst_domain) (simp add: finite_subset)
 
 lemma unify_range_vars: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes unif: "unify E [] = Some xs"
   shows "range_vars (subst_of xs) \<subseteq> (\<Union>e \<in> set E. vars_term (fst e) \<union> vars_term (snd e))"
 proof -
   from unify_Some_UNIF[OF unif] obtain xs' where
     "subst_of xs = compose xs'" and "UNIF xs' (mset E) {#}"
     by auto
   thus ?thesis
     using UNIF_range_vars_subset
     by (metis (mono_tags, lifting) multiset.set_map set_mset_mset vars_mset_def)
 qed
 
 lemma mgu_range_vars: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "mgu s t = Some \<mu>"
   shows "range_vars \<mu> \<subseteq> vars_term s \<union> vars_term t"
 proof -
   obtain xs where "unify [(s, t)] [] = Some xs" and "\<mu> = subst_of xs"
     using assms by (simp add: mgu_def split: option.splits)
   thus ?thesis
     using unify_range_vars by fastforce
 qed
 
 lemma unify_subst_domain_range_vars_disjoint: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes unif: "unify E [] = Some xs"
   shows "subst_domain (subst_of xs) \<inter> range_vars (subst_of xs) = {}"
 proof -
   from unify_Some_UNIF[OF unif] obtain xs' where
     "subst_of xs = compose xs'" and "UNIF xs' (mset E) {#}"
     by auto
   thus ?thesis
     using UNIF_subst_domain_range_vars_Int by metis
 qed
 
 lemma mgu_subst_domain_range_vars_disjoint: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "mgu s t = Some \<mu>"
   shows "subst_domain \<mu> \<inter> range_vars \<mu> = {}"
 proof -
   obtain xs where "unify [(s, t)] [] = Some xs" and "\<mu> = subst_of xs"
     using assms by (simp add: mgu_def split: option.splits)
   thus ?thesis
     using unify_subst_domain_range_vars_disjoint by metis
 qed
 
 corollary subst_apply_term_eq_subst_apply_term_if_mgu: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes mgu_t_u: "mgu t u = Some \<mu>"
   shows "t \<cdot> \<mu> = u \<cdot> \<mu>"
   using mgu_sound[OF mgu_t_u]
   by (simp add: is_imgu_def unifiers_def)
 
 lemma mgu_same: "mgu t t = Some Var" \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   by (simp add: mgu_def unify_same)
 
 lemma mgu_is_Var_if_not_in_equations: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<mu> :: "('f, 'v) subst" and E :: "('f, 'v) equations" and x :: 'v
   assumes
     mgu_\<mu>: "is_mgu \<mu> E" and
     x_not_in: "x \<notin> (\<Union>e\<in>E. vars_term (fst e) \<union> vars_term (snd e))"
   shows "is_Var (\<mu> x)"
 proof -
   from mgu_\<mu> have unif_\<mu>: "\<mu> \<in> unifiers E" and minimal_\<mu>: "\<forall>\<tau> \<in> unifiers E. \<exists>\<gamma>. \<tau> = \<mu> \<circ>\<^sub>s \<gamma>"
     by (simp_all add: is_mgu_def)
 
   define \<tau> :: "('f, 'v) subst" where
     "\<tau> = (\<lambda>x. if x \<in> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e)) then \<mu> x else Var x)"
 
   have \<open>\<tau> \<in> unifiers E\<close>
     unfolding unifiers_def mem_Collect_eq
   proof (rule ballI)
     fix e assume "e \<in> E"
     with unif_\<mu> have "fst e \<cdot> \<mu> = snd e \<cdot> \<mu>"
       by blast
     moreover from \<open>e \<in> E\<close> have "fst e \<cdot> \<tau> = fst e \<cdot> \<mu>" and "snd e \<cdot> \<tau> = snd e \<cdot> \<mu>"
       unfolding term_subst_eq_conv
       by (auto simp: \<tau>_def)
     ultimately show "fst e \<cdot> \<tau> = snd e \<cdot> \<tau>"
       by simp
   qed
   with minimal_\<mu> obtain \<gamma> where "\<mu> \<circ>\<^sub>s \<gamma> = \<tau>"
     by auto
   with x_not_in have "(\<mu> \<circ>\<^sub>s \<gamma>) x = Var x"
     by (simp add: \<tau>_def)
   thus "is_Var (\<mu> x)"
     by (metis subst_apply_eq_Var subst_compose term.disc(1))
 qed
 
 corollary mgu_ball_is_Var: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "is_mgu \<mu> E \<Longrightarrow> \<forall>x \<in> - (\<Union>e\<in>E. vars_term (fst e) \<union> vars_term (snd e)). is_Var (\<mu> x)"
   by (rule ballI) (rule mgu_is_Var_if_not_in_equations[folded Compl_iff])
 
 lemma mgu_inj_on: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<mu> :: "('f, 'v) subst" and E :: "('f, 'v) equations"
   assumes mgu_\<mu>: "is_mgu \<mu> E"
   shows "inj_on \<mu> (- (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e)))"
 proof (rule inj_onI)
   fix x y
   assume
     x_in: "x \<in> - (\<Union>e\<in>E. vars_term (fst e) \<union> vars_term (snd e))" and
     y_in: "y \<in> - (\<Union>e\<in>E. vars_term (fst e) \<union> vars_term (snd e))" and
     "\<mu> x = \<mu> y"
 
   from mgu_\<mu> have unif_\<mu>: "\<mu> \<in> unifiers E" and minimal_\<mu>: "\<forall>\<tau> \<in> unifiers E. \<exists>\<gamma>. \<tau> = \<mu> \<circ>\<^sub>s \<gamma>"
     by (simp_all add: is_mgu_def)
 
   define \<tau> :: "('f, 'v) subst" where
     "\<tau> = (\<lambda>x. if x \<in> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e)) then \<mu> x else Var x)"
 
   have \<open>\<tau> \<in> unifiers E\<close>
     unfolding unifiers_def mem_Collect_eq
   proof (rule ballI)
     fix e assume "e \<in> E"
     with unif_\<mu> have "fst e \<cdot> \<mu> = snd e \<cdot> \<mu>"
       by blast
     moreover from \<open>e \<in> E\<close> have "fst e \<cdot> \<tau> = fst e \<cdot> \<mu>" and "snd e \<cdot> \<tau> = snd e \<cdot> \<mu>"
       unfolding term_subst_eq_conv
       by (auto simp: \<tau>_def)
     ultimately show "fst e \<cdot> \<tau> = snd e \<cdot> \<tau>"
       by simp
   qed
   with minimal_\<mu> obtain \<gamma> where "\<mu> \<circ>\<^sub>s \<gamma> = \<tau>"
     by auto
   hence "(\<mu> \<circ>\<^sub>s \<gamma>) x = Var x" and "(\<mu> \<circ>\<^sub>s \<gamma>) y = Var y"
     using ComplD[OF x_in] ComplD[OF y_in]
     by (simp_all add: \<tau>_def)
   with \<open>\<mu> x = \<mu> y\<close> show "x = y"
     by (simp add: subst_compose_def)
 qed
 
 lemma imgu_subst_domain_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<mu> :: "('f, 'v) subst" and E :: "('f, 'v) equations" and Evars :: "'v set"
   assumes imgu_\<mu>: "is_imgu \<mu> E" and fin_E: "finite E"
   defines "Evars \<equiv> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e))"
   shows "subst_domain \<mu> \<subseteq> Evars"
 proof (intro Set.subsetI)
   from imgu_\<mu> have unif_\<mu>: "\<mu> \<in> unifiers E" and minimal_\<mu>: "\<forall>\<tau> \<in> unifiers E. \<mu> \<circ>\<^sub>s \<tau> = \<tau>"
     by (simp_all add: is_imgu_def)
 
   from fin_E obtain es :: "('f, 'v) equation list" where
     "set es = E"
     using finite_list by auto
   then obtain xs :: "('v \<times> ('f, 'v) Term.term) list" where
     unify_es: "unify es [] = Some xs"
     using unif_\<mu> ex_unify_if_unifiers_not_empty by blast
 
   define \<tau> :: "('f, 'v) subst" where
     "\<tau> = subst_of xs"
 
   have dom_\<tau>: "subst_domain \<tau> \<subseteq> Evars"
     using unify_subst_domain[OF unify_es, unfolded \<open>set es = E\<close>, folded Evars_def \<tau>_def] .
   have range_vars_\<tau>: "range_vars \<tau> \<subseteq> Evars"
     using unify_range_vars[OF unify_es, unfolded \<open>set es = E\<close>, folded Evars_def \<tau>_def] .
 
   have "\<tau> \<in> unifiers E"
     using \<open>set es = E\<close> unify_es \<tau>_def is_imgu_def unify_sound by blast
   with minimal_\<mu> have \<mu>_comp_\<tau>: "\<And>x. (\<mu> \<circ>\<^sub>s \<tau>) x = \<tau> x"
     by auto
 
   fix x :: 'v assume "x \<in> subst_domain \<mu>"
   hence "\<mu> x \<noteq> Var x"
     by (simp add: subst_domain_def)
 
   show "x \<in> Evars"
   proof (cases "x \<in> subst_domain \<tau>")
     case True
     thus ?thesis
       using dom_\<tau> by auto
   next
     case False
     hence "\<tau> x = Var x"
       by (simp add: subst_domain_def)
     hence "\<mu> x \<cdot> \<tau> = Var x"
       using \<mu>_comp_\<tau>[of x] by (simp add: subst_compose)
     thus ?thesis
-    proof (rule subst_apply_eq_Var[of "\<mu> x" \<tau> x])
+    proof (rule subst_apply_eq_Var)
       show "\<And>y. \<mu> x = Var y \<Longrightarrow> \<tau> y = Var x \<Longrightarrow> ?thesis"
         using \<open>\<mu> x \<noteq> Var x\<close> range_vars_\<tau> mem_range_varsI[of \<tau> _ x] by auto
     qed
   qed
 qed
 
 lemma imgu_range_vars_of_equations_vars_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<mu> :: "('f, 'v) subst" and E :: "('f, 'v) equations" and Evars :: "'v set"
   assumes imgu_\<mu>: "is_imgu \<mu> E" and fin_E: "finite E"
   defines "Evars \<equiv> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e))"
   shows "(\<Union>x \<in> Evars. vars_term (\<mu> x)) \<subseteq> Evars"
 proof (rule Set.subsetI)
   from imgu_\<mu> have unif_\<mu>: "\<mu> \<in> unifiers E" and minimal_\<mu>: "\<forall>\<tau> \<in> unifiers E. \<mu> \<circ>\<^sub>s \<tau> = \<tau>"
     by (simp_all add: is_imgu_def)
 
   from fin_E obtain es :: "('f, 'v) equation list" where
     "set es = E"
     using finite_list by auto
   then obtain xs :: "('v \<times> ('f, 'v) Term.term) list" where
     unify_es: "unify es [] = Some xs"
     using unif_\<mu> ex_unify_if_unifiers_not_empty by blast
 
   define \<tau> :: "('f, 'v) subst" where
     "\<tau> = subst_of xs"
 
   have dom_\<tau>: "subst_domain \<tau> \<subseteq> Evars"
     using unify_subst_domain[OF unify_es, unfolded \<open>set es = E\<close>, folded Evars_def \<tau>_def] .
   have range_vars_\<tau>: "range_vars \<tau> \<subseteq> Evars"
     using unify_range_vars[OF unify_es, unfolded \<open>set es = E\<close>, folded Evars_def \<tau>_def] .
   hence ball_vars_apply_\<tau>_subset: "\<forall>x \<in> subst_domain \<tau>. vars_term (\<tau> x) \<subseteq> Evars"
     unfolding range_vars_def
     by (simp add: SUP_le_iff)
 
   have "\<tau> \<in> unifiers E"
     using \<open>set es = E\<close> unify_es \<tau>_def is_imgu_def unify_sound by blast
   with minimal_\<mu> have \<mu>_comp_\<tau>: "\<And>x. (\<mu> \<circ>\<^sub>s \<tau>) x = \<tau> x"
     by auto
 
   fix y :: 'v assume "y \<in> (\<Union>x \<in> Evars. vars_term (\<mu> x))"
   then obtain x :: 'v where
     x_in: "x \<in> Evars" and y_in: "y \<in> vars_term (\<mu> x)"
     by (auto simp: subst_domain_def)
   have vars_\<tau>_x: "vars_term (\<tau> x) \<subseteq> Evars"
     using ball_vars_apply_\<tau>_subset subst_domain_def x_in by fastforce
 
   show "y \<in> Evars"
   proof (rule ccontr)
     assume "y \<notin> Evars"
     hence "y \<notin> vars_term (\<tau> x)"
       using vars_\<tau>_x by blast
     moreover have "y \<in> vars_term ((\<mu> \<circ>\<^sub>s \<tau>) x)"
     proof -
       have "\<tau> y = Var y"
         using \<open>y \<notin> Evars\<close> dom_\<tau>
         by (auto simp add: subst_domain_def)
       thus ?thesis
         unfolding subst_compose_def vars_term_subst_apply_term UN_iff
         using y_in by force
     qed
     ultimately show False
       using \<mu>_comp_\<tau>[of x] by simp
   qed
 qed
 
 lemma imgu_range_vars_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<mu> :: "('f, 'v) subst" and E :: "('f, 'v) equations"
   assumes imgu_\<mu>: "is_imgu \<mu> E" and fin_E: "finite E"
   shows "range_vars \<mu> \<subseteq> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e))"
 proof -
   have "range_vars \<mu> = (\<Union>x \<in> subst_domain \<mu>. vars_term (\<mu> x))"
     by (simp add: range_vars_def)
   also have "\<dots> \<subseteq> (\<Union>x \<in> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e)). vars_term (\<mu> x))"
     using imgu_subst_domain_subset[OF imgu_\<mu> fin_E] by fast
   also have "\<dots> \<subseteq> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e))"
     using imgu_range_vars_of_equations_vars_subset[OF imgu_\<mu> fin_E] by metis
   finally show ?thesis .
 qed
 
 
 definition the_mgu :: "('f, 'v) term \<Rightarrow> ('f, 'v) term \<Rightarrow> ('f ,'v) subst" where
   "the_mgu s t = (case mgu s t of None \<Rightarrow> Var | Some \<delta> \<Rightarrow> \<delta>)"
 
 lemma the_mgu_is_imgu:
   fixes \<sigma> :: "('f, 'v) subst"
   assumes "s \<cdot> \<sigma> = t \<cdot> \<sigma>"
   shows "is_imgu (the_mgu s t) {(s, t)}"
 proof -
   from assms have "unifiers {(s, t)} \<noteq> {}" by (force simp: unifiers_def)
   then obtain \<tau> where "mgu s t = Some \<tau>"
     and "the_mgu s t = \<tau>"
     using mgu_complete by (auto simp: the_mgu_def)
   with mgu_sound show ?thesis by blast
 qed
 
 lemma the_mgu:
   fixes \<sigma> :: "('f, 'v) subst"
   assumes "s \<cdot> \<sigma> = t \<cdot> \<sigma>"
   shows "s \<cdot> the_mgu s t = t \<cdot> the_mgu s t \<and> \<sigma> = the_mgu s t \<circ>\<^sub>s \<sigma>" 
 proof -
   have *: "\<sigma> \<in> unifiers {(s, t)}" by (force simp: assms unifiers_def)
   show ?thesis
   proof (cases "mgu s t")
     assume "mgu s t = None"
     then have "unifiers {(s, t)} = {}" by (rule mgu_complete)
     with * show ?thesis by simp
   next
     fix \<tau>
     assume "mgu s t = Some \<tau>"
     moreover then have "is_imgu \<tau> {(s, t)}" by (rule mgu_sound)
     ultimately have "is_imgu (the_mgu s t) {(s, t)}" by (unfold the_mgu_def, simp)
     with * show ?thesis by (auto simp: is_imgu_def unifiers_def)
   qed
 qed
 
 subsubsection \<open>Unification of two terms where variables should be considered disjoint\<close>
 
 definition
   mgu_var_disjoint_generic ::
     "('v \<Rightarrow> 'u) \<Rightarrow> ('w \<Rightarrow> 'u) \<Rightarrow> ('f, 'v) term \<Rightarrow> ('f, 'w) term \<Rightarrow>
       (('f, 'v, 'u) gsubst \<times> ('f, 'w, 'u) gsubst) option"
 where
   "mgu_var_disjoint_generic vu wu s t =
     (case mgu (map_vars_term vu s) (map_vars_term wu t) of
       None \<Rightarrow> None 
     | Some \<gamma> \<Rightarrow> Some (\<gamma> \<circ> vu, \<gamma> \<circ> wu))"
 
 lemma mgu_var_disjoint_generic_sound: 
   assumes unif: "mgu_var_disjoint_generic vu wu s t = Some (\<gamma>1, \<gamma>2)"
   shows "s \<cdot> \<gamma>1 = t \<cdot> \<gamma>2"
 proof -
   from unif[unfolded mgu_var_disjoint_generic_def] obtain \<gamma> where
     unif2: "mgu (map_vars_term vu s) (map_vars_term wu t) = Some \<gamma>"
     by (cases "mgu (map_vars_term vu s) (map_vars_term wu t)", auto)
   from mgu_sound[OF unif2[unfolded mgu_var_disjoint_generic_def], unfolded is_imgu_def unifiers_def]
   have "map_vars_term vu s \<cdot> \<gamma> = map_vars_term wu t \<cdot> \<gamma>" by auto
   from this[unfolded apply_subst_map_vars_term] unif[unfolded mgu_var_disjoint_generic_def unif2] 
   show ?thesis by simp
 qed
 
 (* if terms s and t can become identical via two substitutions \<sigma> and \<delta> 
    then mgu_var_disjoint yields two more general substitutions \<mu>1 \<mu>2 *)
 lemma mgu_var_disjoint_generic_complete:
   fixes \<sigma> :: "('f, 'v, 'u) gsubst" and \<tau> :: "('f, 'w, 'u) gsubst" 
     and vu :: "'v \<Rightarrow> 'u" and wu:: "'w \<Rightarrow> 'u"
   assumes inj: "inj vu" "inj wu"
     and vwu: "range vu \<inter> range wu = {}"
     and unif_disj: "s \<cdot> \<sigma> = t \<cdot> \<tau>"
   shows "\<exists>\<mu>1 \<mu>2 \<delta>. mgu_var_disjoint_generic vu wu s t = Some (\<mu>1, \<mu>2) \<and> 
     \<sigma> = \<mu>1 \<circ>\<^sub>s \<delta> \<and>
     \<tau> = \<mu>2 \<circ>\<^sub>s \<delta> \<and>
     s \<cdot> \<mu>1 = t \<cdot> \<mu>2"
 proof -
   note inv1[simp] = the_inv_f_f[OF inj(1)]
   note inv2[simp] = the_inv_f_f[OF inj(2)]
   obtain \<gamma> :: "('f,'u)subst" where gamma: "\<gamma> = (\<lambda> x. if x \<in> range vu then \<sigma> (the_inv vu x) else \<tau> (the_inv wu x))" by auto 
   have ids: "s \<cdot> \<sigma> = map_vars_term vu s \<cdot> \<gamma>" unfolding gamma
     by (induct s, auto)
   have idt: "t \<cdot> \<tau> = map_vars_term wu t \<cdot> \<gamma>" unfolding gamma
     by (induct t, insert vwu, auto)
   from unif_disj ids idt
   have unif: "map_vars_term vu s \<cdot> \<gamma> = map_vars_term wu t \<cdot> \<gamma>" (is "?s \<cdot> \<gamma> = ?t \<cdot> \<gamma>") by auto
   from the_mgu[OF unif] have unif2: "?s \<cdot> the_mgu ?s ?t = ?t \<cdot> the_mgu ?s ?t" and inst: "\<gamma> = the_mgu ?s ?t \<circ>\<^sub>s \<gamma>" by auto
   have "mgu ?s ?t = Some (the_mgu ?s ?t)" unfolding the_mgu_def
     using mgu_complete[unfolded unifiers_def] unif
     by (cases "mgu ?s ?t", auto)
   with inst obtain \<mu> where mu: "mgu ?s ?t = Some \<mu>" and gamma_mu: "\<gamma> = \<mu> \<circ>\<^sub>s \<gamma>" by auto
   let ?tau1 = "\<mu> \<circ> vu"
   let ?tau2 = "\<mu> \<circ> wu"
   show ?thesis unfolding mgu_var_disjoint_generic_def mu option.simps
   proof (intro exI conjI, rule refl)
     show "\<sigma> = ?tau1 \<circ>\<^sub>s \<gamma>"
     proof (rule ext)
       fix x
       have "(?tau1 \<circ>\<^sub>s \<gamma>) x = \<gamma> (vu x)" using fun_cong[OF gamma_mu, of "vu x"] by (simp add: subst_compose_def)
       also have "... = \<sigma> x" unfolding gamma by simp
       finally show "\<sigma> x = (?tau1 \<circ>\<^sub>s \<gamma>) x" by simp
     qed
   next
     show "\<tau> = ?tau2 \<circ>\<^sub>s \<gamma>"
     proof (rule ext)
       fix x
       have "(?tau2 \<circ>\<^sub>s \<gamma>) x = \<gamma> (wu x)" using fun_cong[OF gamma_mu, of "wu x"] by (simp add: subst_compose_def)
       also have "... = \<tau> x" unfolding gamma using vwu by auto
       finally show "\<tau> x = (?tau2 \<circ>\<^sub>s \<gamma>) x" by simp
     qed
   next
     have "s \<cdot> ?tau1 = map_vars_term vu s \<cdot> \<mu>" unfolding apply_subst_map_vars_term ..
     also have "... = map_vars_term wu t \<cdot> \<mu>"
       unfolding unif2[unfolded the_mgu_def mu option.simps] ..
     also have "... = t \<cdot> ?tau2" unfolding apply_subst_map_vars_term ..
     finally show "s \<cdot> ?tau1 = t \<cdot> ?tau2" .
   qed
 qed
 
 abbreviation "mgu_var_disjoint_sum \<equiv> mgu_var_disjoint_generic Inl Inr"
 
 lemma mgu_var_disjoint_sum_sound: 
   "mgu_var_disjoint_sum s t = Some (\<gamma>1, \<gamma>2) \<Longrightarrow> s \<cdot> \<gamma>1 = t \<cdot> \<gamma>2"
   by (rule mgu_var_disjoint_generic_sound)
 
 lemma mgu_var_disjoint_sum_complete:
   fixes \<sigma> :: "('f, 'v, 'v + 'w) gsubst" and \<tau> :: "('f, 'w, 'v + 'w) gsubst"
   assumes unif_disj: "s \<cdot> \<sigma> = t \<cdot> \<tau>"
   shows "\<exists>\<mu>1 \<mu>2 \<delta>. mgu_var_disjoint_sum s t = Some (\<mu>1, \<mu>2) \<and> 
     \<sigma> = \<mu>1 \<circ>\<^sub>s \<delta> \<and>
     \<tau> = \<mu>2 \<circ>\<^sub>s \<delta> \<and>
     s \<cdot> \<mu>1 = t \<cdot> \<mu>2"
   by (rule mgu_var_disjoint_generic_complete[OF _ _ _ unif_disj], auto simp: inj_on_def)
 
 lemma mgu_var_disjoint_sum_instance:
   fixes \<sigma> :: "('f, 'v) subst" and \<delta> :: "('f, 'v) subst"
   assumes unif_disj: "s \<cdot> \<sigma> = t \<cdot> \<delta>"
   shows "\<exists>\<mu>1 \<mu>2 \<tau>. mgu_var_disjoint_sum s t = Some (\<mu>1, \<mu>2) \<and>
     \<sigma> = \<mu>1 \<circ>\<^sub>s \<tau> \<and>
     \<delta> = \<mu>2 \<circ>\<^sub>s \<tau> \<and> 
     s \<cdot> \<mu>1 = t \<cdot> \<mu>2"
 proof -
   let ?map = "\<lambda> m \<sigma> v. map_vars_term m (\<sigma> v)"
   let ?m = "?map (Inl :: ('v \<Rightarrow> 'v + 'v))"
   let ?m' = "?map (case_sum (\<lambda> x. x) (\<lambda> x. x))"
   from unif_disj have id: "map_vars_term Inl (s \<cdot> \<sigma>) = map_vars_term Inl (t \<cdot> \<delta>)" by simp
   from mgu_var_disjoint_sum_complete[OF id[unfolded map_vars_term_subst]]
   obtain \<mu>1 \<mu>2 \<tau> where mgu: "mgu_var_disjoint_sum s t = Some (\<mu>1,\<mu>2)"
     and \<sigma>: "?m \<sigma> = \<mu>1 \<circ>\<^sub>s \<tau>" 
     and \<delta>: "?m \<delta> = \<mu>2 \<circ>\<^sub>s \<tau>"
     and unif: "s \<cdot> \<mu>1 = t \<cdot> \<mu>2" by blast
   {
     fix \<sigma> :: "('f, 'v) subst"
     have "?m' (?m \<sigma>) = \<sigma>" by (simp add: map_vars_term_compose o_def term.map_ident)
   } note id = this
   {
     fix \<mu> :: "('f,'v,'v+'v)gsubst" and \<tau> :: "('f,'v + 'v)subst"
     have "?m' (\<mu> \<circ>\<^sub>s \<tau>) = \<mu> \<circ>\<^sub>s ?m' \<tau>"
       by (rule ext, unfold subst_compose_def, simp add: map_vars_term_subst)
   } note id' = this
   from arg_cong[OF \<sigma>, of ?m', unfolded id id'] have \<sigma>: "\<sigma> = \<mu>1 \<circ>\<^sub>s ?m' \<tau>" .
   from arg_cong[OF \<delta>, of ?m', unfolded id id'] have \<delta>: "\<delta> = \<mu>2 \<circ>\<^sub>s ?m' \<tau>" .
   show ?thesis
     by (intro exI conjI, rule mgu, rule \<sigma>, rule \<delta>, rule unif)
 qed
 
 subsubsection \<open>A variable disjoint unification algorithm without changing the type\<close>
 
 text \<open>We pass the renaming function as additional argument\<close>
 
 definition mgu_vd :: "'v :: infinite renaming2 \<Rightarrow> _ \<Rightarrow> _" where
   "mgu_vd r = mgu_var_disjoint_generic (rename_1 r) (rename_2 r)" 
 
 lemma mgu_vd_sound: "mgu_vd r s t = Some (\<gamma>1, \<gamma>2) \<Longrightarrow> s \<cdot> \<gamma>1 = t \<cdot> \<gamma>2"
   unfolding mgu_vd_def by (rule mgu_var_disjoint_generic_sound)
 
 lemma mgu_vd_complete: 
   fixes \<sigma> :: "('f, 'v :: infinite) subst" and \<tau> :: "('f, 'v) subst" 
   assumes unif_disj: "s \<cdot> \<sigma> = t \<cdot> \<tau>"
   shows "\<exists>\<mu>1 \<mu>2 \<delta>. mgu_vd r s t = Some (\<mu>1, \<mu>2) \<and>
     \<sigma> = \<mu>1 \<circ>\<^sub>s \<delta> \<and>
     \<tau> = \<mu>2 \<circ>\<^sub>s \<delta> \<and>
     s \<cdot> \<mu>1 = t \<cdot> \<mu>2"
   unfolding mgu_vd_def
   by (rule mgu_var_disjoint_generic_complete[OF rename_12 unif_disj])
 
 end
diff --git a/thys/Rewrite_Properties_Reduction/Rewriting/Replace_Constant.thy b/thys/Rewrite_Properties_Reduction/Rewriting/Replace_Constant.thy
--- a/thys/Rewrite_Properties_Reduction/Rewriting/Replace_Constant.thy
+++ b/thys/Rewrite_Properties_Reduction/Rewriting/Replace_Constant.thy
@@ -1,370 +1,370 @@
 theory Replace_Constant
   imports Rewriting
 begin
 
 subsection \<open>Removing/Replacing constants in a rewrite sequence that do not appear in the rewrite system\<close>
 lemma funas_term_const_subst_conv:
   "(c, 0) \<notin> funas_term l \<longleftrightarrow> \<not> (l \<unrhd> constT c)"
 proof (induct l)
   case (Fun f ts) then show ?case
     by auto (metis Fun_supt supteq_supt_conv term.inject(2))+
 qed (auto simp add: supteq_var_imp_eq)
 
 lemma fresh_const_single_step_replace:
   assumes lin: "linear_sys \<R>" and fresh: "(c, 0) \<notin> funas_rel \<R>"
     and occ: "p \<in> poss_of_term (constT c) s" and step: "(s, t) \<in> rstep \<R>"
   shows "(s[p \<leftarrow> u], t) \<in> rstep \<R> \<or>
     (\<exists> q. q \<in> poss_of_term (constT c) t \<and> (s[p \<leftarrow> u], t[q \<leftarrow> u]) \<in> rstep \<R>)"
 proof -
   from occ have const: "p \<in> poss s \<and> s |_ p = constT c" by auto
   from step obtain C l r \<sigma> where t [simp]: "s = C\<langle>l \<cdot> \<sigma>\<rangle>" "t = C\<langle>r \<cdot> \<sigma>\<rangle>"
     and rule: "(l, r) \<in> \<R>" by blast
   from rule lin have lin: "linear_term l" "linear_term r" by fastforce+
   from fresh rule have nt_lhs: "(c, 0) \<notin> funas_term l" by (auto simp: funas_rel_def)
   consider (par) "p \<bottom> (hole_pos C)" | (below) "hole_pos C \<le>\<^sub>p p" using occ
     by (auto dest: poss_of_term_const_ctxt_apply)
   then show ?thesis
   proof cases
     case par
     then have possc: "p \<in> possc C" using const t possc_def by blast 
     then have "p \<in> poss_of_term (constT c) t" "(s[p \<leftarrow> u], t[p \<leftarrow> u]) \<in> rstep \<R>"
       using const par_hole_pos_replace_term_context_at[OF par]
       using possc_subt_at_ctxt_apply[OF possc par, of "r \<cdot> \<sigma>" "l \<cdot> \<sigma>"] rule
       by auto (metis par par_pos_replace_pres replace_at_hole_pos) 
     then show ?thesis by blast
   next
     case below
     then obtain q where [simp]:"p = hole_pos C @ q" and poss: "q \<in> poss (l \<cdot> \<sigma>)"
       using const position_less_eq_def
       by (metis (full_types) ctxt_at_pos_hole_pos ctxt_at_pos_subt_at_pos poss_append_poss t(1))
     have const: "l \<cdot> \<sigma> |_ q = constT c" using const by auto
     from nt_lhs have "\<exists> r. r \<in> varposs l \<and> r \<le>\<^sub>p q" using const poss
     proof (induct l arbitrary: q)
       case (Var x)
       then show ?case by auto
     next
       case (Fun f ts)
       from Fun(1)[OF nth_mem, of "hd q" "tl q"] Fun(2-) obtain r where
         "r \<in> varposs (ts ! hd q) \<and> r \<le>\<^sub>p tl q"
         by (cases q) auto
       then show ?case using Fun(2- 4)
         by (intro exI[of _ "hd q # r"]) auto
     qed
     then obtain x v where varposs: "v \<in> varposs l" "v \<le>\<^sub>p q" "l |_ v = Var x"
       unfolding varposs_def by blast
     let ?\<tau> = "\<lambda>x. if Var x = l |_ v then (\<sigma> x)[q -\<^sub>p v \<leftarrow> u] else \<sigma> x"
     show ?thesis
     proof (cases "x \<in> vars_term r")
       case True
       then obtain q' where varposs_r: "q' \<in> varposs r" "r |_ q' = Var x"
         by (metis vars_term_varposs_iff)
       have "(s[p \<leftarrow> u], t[(hole_pos C) @ q' @ (q -\<^sub>p v) \<leftarrow> u]) \<in> rstep \<R>"
         using lin varposs rule varposs_r
         by (auto simp: linear_term_varposs_subst_replace_term intro!: rstep_ctxtI)
           (smt (verit, ccfv_SIG) pos_diff_append_itself rrstep.intros rrstep_rstep_mono subset_eq term_subst_eq)
       moreover have "(hole_pos C) @ q' @ q -\<^sub>p v \<in> poss_of_term (constT c) t"
         using varposs_r varposs poss const poss_pos_diffI[OF varposs(2) poss]
         using subt_at_append_dist[of q' "q -\<^sub>p v" "r \<cdot> \<sigma>"]
         by (auto simp: poss_append_poss varposs_imp_poss[THEN subst_subt_at_dist] varposs_imp_poss[THEN subsetD[OF subst_poss_mono]])
-          (metis pos_les_eq_append_diff subst_apply_term.simps(1) subst_subt_at_dist subt_at_append_dist varposs_imp_poss)
+          (metis pos_les_eq_append_diff eval_term.simps(1) subst_subt_at_dist subt_at_append_dist varposs_imp_poss)
       ultimately show ?thesis by auto
     next
       case False
       then have [simp]: "r \<cdot> \<sigma> = r \<cdot> ?\<tau>" using varposs
         by (auto simp add: term_subst_eq_conv)
       have "(s[p \<leftarrow> u], t) \<in> rstep \<R>" using rule varposs lin
         by (auto simp: linear_term_varposs_subst_replace_term)
       then show ?thesis by auto
     qed
   qed
 qed
 
 lemma fresh_const_steps_replace:
   assumes lin: "linear_sys \<R>" and fresh: "(c, 0) \<notin> funas_rel \<R>"
     and occ: "p \<in> poss_of_term (constT c) s" and steps: "(s, t) \<in> (rstep \<R>)\<^sup>+"
   shows "(s[p \<leftarrow> u], t) \<in> (rstep \<R>)\<^sup>+ \<or>
     (\<exists> q. q \<in> poss_of_term (constT c) t \<and> (s[p \<leftarrow> u], t[q \<leftarrow> u]) \<in> (rstep \<R>)\<^sup>+)"
   using steps occ
 proof (induct arbitrary: p rule: converse_trancl_induct)
   case (base s)
   from fresh_const_single_step_replace[OF lin fresh base(2, 1)] show ?case
     by (meson r_into_trancl')
 next
   case (step s t)
   from fresh_const_single_step_replace[OF lin fresh step(4, 1)]
   consider (a) "(s[p \<leftarrow> u], t) \<in> rstep \<R>" | (b) "\<exists>q. q \<in> poss_of_term (constT c) t \<and> (s[p \<leftarrow> u], t[q \<leftarrow> u]) \<in> rstep \<R>" by blast
   then show ?case
   proof cases
     case a then show ?thesis using step(2)
       by auto
   next
     case b
     then obtain q where "q \<in> poss_of_term (constT c) t" "(s[p \<leftarrow> u], t[q \<leftarrow> u]) \<in> rstep \<R>" by blast
     from step(3)[OF this(1)] this(2) show ?thesis
       by (metis trancl_into_trancl2)
   qed
 qed
 
 lemma remove_const_lhs_steps:
   assumes lin: "linear_sys \<R>" and fresh: "(c, 0) \<notin> funas_rel \<R>"
     and const: "(c, 0) \<notin> funas_term t"
     and pos: "p \<in> poss_of_term (constT c) s" 
     and steps: "(s, t) \<in> (rstep \<R>)\<^sup>+"
   shows "(s[p \<leftarrow> u], t) \<in> (rstep \<R>)\<^sup>+" using steps pos const fresh_const_steps_replace
   by (metis fresh funas_term_const_subst_conv lin poss_of_termE subt_at_imp_supteq)
 
 
 text \<open>Now we can show that we may remove a constant substitution\<close>
 
 definition const_replace_closed where
   "const_replace_closed c U = (\<forall> s t u p.
     p \<in> poss_of_term (constT c) s \<longrightarrow> (s, t) \<in> U \<longrightarrow>
     (\<exists> q. q \<in> poss_of_term (constT c) t \<and> (s[p \<leftarrow> u], t[q \<leftarrow> u]) \<in> U) \<or> (s[p \<leftarrow> u], t) \<in> U)"
 
 lemma const_replace_closedD:
   assumes "const_replace_closed c U" "p \<in> poss_of_term (constT c) s" "(s, t) \<in> U"
   shows "(s[p \<leftarrow> u], t) \<in> U \<or> (\<exists> q. q \<in> poss_of_term (constT c) t \<and> (s[p \<leftarrow> u], t[q \<leftarrow> u]) \<in> U)" using assms
   unfolding const_replace_closed_def by blast
 
 lemma const_replace_closedI:
   assumes "\<And> s t u p. p \<in> poss_of_term (constT c) s \<Longrightarrow> (s, t) \<in> U \<Longrightarrow>
        (\<exists> q. q \<in> poss_of_term (constT c) t \<and> (s[p \<leftarrow> u], t[q \<leftarrow> u]) \<in> U) \<or> (s[p \<leftarrow> u], t) \<in> U"
   shows "const_replace_closed c U" using assms
   unfolding const_replace_closed_def
   by auto
 
 abbreviation const_subst :: "'f \<Rightarrow> 'v \<Rightarrow> ('f, 'v) Term.term" where
   "const_subst c \<equiv> (\<lambda> x. Fun c [])"
 
 lemma lin_fresh_rstep_const_replace_closed:
   "linear_sys \<R> \<Longrightarrow> (c, 0) \<notin> funas_rel \<R> \<Longrightarrow> const_replace_closed c (rstep \<R>)"
   using fresh_const_single_step_replace[of \<R> c]
   by (intro const_replace_closedI) (auto simp: constT_nfunas_term_poss_of_term_empty, blast)
 
 lemma const_replace_closed_symcl:
   "const_replace_closed c U \<Longrightarrow> const_replace_closed c (U\<^sup>=)"
   unfolding const_replace_closed_def
   by (metis Un_iff pair_in_Id_conv)
 
 lemma const_replace_closed_trancl:
   "const_replace_closed c U \<Longrightarrow> const_replace_closed c (U\<^sup>+)"
 proof (intro const_replace_closedI)
   fix s t u p
   assume const: "const_replace_closed c U" and wit: "p \<in> poss_of_term (constT c) s"
     and steps :"(s, t) \<in> U\<^sup>+"
   show "(\<exists>q. q \<in> poss_of_term (constT c) t \<and> (s[p \<leftarrow> u], t[q \<leftarrow> u]) \<in> U\<^sup>+) \<or> (s[p \<leftarrow> u], t) \<in> U\<^sup>+" using steps wit
   proof (induct arbitrary: p rule: converse_trancl_induct)
     case (base s)
     show ?case using const_replace_closedD[OF const base(2, 1)]
       by blast
   next
     case (step s v)
     from const_replace_closedD[OF const step(4, 1)]
     consider (a) "(s[p \<leftarrow> u], v) \<in> U" | (b) "\<exists> q. q \<in> poss_of_term (constT c) v \<and> (s[p \<leftarrow> u], v[q \<leftarrow> u]) \<in> U" by auto
     then show ?case
     proof cases
       case a then show ?thesis using step(2)
         by (meson trancl_into_trancl2)
     next
       case b
       then show ?thesis using step(3, 4) by (meson trancl_into_trancl2) 
     qed
   qed
 qed
 
 lemma const_replace_closed_rtrancl:
   "const_replace_closed c U \<Longrightarrow> const_replace_closed c (U\<^sup>*)"
 proof (intro const_replace_closedI)
   fix s t u p
   assume const: "const_replace_closed c U" and wit: "p \<in> poss_of_term (constT c) s"
     and steps :"(s, t) \<in> U\<^sup>*"
   show "(\<exists>q. q \<in> poss_of_term (constT c) t \<and> (s[p \<leftarrow> u], t[q \<leftarrow> u]) \<in> U\<^sup>*) \<or> (s[p \<leftarrow> u], t) \<in> U\<^sup>*"
     using const_replace_closed_trancl[OF const] wit steps
     by (metis const_replace_closedD rtrancl_eq_or_trancl)
 qed
 
 lemma const_replace_closed_relcomp:
   "const_replace_closed c U \<Longrightarrow> const_replace_closed c V \<Longrightarrow> const_replace_closed c (U O V)"
 proof (intro const_replace_closedI)
   fix s t u p
   assume const: "const_replace_closed c U" "const_replace_closed c V"
    and wit: "p \<in> poss_of_term (constT c) s" and step: "(s, t) \<in> U O V"
   from step obtain w where w: "(s, w) \<in> U" "(w, t) \<in> V" by auto
   from const_replace_closedD[OF const(1) wit this(1)]
   consider (a) "(s[p \<leftarrow> u], w) \<in> U" | (b) "(\<exists>q. q \<in> poss_of_term (constT c) w \<and> (s[p \<leftarrow> u], w[q \<leftarrow> u]) \<in> U)"
     by auto  
   then show "(\<exists>q. q \<in> poss_of_term (constT c) t \<and> (s[p \<leftarrow> u], t[q \<leftarrow> u]) \<in> U O V) \<or> (s[p \<leftarrow> u], t) \<in> U O V"
   proof cases
     case a
     then show ?thesis using w(2) by auto
   next
     case b
     then show ?thesis using const_replace_closedD[OF const(2) _ w(2)]
       by (meson relcomp.simps)
   qed
 qed
 
 
 text \<open>@{const const_replace_closed} allow the removal of a fresh constant substitution\<close>
 lemma const_replace_closed_remove_subst_lhs:
   assumes repcl: "const_replace_closed c U"
     and const: "(c, 0) \<notin> funas_term t"
     and steps: "(s \<cdot> const_subst c, t) \<in> U"
   shows "(s, t) \<in> U" using steps
 proof (induct "card (varposs s)" arbitrary: s)
   case (Suc n)
   obtain p ps where vl: "varposs s = insert p ps" "p \<notin> ps" using Suc(2)
     by (metis card_le_Suc_iff dual_order.refl)
   let ?s = "s[p \<leftarrow> Fun c []]" have vp: "p \<in> varposs s" using vl by auto
   then have [simp]: "?s \<cdot> const_subst c = s \<cdot> const_subst c"
     by (induct s arbitrary: p) (auto simp: nth_list_update map_update intro!: nth_equalityI)
   have "varposs ?s = ps" using vl varposs_ground_replace_at[of p s "constT c"]
     by auto
   then have "n = card (varposs ?s)" using vl Suc(2) by (auto simp: card_insert_if finite_varposs)
   from Suc(1)[OF this] have IH: "(s[p \<leftarrow> constT c], t) \<in> U" "p \<in> poss_of_term (constT c) s[p \<leftarrow> constT c]"
     using Suc(2, 3) vl poss_of_term_replace_term_at varposs_imp_poss vp
     using \<open>s[p \<leftarrow> constT c] \<cdot> const_subst c = s \<cdot> const_subst c\<close>
     by fastforce+
   show ?case using const_replace_closedD[OF repcl] const IH(2, 1)
     by (metis constT_nfunas_term_poss_of_term_empty empty_iff replace_term_at_same_pos replace_term_at_subt_at_id)
 qed (auto simp: ground_subst_apply card_eq_0_iff finite_varposs varposs_empty_gound)
 
 
 subsubsection \<open>Removal lemma applied to various rewrite relations\<close>
 
 lemma remove_const_subst_step_lhs:
   assumes lin: "linear_sys \<R>" and fresh: "(c, 0) \<notin> funas_rel \<R>"
     and const: "(c, 0) \<notin> funas_term t"
     and step: "(s \<cdot> const_subst c, t) \<in> (rstep \<R>)"
   shows "(s, t) \<in> (rstep \<R>)"
   using lin_fresh_rstep_const_replace_closed[OF lin fresh, THEN const_replace_closed_remove_subst_lhs] const step
   by blast
 
 lemma remove_const_subst_steps_lhs:
   assumes lin: "linear_sys \<R>" and fresh: "(c, 0) \<notin> funas_rel \<R>"
     and const: "(c, 0) \<notin> funas_term t"
     and steps: "(s \<cdot> const_subst c, t) \<in> (rstep \<R>)\<^sup>+"
   shows "(s, t) \<in> (rstep \<R>)\<^sup>+"
   using lin_fresh_rstep_const_replace_closed[THEN const_replace_closed_trancl,
     OF lin fresh, THEN const_replace_closed_remove_subst_lhs]
   using const steps
   by blast
 
 lemma remove_const_subst_steps_eq_lhs:
   assumes lin: "linear_sys \<R>" and fresh: "(c, 0) \<notin> funas_rel \<R>"
     and const: "(c, 0) \<notin> funas_term t"
     and steps: "(s \<cdot> const_subst c, t) \<in> (rstep \<R>)\<^sup>*"
   shows "(s, t) \<in> (rstep \<R>)\<^sup>*" using steps const 
   by (cases "s = t") (auto simp: rtrancl_eq_or_trancl funas_term_subst ground_subst_apply vars_term_empty_ground
       dest: remove_const_subst_steps_lhs[OF lin fresh const] split: if_splits)
 
 lemma remove_const_subst_steps_rhs:
   assumes lin: "linear_sys \<R>" and fresh: "(c, 0) \<notin> funas_rel \<R>"
     and const: "(c, 0) \<notin> funas_term s"
     and steps: "(s, t \<cdot> const_subst c) \<in> (rstep \<R>)\<^sup>+"
   shows "(s, t) \<in> (rstep \<R>)\<^sup>+"
 proof -
   from steps have revs: "(t \<cdot> const_subst c, s) \<in> (rstep (\<R>\<inverse>))\<^sup>+"
     unfolding rew_converse_outwards by auto
   have "(t, s) \<in> (rstep (\<R>\<inverse>))\<^sup>+" using assms
     by (intro remove_const_subst_steps_lhs[OF _ _ _ revs]) (auto simp: funas_rel_def)
   then show ?thesis unfolding rew_converse_outwards by auto
 qed
 
 lemma remove_const_subst_steps_eq_rhs:
   assumes lin: "linear_sys \<R>" and fresh: "(c, 0) \<notin> funas_rel \<R>"
     and const: "(c, 0) \<notin> funas_term s"
     and steps: "(s, t \<cdot> const_subst c) \<in> (rstep \<R>)\<^sup>*"
   shows "(s, t) \<in> (rstep \<R>)\<^sup>*"
   using steps const
   by (cases "s = t") (auto simp: rtrancl_eq_or_trancl funas_term_subst ground_subst_apply vars_term_empty_ground
       dest!: remove_const_subst_steps_rhs[OF lin fresh const] split: if_splits)
 
 
 text \<open>Main lemmas\<close>
 lemma const_subst_eq_ground_eq:
   assumes "s \<cdot> const_subst c = t \<cdot> const_subst d" "c \<noteq> d"
     and "(c, 0) \<notin> funas_term t" "(d, 0) \<notin> funas_term s"
   shows "s = t" using assms
 proof (induct s arbitrary: t)
   case (Var x) then show ?case by (cases t) auto
 next
   case (Fun f ts)
   from Fun(2-) obtain g us where [simp]: "t = Fun g us" by (cases t) auto
   have [simp]: "g = f" and l: "length ts = length us" using Fun(2)
     by (auto intro: map_eq_imp_length_eq)
   have "i < length ts \<Longrightarrow> ts ! i = us ! i" for i
     using Fun(1)[OF nth_mem, of i "us ! i" for i] Fun(2-) l
     by (auto simp: map_eq_conv')
   then show ?case using l
     by (auto intro: nth_equalityI)
 qed
 
 
 lemma remove_const_subst_steps:
   assumes "linear_sys \<R>" and  "(c, 0) \<notin> funas_rel \<R>" and "(d, 0) \<notin> funas_rel \<R>"
     and "c \<noteq> d" "(c, 0) \<notin> funas_term t" "(d, 0) \<notin> funas_term s"
     and "(s \<cdot> const_subst c, t \<cdot> const_subst d) \<in> (rstep \<R>)\<^sup>*"
   shows "(s, t) \<in> (rstep \<R>)\<^sup>*"
 proof (cases "s \<cdot> const_subst c = t \<cdot> const_subst d")
   case True
   from const_subst_eq_ground_eq[OF this] assms(4 - 6) show ?thesis by auto
 next
   case False
   then have step: "(s \<cdot> const_subst c, t \<cdot> const_subst d) \<in> (rstep \<R>)\<^sup>+" using assms(7)
     by (auto simp: rtrancl_eq_or_trancl)
   then have "(s, t \<cdot> const_subst d) \<in> (rstep \<R>)\<^sup>+" using assms
     by (intro remove_const_subst_steps_lhs[OF _ _ _ step]) (auto simp: funas_term_subst)
   from remove_const_subst_steps_rhs[OF _ _ _ this] show ?thesis using assms
     by auto
 qed
 
 lemma remove_const_subst_relcomp_lhs:
   assumes sys: "linear_sys \<R>" "linear_sys \<S>"
     and fr: "(c, 0) \<notin> funas_rel \<R>" and fs:"(c, 0) \<notin> funas_rel \<S>"
     and funas: "(c, 0) \<notin> funas_term t"
     and seq: "(s \<cdot> const_subst c, t) \<in> (rstep \<R>)\<^sup>* O (rstep \<S>)\<^sup>*"
   shows "(s, t) \<in> (rstep \<R>)\<^sup>* O (rstep \<S>)\<^sup>*" using seq
   using lin_fresh_rstep_const_replace_closed[OF sys(1) fr, THEN const_replace_closed_rtrancl]
   using lin_fresh_rstep_const_replace_closed[OF sys(2) fs, THEN const_replace_closed_rtrancl]
   using const_replace_closed_relcomp
   by (intro const_replace_closed_remove_subst_lhs[OF _ funas seq]) force
 
 lemma remove_const_subst_relcomp_rhs:
   assumes sys: "linear_sys \<R>" "linear_sys \<S>"
     and fr: "(c, 0) \<notin> funas_rel \<R>" and fs:"(c, 0) \<notin> funas_rel \<S>"
     and funas: "(c, 0) \<notin> funas_term s"
     and seq: "(s, t \<cdot> const_subst c) \<in> (rstep \<R>)\<^sup>* O (rstep \<S>)\<^sup>*"
   shows "(s, t) \<in> (rstep \<R>)\<^sup>* O (rstep \<S>)\<^sup>*"
 proof -
   from seq have "(t \<cdot> const_subst c,s) \<in> ((rstep \<R>)\<^sup>* O (rstep \<S>)\<^sup>*)\<inverse>"
     by auto
   then have "(t \<cdot> const_subst c,s) \<in> ((rstep \<S>)\<^sup>*)\<inverse> O ((rstep \<R>)\<^sup>*)\<inverse>"
     using converse_relcomp by blast
   note seq = this[unfolded rtrancl_converse[symmetric] rew_converse_inwards]
   from sys fr fs have "linear_sys (\<S>\<inverse>)" "linear_sys (\<R>\<inverse>)" "(c, 0) \<notin> funas_rel (\<S>\<inverse>)" "(c, 0) \<notin> funas_rel (\<R>\<inverse>)"
     by (auto simp: funas_rel_def)
   from remove_const_subst_relcomp_lhs[OF this funas seq]
   have "(t, s) \<in> (rstep (\<S>\<inverse>))\<^sup>* O (rstep (\<R>\<inverse>))\<^sup>*" by simp
   then show ?thesis
     unfolding rew_converse_outwards converse_relcomp[symmetric]
     by simp
 qed
 
 
 lemma remove_const_subst_relcomp:
   assumes sys: "linear_sys \<R>" "linear_sys \<S>"
     and fr: "(c, 0) \<notin> funas_rel \<R>" "(d, 0) \<notin> funas_rel \<R>"
     and fs:"(c, 0) \<notin> funas_rel \<S>" "(d, 0) \<notin> funas_rel \<S>"
     and diff: "c \<noteq> d" and funas: "(c, 0) \<notin> funas_term t" "(d, 0) \<notin> funas_term s"
     and seq: "(s \<cdot> const_subst c, t \<cdot> const_subst d) \<in> (rstep \<R>)\<^sup>* O (rstep \<S>)\<^sup>*"
   shows "(s, t) \<in> (rstep \<R>)\<^sup>* O (rstep \<S>)\<^sup>*"
 proof -
   from diff funas(1) have *: "(c, 0) \<notin> funas_term (t \<cdot> const_subst d)"
     by (auto simp: funas_term_subst)
   show ?thesis using remove_const_subst_relcomp_rhs[OF sys fr(2) fs(2) funas(2)
         remove_const_subst_relcomp_lhs[OF sys fr(1) fs(1) * seq]]
     by blast
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Intruder_Deduction.thy b/thys/Stateful_Protocol_Composition_and_Typing/Intruder_Deduction.thy
--- a/thys/Stateful_Protocol_Composition_and_Typing/Intruder_Deduction.thy
+++ b/thys/Stateful_Protocol_Composition_and_Typing/Intruder_Deduction.thy
@@ -1,1193 +1,1191 @@
 (*  Title:      Intruder_Deduction.thy
     Author:     Andreas Viktor Hess, DTU
     SPDX-License-Identifier: BSD-3-Clause
 *)
 
 section \<open>Dolev-Yao Intruder Model\<close>
 theory Intruder_Deduction
 imports Messages More_Unification
 begin
 
 subsection \<open>Syntax for the Intruder Deduction Relations\<close>
 consts INTRUDER_SYNTH::"('f,'v) terms \<Rightarrow> ('f,'v) term \<Rightarrow> bool" (infix "\<turnstile>\<^sub>c" 50)
 consts INTRUDER_DEDUCT::"('f,'v) terms \<Rightarrow> ('f,'v) term \<Rightarrow> bool" (infix "\<turnstile>" 50)
 
 
 subsection \<open>Intruder Model Locale\<close>
 text \<open>
   The intruder model is parameterized over arbitrary function symbols (e.g, cryptographic operators)
   and variables. It requires three functions:
   - \<open>arity\<close> that assigns an arity to each function symbol.
   - \<open>public\<close> that partitions the function symbols into those that will be available to the intruder
     and those that will not.
   - \<open>Ana\<close>, the analysis interface, that defines how messages can be decomposed (e.g., decryption).
 \<close>
 locale intruder_model =
   fixes arity :: "'fun \<Rightarrow> nat"
     and public :: "'fun \<Rightarrow> bool"
     and Ana :: "('fun,'var) term \<Rightarrow> (('fun,'var) term list \<times> ('fun,'var) term list)"
   assumes Ana_keys_fv: "\<And>t K R. Ana t = (K,R) \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set K) \<subseteq> fv t"
     and Ana_keys_wf: "\<And>t k K R f T.
       Ana t = (K,R) \<Longrightarrow> (\<And>g S. Fun g S \<sqsubseteq> t \<Longrightarrow> length S = arity g)
                     \<Longrightarrow> k \<in> set K \<Longrightarrow> Fun f T \<sqsubseteq> k \<Longrightarrow> length T = arity f"
     and Ana_var[simp]: "\<And>x. Ana (Var x) = ([],[])"
     and Ana_fun_subterm: "\<And>f T K R. Ana (Fun f T) = (K,R) \<Longrightarrow> set R \<subseteq> set T"
     and Ana_subst: "\<And>t \<delta> K R. \<lbrakk>Ana t = (K,R); K \<noteq> [] \<or> R \<noteq> []\<rbrakk> \<Longrightarrow> Ana (t \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>,R \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)"
 begin
 
 lemma Ana_subterm: assumes "Ana t = (K,T)" shows "set T \<subset> subterms t"
 using assms
 by (cases t)
    (simp add: psubsetI,
     metis Ana_fun_subterm Fun_gt_params UN_I term.order_refl
           params_subterms psubsetI subset_antisym subset_trans)
 
 lemma Ana_subterm': "s \<in> set (snd (Ana t)) \<Longrightarrow> s \<sqsubseteq> t"
 using Ana_subterm by (cases "Ana t") auto
 
 lemma Ana_vars: assumes "Ana t = (K,M)" shows "fv\<^sub>s\<^sub>e\<^sub>t (set K) \<subseteq> fv t" "fv\<^sub>s\<^sub>e\<^sub>t (set M) \<subseteq> fv t"
 by (rule Ana_keys_fv[OF assms]) (use Ana_subterm[OF assms] subtermeq_vars_subset in auto)
 
 abbreviation \<V> where "\<V> \<equiv> UNIV::'var set"
 abbreviation \<Sigma>n ("\<Sigma>\<^sup>_") where "\<Sigma>\<^sup>n \<equiv> {f::'fun. arity f = n}"
 abbreviation \<Sigma>npub ("\<Sigma>\<^sub>p\<^sub>u\<^sub>b\<^sup>_") where "\<Sigma>\<^sub>p\<^sub>u\<^sub>b\<^sup>n \<equiv> {f. public f} \<inter> \<Sigma>\<^sup>n"
 abbreviation \<Sigma>npriv ("\<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v\<^sup>_") where "\<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v\<^sup>n \<equiv> {f. \<not>public f} \<inter> \<Sigma>\<^sup>n"
 abbreviation \<Sigma>\<^sub>p\<^sub>u\<^sub>b where "\<Sigma>\<^sub>p\<^sub>u\<^sub>b \<equiv> (\<Union>n. \<Sigma>\<^sub>p\<^sub>u\<^sub>b\<^sup>n)"
 abbreviation \<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v where "\<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v \<equiv> (\<Union>n. \<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v\<^sup>n)"
 abbreviation \<Sigma> where "\<Sigma> \<equiv> (\<Union>n. \<Sigma>\<^sup>n)"
 abbreviation \<C> where "\<C> \<equiv> \<Sigma>\<^sup>0"
 abbreviation \<C>\<^sub>p\<^sub>u\<^sub>b where "\<C>\<^sub>p\<^sub>u\<^sub>b \<equiv> {f. public f} \<inter> \<C>"
 abbreviation \<C>\<^sub>p\<^sub>r\<^sub>i\<^sub>v where "\<C>\<^sub>p\<^sub>r\<^sub>i\<^sub>v \<equiv> {f. \<not>public f} \<inter> \<C>"
 abbreviation \<Sigma>\<^sub>f where "\<Sigma>\<^sub>f \<equiv> \<Sigma> - \<C>"
 abbreviation \<Sigma>\<^sub>f\<^sub>p\<^sub>u\<^sub>b where "\<Sigma>\<^sub>f\<^sub>p\<^sub>u\<^sub>b \<equiv> \<Sigma>\<^sub>f \<inter> \<Sigma>\<^sub>p\<^sub>u\<^sub>b"
 abbreviation \<Sigma>\<^sub>f\<^sub>p\<^sub>r\<^sub>i\<^sub>v where "\<Sigma>\<^sub>f\<^sub>p\<^sub>r\<^sub>i\<^sub>v \<equiv> \<Sigma>\<^sub>f \<inter> \<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v"
 
 lemma disjoint_fun_syms: "\<Sigma>\<^sub>f \<inter> \<C> = {}" by auto
 lemma id_union_univ: "\<Sigma>\<^sub>f \<union> \<C> = UNIV" "\<Sigma> = UNIV" by auto
 lemma const_arity_eq_zero[dest]: "c \<in> \<C> \<Longrightarrow> arity c = 0" by simp
 lemma const_pub_arity_eq_zero[dest]: "c \<in> \<C>\<^sub>p\<^sub>u\<^sub>b \<Longrightarrow> arity c = 0 \<and> public c" by simp
 lemma const_priv_arity_eq_zero[dest]: "c \<in> \<C>\<^sub>p\<^sub>r\<^sub>i\<^sub>v \<Longrightarrow> arity c = 0 \<and> \<not>public c" by simp
 lemma fun_arity_gt_zero[dest]: "f \<in> \<Sigma>\<^sub>f \<Longrightarrow> arity f > 0" by fastforce
 lemma pub_fun_public[dest]: "f \<in> \<Sigma>\<^sub>f\<^sub>p\<^sub>u\<^sub>b \<Longrightarrow> public f" by fastforce
 lemma pub_fun_arity_gt_zero[dest]: "f \<in> \<Sigma>\<^sub>f\<^sub>p\<^sub>u\<^sub>b \<Longrightarrow> arity f > 0" by fastforce
 
 lemma \<Sigma>\<^sub>f_unfold: "\<Sigma>\<^sub>f = {f::'fun. arity f > 0}" by auto
 lemma \<C>_unfold: "\<C> = {f::'fun. arity f = 0}" by auto
 lemma \<C>pub_unfold: "\<C>\<^sub>p\<^sub>u\<^sub>b = {f::'fun. arity f = 0 \<and> public f}" by auto
 lemma \<C>priv_unfold: "\<C>\<^sub>p\<^sub>r\<^sub>i\<^sub>v = {f::'fun. arity f = 0 \<and> \<not>public f}" by auto
 lemma \<Sigma>npub_unfold: "(\<Sigma>\<^sub>p\<^sub>u\<^sub>b\<^sup>n) = {f::'fun. arity f = n \<and> public f}" by auto
 lemma \<Sigma>npriv_unfold: "(\<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v\<^sup>n) = {f::'fun. arity f = n \<and> \<not>public f}" by auto
 lemma \<Sigma>fpub_unfold: "\<Sigma>\<^sub>f\<^sub>p\<^sub>u\<^sub>b = {f::'fun. arity f > 0 \<and> public f}" by auto
 lemma \<Sigma>fpriv_unfold: "\<Sigma>\<^sub>f\<^sub>p\<^sub>r\<^sub>i\<^sub>v = {f::'fun. arity f > 0 \<and> \<not>public f}" by auto
 lemma \<Sigma>n_m_eq: "\<lbrakk>(\<Sigma>\<^sup>n) \<noteq> {}; (\<Sigma>\<^sup>n) = (\<Sigma>\<^sup>m)\<rbrakk> \<Longrightarrow> n = m" by auto
 
 
 subsection \<open>Term Well-formedness\<close>
 definition "wf\<^sub>t\<^sub>r\<^sub>m t \<equiv> \<forall>f T. Fun f T \<sqsubseteq> t \<longrightarrow> length T = arity f"
 
 abbreviation "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s T \<equiv> \<forall>t \<in> T. wf\<^sub>t\<^sub>r\<^sub>m t"
 
 lemma Ana_keys_wf': "Ana t = (K,T) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m t \<Longrightarrow> k \<in> set K \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m k"
 using Ana_keys_wf unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by metis
 
 lemma wf_trm_Var[simp]: "wf\<^sub>t\<^sub>r\<^sub>m (Var x)" unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by simp
 
 lemma wf_trm_subst_range_Var[simp]: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" by simp
 
 lemma wf_trm_subst_range_iff: "(\<forall>x. wf\<^sub>t\<^sub>r\<^sub>m (\<theta> x)) \<longleftrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
 by force
 
 lemma wf_trm_subst_rangeD: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m (\<theta> x)"
 by (metis wf_trm_subst_range_iff)
 
 lemma wf_trm_subst_rangeI[intro]:
   "(\<And>x. wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
 by (metis wf_trm_subst_range_iff)
 
 lemma wf_trmI[intro]:
   assumes "\<And>t. t \<in> set T \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m t" "length T = arity f"
   shows "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)"
 using assms unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
 
 lemma wf_trm_subterm: "\<lbrakk>wf\<^sub>t\<^sub>r\<^sub>m t; s \<sqsubset> t\<rbrakk> \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m s"
 unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (induct t) auto
 
 lemma wf_trm_subtermeq:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "s \<sqsubseteq> t"
   shows "wf\<^sub>t\<^sub>r\<^sub>m s"
 proof (cases "s = t")
   case False thus "wf\<^sub>t\<^sub>r\<^sub>m s" using assms(2) wf_trm_subterm[OF assms(1)] by simp
 qed (metis assms(1))
 
 lemma wf_trm_param:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" "t \<in> set T"
   shows "wf\<^sub>t\<^sub>r\<^sub>m t"
 by (meson assms subtermeqI'' wf_trm_subtermeq)
 
 lemma wf_trm_param_idx:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)"
     and "i < length T"
   shows "wf\<^sub>t\<^sub>r\<^sub>m (T ! i)"
 using wf_trm_param[OF assms(1), of "T ! i"] assms(2)
 by fastforce
 
 lemma wf_trm_subst:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m t = wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>)"
 proof
   show "wf\<^sub>t\<^sub>r\<^sub>m t \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>)"
   proof (induction t)
     case (Fun f T)
     hence "\<And>t. t \<in> set T \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m t"
       by (meson wf\<^sub>t\<^sub>r\<^sub>m_def Fun_param_is_subterm term.order_trans)
     hence "\<And>t. t \<in> set T \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>)" using Fun.IH by auto
     moreover have "length (map (\<lambda>t. t \<cdot> \<delta>) T) = arity f"
       using Fun.prems unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
     ultimately show ?case by fastforce
   qed (simp add: wf_trm_subst_rangeD[OF assms])
 
   show "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m t"
   proof (induction t)
     case (Fun f T)
     hence "wf\<^sub>t\<^sub>r\<^sub>m t" when "t \<in> set (map (\<lambda>s. s \<cdot> \<delta>) T)" for t
-      by (metis that wf\<^sub>t\<^sub>r\<^sub>m_def Fun_param_is_subterm term.order_trans subst_apply_term.simps(2)) 
+      by (metis that wf\<^sub>t\<^sub>r\<^sub>m_def Fun_param_is_subterm term.order_trans eval_term.simps(2)) 
     hence "wf\<^sub>t\<^sub>r\<^sub>m t" when "t \<in> set T" for t using that Fun.IH by auto
     moreover have "length (map (\<lambda>t. t \<cdot> \<delta>) T) = arity f"
       using Fun.prems unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
     ultimately show ?case by fastforce
   qed (simp add: assms)
 qed
 
 lemma wf_trm_subst_singleton:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" shows "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> Var(v := t'))"
 proof -
   have "wf\<^sub>t\<^sub>r\<^sub>m ((Var(v := t')) w)" for w using assms(2) unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by simp
   thus ?thesis using assms(1) wf_trm_subst[of "Var(v := t')" t, OF wf_trm_subst_rangeI] by simp
 qed
 
 lemma wf_trm_subst_rm_vars:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> rm_vars X \<delta>)"
 using assms
 proof (induction t)
   case (Fun f T)
   have "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>)" when "t \<in> set T" for t
     using that wf_trm_param[of f "map (\<lambda>t. t \<cdot> \<delta>) T"] Fun.prems
     by auto
   hence "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> rm_vars X \<delta>)" when "t \<in> set T" for t using that Fun.IH by simp
   moreover have "length T = arity f" using Fun.prems unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
   ultimately show ?case unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
 qed simp
 
 lemma wf_trm_subst_rm_vars': "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> v) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m (rm_vars X \<delta> v)"
 by auto
 
 lemma wf_trms_subst:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
 by (metis (no_types, lifting) assms imageE wf_trm_subst)
 
 lemma wf_trms_subst_rm_vars:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (M \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars X \<delta>)"
 using assms wf_trm_subst_rm_vars by blast
 
 lemma wf_trms_subst_rm_vars':
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (rm_vars X \<delta>))"
 using assms by force  
 
 lemma wf_trms_subst_compose:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<delta>))"
 using assms subst_img_comp_subset' wf_trm_subst by blast 
 
 lemma wf_trm_subst_compose:
   fixes \<delta>::"('fun, 'v) subst"
   assumes "wf\<^sub>t\<^sub>r\<^sub>m (\<theta> x)" "\<And>x. wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m ((\<theta> \<circ>\<^sub>s \<delta>) x)"
 using wf_trm_subst[of \<delta> "\<theta> x", OF wf_trm_subst_rangeI[OF assms(2)]] assms(1)
       subst_subst_compose[of "Var x" \<theta> \<delta>]
-      subst_apply_term.simps(1)[of x \<theta>]
-      subst_apply_term.simps(1)[of x "\<theta> \<circ>\<^sub>s \<delta>"]
-by argo
+by auto
 
 lemma wf_trms_Var_range:
   assumes "subst_range \<delta> \<subseteq> range Var"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
 using assms by fastforce
 
 lemma wf_trms_subst_compose_Var_range:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
     and "subst_range \<delta> \<subseteq> range Var"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<delta> \<circ>\<^sub>s \<theta>))"
     and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<delta>))"
 using assms wf_trms_subst_compose wf_trms_Var_range by metis+
 
 lemma wf_trm_subst_inv: "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m t"
 unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (induct t) auto
 
 lemma wf_trms_subst_inv: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
 using wf_trm_subst_inv by fast
 
 lemma wf_trm_subterms: "wf\<^sub>t\<^sub>r\<^sub>m t \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subterms t)"
 using wf_trm_subterm by blast
 
 lemma wf_trms_subterms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subterms\<^sub>s\<^sub>e\<^sub>t M)"
 using wf_trm_subterms by blast
 
 lemma wf_trm_arity: "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T) \<Longrightarrow> length T = arity f"
 unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by blast
 
 lemma wf_trm_subterm_arity: "wf\<^sub>t\<^sub>r\<^sub>m t \<Longrightarrow> Fun f T \<sqsubseteq> t \<Longrightarrow> length T = arity f"
 unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by blast
 
 lemma unify_list_wf_trm:
   assumes "Unification.unify E B = Some U" "\<forall>(s,t) \<in> set E. wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t"
   and "\<forall>(v,t) \<in> set B. wf\<^sub>t\<^sub>r\<^sub>m t"
   shows "\<forall>(v,t) \<in> set U. wf\<^sub>t\<^sub>r\<^sub>m t"
 using assms
 proof (induction E B arbitrary: U rule: Unification.unify.induct)
   case (1 B U) thus ?case by auto
 next
   case (2 f T g S E B U)
   have wf_fun: "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun g S)" using "2.prems"(2) by auto
   from "2.prems"(1) obtain E' where *: "decompose (Fun f T) (Fun g S) = Some E'"
     and [simp]: "f = g" "length T = length S" "E' = zip T S"
     and **: "Unification.unify (E'@E) B = Some U"
     by (auto split: option.splits)
   hence "t \<sqsubset> Fun f T" "t' \<sqsubset> Fun g S" when "(t,t') \<in> set E'" for t t'
     using that by (metis zip_arg_subterm(1), metis zip_arg_subterm(2))
   hence "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" when "(t,t') \<in> set E'" for t t'
     using wf_trm_subterm wf_fun \<open>f = g\<close> that by blast+
   thus ?case using "2.IH"[OF * ** _ "2.prems"(3)] "2.prems"(2) by fastforce
 next
   case (3 v t E B)
   hence *: "\<forall>(w,x) \<in> set ((v, t) # B). wf\<^sub>t\<^sub>r\<^sub>m x"
       and **: "\<forall>(s,t) \<in> set E. wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t"
     by auto
 
   show ?case
   proof (cases "t = Var v")
     case True thus ?thesis using "3.prems" "3.IH"(1) by auto
   next
     case False
     hence "v \<notin> fv t" using "3.prems"(1) by auto
     hence "Unification.unify (subst_list (subst v t) E) ((v, t)#B) = Some U"
       using \<open>t \<noteq> Var v\<close> "3.prems"(1) by auto
     moreover have "\<forall>(s, t) \<in> set (subst_list (subst v t) E). wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t"
       using wf_trm_subst_singleton[OF _ \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close>] "3.prems"(2)
       unfolding subst_list_def subst_def by auto
     ultimately show ?thesis using "3.IH"(2)[OF \<open>t \<noteq> Var v\<close> \<open>v \<notin> fv t\<close> _ _ *] by metis
   qed
 next
   case (4 f T v E B U)
   hence *: "\<forall>(w,x) \<in> set ((v, Fun f T) # B). wf\<^sub>t\<^sub>r\<^sub>m x"
       and **: "\<forall>(s,t) \<in> set E. wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)"
     by auto
 
   have "v \<notin> fv (Fun f T)" using "4.prems"(1) by force
   hence "Unification.unify (subst_list (subst v (Fun f T)) E) ((v, Fun f T)#B) = Some U"
     using "4.prems"(1) by auto
   moreover have "\<forall>(s, t) \<in> set (subst_list (subst v (Fun f T)) E). wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t"
     using wf_trm_subst_singleton[OF _ \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)\<close>] "4.prems"(2)
     unfolding subst_list_def subst_def by auto
   ultimately show ?case using "4.IH"[OF \<open>v \<notin> fv (Fun f T)\<close> _ _ *] by metis
 qed
 
 lemma mgu_wf_trm:
   assumes "mgu s t = Some \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t"
   shows "wf\<^sub>t\<^sub>r\<^sub>m (\<sigma> v)"
 proof -
   from assms obtain \<sigma>' where "subst_of \<sigma>' = \<sigma>" "\<forall>(v,t) \<in> set \<sigma>'. wf\<^sub>t\<^sub>r\<^sub>m t"
     using unify_list_wf_trm[of "[(s,t)]" "[]"] by (auto simp: mgu_def split: option.splits)
   thus ?thesis
   proof (induction \<sigma>' arbitrary: \<sigma> v rule: List.rev_induct)
     case (snoc x \<sigma>' \<sigma> v)
     define \<theta> where "\<theta> = subst_of \<sigma>'"
     hence "wf\<^sub>t\<^sub>r\<^sub>m (\<theta> v)" for v using snoc.prems(2) snoc.IH[of \<theta>] by fastforce 
     moreover obtain w t where x: "x = (w,t)" by (metis surj_pair) 
     hence \<sigma>: "\<sigma> = Var(w := t) \<circ>\<^sub>s \<theta>" using snoc.prems(1) by (simp add: subst_def \<theta>_def)
     moreover have "wf\<^sub>t\<^sub>r\<^sub>m t" using snoc.prems(2) x by auto
     ultimately show ?case using wf_trm_subst[of _ t] unfolding subst_compose_def by auto
   qed (simp add: wf\<^sub>t\<^sub>r\<^sub>m_def)
 qed
 
 lemma mgu_wf_trms:
   assumes "mgu s t = Some \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
 using mgu_wf_trm[OF assms] by simp
 
 subsection \<open>Definitions: Intruder Deduction Relations\<close>
 text \<open>
   A standard Dolev-Yao intruder.
 \<close>
 inductive intruder_deduct::"('fun,'var) terms \<Rightarrow> ('fun,'var) term \<Rightarrow> bool"
 where
   Axiom[simp]:   "t \<in> M \<Longrightarrow> intruder_deduct M t"
 | Compose[simp]: "\<lbrakk>length T = arity f; public f; \<And>t. t \<in> set T \<Longrightarrow> intruder_deduct M t\<rbrakk>
                   \<Longrightarrow> intruder_deduct M (Fun f T)"
 | Decompose:     "\<lbrakk>intruder_deduct M t; Ana t = (K, T); \<And>k. k \<in> set K \<Longrightarrow> intruder_deduct M k;
                    t\<^sub>i \<in> set T\<rbrakk>
                   \<Longrightarrow> intruder_deduct M t\<^sub>i"
 
 text \<open>
   A variant of the intruder relation which limits the intruder to composition only.
 \<close>
 inductive intruder_synth::"('fun,'var) terms \<Rightarrow> ('fun,'var) term \<Rightarrow> bool"
 where
   AxiomC[simp]:   "t \<in> M \<Longrightarrow> intruder_synth M t"
 | ComposeC[simp]: "\<lbrakk>length T = arity f; public f; \<And>t. t \<in> set T \<Longrightarrow> intruder_synth M t\<rbrakk>
                     \<Longrightarrow> intruder_synth M (Fun f T)"
 
 adhoc_overloading INTRUDER_DEDUCT intruder_deduct
 adhoc_overloading INTRUDER_SYNTH intruder_synth
 
 lemma intruder_deduct_induct[consumes 1, case_names Axiom Compose Decompose]:
   assumes "M \<turnstile> t" "\<And>t. t \<in> M \<Longrightarrow> P M t"
           "\<And>T f. \<lbrakk>length T = arity f; public f;
                   \<And>t. t \<in> set T \<Longrightarrow> M \<turnstile> t;
                   \<And>t. t \<in> set T \<Longrightarrow> P M t\<rbrakk> \<Longrightarrow> P M (Fun f T)"
           "\<And>t K T t\<^sub>i. \<lbrakk>M \<turnstile> t; P M t; Ana t = (K, T); \<And>k. k \<in> set K \<Longrightarrow> M \<turnstile> k;
                        \<And>k. k \<in> set K \<Longrightarrow> P M k; t\<^sub>i \<in> set T\<rbrakk> \<Longrightarrow> P M t\<^sub>i"
   shows "P M t"
 using assms by (induct rule: intruder_deduct.induct) blast+
 
 lemma intruder_synth_induct[consumes 1, case_names AxiomC ComposeC]:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "M \<turnstile>\<^sub>c t" "\<And>t. t \<in> M \<Longrightarrow> P M t"
           "\<And>T f. \<lbrakk>length T = arity f; public f;
                   \<And>t. t \<in> set T \<Longrightarrow> M \<turnstile>\<^sub>c t;
                   \<And>t. t \<in> set T \<Longrightarrow> P M t\<rbrakk> \<Longrightarrow> P M (Fun f T)"
   shows "P M t"
 using assms by (induct rule: intruder_synth.induct) auto
 
 
 subsection \<open>Definitions: Analyzed Knowledge and Public Ground Well-formed Terms (PGWTs)\<close>
 definition analyzed::"('fun,'var) terms \<Rightarrow> bool" where
   "analyzed M \<equiv> \<forall>t. M \<turnstile> t \<longleftrightarrow> M \<turnstile>\<^sub>c t"
 
 definition analyzed_in where
   "analyzed_in t M \<equiv> \<forall>K R. (Ana t = (K,R) \<and> (\<forall>k \<in> set K. M \<turnstile>\<^sub>c k)) \<longrightarrow> (\<forall>r \<in> set R. M \<turnstile>\<^sub>c r)"
 
 definition decomp_closure::"('fun,'var) terms \<Rightarrow> ('fun,'var) terms \<Rightarrow> bool" where
   "decomp_closure M M' \<equiv> \<forall>t. M \<turnstile> t \<and> (\<exists>t' \<in> M. t \<sqsubseteq> t') \<longleftrightarrow> t \<in> M'"
 
 inductive public_ground_wf_term::"('fun,'var) term \<Rightarrow> bool" where
   PGWT[simp]: "\<lbrakk>public f; arity f = length T;
                 \<And>t. t \<in> set T \<Longrightarrow> public_ground_wf_term t\<rbrakk>
                   \<Longrightarrow> public_ground_wf_term (Fun f T)"
 
 abbreviation "public_ground_wf_terms \<equiv> {t. public_ground_wf_term t}"
 
 lemma public_const_deduct:
   assumes "c \<in> \<C>\<^sub>p\<^sub>u\<^sub>b"
   shows "M \<turnstile> Fun c []" "M \<turnstile>\<^sub>c Fun c []"
 proof -
   have "arity c = 0" "public c" using const_arity_eq_zero \<open>c \<in> \<C>\<^sub>p\<^sub>u\<^sub>b\<close> by auto
   thus "M \<turnstile> Fun c []" "M \<turnstile>\<^sub>c Fun c []"
     using intruder_synth.ComposeC[OF _ \<open>public c\<close>, of "[]"]
           intruder_deduct.Compose[OF _ \<open>public c\<close>, of "[]"]
     by auto
 qed
 
 lemma public_const_deduct'[simp]:
   assumes "arity c = 0" "public c"
   shows "M \<turnstile> Fun c []" "M \<turnstile>\<^sub>c Fun c []"
 using intruder_deduct.Compose[of "[]" c] intruder_synth.ComposeC[of "[]" c] assms by simp_all
 
 lemma private_fun_deduct_in_ik:
   assumes t: "M \<turnstile> t" "Fun f T \<in> subterms t"
     and f: "\<not>public f"
   shows "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t M"
 using t
 proof (induction t rule: intruder_deduct.induct)
   case Decompose thus ?case by (meson Ana_subterm psubsetD term.order_trans)
 qed (auto simp add: f in_subterms_Union)
 
 lemma private_fun_deduct_in_ik':
   assumes t: "M \<turnstile> Fun f T"
     and f: "\<not>public f"
   shows "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t M"
 by (rule private_fun_deduct_in_ik[OF t term.order_refl f])
 
 lemma pgwt_public: "\<lbrakk>public_ground_wf_term t; Fun f T \<sqsubseteq> t\<rbrakk> \<Longrightarrow> public f"
 by (induct t rule: public_ground_wf_term.induct) auto
 
 lemma pgwt_ground: "public_ground_wf_term t \<Longrightarrow> fv t = {}"
 by (induct t rule: public_ground_wf_term.induct) auto
 
 lemma pgwt_fun: "public_ground_wf_term t \<Longrightarrow> \<exists>f T. t = Fun f T"
 using pgwt_ground[of t] by (cases t) auto
 
 lemma pgwt_arity: "\<lbrakk>public_ground_wf_term t; Fun f T \<sqsubseteq> t\<rbrakk> \<Longrightarrow> arity f = length T"
 by (induct t rule: public_ground_wf_term.induct) auto
 
 lemma pgwt_wellformed: "public_ground_wf_term t \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m t"
 by (induct t rule: public_ground_wf_term.induct) auto
 
 lemma pgwt_deducible: "public_ground_wf_term t \<Longrightarrow> M \<turnstile>\<^sub>c t"
 by (induct t rule: public_ground_wf_term.induct) auto
 
 lemma pgwt_is_empty_synth: "public_ground_wf_term t \<longleftrightarrow> {} \<turnstile>\<^sub>c t"
 proof -
   { fix M::"('fun,'var) term set" assume "M \<turnstile>\<^sub>c t" "M = {}" hence "public_ground_wf_term t"
       by (induct t rule: intruder_synth.induct) auto
   }
   thus ?thesis using pgwt_deducible by auto
 qed
 
 lemma ideduct_synth_subst_apply:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "{} \<turnstile>\<^sub>c t" "\<And>v. M \<turnstile>\<^sub>c \<theta> v"
   shows "M \<turnstile>\<^sub>c t \<cdot> \<theta>"
 proof -
   { fix M'::"('fun,'var) term set" assume "M' \<turnstile>\<^sub>c t" "M' = {}" hence "M \<turnstile>\<^sub>c t \<cdot> \<theta>"
     proof (induction t rule: intruder_synth.induct)
       case (ComposeC T f M')
       hence "length (map (\<lambda>t. t \<cdot> \<theta>) T) = arity f" "\<And>x. x \<in> set (map (\<lambda>t. t \<cdot> \<theta>) T) \<Longrightarrow> M \<turnstile>\<^sub>c x"
         by auto
       thus ?case using intruder_synth.ComposeC[of "map (\<lambda>t. t \<cdot> \<theta>) T" f M] \<open>public f\<close> by fastforce
     qed simp
   }
   thus ?thesis using assms by metis
 qed
   
 
 subsection \<open>Lemmata: Monotonicity, Deduction of Private Constants, etc.\<close>
 context
 begin
 lemma ideduct_mono:
   "\<lbrakk>M \<turnstile> t; M \<subseteq> M'\<rbrakk> \<Longrightarrow> M' \<turnstile> t"
 proof (induction rule: intruder_deduct.induct)
   case (Decompose M t K T t\<^sub>i)
   have "\<forall>k. k \<in> set K \<longrightarrow> M' \<turnstile> k" using Decompose.IH \<open>M \<subseteq> M'\<close> by simp
   moreover have "M' \<turnstile> t" using Decompose.IH \<open>M \<subseteq> M'\<close> by simp
   ultimately show ?case using Decompose.hyps intruder_deduct.Decompose by blast
 qed auto
 
 lemma ideduct_synth_mono:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   shows "\<lbrakk>M \<turnstile>\<^sub>c t; M \<subseteq> M'\<rbrakk> \<Longrightarrow> M' \<turnstile>\<^sub>c t"
 by (induct rule: intruder_synth.induct) auto
 
 context
 begin
 
 \<comment> \<open>Used by \<open>inductive_set\<close>\<close>
 private lemma ideduct_mono_set[mono_set]:
   "M \<subseteq> N \<Longrightarrow> M \<turnstile> t \<longrightarrow> N \<turnstile> t"
   "M \<subseteq> N \<Longrightarrow> M \<turnstile>\<^sub>c t \<longrightarrow> N \<turnstile>\<^sub>c t"
 using ideduct_mono ideduct_synth_mono by (blast, blast)
 
 end
 
 lemma ideduct_reduce:
   "\<lbrakk>M \<union> M' \<turnstile> t; \<And>t'. t' \<in> M' \<Longrightarrow> M \<turnstile> t'\<rbrakk> \<Longrightarrow> M \<turnstile> t"
 proof (induction rule: intruder_deduct_induct)
   case Decompose thus ?case using intruder_deduct.Decompose by blast 
 qed auto
 
 lemma ideduct_synth_reduce:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   shows "\<lbrakk>M \<union> M' \<turnstile>\<^sub>c t; \<And>t'. t' \<in> M' \<Longrightarrow> M \<turnstile>\<^sub>c t'\<rbrakk> \<Longrightarrow> M \<turnstile>\<^sub>c t"
 by (induct rule: intruder_synth_induct) auto
 
 lemma ideduct_mono_eq:
   assumes "\<forall>t. M \<turnstile> t \<longleftrightarrow> M' \<turnstile> t" shows "M \<union> N \<turnstile> t \<longleftrightarrow> M' \<union> N \<turnstile> t"
 proof
   show "M \<union> N \<turnstile> t \<Longrightarrow> M' \<union> N \<turnstile> t"
   proof (induction t rule: intruder_deduct_induct)
     case (Axiom t) thus ?case
     proof (cases "t \<in> M")
       case True
       hence "M \<turnstile> t" using intruder_deduct.Axiom by metis
       thus ?thesis using assms ideduct_mono[of M' t "M' \<union> N"] by simp
     qed auto
   next
     case (Compose T f) thus ?case using intruder_deduct.Compose by auto
   next
     case (Decompose t K T t\<^sub>i) thus ?case using intruder_deduct.Decompose[of "M' \<union> N" t K T] by auto
   qed
 
   show "M' \<union> N \<turnstile> t \<Longrightarrow> M \<union> N \<turnstile> t"
   proof (induction t rule: intruder_deduct_induct)
     case (Axiom t) thus ?case
     proof (cases "t \<in> M'")
       case True
       hence "M' \<turnstile> t" using intruder_deduct.Axiom by metis
       thus ?thesis using assms ideduct_mono[of M t "M \<union> N"] by simp
     qed auto
   next
     case (Compose T f) thus ?case using intruder_deduct.Compose by auto
   next
     case (Decompose t K T t\<^sub>i) thus ?case using intruder_deduct.Decompose[of "M \<union> N" t K T] by auto
   qed
 qed
 
 lemma deduct_synth_subterm:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "M \<turnstile>\<^sub>c t" "s \<in> subterms t" "\<forall>m \<in> M. \<forall>s \<in> subterms m. M \<turnstile>\<^sub>c s"
   shows "M \<turnstile>\<^sub>c s"
 using assms by (induct t rule: intruder_synth.induct) auto
 
 lemma deduct_if_synth[intro, dest]: "M \<turnstile>\<^sub>c t \<Longrightarrow> M \<turnstile> t"
 by (induct rule: intruder_synth.induct) auto
 
 private lemma ideduct_ik_eq: assumes "\<forall>t \<in> M. M' \<turnstile> t" shows "M' \<turnstile> t \<longleftrightarrow> M' \<union> M \<turnstile> t"
 by (meson assms ideduct_mono ideduct_reduce sup_ge1)
 
 private lemma synth_if_deduct_empty: "{} \<turnstile> t \<Longrightarrow> {} \<turnstile>\<^sub>c t"
 proof (induction t rule: intruder_deduct_induct)
   case (Decompose t K M m)
   then obtain f T where "t = Fun f T" "m \<in> set T"
     using Ana_fun_subterm Ana_var by (cases t) fastforce+
   with Decompose.IH(1) show ?case by (induction rule: intruder_synth_induct) auto
 qed auto
 
 private lemma ideduct_deduct_synth_mono_eq:
   assumes "\<forall>t. M \<turnstile> t \<longleftrightarrow> M' \<turnstile>\<^sub>c t" "M \<subseteq> M'"
   and "\<forall>t. M' \<union> N \<turnstile> t \<longleftrightarrow> M' \<union> N \<union> D \<turnstile>\<^sub>c t"
   shows "M \<union> N \<turnstile> t \<longleftrightarrow> M' \<union> N \<union> D \<turnstile>\<^sub>c t"
 proof -
   have "\<forall>m \<in> M'. M \<turnstile> m" using assms(1) by auto
   hence "\<forall>t. M \<turnstile> t \<longleftrightarrow> M' \<turnstile> t" by (metis assms(1,2) deduct_if_synth ideduct_reduce sup.absorb2)
   hence "\<forall>t. M' \<union> N \<turnstile> t \<longleftrightarrow> M \<union> N \<turnstile> t" by (meson ideduct_mono_eq)
   thus ?thesis by (meson assms(3))
 qed
 
 lemma ideduct_subst: "M \<turnstile> t \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<turnstile> t \<cdot> \<delta>"
 proof (induction t rule: intruder_deduct_induct)
   case (Compose T f)
   hence "length (map (\<lambda>t. t \<cdot> \<delta>) T) = arity f" "\<And>t. t \<in> set T \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<turnstile> t \<cdot> \<delta>" by auto
   thus ?case using intruder_deduct.Compose[OF _ Compose.hyps(2), of "map (\<lambda>t. t \<cdot> \<delta>) T"] by auto
 next
   case (Decompose t K M' m')
   hence "Ana (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>)"
         "\<And>k. k \<in> set (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>) \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<turnstile> k"
         "m' \<cdot> \<delta> \<in> set (M' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)"
     using Ana_subst[OF Decompose.hyps(2)] by fastforce+
   thus ?case using intruder_deduct.Decompose[OF Decompose.IH(1)] by metis
 qed simp
 
 lemma ideduct_synth_subst:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term" and \<delta>::"('fun,'var) subst"
   shows "M \<turnstile>\<^sub>c t \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<turnstile>\<^sub>c t \<cdot> \<delta>"
 proof (induction t rule: intruder_synth_induct)
   case (ComposeC T f)
   hence "length (map (\<lambda>t. t \<cdot> \<delta>) T) = arity f" "\<And>t. t \<in> set T \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<turnstile>\<^sub>c t \<cdot> \<delta>" by auto
   thus ?case using intruder_synth.ComposeC[OF _ ComposeC.hyps(2), of "map (\<lambda>t. t \<cdot> \<delta>) T"] by auto
 qed simp
 
 lemma ideduct_vars:
   assumes "M \<turnstile> t"
   shows "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
 using assms 
 proof (induction t rule: intruder_deduct_induct)
   case (Decompose t K T t\<^sub>i) thus ?case
     using Ana_vars(2) fv_subset by blast 
 qed auto
 
 lemma ideduct_synth_vars:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "M \<turnstile>\<^sub>c t"
   shows "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
 using assms by (induct t rule: intruder_synth_induct) auto
 
 lemma ideduct_synth_priv_fun_in_ik:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "M \<turnstile>\<^sub>c t" "f \<in> funs_term t" "\<not>public f"
   shows "f \<in> \<Union>(funs_term ` M)"
 using assms by (induct t rule: intruder_synth_induct) auto
 
 lemma ideduct_synth_priv_const_in_ik:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "M \<turnstile>\<^sub>c Fun c []" "\<not>public c"
   shows "Fun c [] \<in> M"
 using intruder_synth.cases[OF assms(1)] assms(2) by fast
 
 lemma ideduct_synth_ik_replace:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "\<forall>t \<in> M. N \<turnstile>\<^sub>c t"
     and "M \<turnstile>\<^sub>c t"
   shows "N \<turnstile>\<^sub>c t"
 using assms(2,1) by (induct t rule: intruder_synth.induct) auto
 end
 
 subsection \<open>Lemmata: Analyzed Intruder Knowledge Closure\<close>
 lemma deducts_eq_if_analyzed: "analyzed M \<Longrightarrow> M \<turnstile> t \<longleftrightarrow> M \<turnstile>\<^sub>c t"
 unfolding analyzed_def by auto
 
 lemma closure_is_superset: "decomp_closure M M' \<Longrightarrow> M \<subseteq> M'"
 unfolding decomp_closure_def by force
 
 lemma deduct_if_closure_deduct: "\<lbrakk>M' \<turnstile> t; decomp_closure M M'\<rbrakk> \<Longrightarrow> M \<turnstile> t"
 proof (induction t rule: intruder_deduct.induct)
   case (Decompose M' t K T t\<^sub>i)
   thus ?case using intruder_deduct.Decompose[OF _ \<open>Ana t = (K,T)\<close> _ \<open>t\<^sub>i \<in> set T\<close>] by simp
 qed (auto simp add: decomp_closure_def)
 
 lemma deduct_if_closure_synth: "\<lbrakk>decomp_closure M M'; M' \<turnstile>\<^sub>c t\<rbrakk> \<Longrightarrow> M \<turnstile> t"
 using deduct_if_closure_deduct by blast
 
 lemma decomp_closure_subterms_composable:
   assumes "decomp_closure M M'"
   and "M' \<turnstile>\<^sub>c t'" "M' \<turnstile> t" "t \<sqsubseteq> t'"
   shows "M' \<turnstile>\<^sub>c t"
 using \<open>M' \<turnstile>\<^sub>c t'\<close> assms
 proof (induction t' rule: intruder_synth.induct)
   case (AxiomC t' M')
   have "M \<turnstile> t" using \<open>M' \<turnstile> t\<close> deduct_if_closure_deduct AxiomC.prems(1) by blast
   moreover
   { have "\<exists>s \<in> M. t' \<sqsubseteq> s" using \<open>t' \<in> M'\<close> AxiomC.prems(1) unfolding decomp_closure_def by blast
     hence "\<exists>s \<in> M. t \<sqsubseteq> s" using \<open>t \<sqsubseteq> t'\<close> term.order_trans by auto
   }
   ultimately have "t \<in> M'" using AxiomC.prems(1) unfolding decomp_closure_def by blast
   thus ?case by simp
 next
   case (ComposeC T f M')
   let ?t' = "Fun f T"
   { assume "t = ?t'" have "M' \<turnstile>\<^sub>c t" using \<open>M' \<turnstile>\<^sub>c ?t'\<close> \<open>t = ?t'\<close> by simp }
   moreover
   { assume "t \<noteq> ?t'"
     have "\<exists>x \<in> set T. t \<sqsubseteq> x" using \<open>t \<sqsubseteq> ?t'\<close> \<open>t \<noteq> ?t'\<close> by simp
     hence "M' \<turnstile>\<^sub>c t" using ComposeC.IH ComposeC.prems(1,3) ComposeC.hyps(3) by blast
   }
   ultimately show ?case using cases_simp[of "t = ?t'" "M' \<turnstile>\<^sub>c t"] by simp
 qed
 
 lemma decomp_closure_analyzed:
   assumes "decomp_closure M M'"
   shows "analyzed M'"
 proof -
   { fix t assume "M' \<turnstile> t" have "M' \<turnstile>\<^sub>c t" using \<open>M' \<turnstile> t\<close> assms
     proof (induction t rule: intruder_deduct.induct)
       case (Decompose M' t K T t\<^sub>i) 
       hence "M' \<turnstile> t\<^sub>i" using Decompose.hyps intruder_deduct.Decompose by blast
       moreover have "t\<^sub>i \<sqsubseteq> t"
         using Decompose.hyps(4) Ana_subterm[OF Decompose.hyps(2)] by blast
       moreover have "M' \<turnstile>\<^sub>c t" using Decompose.IH(1) Decompose.prems by blast
       ultimately show "M' \<turnstile>\<^sub>c t\<^sub>i" using decomp_closure_subterms_composable Decompose.prems by blast
     qed auto
   }
   moreover have "\<forall>t. M \<turnstile>\<^sub>c t \<longrightarrow> M \<turnstile> t" by auto
   ultimately show ?thesis by (auto simp add: decomp_closure_def analyzed_def)
 qed
 
 lemma analyzed_if_all_analyzed_in:
   assumes M: "\<forall>t \<in> M. analyzed_in t M"
   shows "analyzed M"
 proof (unfold analyzed_def, intro allI iffI)
   fix t
   assume t: "M \<turnstile> t"
   thus "M \<turnstile>\<^sub>c t"
   proof (induction t rule: intruder_deduct_induct)
     case (Decompose t K T t\<^sub>i)
     { assume "t \<in> M"
       hence ?case
         using M Decompose.IH(2) Decompose.hyps(2,4)
         unfolding analyzed_in_def by fastforce
     } moreover {
       fix f S assume "t = Fun f S" "\<And>s. s \<in> set S \<Longrightarrow> M \<turnstile>\<^sub>c s"
       hence ?case using Ana_fun_subterm[of f S] Decompose.hyps(2,4) by blast
     } ultimately show ?case using intruder_synth.cases[OF Decompose.IH(1), of ?case] by blast
   qed simp_all
 qed auto
 
 lemma analyzed_is_all_analyzed_in:
   "(\<forall>t \<in> M. analyzed_in t M) \<longleftrightarrow> analyzed M"
 proof
   show "analyzed M \<Longrightarrow> \<forall>t \<in> M. analyzed_in t M"
     unfolding analyzed_in_def analyzed_def
     by (auto intro: intruder_deduct.Decompose[OF intruder_deduct.Axiom])
 qed (rule analyzed_if_all_analyzed_in)
 
 lemma ik_has_synth_ik_closure:
   fixes M :: "('fun,'var) terms"
   shows "\<exists>M'. (\<forall>t. M \<turnstile> t \<longleftrightarrow> M' \<turnstile>\<^sub>c t) \<and> decomp_closure M M' \<and> (finite M \<longrightarrow> finite M')"
 proof -
   let ?M' = "{t. M \<turnstile> t \<and> (\<exists>t' \<in> M. t \<sqsubseteq> t')}"
 
   have M'_closes: "decomp_closure M ?M'" unfolding decomp_closure_def by simp
   hence "M \<subseteq> ?M'" using closure_is_superset by simp
 
   have "\<forall>t. ?M' \<turnstile>\<^sub>c t \<longrightarrow> M \<turnstile> t" using deduct_if_closure_synth[OF M'_closes] by blast 
   moreover have "\<forall>t. M \<turnstile> t \<longrightarrow> ?M' \<turnstile> t" using ideduct_mono[OF _ \<open>M \<subseteq> ?M'\<close>] by simp
   moreover have "analyzed ?M'" using decomp_closure_analyzed[OF M'_closes] .
   ultimately have "\<forall>t. M \<turnstile> t \<longleftrightarrow> ?M' \<turnstile>\<^sub>c t" unfolding analyzed_def by blast
   moreover have "finite M \<longrightarrow> finite ?M'" by auto
   ultimately show ?thesis using M'_closes by blast
 qed
 
 lemma deducts_eq_if_empty_ik:
   "{} \<turnstile> t \<longleftrightarrow> {} \<turnstile>\<^sub>c t"
 using analyzed_is_all_analyzed_in[of "{}"] deducts_eq_if_analyzed[of "{}" t] by blast
 
 
 subsection \<open>Intruder Variants: Numbered and Composition-Restricted Intruder Deduction Relations\<close>
 text \<open>
   A variant of the intruder relation which restricts composition to only those terms that satisfy
   a given predicate Q.
 \<close>
 inductive intruder_deduct_restricted::
   "('fun,'var) terms \<Rightarrow> (('fun,'var) term \<Rightarrow> bool) \<Rightarrow> ('fun,'var) term \<Rightarrow> bool"
   ("\<langle>_;_\<rangle> \<turnstile>\<^sub>r _" 50)
 where
   AxiomR[simp]:   "t \<in> M \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r t"
 | ComposeR[simp]: "\<lbrakk>length T = arity f; public f; \<And>t. t \<in> set T \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r t; Q (Fun f T)\<rbrakk>
                     \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r Fun f T"
 | DecomposeR:     "\<lbrakk>\<langle>M; Q\<rangle> \<turnstile>\<^sub>r t; Ana t = (K, T); \<And>k. k \<in> set K \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r k; t\<^sub>i \<in> set T\<rbrakk>
                     \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r t\<^sub>i"
 
 text \<open>
   A variant of the intruder relation equipped with a number representing the height of the
   derivation tree (i.e., \<open>\<langle>M; k\<rangle> \<turnstile>\<^sub>n t\<close> iff k is the maximum number of applications of the compose
   and decompose rules in any path of the derivation tree for \<open>M \<turnstile> t\<close>).
 \<close>
 inductive intruder_deduct_num::
   "('fun,'var) terms \<Rightarrow> nat \<Rightarrow> ('fun,'var) term \<Rightarrow> bool"
   ("\<langle>_; _\<rangle> \<turnstile>\<^sub>n _" 50)
 where
   AxiomN[simp]:   "t \<in> M \<Longrightarrow> \<langle>M; 0\<rangle> \<turnstile>\<^sub>n t"
 | ComposeN[simp]: "\<lbrakk>length T = arity f; public f; \<And>t. t \<in> set T \<Longrightarrow> \<langle>M; steps t\<rangle> \<turnstile>\<^sub>n t\<rbrakk>
                     \<Longrightarrow> \<langle>M; Suc (Max (insert 0 (steps ` set T)))\<rangle> \<turnstile>\<^sub>n Fun f T"
 | DecomposeN:     "\<lbrakk>\<langle>M; n\<rangle> \<turnstile>\<^sub>n t; Ana t = (K, T); \<And>k. k \<in> set K \<Longrightarrow> \<langle>M; steps k\<rangle> \<turnstile>\<^sub>n k; t\<^sub>i \<in> set T\<rbrakk>
                     \<Longrightarrow> \<langle>M; Suc (Max (insert n (steps ` set K)))\<rangle> \<turnstile>\<^sub>n t\<^sub>i"
 
 lemma intruder_deduct_restricted_induct[consumes 1, case_names AxiomR ComposeR DecomposeR]:
   assumes "\<langle>M; Q\<rangle> \<turnstile>\<^sub>r t" "\<And>t. t \<in> M \<Longrightarrow> P M Q t"
           "\<And>T f. \<lbrakk>length T = arity f; public f;
                   \<And>t. t \<in> set T \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r t;
                   \<And>t. t \<in> set T \<Longrightarrow> P M Q t; Q (Fun f T)
                   \<rbrakk> \<Longrightarrow> P M Q (Fun f T)"
           "\<And>t K T t\<^sub>i. \<lbrakk>\<langle>M; Q\<rangle> \<turnstile>\<^sub>r t; P M Q t; Ana t = (K, T); \<And>k. k \<in> set K \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r k;
                        \<And>k. k \<in> set K \<Longrightarrow> P M Q k; t\<^sub>i \<in> set T\<rbrakk> \<Longrightarrow> P M Q t\<^sub>i"
   shows "P M Q t"
 using assms by (induct t rule: intruder_deduct_restricted.induct) blast+
 
 lemma intruder_deduct_num_induct[consumes 1, case_names AxiomN ComposeN DecomposeN]:
   assumes "\<langle>M; n\<rangle> \<turnstile>\<^sub>n t" "\<And>t. t \<in> M \<Longrightarrow> P M 0 t"
           "\<And>T f steps.
               \<lbrakk>length T = arity f; public f;
                \<And>t. t \<in> set T \<Longrightarrow> \<langle>M; steps t\<rangle> \<turnstile>\<^sub>n t;
                \<And>t. t \<in> set T \<Longrightarrow> P M (steps t) t\<rbrakk>
               \<Longrightarrow> P M (Suc (Max (insert 0 (steps ` set T)))) (Fun f T)"
           "\<And>t K T t\<^sub>i steps n.
               \<lbrakk>\<langle>M; n\<rangle> \<turnstile>\<^sub>n t; P M n t; Ana t = (K, T);
                \<And>k. k \<in> set K \<Longrightarrow> \<langle>M; steps k\<rangle> \<turnstile>\<^sub>n k;
                t\<^sub>i \<in> set T; \<And>k. k \<in> set K \<Longrightarrow> P M (steps k) k\<rbrakk>
               \<Longrightarrow> P M (Suc (Max (insert n (steps ` set K)))) t\<^sub>i"
   shows "P M n t"
 using assms by (induct rule: intruder_deduct_num.induct) blast+
 
 lemma ideduct_restricted_mono:
   "\<lbrakk>\<langle>M; P\<rangle> \<turnstile>\<^sub>r t; M \<subseteq> M'\<rbrakk> \<Longrightarrow> \<langle>M'; P\<rangle> \<turnstile>\<^sub>r t"
 proof (induction rule: intruder_deduct_restricted_induct)
   case (DecomposeR t K T t\<^sub>i)
   have "\<forall>k. k \<in> set K \<longrightarrow> \<langle>M'; P\<rangle> \<turnstile>\<^sub>r k" using DecomposeR.IH \<open>M \<subseteq> M'\<close> by simp
   moreover have "\<langle>M'; P\<rangle> \<turnstile>\<^sub>r t" using DecomposeR.IH \<open>M \<subseteq> M'\<close> by simp
   ultimately show ?case
     using DecomposeR
           intruder_deduct_restricted.DecomposeR[OF _ DecomposeR.hyps(2) _ DecomposeR.hyps(4)]
     by blast
 qed auto
 
 
 subsection \<open>Lemmata: Intruder Deduction Equivalences\<close>
 lemma deduct_if_restricted_deduct: "\<langle>M;P\<rangle> \<turnstile>\<^sub>r m \<Longrightarrow> M \<turnstile> m"
 proof (induction m rule: intruder_deduct_restricted_induct)
   case (DecomposeR t K T t\<^sub>i) thus ?case using intruder_deduct.Decompose by blast
 qed simp_all
 
 lemma restricted_deduct_if_restricted_ik:
   assumes "\<langle>M;P\<rangle> \<turnstile>\<^sub>r m" "\<forall>m \<in> M. P m"
   and P: "\<forall>t t'. P t \<longrightarrow> t' \<sqsubseteq> t \<longrightarrow> P t'"
   shows "P m"
 using assms(1)
 proof (induction m rule: intruder_deduct_restricted_induct)
   case (DecomposeR t K T t\<^sub>i)
   obtain f S where "t = Fun f S" using Ana_var \<open>t\<^sub>i \<in> set T\<close> \<open>Ana t = (K, T)\<close> by (cases t) auto
   thus ?case using DecomposeR assms(2) P Ana_subterm by blast
 qed (simp_all add: assms(2))
 
 lemma deduct_restricted_if_synth:
   assumes P: "P m" "\<forall>t t'. P t \<longrightarrow> t' \<sqsubseteq> t \<longrightarrow> P t'"
   and m: "M \<turnstile>\<^sub>c m"
   shows "\<langle>M; P\<rangle> \<turnstile>\<^sub>r m"
 using m P(1)
 proof (induction m rule: intruder_synth_induct)
   case (ComposeC T f)
   hence "\<langle>M; P\<rangle> \<turnstile>\<^sub>r t" when t: "t \<in> set T" for t
     using t P(2) subtermeqI''[of _ T f]
     by fastforce
   thus ?case
     using intruder_deduct_restricted.ComposeR[OF ComposeC.hyps(1,2)] ComposeC.prems(1)
     by metis
 qed simp
 
 lemma deduct_zero_in_ik:
   assumes "\<langle>M; 0\<rangle> \<turnstile>\<^sub>n t" shows "t \<in> M"
 proof -
   { fix k assume "\<langle>M; k\<rangle> \<turnstile>\<^sub>n t" hence "k > 0 \<or> t \<in> M" by (induct t) auto
   } thus ?thesis using assms by auto
 qed
 
 lemma deduct_if_deduct_num: "\<langle>M; k\<rangle> \<turnstile>\<^sub>n t \<Longrightarrow> M \<turnstile> t"
 by (induct t rule: intruder_deduct_num.induct)
    (metis intruder_deduct.Axiom,
     metis intruder_deduct.Compose,
     metis intruder_deduct.Decompose)
 
 lemma deduct_num_if_deduct: "M \<turnstile> t \<Longrightarrow> \<exists>k. \<langle>M; k\<rangle> \<turnstile>\<^sub>n t"
 proof (induction t rule: intruder_deduct_induct)
   case (Compose T f)
   then obtain steps where *: "\<forall>t \<in> set T. \<langle>M; steps t\<rangle> \<turnstile>\<^sub>n t" by moura
   then obtain n where "\<forall>t \<in> set T. steps t \<le> n"
     using finite_nat_set_iff_bounded_le[of "steps ` set T"]
     by auto
   thus ?case using ComposeN[OF Compose.hyps(1,2), of M steps] * by force
 next
   case (Decompose t K T t\<^sub>i)
   hence "\<And>u. u \<in> insert t (set K) \<Longrightarrow> \<exists>k. \<langle>M; k\<rangle> \<turnstile>\<^sub>n u" by auto
   then obtain steps where *: "\<langle>M; steps t\<rangle> \<turnstile>\<^sub>n t" "\<forall>t \<in> set K. \<langle>M; steps t\<rangle> \<turnstile>\<^sub>n t" by moura
   then obtain n where "steps t \<le> n" "\<forall>t \<in> set K. steps t \<le> n"
     using finite_nat_set_iff_bounded_le[of "steps ` insert t (set K)"]
     by auto
   thus ?case using DecomposeN[OF _ Decompose.hyps(2) _ Decompose.hyps(4), of M _ steps] * by force
 qed (metis AxiomN)
 
 lemma deduct_normalize:
   assumes M: "\<forall>m \<in> M. \<forall>f T. Fun f T \<sqsubseteq> m \<longrightarrow> P f T"
   and t: "\<langle>M; k\<rangle> \<turnstile>\<^sub>n t" "Fun f T \<sqsubseteq> t" "\<not>P f T"
   shows "\<exists>l \<le> k. (\<langle>M; l\<rangle> \<turnstile>\<^sub>n Fun f T) \<and> (\<forall>t \<in> set T. \<exists>j < l. \<langle>M; j\<rangle> \<turnstile>\<^sub>n t)"
 using t
 proof (induction t rule: intruder_deduct_num_induct)
   case (AxiomN t) thus ?case using M by auto
 next
   case (ComposeN T' f' steps) thus ?case
   proof (cases "Fun f' T' = Fun f T")
     case True
     hence "\<langle>M; Suc (Max (insert 0 (steps ` set T')))\<rangle> \<turnstile>\<^sub>n Fun f T" "T = T'"
       using intruder_deduct_num.ComposeN[OF ComposeN.hyps] by auto
     moreover have "\<And>t. t \<in> set T \<Longrightarrow> \<langle>M; steps t\<rangle> \<turnstile>\<^sub>n t"
       using True ComposeN.hyps(3) by auto
     moreover have "\<And>t. t \<in> set T \<Longrightarrow> steps t < Suc (Max (insert 0 (steps ` set T)))"
       using Max_less_iff[of "insert 0 (steps ` set T)" "Suc (Max (insert 0 (steps ` set T)))"]
       by auto
     ultimately show ?thesis by auto
   next
     case False
     then obtain t' where t': "t' \<in> set T'" "Fun f T \<sqsubseteq> t'" using ComposeN by auto
     hence "\<exists>l \<le> steps t'. (\<langle>M; l\<rangle> \<turnstile>\<^sub>n Fun f T) \<and> (\<forall>t \<in> set T. \<exists>j < l. \<langle>M; j\<rangle> \<turnstile>\<^sub>n t)"
       using ComposeN.IH[OF _ _ ComposeN.prems(2)] by auto
     moreover have "steps t' < Suc (Max (insert 0 (steps ` set T')))"
       using Max_less_iff[of "insert 0 (steps ` set T')" "Suc (Max (insert 0 (steps ` set T')))"]
       using t'(1) by auto
     ultimately show ?thesis using ComposeN.hyps(3)[OF t'(1)]
       by (meson Suc_le_eq le_Suc_eq le_trans)
   qed
 next
   case (DecomposeN t K T' t\<^sub>i steps n)
   hence *: "Fun f T \<sqsubseteq> t"
     using term.order_trans[of "Fun f T" t\<^sub>i t] Ana_subterm[of t K T']
     by blast
   have "\<exists>l \<le> n. (\<langle>M; l\<rangle> \<turnstile>\<^sub>n Fun f T) \<and> (\<forall>t' \<in> set T. \<exists>j < l. \<langle>M; j\<rangle> \<turnstile>\<^sub>n t')"
     using DecomposeN.IH(1)[OF * DecomposeN.prems(2)] by auto
   moreover have "n < Suc (Max (insert n (steps ` set K)))"
       using Max_less_iff[of "insert n (steps ` set K)" "Suc (Max (insert n (steps ` set K)))"]
       by auto
   ultimately show ?case using DecomposeN.hyps(4) by (meson Suc_le_eq le_Suc_eq le_trans)
 qed
 
 lemma deduct_inv:
   assumes "\<langle>M; n\<rangle> \<turnstile>\<^sub>n t"
   shows "t \<in> M \<or>
          (\<exists>f T. t = Fun f T \<and> public f \<and> length T = arity f \<and> (\<forall>t \<in> set T. \<exists>l < n. \<langle>M; l\<rangle> \<turnstile>\<^sub>n t)) \<or>
          (\<exists>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t M.
             (\<exists>l < n. \<langle>M; l\<rangle> \<turnstile>\<^sub>n m) \<and> (\<forall>k \<in> set (fst (Ana m)). \<exists>l < n. \<langle>M; l\<rangle> \<turnstile>\<^sub>n k) \<and>
             t \<in> set (snd (Ana m)))"
     (is "?P t n \<or> ?Q t n \<or> ?R t n")
 using assms
 proof (induction n arbitrary: t rule: nat_less_induct)
   case (1 n t) thus ?case
   proof (cases n)
     case 0
     hence "t \<in> M" using deduct_zero_in_ik "1.prems"(1) by metis
     thus ?thesis by auto
   next
     case (Suc n')
     hence "\<langle>M; Suc n'\<rangle> \<turnstile>\<^sub>n t"
           "\<forall>m < Suc n'. \<forall>x. (\<langle>M; m\<rangle> \<turnstile>\<^sub>n x) \<longrightarrow> ?P x m \<or> ?Q x m \<or> ?R x m"
       using "1.prems" "1.IH" by blast+
     hence "?P t (Suc n') \<or> ?Q t (Suc n') \<or> ?R t (Suc n')"
     proof (induction t rule: intruder_deduct_num_induct)
       case (AxiomN t) thus ?case by simp
     next
       case (ComposeN T f steps)
       have "\<And>t. t \<in> set T \<Longrightarrow> steps t < Suc (Max (insert 0 (steps ` set T)))"
           using Max_less_iff[of "insert 0 (steps ` set T)" "Suc (Max (insert 0 (steps ` set T)))"]
           by auto
       thus ?case using ComposeN.hyps by metis
     next
       case (DecomposeN t K T t\<^sub>i steps n)
       have 0: "n < Suc (Max (insert n (steps ` set K)))"
               "\<And>k. k \<in> set K \<Longrightarrow> steps k < Suc (Max (insert n (steps ` set K)))"
         using Max_less_iff[of "insert n (steps ` set K)" "Suc (Max (insert n (steps ` set K)))"]
         by auto
 
       have IH1: "?P t j \<or> ?Q t j \<or> ?R t j" when jt: "j < n" "\<langle>M; j\<rangle> \<turnstile>\<^sub>n t" for j t
         using jt DecomposeN.prems(1) 0(1)
         by simp
 
       have IH2: "?P t n \<or> ?Q t n \<or> ?R t n"
         using DecomposeN.IH(1) IH1
         by simp
 
       have 1: "\<forall>k \<in> set (fst (Ana t)). \<exists>l < Suc (Max (insert n (steps ` set K))). \<langle>M; l\<rangle> \<turnstile>\<^sub>n k"
         using DecomposeN.hyps(1,2,3) 0(2)
         by auto
     
       have 2: "t\<^sub>i \<in> set (snd (Ana t))"
         using DecomposeN.hyps(2,4)
         by fastforce
     
       have 3: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M" when "t \<in> set (snd (Ana m))" "m \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M" for m
         using that(1) Ana_subterm[of m _ "snd (Ana m)"] in_subterms_subset_Union[OF that(2)]
         by (metis (no_types, lifting) prod.collapse psubsetD subsetCE subsetD) 
     
       have 4: "?R t\<^sub>i (Suc (Max (insert n (steps ` set K))))" when "?R t n"
         using that 0(1) 1 2 3 DecomposeN.hyps(1)
         by (metis (no_types, lifting)) 
     
       have 5: "?R t\<^sub>i (Suc (Max (insert n (steps ` set K))))" when "?P t n"
         using that 0(1) 1 2 DecomposeN.hyps(1)
         by blast
     
       have 6: ?case when *: "?Q t n"
       proof -
         obtain g S where g:
             "t = Fun g S" "public g" "length S = arity g" "\<forall>t \<in> set S. \<exists>l < n. \<langle>M; l\<rangle> \<turnstile>\<^sub>n t"
           using * by moura
         then obtain l where l: "l < n" "\<langle>M; l\<rangle> \<turnstile>\<^sub>n t\<^sub>i"
           using 0(1) DecomposeN.hyps(2,4) Ana_fun_subterm[of g S K T] by blast
     
         have **: "l < Suc (Max (insert n (steps ` set K)))" using l(1) 0(1) by simp
     
         show ?thesis using IH1[OF l] less_trans[OF _ **] by fastforce
       qed
 
       show ?case using IH2 4 5 6 by argo
     qed
     thus ?thesis using Suc by fast
   qed
 qed
 
 lemma deduct_inv':
   assumes "M \<turnstile> Fun f ts"
   shows "Fun f ts \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<or> (\<forall>t \<in> set ts. M \<turnstile> t)"
 proof -
   obtain k where k: "intruder_deduct_num M k (Fun f ts)"
     using deduct_num_if_deduct[OF assms] by fast
 
   have "Fun f ts \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<or> (\<forall>t \<in> set ts. \<exists>l. intruder_deduct_num M l t)"
     using deduct_inv[OF k] Ana_subterm'[of "Fun f ts"] in_subterms_subset_Union by blast
   thus ?thesis using deduct_if_deduct_num by blast
 qed
 
 lemma restricted_deduct_if_deduct:
   assumes M: "\<forall>m \<in> M. \<forall>f T. Fun f T \<sqsubseteq> m \<longrightarrow> P (Fun f T)"
   and P_subterm: "\<forall>f T t. M \<turnstile> Fun f T \<longrightarrow> P (Fun f T) \<longrightarrow> t \<in> set T \<longrightarrow> P t"
   and P_Ana_key: "\<forall>t K T k. M \<turnstile> t \<longrightarrow> P t \<longrightarrow> Ana t = (K, T) \<longrightarrow> M \<turnstile> k \<longrightarrow> k \<in> set K \<longrightarrow> P k"
   and m: "M \<turnstile> m" "P m"
   shows "\<langle>M; P\<rangle> \<turnstile>\<^sub>r m"
 proof -
   { fix k assume "\<langle>M; k\<rangle> \<turnstile>\<^sub>n m"
     hence ?thesis using m(2)
     proof (induction k arbitrary: m rule: nat_less_induct)
       case (1 n m) thus ?case
       proof (cases n)
         case 0
         hence "m \<in> M" using deduct_zero_in_ik "1.prems"(1) by metis
         thus ?thesis by auto
       next
         case (Suc n')
         hence "\<langle>M; Suc n'\<rangle> \<turnstile>\<^sub>n m"
               "\<forall>m < Suc n'. \<forall>x. (\<langle>M; m\<rangle> \<turnstile>\<^sub>n x) \<longrightarrow> P x \<longrightarrow> \<langle>M;P\<rangle> \<turnstile>\<^sub>r x"
           using "1.prems" "1.IH" by blast+
         thus ?thesis using "1.prems"(2)
         proof (induction m rule: intruder_deduct_num_induct)
           case (ComposeN T f steps)
           have *: "steps t < Suc (Max (insert 0 (steps ` set T)))" when "t \<in> set T" for t
             using Max_less_iff[of "insert 0 (steps ` set T)"] that
             by blast
 
           have **: "P t" when "t \<in> set T" for t
             using P_subterm ComposeN.prems(2) that
                   Fun_param_is_subterm[OF that]
                   intruder_deduct.Compose[OF ComposeN.hyps(1,2)]
                   deduct_if_deduct_num[OF ComposeN.hyps(3)]
             by blast
 
           have "\<langle>M; P\<rangle> \<turnstile>\<^sub>r t" when "t \<in> set T" for t
             using ComposeN.prems(1) ComposeN.hyps(3)[OF that] *[OF that] **[OF that]
             by blast
           thus ?case
             by (metis intruder_deduct_restricted.ComposeR[OF ComposeN.hyps(1,2)] ComposeN.prems(2))
         next
           case (DecomposeN t K T t\<^sub>i steps l)
           show ?case
           proof (cases "P t")
             case True
             hence "\<And>k. k \<in> set K \<Longrightarrow> P k"
               using P_Ana_key DecomposeN.hyps(1,2,3) deduct_if_deduct_num
               by blast
             moreover have
                 "\<And>k m x. k \<in> set K \<Longrightarrow> m < steps k \<Longrightarrow> \<langle>M; m\<rangle> \<turnstile>\<^sub>n x \<Longrightarrow> P x \<Longrightarrow> \<langle>M;P\<rangle> \<turnstile>\<^sub>r x"
             proof -
               fix k m x assume *: "k \<in> set K" "m < steps k" "\<langle>M; m\<rangle> \<turnstile>\<^sub>n x" "P x"
               have "steps k \<in> insert l (steps ` set K)" using *(1) by simp
               hence "m < Suc (Max (insert l (steps ` set K)))"
                 using less_trans[OF *(2), of "Suc (Max (insert l (steps ` set K)))"]
                       Max_less_iff[of "insert l (steps ` set K)"
                                       "Suc (Max (insert l (steps ` set K)))"]
                 by auto
               thus "\<langle>M;P\<rangle> \<turnstile>\<^sub>r x" using DecomposeN.prems(1) *(3,4) by simp
             qed
             ultimately have "\<And>k. k \<in> set K \<Longrightarrow> \<langle>M; P\<rangle> \<turnstile>\<^sub>r k"
               using DecomposeN.IH(2) by auto
             moreover have "\<langle>M; P\<rangle> \<turnstile>\<^sub>r t"
               using True DecomposeN.prems(1) DecomposeN.hyps(1) le_imp_less_Suc
                     Max_less_iff[of "insert l (steps ` set K)" "Suc (Max (insert l (steps ` set K)))"]
               by blast
             ultimately show ?thesis
               using intruder_deduct_restricted.DecomposeR[OF _ DecomposeN.hyps(2)
                                                              _ DecomposeN.hyps(4)]
               by metis
           next
             case False
             obtain g S where gS: "t = Fun g S" using DecomposeN.hyps(2,4) by (cases t) moura+
             hence *: "Fun g S \<sqsubseteq> t" "\<not>P (Fun g S)" using False by force+
             have "\<exists>j<l. \<langle>M; j\<rangle> \<turnstile>\<^sub>n t\<^sub>i"
               using gS DecomposeN.hyps(2,4) Ana_fun_subterm[of g S K T]
                     deduct_normalize[of M "\<lambda>f T. P (Fun f T)", OF M DecomposeN.hyps(1) *]
               by force
             hence "\<exists>j<Suc (Max (insert l (steps ` set K))). \<langle>M; j\<rangle> \<turnstile>\<^sub>n t\<^sub>i"
               using Max_less_iff[of "insert l (steps ` set K)"
                                     "Suc (Max (insert l (steps ` set K)))"]
                     less_trans[of _ l "Suc (Max (insert l (steps ` set K)))"]
               by blast
             thus ?thesis using DecomposeN.prems(1,2) by meson
           qed
         qed auto
       qed
     qed
   } thus ?thesis using deduct_num_if_deduct m(1) by metis
 qed
 
 lemma restricted_deduct_if_deduct':
   assumes "\<forall>m \<in> M. P m"
     and "\<forall>t t'. P t \<longrightarrow> t' \<sqsubseteq> t \<longrightarrow> P t'"
     and "\<forall>t K T k. P t \<longrightarrow> Ana t = (K, T) \<longrightarrow> k \<in> set K \<longrightarrow> P k"
     and "M \<turnstile> m" "P m"
   shows "\<langle>M; P\<rangle> \<turnstile>\<^sub>r m"
 using restricted_deduct_if_deduct[of M P m] assms
 by blast
 
 lemma private_const_deduct:
   assumes c: "\<not>public c" "M \<turnstile> (Fun c []::('fun,'var) term)"
   shows "Fun c [] \<in> M \<or>
          (\<exists>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t M. M \<turnstile> m \<and> (\<forall>k \<in> set (fst (Ana m)). M \<turnstile> m) \<and>
                              Fun c [] \<in> set (snd (Ana m)))"
 proof -
   obtain n where "\<langle>M; n\<rangle> \<turnstile>\<^sub>n Fun c []"
     using c(2) deduct_num_if_deduct by moura
   hence "Fun c [] \<in> M \<or>
          (\<exists>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t M.
             (\<exists>l < n. \<langle>M; l\<rangle> \<turnstile>\<^sub>n m) \<and>
             (\<forall>k \<in> set (fst (Ana m)). \<exists>l < n. \<langle>M; l\<rangle> \<turnstile>\<^sub>n k) \<and> Fun c [] \<in> set (snd (Ana m)))"
     using deduct_inv[of M n "Fun c []"] c(1) by fast
   thus ?thesis using deduct_if_deduct_num[of M] by blast
 qed
 
 lemma private_fun_deduct_in_ik'':
   assumes t: "M \<turnstile> Fun f T" "Fun c [] \<in> set T" "\<forall>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t M. Fun f T \<notin> set (snd (Ana m))"
     and c: "\<not>public c" "Fun c [] \<notin> M" "\<forall>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t M. Fun c [] \<notin> set (snd (Ana m))"
   shows "Fun f T \<in> M"
 proof -
   have *: "\<nexists>n. \<langle>M; n\<rangle> \<turnstile>\<^sub>n Fun c []"
     using private_const_deduct[OF c(1)] c(2,3) deduct_if_deduct_num
     by blast
 
   obtain n where n: "\<langle>M; n\<rangle> \<turnstile>\<^sub>n Fun f T"
     using t(1) deduct_num_if_deduct
     by blast
 
   show ?thesis
     using deduct_inv[OF n] t(2,3) *
     by blast
 qed
 
 end
 
 subsection \<open>Executable Definitions for Code Generation\<close>
 fun intruder_synth' where
   "intruder_synth' pu ar M (Var x) = (Var x \<in> M)"
 | "intruder_synth' pu ar M (Fun f T) = (
     Fun f T \<in> M \<or> (pu f \<and> length T = ar f \<and> list_all (intruder_synth' pu ar M) T))"
 
 definition "wf\<^sub>t\<^sub>r\<^sub>m' ar t \<equiv> (\<forall>s \<in> subterms t. is_Fun s \<longrightarrow> ar (the_Fun s) = length (args s))"
 
 definition "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' ar M \<equiv> (\<forall>t \<in> M. wf\<^sub>t\<^sub>r\<^sub>m' ar t)"
 
 definition "analyzed_in' An pu ar t M \<equiv> (case An t of
     (K,T) \<Rightarrow> (\<forall>k \<in> set K. intruder_synth' pu ar M k) \<longrightarrow> (\<forall>s \<in> set T. intruder_synth' pu ar M s))"
 
 lemma (in intruder_model) intruder_synth'_induct[consumes 1, case_names Var Fun]:
   assumes "intruder_synth' public arity M t"
           "\<And>x. intruder_synth' public arity M (Var x) \<Longrightarrow> P (Var x)"
           "\<And>f T. (\<And>z. z \<in> set T \<Longrightarrow> intruder_synth' public arity M z \<Longrightarrow> P z) \<Longrightarrow>
                   intruder_synth' public arity M (Fun f T) \<Longrightarrow> P (Fun f T) "
   shows "P t"
 using assms by (induct public arity M t rule: intruder_synth'.induct) auto
 
 lemma (in intruder_model) wf\<^sub>t\<^sub>r\<^sub>m_code[code_unfold]:
   "wf\<^sub>t\<^sub>r\<^sub>m t = wf\<^sub>t\<^sub>r\<^sub>m' arity t"
 unfolding wf\<^sub>t\<^sub>r\<^sub>m_def wf\<^sub>t\<^sub>r\<^sub>m'_def
 by auto
 
 lemma (in intruder_model) wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[code_unfold]:
   "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M = wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity M"
 using wf\<^sub>t\<^sub>r\<^sub>m_code
 unfolding wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s'_def
 by auto
 
 lemma (in intruder_model) intruder_synth_code[code_unfold]:
   "intruder_synth M t = intruder_synth' public arity M t"
   (is "?A \<longleftrightarrow> ?B")
 proof
   show "?A \<Longrightarrow> ?B"
   proof (induction t rule: intruder_synth_induct)
     case (AxiomC t) thus ?case by (cases t) auto
   qed (fastforce simp add: list_all_iff)
 
   show "?B \<Longrightarrow> ?A"
   proof (induction t rule: intruder_synth'_induct)
     case (Fun f T) thus ?case
     proof (cases "Fun f T \<in> M")
       case False
       hence "public f" "length T = arity f" "list_all (intruder_synth' public arity M) T"
         using Fun.hyps by fastforce+
       thus ?thesis
         using Fun.IH intruder_synth.ComposeC[of T f M] Ball_set[of T]
         by blast
     qed simp
   qed simp
 qed
 
 lemma (in intruder_model) analyzed_in_code[code_unfold]:
   "analyzed_in t M = analyzed_in' Ana public arity t M"
 using intruder_synth_code[of M]
 unfolding analyzed_in_def analyzed_in'_def
 by fastforce
 
 end
diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Lazy_Intruder.thy b/thys/Stateful_Protocol_Composition_and_Typing/Lazy_Intruder.thy
--- a/thys/Stateful_Protocol_Composition_and_Typing/Lazy_Intruder.thy
+++ b/thys/Stateful_Protocol_Composition_and_Typing/Lazy_Intruder.thy
@@ -1,996 +1,994 @@
 (*  Title:      Lazy_Intruder.thy
     Author:     Andreas Viktor Hess, DTU
     SPDX-License-Identifier: BSD-3-Clause
 *)
 
 section \<open>The Lazy Intruder\<close>
 theory Lazy_Intruder
 imports Strands_and_Constraints Intruder_Deduction
 begin
 
 context intruder_model
 begin
 
 subsection \<open>Definition of the Lazy Intruder\<close>
 text \<open>The lazy intruder constraint reduction system, defined as a relation on constraint states\<close>
 inductive_set LI_rel::
     "((('fun,'var) strand \<times> (('fun,'var) subst)) \<times>
        ('fun,'var) strand \<times> (('fun,'var) subst)) set"
   and LI_rel' (infix "\<leadsto>" 50)
   and LI_rel_trancl (infix "\<leadsto>\<^sup>+" 50)
   and LI_rel_rtrancl (infix "\<leadsto>\<^sup>*" 50)
 where
   "A \<leadsto> B \<equiv> (A,B) \<in> LI_rel"
 | "A \<leadsto>\<^sup>+ B \<equiv> (A,B) \<in> LI_rel\<^sup>+"
 | "A \<leadsto>\<^sup>* B \<equiv> (A,B) \<in> LI_rel\<^sup>*"
 
 | Compose: "\<lbrakk>simple S; length T = arity f; public f\<rbrakk>
             \<Longrightarrow> (S@Send [Fun f T]#S',\<theta>) \<leadsto> (S@(map Send1 T)@S',\<theta>)"
 | Unify: "\<lbrakk>simple S; Fun f T' \<in> ik\<^sub>s\<^sub>t S; Some \<delta> = mgu (Fun f T) (Fun f T')\<rbrakk>
           \<Longrightarrow> (S@Send [Fun f T]#S',\<theta>) \<leadsto> ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta> \<circ>\<^sub>s \<delta>)"
 | Equality: "\<lbrakk>simple S; Some \<delta> = mgu t t'\<rbrakk>
           \<Longrightarrow> (S@Equality _ t t'#S',\<theta>) \<leadsto> ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta> \<circ>\<^sub>s \<delta>)"
 
 
 text \<open>A "pre-processing step" to be applied before constraint reduction. It transforms constraints
 such that exactly one message is transmitted in each message transmission step. It is sound and
 complete and preserves the various well-formedness properties required by the lazy intruder.\<close>
 fun LI_preproc where
   "LI_preproc [] = []"
 | "LI_preproc (Send ts#S) = map Send1 ts@LI_preproc S"
 | "LI_preproc (Receive ts#S) = map Receive1 ts@LI_preproc S"
 | "LI_preproc (x#S) = x#LI_preproc S"
 
 definition LI_preproc_prop where
   "LI_preproc_prop S \<equiv> \<forall>ts. Send ts \<in> set S \<or> Receive ts \<in> set S \<longrightarrow> (\<exists>t. ts = [t])" 
 
 
 subsection \<open>Lemmata: Preprocessing \<close>
 lemma LI_preproc_preproc_prop:
   "LI_preproc_prop (LI_preproc S)"
 by (induct S rule: LI_preproc.induct) (auto simp add: LI_preproc_prop_def)
 
 lemma LI_preproc_sem_eq:
   "\<lbrakk>M; S\<rbrakk>\<^sub>c \<I> \<longleftrightarrow> \<lbrakk>M; LI_preproc S\<rbrakk>\<^sub>c \<I>" (is "?A \<longleftrightarrow> ?B")
 proof
   show "?A \<Longrightarrow> ?B"
   proof (induction S rule: strand_sem_induct)
     case (ConsSnd M ts S)
     hence "\<lbrakk>M; LI_preproc S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; map Send1 ts\<rbrakk>\<^sub>c \<I>" using strand_sem_Send_map(5) by auto
     moreover have "ik\<^sub>s\<^sub>t (map Send1 ts) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = {}" unfolding ik\<^sub>s\<^sub>t_is_rcv_set by fastforce
     ultimately show ?case using strand_sem_append(1) by simp
   next
     case (ConsRcv M ts S)
     hence "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> M; LI_preproc S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; map Receive1 ts\<rbrakk>\<^sub>c \<I>"
       using strand_sem_Receive_map(3) by auto
     moreover have "ik\<^sub>s\<^sub>t (map Receive1 ts) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" unfolding ik\<^sub>s\<^sub>t_is_rcv_set by force
     ultimately show ?case using strand_sem_append(1) by (simp add: Un_commute)
   qed simp_all
 
   show "?B \<Longrightarrow> ?A"
   proof (induction S arbitrary: M rule: LI_preproc.induct)
     case (2 ts S)
     have "ik\<^sub>s\<^sub>t (map Send1 ts) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = {}" unfolding ik\<^sub>s\<^sub>t_is_rcv_set by fastforce
     hence "\<lbrakk>M; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; map Send1 ts\<rbrakk>\<^sub>c \<I>" using 2 strand_sem_append(1) by auto
     thus ?case using strand_sem_Send_map(5) by simp
   next
     case (3 ts S)
     have "ik\<^sub>s\<^sub>t (map Receive1 ts) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" unfolding ik\<^sub>s\<^sub>t_is_rcv_set by force
     hence "\<lbrakk>M \<union> (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>); S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; map Receive1 ts\<rbrakk>\<^sub>c \<I>"
       using 3 strand_sem_append(1) by auto
     thus ?case using strand_sem_Receive_map(3) by (simp add: Un_commute)
   qed simp_all
 qed
 
 lemma LI_preproc_sem_eq':
   "(\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>) \<longleftrightarrow> (\<I> \<Turnstile>\<^sub>c \<langle>LI_preproc S, \<theta>\<rangle>)"
 using LI_preproc_sem_eq unfolding constr_sem_c_def by simp
 
 lemma LI_preproc_vars_eq:
   "fv\<^sub>s\<^sub>t (LI_preproc S) = fv\<^sub>s\<^sub>t S"
   "bvars\<^sub>s\<^sub>t (LI_preproc S) = bvars\<^sub>s\<^sub>t S"
   "vars\<^sub>s\<^sub>t (LI_preproc S) = vars\<^sub>s\<^sub>t S"
 by (induct S rule: LI_preproc.induct) auto
 
 lemma LI_preproc_trms_eq:
   "trms\<^sub>s\<^sub>t (LI_preproc S) = trms\<^sub>s\<^sub>t S"
 by (induct S rule: LI_preproc.induct) auto
 
 lemma LI_preproc_wf\<^sub>s\<^sub>t:
   assumes "wf\<^sub>s\<^sub>t X S"
   shows "wf\<^sub>s\<^sub>t X (LI_preproc S)"
   using assms
 proof (induction S arbitrary: X rule: wf\<^sub>s\<^sub>t_induct)
   case (ConsRcv X ts S)
   hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> X" "wf\<^sub>s\<^sub>t X (LI_preproc S)" by auto
   thus ?case using wf_Receive1_prefix by simp
 next
   case (ConsSnd X ts S)
   hence "wf\<^sub>s\<^sub>t (X \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)) (LI_preproc S)" by simp
   thus ?case using wf_Send1_prefix by simp
 qed simp_all
 
 lemma LI_preproc_preserves_wellformedness:
   assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>"
   shows "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r (LI_preproc S) \<theta>"
 using assms LI_preproc_vars_eq[of S] LI_preproc_wf\<^sub>s\<^sub>t[of "{}" S] unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by argo
 
 lemma LI_preproc_prop_SendE:
   assumes "LI_preproc_prop S"
     and "Send ts \<in> set S"
   shows "(\<exists>x. ts = [Var x]) \<or> (\<exists>f T. ts = [Fun f T])"
 proof -
   obtain t where "ts = [t]" using assms unfolding LI_preproc_prop_def by auto
   thus ?thesis by (cases t) auto
 qed
 
 lemma LI_preproc_prop_split:
   "LI_preproc_prop (S@S') \<longleftrightarrow> LI_preproc_prop S \<and> LI_preproc_prop S'" (is "?A \<longleftrightarrow> ?B")
 proof
   show "?A \<Longrightarrow> ?B"
   proof (induction S)
     case (Cons x S) thus ?case unfolding LI_preproc_prop_def by (cases x) auto
   qed (simp add: LI_preproc_prop_def)
 
   show "?B \<Longrightarrow> ?A"
   proof (induction S)
     case (Cons x S) thus ?case unfolding LI_preproc_prop_def by (cases x) auto
   qed (simp add: LI_preproc_prop_def)
 qed
 
 subsection \<open>Lemma: The Lazy Intruder is Well-founded\<close>
 context
 begin
 private lemma LI_compose_measure_lt:
   "((S@(map Send1 T)@S',\<theta>\<^sub>1), (S@Send [Fun f T]#S',\<theta>\<^sub>2)) \<in> measure\<^sub>s\<^sub>t"
 using strand_fv_card_map_fun_eq[of S f T S'] strand_size_map_fun_lt[of T f]
 by (simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)
 
 private lemma LI_unify_measure_lt:
   assumes "Some \<delta> = mgu (Fun f T) t" "fv t \<subseteq> fv\<^sub>s\<^sub>t S"
   shows "(((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta>\<^sub>1), (S@Send [Fun f T]#S',\<theta>\<^sub>2)) \<in> measure\<^sub>s\<^sub>t"
 proof (cases "\<delta> = Var")
   assume "\<delta> = Var"
   hence "(S@S') \<cdot>\<^sub>s\<^sub>t \<delta> = S@S'" by blast
   thus ?thesis
     using strand_fv_card_rm_fun_le[of S S' f T]
     by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)
 next
   assume "\<delta> \<noteq> Var"
   then obtain v where "v \<in> fv (Fun f T) \<union> fv t" "subst_elim \<delta> v"
     using mgu_eliminates[OF assms(1)[symmetric]] by metis
   hence v_in: "v \<in> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
     using assms(2) by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)
   
   have "range_vars \<delta> \<subseteq> fv (Fun f T) \<union> fv\<^sub>s\<^sub>t S"
     using assms(2) mgu_vars_bounded[OF assms(1)[symmetric]] by auto
   hence img_bound: "range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')" by auto
 
   have finite_fv: "finite (fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S'))" by auto
 
   have "v \<notin> fv\<^sub>s\<^sub>t ((S@Send [Fun f T]#S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
     using strand_fv_subst_subset_if_subst_elim[OF \<open>subst_elim \<delta> v\<close>] v_in by metis
   hence v_not_in: "v \<notin> fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)" by auto
   
   have "fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
     using strand_subst_fv_bounded_if_img_bounded[OF img_bound] by simp
   hence "fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subset> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')" using v_in v_not_in by blast
   hence "card (fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)) < card (fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S'))"
     using psubset_card_mono[OF finite_fv] by simp
   thus ?thesis by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)
 qed
 
 private lemma LI_equality_measure_lt:
   assumes "Some \<delta> = mgu t t'"
   shows "(((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta>\<^sub>1), (S@Equality a t t'#S',\<theta>\<^sub>2)) \<in> measure\<^sub>s\<^sub>t"
 proof (cases "\<delta> = Var")
   assume "\<delta> = Var"
   hence "(S@S') \<cdot>\<^sub>s\<^sub>t \<delta> = S@S'" by blast
   thus ?thesis
     using strand_fv_card_rm_eq_le[of S S' a t t']
     by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)
 next
   assume "\<delta> \<noteq> Var"
   then obtain v where "v \<in> fv t \<union> fv t'" "subst_elim \<delta> v"
     using mgu_eliminates[OF assms(1)[symmetric]] by metis
   hence v_in: "v \<in> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" using assms by auto
   
   have "range_vars \<delta> \<subseteq> fv t \<union> fv t' \<union> fv\<^sub>s\<^sub>t S"
     using assms mgu_vars_bounded[OF assms(1)[symmetric]] by auto
   hence img_bound: "range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" by auto
 
   have finite_fv: "finite (fv\<^sub>s\<^sub>t (S@Equality a t t'#S'))" by auto
 
   have "v \<notin> fv\<^sub>s\<^sub>t ((S@Equality a t t'#S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
     using strand_fv_subst_subset_if_subst_elim[OF \<open>subst_elim \<delta> v\<close>] v_in by metis
   hence v_not_in: "v \<notin> fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)" by auto
   
   have "fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')"
     using strand_subst_fv_bounded_if_img_bounded[OF img_bound] by simp
   hence "fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subset> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" using v_in v_not_in by blast
   hence "card (fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)) < card (fv\<^sub>s\<^sub>t (S@Equality a t t'#S'))"
     using psubset_card_mono[OF finite_fv] by simp
   thus ?thesis by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)
 qed
 
 private lemma LI_in_measure: "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto> (S\<^sub>2,\<theta>\<^sub>2) \<Longrightarrow> ((S\<^sub>2,\<theta>\<^sub>2),(S\<^sub>1,\<theta>\<^sub>1)) \<in> measure\<^sub>s\<^sub>t"
 proof (induction rule: LI_rel.induct)
   case (Compose S T f S' \<theta>) thus ?case using LI_compose_measure_lt[of S T S'] by metis
 next
   case (Unify S f U \<delta> T S' \<theta>)
   hence "fv (Fun f U) \<subseteq> fv\<^sub>s\<^sub>t S"
     using fv_snd_rcv_strand_subset(2)[of S] by force
   thus ?case using LI_unify_measure_lt[OF Unify.hyps(3), of S S'] by metis
 qed (metis LI_equality_measure_lt)
 
 private lemma LI_in_measure_trans: "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>+ (S\<^sub>2,\<theta>\<^sub>2) \<Longrightarrow> ((S\<^sub>2,\<theta>\<^sub>2),(S\<^sub>1,\<theta>\<^sub>1)) \<in> measure\<^sub>s\<^sub>t"
 by (induction rule: trancl.induct, metis surjective_pairing LI_in_measure)
    (metis (no_types, lifting) surjective_pairing LI_in_measure measure\<^sub>s\<^sub>t_trans trans_def)
 
 private lemma LI_converse_wellfounded_trans: "wf ((LI_rel\<^sup>+)\<inverse>)"
 proof -
   have "(LI_rel\<^sup>+)\<inverse> \<subseteq> measure\<^sub>s\<^sub>t" using LI_in_measure_trans by auto
   thus ?thesis using measure\<^sub>s\<^sub>t_wellfounded wf_subset by metis
 qed
 
 private lemma LI_acyclic_trans: "acyclic (LI_rel\<^sup>+)"
 using wf_acyclic[OF LI_converse_wellfounded_trans] acyclic_converse by metis
 
 private lemma LI_acyclic: "acyclic LI_rel"
 using LI_acyclic_trans acyclic_subset by (simp add: acyclic_def)
 
 lemma LI_no_infinite_chain: "\<not>(\<exists>f. \<forall>i. f i \<leadsto>\<^sup>+ f (Suc i))"
 proof -
   have "\<not>(\<exists>f. \<forall>i. (f (Suc i), f i) \<in> (LI_rel\<^sup>+)\<inverse>)"
     using wf_iff_no_infinite_down_chain LI_converse_wellfounded_trans by metis
   thus ?thesis by simp
 qed
 
 private lemma LI_unify_finite:
   assumes "finite M"
   shows "finite {((S@Send [Fun f T]#S',\<theta>), ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta> \<circ>\<^sub>s \<delta>)) | \<delta> T'. 
                    simple S \<and> Fun f T' \<in> M \<and> Some \<delta> = mgu (Fun f T) (Fun f T')}"
 using assms
 proof (induction M rule: finite_induct)
   case (insert m M) thus ?case
   proof (cases m)
     case (Fun g U)
     let ?a = "\<lambda>\<delta>. ((S@Send [Fun f T]#S',\<theta>), ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta> \<circ>\<^sub>s \<delta>))"
     let ?A = "\<lambda>B. {?a \<delta> | \<delta> T'. simple S \<and> Fun f T' \<in> B \<and> Some \<delta> = mgu (Fun f T) (Fun f T')}"
 
     have "?A (insert m M) = (?A M) \<union> (?A {m})" by auto
     moreover have "finite (?A {m})"
     proof (cases "\<exists>\<delta>. Some \<delta> = mgu (Fun f T) (Fun g U)")
       case True
       then obtain \<delta> where \<delta>: "Some \<delta> = mgu (Fun f T) (Fun g U)" by blast
       
       have A_m_eq: "\<And>\<delta>'. ?a \<delta>' \<in> ?A {m} \<Longrightarrow> ?a \<delta> = ?a \<delta>'"
       proof -
         fix \<delta>' assume "?a \<delta>' \<in> ?A {m}"
         hence "\<exists>\<sigma>. Some \<sigma> = mgu (Fun f T) (Fun g U) \<and> ?a \<sigma> = ?a \<delta>'"
           using \<open>m = Fun g U\<close> by auto
         thus "?a \<delta> = ?a \<delta>'" by (metis \<delta> option.inject)
       qed
 
       have "?A {m} = {} \<or> ?A {m} = {?a \<delta>}"
       proof (cases "simple S \<and> ?A {m} \<noteq> {}")
         case True
         hence "simple S" "?A {m} \<noteq> {}" by meson+
         hence "?A {m} = {?a \<delta> | \<delta>. Some \<delta> = mgu (Fun f T) (Fun g U)}" using \<open>m = Fun g U\<close> by auto
         hence "?a \<delta> \<in> ?A {m}" using \<delta> by auto
        show ?thesis
         proof (rule ccontr)
           assume "\<not>(?A {m} = {} \<or> ?A {m} = {?a \<delta>})"
           then obtain B where B: "?A {m} = insert (?a \<delta>) B" "?a \<delta> \<notin> B" "B \<noteq> {}"
             using \<open>?A {m} \<noteq> {}\<close> \<open>?a \<delta> \<in> ?A {m}\<close> by (metis (no_types, lifting) Set.set_insert)
           then obtain b where b: "?a \<delta> \<noteq> b" "b \<in> B" by (metis (no_types, lifting) ex_in_conv)
           then obtain \<delta>' where \<delta>': "b = ?a \<delta>'" using B(1) by blast
           moreover have "?a \<delta>' \<in> ?A {m}" using B(1) b(2) \<delta>' by auto
           hence "?a \<delta> = ?a \<delta>'" by (blast dest!: A_m_eq)
           ultimately show False using b(1) by simp
         qed
       qed auto
       thus ?thesis by (metis (no_types, lifting) finite.emptyI finite_insert) 
     next
       case False
       hence "?A {m} = {}" using \<open>m = Fun g U\<close> by blast
       thus ?thesis by (metis finite.emptyI)
     qed
     ultimately show ?thesis using insert.IH by auto
   qed simp
 qed fastforce
 end
 
 
 subsection \<open>Lemma: The Lazy Intruder Preserves Well-formedness\<close>
 context
 begin
 private lemma LI_preserves_subst_wf_single:
   assumes "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto> (S\<^sub>2,\<theta>\<^sub>2)" "fv\<^sub>s\<^sub>t S\<^sub>1 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>1 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<^sub>1"
   and "subst_domain \<theta>\<^sub>1 \<inter> vars\<^sub>s\<^sub>t S\<^sub>1 = {}" "range_vars \<theta>\<^sub>1 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>1 = {}"
   shows "fv\<^sub>s\<^sub>t S\<^sub>2 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>2 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<^sub>2"
   and "subst_domain \<theta>\<^sub>2 \<inter> vars\<^sub>s\<^sub>t S\<^sub>2 = {}" "range_vars \<theta>\<^sub>2 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>2 = {}"
 using assms
 proof (induction rule: LI_rel.induct)
   case (Compose S X f S' \<theta>)
   { case 1 thus ?case using vars_st_snd_map by auto }
   { case 2 thus ?case using vars_st_snd_map by auto }
   { case 3 thus ?case using vars_st_snd_map by force }
   { case 4 thus ?case using vars_st_snd_map by auto }
 next
   case (Unify S f U \<delta> T S' \<theta>)
   hence "fv (Fun f U) \<subseteq> fv\<^sub>s\<^sub>t S" using fv_subset_if_in_strand_ik' by blast
   hence *: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
     using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]]
     unfolding range_vars_alt_def by (fastforce simp del: subst_range.simps)
 
   have "fv\<^sub>s\<^sub>t (S@S') \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')" "vars\<^sub>s\<^sub>t (S@S') \<subseteq> vars\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
     by auto
   hence **: "fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
             "vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> vars\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
     using subst_sends_strand_fv_to_img[of "S@S'" \<delta>]
           strand_subst_vars_union_bound[of "S@S'" \<delta>] *
     by blast+
 
   have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" by (fact mgu_gives_wellformed_subst[OF Unify.hyps(3)[symmetric]])
   
   { case 1
     have "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
       using bvars_subst_ident[of "S@S'" \<delta>] by auto
     thus ?case using 1 ** by blast
   }
   { case 2
     hence "subst_domain \<theta> \<inter> subst_domain \<delta> = {}" "subst_domain \<theta> \<inter> range_vars \<delta> = {}"
       using * by blast+
     thus ?case by (metis wf_subst_compose[OF \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>\<close>])
   }
   { case 3
     hence "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using ** by blast
     moreover have "v \<in> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')" when "v \<in> subst_domain \<delta>" for v
       using * that by blast
     hence "subst_domain \<delta> \<inter> fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}"
       using mgu_eliminates_dom[OF Unify.hyps(3)[symmetric],
                 THEN strand_fv_subst_subset_if_subst_elim, of _ "S@Send [Fun f T]#S'"]
       unfolding subst_elim_def by auto
     moreover have "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
       using bvars_subst_ident[of "S@S'" \<delta>] by auto
     hence "subst_domain \<delta> \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using 3(1) * by blast
     ultimately show ?case
       using ** * subst_domain_compose[of \<theta> \<delta>] vars\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>t[of "S@S' \<cdot>\<^sub>s\<^sub>t \<delta>"]
       by blast
   }
   { case 4
     have ***: "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
       using bvars_subst_ident[of "S@S'" \<delta>] by auto
     hence "range_vars \<delta> \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using 4(1) * by blast
     thus ?case using subst_img_comp_subset[of \<theta> \<delta>] 4(4) *** by blast
   }
 next
   case (Equality S \<delta> t t' a S' \<theta>)
   hence *: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')"
     using mgu_vars_bounded[OF Equality.hyps(2)[symmetric]]
     unfolding range_vars_alt_def by fastforce
 
   have "fv\<^sub>s\<^sub>t (S@S') \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" "vars\<^sub>s\<^sub>t (S@S') \<subseteq> vars\<^sub>s\<^sub>t (S@Equality a t t'#S')"
     by auto
   hence **: "fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')"
             "vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> vars\<^sub>s\<^sub>t (S@Equality a t t'#S')"
     using subst_sends_strand_fv_to_img[of "S@S'" \<delta>]
           strand_subst_vars_union_bound[of "S@S'" \<delta>] *
     by blast+
 
   have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" by (fact mgu_gives_wellformed_subst[OF Equality.hyps(2)[symmetric]])
   
   { case 1
     have "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Equality a t t'#S')"
       using bvars_subst_ident[of "S@S'" \<delta>] by auto
     thus ?case using 1 ** by blast
   }
   { case 2
     hence "subst_domain \<theta> \<inter> subst_domain \<delta> = {}" "subst_domain \<theta> \<inter> range_vars \<delta> = {}"
       using * by blast+
     thus ?case by (metis wf_subst_compose[OF \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>\<close>])
   }
   { case 3
     hence "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using ** by blast
     moreover have "v \<in> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" when "v \<in> subst_domain \<delta>" for v
       using * that by blast
     hence "subst_domain \<delta> \<inter> fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}"
       using mgu_eliminates_dom[OF Equality.hyps(2)[symmetric],
                 THEN strand_fv_subst_subset_if_subst_elim, of _ "S@Equality a t t'#S'"]
       unfolding subst_elim_def by auto
     moreover have "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Equality a t t'#S')"
       using bvars_subst_ident[of "S@S'" \<delta>] by auto
     hence "subst_domain \<delta> \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using 3(1) * by blast
     ultimately show ?case
       using ** * subst_domain_compose[of \<theta> \<delta>] vars\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>t[of "S@S' \<cdot>\<^sub>s\<^sub>t \<delta>"]
       by blast
   }
   { case 4
     have ***: "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Equality a t t'#S')"
       using bvars_subst_ident[of "S@S'" \<delta>] by auto
     hence "range_vars \<delta> \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using 4(1) * by blast
     thus ?case using subst_img_comp_subset[of \<theta> \<delta>] 4(4) *** by blast
   }
 qed
 
 private lemma LI_preserves_subst_wf:
   assumes "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2)" "fv\<^sub>s\<^sub>t S\<^sub>1 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>1 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<^sub>1"
   and "subst_domain \<theta>\<^sub>1 \<inter> vars\<^sub>s\<^sub>t S\<^sub>1 = {}" "range_vars \<theta>\<^sub>1 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>1 = {}"
   shows "fv\<^sub>s\<^sub>t S\<^sub>2 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>2 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<^sub>2"
   and "subst_domain \<theta>\<^sub>2 \<inter> vars\<^sub>s\<^sub>t S\<^sub>2 = {}" "range_vars \<theta>\<^sub>2 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>2 = {}"
 using assms
 proof (induction S\<^sub>2 \<theta>\<^sub>2 rule: rtrancl_induct2)
   case (step S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j)
   { case 1 thus ?case using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] step.IH by metis }
   { case 2 thus ?case using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] step.IH by metis }
   { case 3 thus ?case using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] step.IH by metis }
   { case 4 thus ?case using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] step.IH by metis }
 qed metis
 
 lemma LI_preserves_wellformedness:
   assumes "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2)" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1"
   shows "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>2 \<theta>\<^sub>2"
 proof -
   have *: "wf\<^sub>s\<^sub>t {} S\<^sub>j"
     when "(S\<^sub>i, \<theta>\<^sub>i) \<leadsto> (S\<^sub>j, \<theta>\<^sub>j)" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>i \<theta>\<^sub>i" for S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j
     using that
   proof (induction rule: LI_rel.induct)
     case (Compose S T f S' \<theta>) thus ?case by (metis wf_send_compose wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
   next
     case (Unify S f U \<delta> T S' \<theta>)
     have "fv (Fun f T) \<union> fv (Fun f U) \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')" using Unify.hyps(2) by force
     hence "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
       using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] by (metis subset_trans)
     hence "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t (S@Send [Fun f T]#S') = {}"
       using Unify.prems unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by blast
     thus ?case
       using wf_unify[OF _ Unify.hyps(2) MGU_is_Unifier[OF mgu_gives_MGU], of "{}",
                      OF _ Unify.hyps(3)[symmetric], of S'] Unify.prems(1)
       by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
   next
     case (Equality S \<delta> t t' a S' \<theta>)
     have "fv t \<union> fv t' \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" using Equality.hyps(2) by force
     hence "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')"
       using mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] by (metis subset_trans)
     hence "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t (S@Equality a t t'#S') = {}"
       using Equality.prems unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by blast
     thus ?case
       using wf_equality[OF _ Equality.hyps(2)[symmetric], of "{}" S a S'] Equality.prems(1)
       by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
   qed
 
   show ?thesis using assms
   proof (induction rule: rtrancl_induct2)
     case (step S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j) thus ?case
       using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] *[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>]
       by (metis wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
   qed simp
 qed
 
 lemma LI_preserves_trm_wf:
   assumes "(S,\<theta>) \<leadsto>\<^sup>* (S',\<theta>')" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')"
 proof -
   { fix S \<theta> S' \<theta>'
     assume "(S,\<theta>) \<leadsto> (S',\<theta>')" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
     hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')"
     proof (induction rule: LI_rel.induct)
       case (Compose S T f S' \<theta>)
       hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)"
         and *: "t \<in> set S \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p t)" "t \<in> set S' \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p t)" for t
         by auto
       hence "wf\<^sub>t\<^sub>r\<^sub>m t" when "t \<in> set T" for t using that unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
       hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p t)" when "t \<in> set (map Send1 T)" for t
         using that unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
       thus ?case using * by force
     next
       case (Unify S f U \<delta> T S' \<theta>)
       have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f U)"
         using Unify.prems(1) Unify.hyps(2) wf_trm_subterm[of _ "Fun f U"]
         by (simp, force)
       hence range_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
         using mgu_wf_trm[OF Unify.hyps(3)[symmetric]] by simp
 
       { fix s assume "s \<in> set (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)"
         hence "\<exists>s' \<in> set (S@S'). s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')"
           using Unify.prems(1) by (auto simp add: subst_apply_strand_def)
         moreover {
           fix s' assume s': "s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')" "s' \<in> set (S@S')"
           from s'(2) have "trms\<^sub>s\<^sub>t\<^sub>p (s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = trms\<^sub>s\<^sub>t\<^sub>p s' \<cdot>\<^sub>s\<^sub>e\<^sub>t (rm_vars (set (bvars\<^sub>s\<^sub>t\<^sub>p s')) \<delta>)"
           proof (induction s')
             case (Inequality X F) thus ?case by (induct F) (auto simp add: subst_apply_pairs_def)
           qed auto
           hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)"
             using wf_trm_subst[OF wf_trms_subst_rm_vars'[OF range_wf]] \<open>wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')\<close> s'(1)
             by simp
         }
         ultimately have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)" by auto
       }
       thus ?case by auto
     next
       case (Equality S \<delta> t t' a S' \<theta>)
       hence "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" by simp_all
       hence range_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
         using mgu_wf_trm[OF Equality.hyps(2)[symmetric]] by simp
 
       { fix s assume "s \<in> set (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)"
         hence "\<exists>s' \<in> set (S@S'). s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')"
           using Equality.prems(1) by (auto simp add: subst_apply_strand_def)
         moreover {
           fix s' assume s': "s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')" "s' \<in> set (S@S')"
           from s'(2) have "trms\<^sub>s\<^sub>t\<^sub>p (s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = trms\<^sub>s\<^sub>t\<^sub>p s' \<cdot>\<^sub>s\<^sub>e\<^sub>t (rm_vars (set (bvars\<^sub>s\<^sub>t\<^sub>p s')) \<delta>)"
           proof (induction s')
             case (Inequality X F) thus ?case by (induct F) (auto simp add: subst_apply_pairs_def)
           qed auto
           hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)"
             using wf_trm_subst[OF wf_trms_subst_rm_vars'[OF range_wf]] \<open>wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')\<close> s'(1)
             by simp
         }
         ultimately have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)" by auto
       }
       thus ?case by auto
     qed
   }
   with assms show ?thesis by (induction rule: rtrancl_induct2) metis+
 qed
 
 lemma LI_preproc_prop_subst:
   "LI_preproc_prop S \<longleftrightarrow> LI_preproc_prop (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
 proof (induction S)
   case (Cons x S) thus ?case unfolding LI_preproc_prop_def by (cases x) auto
 qed (simp add: LI_preproc_prop_def)
 
 lemma LI_preserves_LI_preproc_prop:
   assumes "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2)" "LI_preproc_prop S\<^sub>1"
   shows "LI_preproc_prop S\<^sub>2"
 using assms
 proof (induction rule: rtrancl_induct2)
   case (step S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j)
   hence "LI_preproc_prop S\<^sub>i" by metis
   with step.hyps(2) show ?case 
   proof (induction rule: LI_rel.induct)
     case (Unify S f T' \<delta> T S' \<theta>) thus ?case
       using LI_preproc_prop_subst LI_preproc_prop_split
       by (metis append.left_neutral append_Cons)
   next
     case (Equality S \<delta> t t' uu S' \<theta>) thus ?case
       using LI_preproc_prop_subst LI_preproc_prop_split
       by (metis append.left_neutral append_Cons)
   qed (auto simp add: LI_preproc_prop_def)
 qed simp
 
 end
 
 subsection \<open>Theorem: Soundness of the Lazy Intruder\<close>
 context
 begin
 private lemma LI_soundness_single:
   assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1" "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto> (S\<^sub>2,\<theta>\<^sub>2)" "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2,\<theta>\<^sub>2\<rangle>"
   shows "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1,\<theta>\<^sub>1\<rangle>"
 using assms(2,1,3)
 proof (induction rule: LI_rel.induct)
   case (Compose S T f S' \<theta>)
   have "ik\<^sub>s\<^sub>t (map Send1 T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = {}" by fastforce
   hence *: "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; map Send1 T\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>"
     using Compose unfolding constr_sem_c_def
     by (force, force, fastforce)
 
   have "ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c Fun f T \<cdot> \<I>"
     using *(2) Compose.hyps(2) ComposeC[OF _ Compose.hyps(3), of "map (\<lambda>x. x \<cdot> \<I>) T"]
     unfolding subst_compose_def by force
   thus "\<I> \<Turnstile>\<^sub>c \<langle>S@Send [Fun f T]#S',\<theta>\<rangle>"
     using *(1,3) \<open>\<I> \<Turnstile>\<^sub>c \<langle>S@map Send1 T@S',\<theta>\<rangle>\<close>
     by (auto simp add: constr_sem_c_def)
 next
   case (Unify S f U \<delta> T S' \<theta>)
   have "(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>" "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>"
     using Unify.prems(2) unfolding constr_sem_c_def by metis+
   then obtain \<sigma> where \<sigma>: "\<theta> \<circ>\<^sub>s \<delta> \<circ>\<^sub>s \<sigma> = \<I>" unfolding subst_compose_def by auto
 
   have \<theta>fun_id: "Fun f U \<cdot> \<theta> = Fun f U" "Fun f T \<cdot> \<theta> = Fun f T"
-    using Unify.prems(1) trm_subst_ident[of "Fun f U" \<theta>]
+    using Unify.prems(1) subst_apply_term_ident[of "Fun f U" \<theta>]
           fv_subset_if_in_strand_ik[of "Fun f U" S] Unify.hyps(2)
           fv_snd_rcv_strand_subset(2)[of S]
           strand_vars_split(1)[of S "Send [Fun f T]#S'"]
     unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def apply blast
-    using Unify.prems(1) trm_subst_ident[of "Fun f T" \<theta>]
+    using Unify.prems(1) subst_apply_term_ident[of "Fun f T" \<theta>]
     unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by fastforce
   hence \<theta>\<delta>_disj:
       "subst_domain \<theta> \<inter> subst_domain \<delta> = {}"
       "subst_domain \<theta> \<inter> range_vars \<delta> = {}"
       "subst_domain \<theta> \<inter> range_vars \<theta> = {}" 
     using trm_subst_disj mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] apply (blast,blast)
     using Unify.prems(1) 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 blast
   hence \<theta>\<delta>_support: "\<theta> supports \<I>" "\<delta> supports \<I>"
     by (simp_all add: subst_support_comp_split[OF \<open>(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>\<close>])
 
   have "fv (Fun f T) \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')" "fv (Fun f U) \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
     using Unify.hyps(2) by force+
   hence \<delta>_vars_bound: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
     using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] by blast
 
   have "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; [Send [Fun f T]]\<rbrakk>\<^sub>c \<I>"
   proof -
     from Unify.hyps(2) have "Fun f U \<cdot> \<I> \<in> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by blast
     hence "Fun f U \<cdot> \<I> \<in> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by blast
     moreover have "Unifier \<delta> (Fun f T) (Fun f U)"
       by (fact MGU_is_Unifier[OF mgu_gives_MGU[OF Unify.hyps(3)[symmetric]]])
     ultimately have "Fun f T \<cdot> \<I> \<in> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
       using \<sigma> by (metis \<theta>fun_id subst_subst_compose) 
     thus ?thesis by simp
   qed
 
   have "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>"
   proof -
     have "(S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta> = S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "(S@S') \<cdot>\<^sub>s\<^sub>t \<theta> = S@S'"
     proof -
       have "subst_domain \<theta> \<inter> vars\<^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)
       hence "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}"
         using \<theta>\<delta>_disj(2) strand_subst_vars_union_bound[of "S@S'" \<delta>] by blast
       thus "(S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta> = S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "(S@S') \<cdot>\<^sub>s\<^sub>t \<theta> = S@S'"
         using strand_subst_comp \<open>subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S') = {}\<close> by (blast,blast)
     qed
     moreover have "subst_idem \<delta>" by (fact mgu_gives_subst_idem[OF Unify.hyps(3)[symmetric]])
     moreover have
         "(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t (S@S') = {}"
         "(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}"
         "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t (S@S') = {}"
       using wf_constr_bvars_disj[OF Unify.prems(1)]
             wf_constr_bvars_disj'[OF Unify.prems(1) \<delta>_vars_bound]
       by auto
     ultimately have "\<lbrakk>{}; S@S'\<rbrakk>\<^sub>c \<I>"
       using \<open>\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>\<close> \<sigma>
             strand_sem_subst(1)[of \<theta> "S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "{}" "\<delta> \<circ>\<^sub>s \<sigma>"]
             strand_sem_subst(2)[of \<theta> "S@S'" "{}" "\<delta> \<circ>\<^sub>s \<sigma>"] 
             strand_sem_subst_subst_idem[of \<delta> "S@S'" "{}" \<sigma>]
       unfolding constr_sem_c_def
       by (metis subst_compose_assoc)
     thus "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>" by auto
   qed
   
   show "\<I> \<Turnstile>\<^sub>c \<langle>S@Send [Fun f T]#S',\<theta>\<rangle>"
     using \<theta>\<delta>_support(1) \<open>\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; [Send [Fun f T]]\<rbrakk>\<^sub>c \<I>\<close> \<open>\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>\<close> \<open>\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>\<close>
     by (auto simp add: constr_sem_c_def)
 next
   case (Equality S \<delta> t t' a S' \<theta>)
   have "(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>" "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>"
     using Equality.prems(2) unfolding constr_sem_c_def by metis+
   then obtain \<sigma> where \<sigma>: "\<theta> \<circ>\<^sub>s \<delta> \<circ>\<^sub>s \<sigma> = \<I>" unfolding subst_compose_def by auto
 
   have "fv t \<subseteq> vars\<^sub>s\<^sub>t (S@Equality a t t'#S')" "fv t' \<subseteq> vars\<^sub>s\<^sub>t (S@Equality a t t'#S')"
     by auto
   moreover have "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@Equality a t t'#S') = {}"
     using Equality.prems(1) unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by auto
-  ultimately have \<theta>fun_id: "t \<cdot> \<theta> = t" "t' \<cdot> \<theta> = t'"
-    using trm_subst_ident[of t \<theta>] trm_subst_ident[of t' \<theta>]
-    by auto
+  ultimately have \<theta>fun_id: "t \<cdot> \<theta> = t" "t' \<cdot> \<theta> = t'" by auto
   hence \<theta>\<delta>_disj:
       "subst_domain \<theta> \<inter> subst_domain \<delta> = {}"
       "subst_domain \<theta> \<inter> range_vars \<delta> = {}"
       "subst_domain \<theta> \<inter> range_vars \<theta> = {}" 
     using trm_subst_disj mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] apply (blast,blast)
     using Equality.prems(1) 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 blast
   hence \<theta>\<delta>_support: "\<theta> supports \<I>" "\<delta> supports \<I>"
     by (simp_all add: subst_support_comp_split[OF \<open>(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>\<close>])
 
   have "fv t \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" "fv t' \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" by auto
   hence \<delta>_vars_bound: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')"
     using mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] by blast
 
   have "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; [Equality a t t']\<rbrakk>\<^sub>c \<I>"
   proof -
     have "t \<cdot> \<delta> = t' \<cdot> \<delta>"
       using MGU_is_Unifier[OF mgu_gives_MGU[OF Equality.hyps(2)[symmetric]]]
       by metis
     hence "t \<cdot> (\<theta> \<circ>\<^sub>s \<delta>) = t' \<cdot> (\<theta> \<circ>\<^sub>s \<delta>)" by (metis \<theta>fun_id subst_subst_compose)
     hence "t \<cdot> \<I> = t' \<cdot> \<I>" by (metis \<sigma> subst_subst_compose) 
     thus ?thesis by simp
   qed
 
   have "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>"
   proof -
     have "(S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta> = S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "(S@S') \<cdot>\<^sub>s\<^sub>t \<theta> = S@S'"
     proof -
       have "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S') = {}"
         using Equality.prems(1)
         by (fastforce simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def simp del: subst_range.simps)
       hence "subst_domain \<theta> \<inter> fv\<^sub>s\<^sub>t (S@S') = {}" by blast
       hence "subst_domain \<theta> \<inter> fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}"
         using \<theta>\<delta>_disj(2) subst_sends_strand_fv_to_img[of "S@S'" \<delta>] by blast
       thus "(S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta> = S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "(S@S') \<cdot>\<^sub>s\<^sub>t \<theta> = S@S'"
         using strand_subst_comp \<open>subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S') = {}\<close> by (blast,blast)
     qed
     moreover have
         "(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t (S@S') = {}"
         "(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}"
         "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t (S@S') = {}"
       using wf_constr_bvars_disj[OF Equality.prems(1)]
             wf_constr_bvars_disj'[OF Equality.prems(1) \<delta>_vars_bound]
       by auto
     ultimately have "\<lbrakk>{}; S@S'\<rbrakk>\<^sub>c \<I>"
       using \<open>\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>\<close> \<sigma>
             strand_sem_subst(1)[of \<theta> "S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "{}" "\<delta> \<circ>\<^sub>s \<sigma>"]
             strand_sem_subst(2)[of \<theta> "S@S'" "{}" "\<delta> \<circ>\<^sub>s \<sigma>"] 
             strand_sem_subst_subst_idem[of \<delta> "S@S'" "{}" \<sigma>]
             mgu_gives_subst_idem[OF Equality.hyps(2)[symmetric]]
       unfolding constr_sem_c_def
       by (metis subst_compose_assoc)
     thus "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>" by auto
   qed
   
   show "\<I> \<Turnstile>\<^sub>c \<langle>S@Equality a t t'#S',\<theta>\<rangle>"
     using \<theta>\<delta>_support(1) \<open>\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; [Equality a t t']\<rbrakk>\<^sub>c \<I>\<close> \<open>\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>\<close> \<open>\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>\<close>
     by (auto simp add: constr_sem_c_def)
 qed
 
 theorem LI_soundness:
   assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1" "(LI_preproc S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2)" "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2, \<theta>\<^sub>2\<rangle>"
   shows "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>"
 using assms(2,1,3)
 proof (induction S\<^sub>2 \<theta>\<^sub>2 rule: rtrancl_induct2)
   case (step S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j) thus ?case
     using LI_preproc_preserves_wellformedness[OF \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1\<close>]
           LI_preserves_wellformedness[OF \<open>(LI_preproc S\<^sub>1, \<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>i, \<theta>\<^sub>i)\<close>]
           LI_soundness_single[OF _ \<open>(S\<^sub>i, \<theta>\<^sub>i) \<leadsto> (S\<^sub>j, \<theta>\<^sub>j)\<close> \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>j, \<theta>\<^sub>j\<rangle>\<close>]
     by metis
 qed (metis LI_preproc_sem_eq')
 end
 
 subsection \<open>Theorem: Completeness of the Lazy Intruder\<close>
 context
 begin
 private lemma LI_completeness_single:
   assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1" "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>" "\<not>simple S\<^sub>1" "LI_preproc_prop S\<^sub>1"
   shows "\<exists>S\<^sub>2 \<theta>\<^sub>2. (S\<^sub>1,\<theta>\<^sub>1) \<leadsto> (S\<^sub>2,\<theta>\<^sub>2) \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2, \<theta>\<^sub>2\<rangle>)"
 using not_simple_elim[OF \<open>\<not>simple S\<^sub>1\<close>]
 proof -
   { \<comment> \<open>In this case \<open>S\<^sub>1\<close> isn't simple because it contains an equality constraint,
         so we can simply proceed with the reduction by computing the MGU for the equation\<close>
     assume "\<exists>S' S'' a t t'. S\<^sub>1 = S'@Equality a t t'#S'' \<and> simple S'"
     then obtain S a t t' S' where S\<^sub>1: "S\<^sub>1 = S@Equality a t t'#S'" "simple S" by moura
     hence *: "wf\<^sub>s\<^sub>t {} S" "\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<^sub>1\<rangle>" "\<theta>\<^sub>1 supports \<I>" "t \<cdot> \<I> = t' \<cdot> \<I>"
       using \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1\<close> wf_eq_fv[of "{}" S t t' S']
             fv_snd_rcv_strand_subset(5)[of S]
       by (auto simp add: constr_sem_c_def wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
 
     from * have "Unifier \<I> t t'" by simp
     then obtain \<delta> where \<delta>:
         "Some \<delta> = mgu t t'" "subst_idem \<delta>" "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv t \<union> fv t'"
       using mgu_always_unifies mgu_gives_subst_idem mgu_vars_bounded by metis+
     
     have "\<delta> \<preceq>\<^sub>\<circ> \<I>"
       using mgu_gives_MGU[OF \<delta>(1)[symmetric]]
       by (metis \<open>Unifier \<I> t t'\<close>)
     hence "\<delta> supports \<I>" using subst_support_if_mgt_subst_idem[OF _ \<delta>(2)] by metis
     hence "(\<theta>\<^sub>1 \<circ>\<^sub>s \<delta>) supports \<I>" using subst_support_comp \<open>\<theta>\<^sub>1 supports \<I>\<close> by metis
     
     have "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>"
     proof -
       have "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t S\<^sub>1" using \<delta>(3) S\<^sub>1(1) by auto
       hence "\<lbrakk>{}; S\<^sub>1 \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>"
         using \<open>subst_idem \<delta>\<close> \<open>\<delta> \<preceq>\<^sub>\<circ> \<I>\<close> \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> strand_sem_subst
               wf_constr_bvars_disj'(1)[OF assms(1)]
         unfolding subst_idem_def constr_sem_c_def
         by (metis (no_types) subst_compose_assoc)
       thus "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>" using S\<^sub>1(1) by force
     qed
     moreover have "(S@Equality a t t'#S', \<theta>\<^sub>1) \<leadsto> (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>, \<theta>\<^sub>1 \<circ>\<^sub>s \<delta>)"
       using LI_rel.Equality[OF \<open>simple S\<close> \<delta>(1)] S\<^sub>1 by metis
     ultimately have ?thesis
       using S\<^sub>1(1) \<open>(\<theta>\<^sub>1 \<circ>\<^sub>s \<delta>) supports \<I>\<close>
       by (auto simp add: constr_sem_c_def)
   } moreover {
     \<comment> \<open>In this case \<open>S\<^sub>1\<close> isn't simple because it contains a deduction constraint for a composed
         term, so we must look at how this composed term is derived under the interpretation \<open>\<I>\<close>\<close>
     assume "\<exists>S' S'' ts. S\<^sub>1 = S'@Send ts#S'' \<and> (\<nexists>x. ts = [Var x]) \<and> simple S'"
     hence "\<exists>S' S'' f T. S\<^sub>1 = S'@Send [Fun f T]#S'' \<and> simple S'"
       using LI_preproc_prop_SendE[OF \<open>LI_preproc_prop S\<^sub>1\<close>]
       by fastforce
     with assms obtain S f T S' where S\<^sub>1: "S\<^sub>1 = S@Send [Fun f T]#S'" "simple S" by moura
     hence "wf\<^sub>s\<^sub>t {} S" "\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<^sub>1\<rangle>" "\<theta>\<^sub>1 supports \<I>"
       using \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1\<close>
       by (auto simp add: constr_sem_c_def wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
   
     \<comment> \<open>Lemma for a common subcase\<close>
     have fun_sat: "\<I> \<Turnstile>\<^sub>c \<langle>S@(map Send1 T)@S', \<theta>\<^sub>1\<rangle>"
       when T: "\<And>t. t \<in> set T \<Longrightarrow> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
     proof -
       have "\<And>t. t \<in> set T \<Longrightarrow> \<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; [Send1 t]\<rbrakk>\<^sub>c \<I>" using T by simp
       hence "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; map Send1 T\<rbrakk>\<^sub>c \<I>"
         using \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> strand_sem_Send_map by blast 
       moreover have "ik\<^sub>s\<^sub>t (S@[Send1 (Fun f T)]) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = ik\<^sub>s\<^sub>t (S@(map Send1 T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by auto
       hence "\<lbrakk>ik\<^sub>s\<^sub>t (S@(map Send1 T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>"
         using \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> unfolding S\<^sub>1(1) constr_sem_c_def by force
       ultimately show ?thesis
         using \<open>\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<^sub>1\<rangle>\<close> strand_sem_append(1)[of "{}" S \<I> "map Send1 T"]
               strand_sem_append(1)[of "{}" "S@map Send1 T" \<I> S']
         unfolding constr_sem_c_def by simp
     qed
   
     from S\<^sub>1 \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> have "ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c Fun f T \<cdot> \<I>" by (auto simp add: constr_sem_c_def)
     hence ?thesis
     proof cases
       \<comment> \<open>Case 1: \<open>\<I>(f(T))\<close> has been derived using the \<open>AxiomC\<close> rule.\<close>
       case AxiomC
       hence ex_t: "\<exists>t. t \<in> ik\<^sub>s\<^sub>t S \<and> Fun f T \<cdot> \<I> = t \<cdot> \<I>" by auto
       show ?thesis
       proof (cases "\<forall>T'. Fun f T' \<in> ik\<^sub>s\<^sub>t S \<longrightarrow> Fun f T \<cdot> \<I> \<noteq> Fun f T' \<cdot> \<I>")
         \<comment> \<open>Case 1.1: \<open>f(T)\<close> is equal to a variable in the intruder knowledge under \<open>\<I>\<close>.
             Hence there must exists a deduction constraint in the simple prefix of the constraint
             in which this variable occurs/"is sent" for the first time. Since this variable itself
             cannot have been derived from the \<open>AxiomC\<close> rule (because it must be equal under the
             interpretation to \<open>f(T)\<close>, which is by assumption not in the intruder knowledge under
             \<open>\<I>\<close>) it must be the case that we can derive it using the \<open>ComposeC\<close> rule. Hence we can
             apply the \<open>Compose\<close> rule of the lazy intruder to \<open>f(T)\<close>.\<close>
         case True
         have "\<exists>v. Var v \<in> ik\<^sub>s\<^sub>t S \<and> Fun f T \<cdot> \<I> = \<I> v"
         proof -
           obtain t where "t \<in> ik\<^sub>s\<^sub>t S" "Fun f T \<cdot> \<I> = t \<cdot> \<I>" using ex_t by moura
           thus ?thesis
             using \<open>\<forall>T'. Fun f T' \<in> ik\<^sub>s\<^sub>t S \<longrightarrow> Fun f T \<cdot> \<I> \<noteq> Fun f T' \<cdot> \<I>\<close>
             by (cases t) auto
         qed
         hence "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>t S. Fun f T \<cdot> \<I> = \<I> v"
           using vars_subset_if_in_strand_ik2[of _ S] by fastforce
         then obtain v S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f
           where S: "S = S\<^sub>p\<^sub>r\<^sub>e@Send [Var v]#S\<^sub>s\<^sub>u\<^sub>f" "Fun f T \<cdot> \<I> = \<I> v"
                    "\<not>(\<exists>w \<in> wfrestrictedvars\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e. Fun f T \<cdot> \<I> = \<I> w)"
           using \<open>wf\<^sub>s\<^sub>t {} S\<close> wf_simple_strand_first_Send_var_split[OF _ \<open>simple S\<close>, of "Fun f T" \<I>]
           by auto
         hence "\<forall>w. Var w \<in> ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<longrightarrow> \<I> v \<noteq> Var w \<cdot> \<I>" by force
         moreover have "\<forall>T'. Fun f T' \<in> ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<longrightarrow> Fun f T \<cdot> \<I> \<noteq> Fun f T' \<cdot> \<I>"
           using \<open>\<forall>T'. Fun f T' \<in> ik\<^sub>s\<^sub>t S \<longrightarrow> Fun f T \<cdot> \<I> \<noteq> Fun f T' \<cdot> \<I>\<close> S(1)
           by (meson contra_subsetD ik_append_subset(1))
         hence "\<forall>g T'. Fun g T' \<in> ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<longrightarrow> \<I> v \<noteq> Fun g T' \<cdot> \<I>" using S(2) by simp
         ultimately have "\<forall>t \<in> ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e. \<I> v \<noteq> t \<cdot> \<I>" by (metis term.exhaust)
         hence "\<I> v \<notin> (ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by auto
   
         have "ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c \<I> v"
           using S\<^sub>1(1) S(1) \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close>
           by (auto simp add: constr_sem_c_def)
         hence "ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c Fun f T \<cdot> \<I>" using \<open>Fun f T \<cdot> \<I> = \<I> v\<close> by metis
         hence "length T = arity f" "public f" "\<And>t. t \<in> set T \<Longrightarrow> ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
           using \<open>Fun f T \<cdot> \<I> = \<I> v\<close> \<open>\<I> v \<notin> ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>\<close>
                 intruder_synth.simps[of "ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "\<I> v"]
           by auto
         hence *: "\<And>t. t \<in> set T \<Longrightarrow> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
           using S(1) by (auto intro: ideduct_synth_mono)
         hence "\<I> \<Turnstile>\<^sub>c \<langle>S@(map Send1 T)@S', \<theta>\<^sub>1\<rangle>" by (metis fun_sat)
         moreover have "(S@Send [Fun f T]#S', \<theta>\<^sub>1) \<leadsto> (S@map Send1 T@S', \<theta>\<^sub>1)"
           by (metis LI_rel.Compose[OF \<open>simple S\<close> \<open>length T = arity f\<close> \<open>public f\<close>])
         ultimately show ?thesis using S\<^sub>1 by auto
       next
         \<comment> \<open>Case 1.2: \<open>\<I>(f(T))\<close> can be derived from an interpreted composed term in the intruder
             knowledge. Use the \<open>Unify\<close> rule on this composed term to further reduce the constraint.\<close>
         case False
         then obtain T' where t: "Fun f T' \<in> ik\<^sub>s\<^sub>t S" "Fun f T \<cdot> \<I> = Fun f T' \<cdot> \<I>"
           by auto
         hence "fv (Fun f T') \<subseteq> fv\<^sub>s\<^sub>t S\<^sub>1"
           using S\<^sub>1(1) fv_subset_if_in_strand_ik'[OF t(1)]
                 fv_snd_rcv_strand_subset(2)[of S]
           by auto
         from t have "Unifier \<I> (Fun f T) (Fun f T')" by simp
         then obtain \<delta> where \<delta>:
             "Some \<delta> = mgu (Fun f T) (Fun f T')" "subst_idem \<delta>"
             "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv (Fun f T) \<union> fv (Fun f T')"
           using mgu_always_unifies mgu_gives_subst_idem mgu_vars_bounded by metis+
         
         have "\<delta> \<preceq>\<^sub>\<circ> \<I>"
           using mgu_gives_MGU[OF \<delta>(1)[symmetric]]
           by (metis \<open>Unifier \<I> (Fun f T) (Fun f T')\<close>)
         hence "\<delta> supports \<I>" using subst_support_if_mgt_subst_idem[OF _ \<delta>(2)] by metis
         hence "(\<theta>\<^sub>1 \<circ>\<^sub>s \<delta>) supports \<I>" using subst_support_comp \<open>\<theta>\<^sub>1 supports \<I>\<close> by metis
         
         have "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>"
         proof -
           have "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t S\<^sub>1"
             using \<delta>(3) S\<^sub>1(1) \<open>fv (Fun f T') \<subseteq> fv\<^sub>s\<^sub>t S\<^sub>1\<close>
             unfolding range_vars_alt_def by (fastforce simp del: subst_range.simps)
           hence "\<lbrakk>{}; S\<^sub>1 \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>"
             using \<open>subst_idem \<delta>\<close> \<open>\<delta> \<preceq>\<^sub>\<circ> \<I>\<close> \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> strand_sem_subst
                   wf_constr_bvars_disj'(1)[OF assms(1)]
             unfolding subst_idem_def constr_sem_c_def
             by (metis (no_types) subst_compose_assoc)
           thus "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>" using S\<^sub>1(1) by force
         qed
         moreover have "(S@Send [Fun f T]#S', \<theta>\<^sub>1) \<leadsto> (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>, \<theta>\<^sub>1 \<circ>\<^sub>s \<delta>)"
           using LI_rel.Unify[OF \<open>simple S\<close> t(1) \<delta>(1)] S\<^sub>1 by metis
         ultimately show ?thesis
           using S\<^sub>1(1) \<open>(\<theta>\<^sub>1 \<circ>\<^sub>s \<delta>) supports \<I>\<close>
           by (auto simp add: constr_sem_c_def)
       qed
     next
       \<comment> \<open>Case 2: \<open>\<I>(f(T))\<close> has been derived using the \<open>ComposeC\<close> rule.
           Simply use the \<open>Compose\<close> rule of the lazy intruder to proceed with the reduction.\<close>
       case (ComposeC T' g)
       hence "f = g" "length T = arity f" "public f"
         and "\<And>x. x \<in> set T \<Longrightarrow> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c x \<cdot> \<I>"
         by auto
       hence "\<I> \<Turnstile>\<^sub>c \<langle>S@(map Send1 T)@S', \<theta>\<^sub>1\<rangle>" using fun_sat by metis
       moreover have "(S\<^sub>1, \<theta>\<^sub>1) \<leadsto> (S@(map Send1 T)@S', \<theta>\<^sub>1)"
         using S\<^sub>1 LI_rel.Compose[OF \<open>simple S\<close> \<open>length T = arity f\<close> \<open>public f\<close>]
         by metis
       ultimately show ?thesis by metis
     qed
   } moreover have "\<And>A B X F. S\<^sub>1 = A@Inequality X F#B \<Longrightarrow> ineq_model \<I> X F"
     using assms(2) by (auto simp add: constr_sem_c_def)
   ultimately show ?thesis using not_simple_elim[OF \<open>\<not>simple S\<^sub>1\<close>] by metis
 qed
 
 theorem LI_completeness:
   assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1" "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>"
   shows "\<exists>S\<^sub>2 \<theta>\<^sub>2. (LI_preproc S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2) \<and> simple S\<^sub>2 \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2, \<theta>\<^sub>2\<rangle>)"
 proof (cases "simple (LI_preproc S\<^sub>1)")
   case False
   let ?Stuck = "\<lambda>S\<^sub>2 \<theta>\<^sub>2. \<not>(\<exists>S\<^sub>3 \<theta>\<^sub>3. (S\<^sub>2,\<theta>\<^sub>2) \<leadsto> (S\<^sub>3,\<theta>\<^sub>3) \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>3, \<theta>\<^sub>3\<rangle>))"
   let ?Sats = "{((S,\<theta>),(S',\<theta>')). (S,\<theta>) \<leadsto> (S',\<theta>') \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>) \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S', \<theta>'\<rangle>)}"
 
   have simple_if_stuck:
       "\<And>S\<^sub>2 \<theta>\<^sub>2. \<lbrakk>(LI_preproc S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>+ (S\<^sub>2,\<theta>\<^sub>2); \<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2, \<theta>\<^sub>2\<rangle>; ?Stuck S\<^sub>2 \<theta>\<^sub>2\<rbrakk> \<Longrightarrow> simple S\<^sub>2"
     using LI_preproc_preserves_wellformedness[OF \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1\<close>]
           LI_preserves_LI_preproc_prop[OF _ LI_preproc_preproc_prop]
           LI_completeness_single[OF LI_preserves_wellformedness]
           trancl_into_rtrancl
     by metis
 
   have base: "\<exists>b. ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),b) \<in> ?Sats"
     using LI_preproc_preserves_wellformedness[OF \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1\<close>]
           LI_completeness_single[OF _ _ False LI_preproc_preproc_prop]
           LI_preproc_sem_eq' \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close>
     by auto
 
   have *: "\<And>S \<theta> S' \<theta>'. ((S,\<theta>),(S',\<theta>')) \<in> ?Sats\<^sup>+ \<Longrightarrow> (S,\<theta>) \<leadsto>\<^sup>+ (S',\<theta>') \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S', \<theta>'\<rangle>)"
   proof -
     fix S \<theta> S' \<theta>'
     assume "((S,\<theta>),(S',\<theta>')) \<in> ?Sats\<^sup>+"
     thus "(S,\<theta>) \<leadsto>\<^sup>+ (S',\<theta>') \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S', \<theta>'\<rangle>)"
       by (induct rule: trancl_induct2) auto
   qed
 
   have "\<exists>S\<^sub>2 \<theta>\<^sub>2. ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S\<^sub>2,\<theta>\<^sub>2)) \<in> ?Sats\<^sup>+ \<and> ?Stuck S\<^sub>2 \<theta>\<^sub>2"
   proof (rule ccontr)
     assume "\<not>(\<exists>S\<^sub>2 \<theta>\<^sub>2. ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S\<^sub>2,\<theta>\<^sub>2)) \<in> ?Sats\<^sup>+ \<and> ?Stuck S\<^sub>2 \<theta>\<^sub>2)"
     hence sat_not_stuck: "\<And>S\<^sub>2 \<theta>\<^sub>2. ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S\<^sub>2,\<theta>\<^sub>2)) \<in> ?Sats\<^sup>+ \<Longrightarrow> \<not>?Stuck S\<^sub>2 \<theta>\<^sub>2" by blast
 
     have "\<forall>S \<theta>. ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S,\<theta>)) \<in> ?Sats\<^sup>+ \<longrightarrow> (\<exists>b. ((S,\<theta>),b) \<in> ?Sats)"
     proof (intro allI impI)
       fix S \<theta> assume a: "((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S,\<theta>)) \<in> ?Sats\<^sup>+"
       have "\<And>b. ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),b) \<in> ?Sats\<^sup>+ \<Longrightarrow> \<exists>c. b \<leadsto> c \<and> ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),c) \<in> ?Sats\<^sup>+"
       proof -
         fix b assume in_sat: "((LI_preproc S\<^sub>1,\<theta>\<^sub>1),b) \<in> ?Sats\<^sup>+"
         hence "\<exists>c. (b,c) \<in> ?Sats" using * sat_not_stuck by (cases b) blast
         thus "\<exists>c. b \<leadsto> c \<and> ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),c) \<in> ?Sats\<^sup>+"
           using trancl_into_trancl[OF in_sat] by blast
       qed
       hence "\<exists>S' \<theta>'. (S,\<theta>) \<leadsto> (S',\<theta>') \<and> ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S',\<theta>')) \<in> ?Sats\<^sup>+" using a by auto
       then obtain S' \<theta>' where S'\<theta>': "(S,\<theta>) \<leadsto> (S',\<theta>')" "((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S',\<theta>')) \<in> ?Sats\<^sup>+" by auto
       hence "\<I> \<Turnstile>\<^sub>c \<langle>S', \<theta>'\<rangle>" using * by blast
       moreover have "(LI_preproc S\<^sub>1, \<theta>\<^sub>1) \<leadsto>\<^sup>+ (S,\<theta>)" using a trancl_mono by blast
       ultimately have "((S,\<theta>),(S',\<theta>')) \<in> ?Sats" using S'\<theta>'(1) * a by blast
       thus "\<exists>b. ((S,\<theta>),b) \<in> ?Sats" using S'\<theta>'(2) by blast 
     qed
     hence "\<exists>f. \<forall>i::nat. (f i, f (Suc i)) \<in> ?Sats"
       using infinite_chain_intro'[OF base] by blast
     moreover have "?Sats \<subseteq> LI_rel\<^sup>+" by auto
     hence "\<not>(\<exists>f. \<forall>i::nat. (f i, f (Suc i)) \<in> ?Sats)"
       using LI_no_infinite_chain infinite_chain_mono by blast
     ultimately show False by auto
   qed
   hence "\<exists>S\<^sub>2 \<theta>\<^sub>2. (LI_preproc S\<^sub>1, \<theta>\<^sub>1) \<leadsto>\<^sup>+ (S\<^sub>2, \<theta>\<^sub>2) \<and> simple S\<^sub>2 \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2, \<theta>\<^sub>2\<rangle>)"
     using simple_if_stuck * by blast
   thus ?thesis by (meson trancl_into_rtrancl)
 qed (use LI_preproc_sem_eq' \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> in blast) 
 end
 
 
 subsection \<open>Corollary: Soundness and Completeness as a Single Theorem\<close>
 corollary LI_soundness_and_completeness:
   assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1"
   shows "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle> \<longleftrightarrow> (\<exists>S\<^sub>2 \<theta>\<^sub>2. (LI_preproc S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2) \<and> simple S\<^sub>2 \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2, \<theta>\<^sub>2\<rangle>))"
 by (metis LI_soundness[OF assms] LI_completeness[OF assms])
 
 end
 
 end
diff --git a/thys/Stateful_Protocol_Composition_and_Typing/More_Unification.thy b/thys/Stateful_Protocol_Composition_and_Typing/More_Unification.thy
--- a/thys/Stateful_Protocol_Composition_and_Typing/More_Unification.thy
+++ b/thys/Stateful_Protocol_Composition_and_Typing/More_Unification.thy
@@ -1,3480 +1,3460 @@
 (*
 Based on src/HOL/ex/Unification.thy packaged with Isabelle/HOL 2015 having the following license:
 
 ISABELLE COPYRIGHT NOTICE, LICENCE AND DISCLAIMER.
 
 Copyright (c) 1986-2015,
   University of Cambridge,
   Technische Universitaet Muenchen,
   and contributors.
 
   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 University of Cambridge or the Technische
 Universitaet Muenchen nor the names of their 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:      More_Unification.thy
     Author:     Andreas Viktor Hess, DTU
     SPDX-License-Identifier: BSD-3-Clause
 
     Originally based on src/HOL/ex/Unification.thy (Isabelle/HOL 2015) by:
     Author:     Martin Coen, Cambridge University Computer Laboratory
     Author:     Konrad Slind, TUM & Cambridge University Computer Laboratory
     Author:     Alexander Krauss, TUM
 *)
 
 section \<open>Definitions and Properties Related to Substitutions and Unification\<close>
 
 theory More_Unification
   imports Messages "First_Order_Terms.Unification"
 begin
 
 subsection \<open>Substitutions\<close>
 
 abbreviation subst_apply_list (infix "\<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t" 51) where
   "T \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta> \<equiv> map (\<lambda>t. t \<cdot> \<theta>) T"  
 
 abbreviation subst_apply_pair (infixl "\<cdot>\<^sub>p" 60) where
   "d \<cdot>\<^sub>p \<theta> \<equiv> (case d of (t,t') \<Rightarrow> (t \<cdot> \<theta>, t' \<cdot> \<theta>))"
 
 abbreviation subst_apply_pair_set (infixl "\<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t" 60) where
   "M \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta> \<equiv> (\<lambda>d. d \<cdot>\<^sub>p \<theta>) ` M"
 
 definition subst_apply_pairs (infix "\<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s" 51) where
   "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta> \<equiv> map (\<lambda>f. f \<cdot>\<^sub>p \<theta>) F"
 
 abbreviation subst_more_general_than (infixl "\<preceq>\<^sub>\<circ>" 50) where
   "\<sigma> \<preceq>\<^sub>\<circ> \<theta> \<equiv> \<exists>\<gamma>. \<theta> = \<sigma> \<circ>\<^sub>s \<gamma>"
 
 abbreviation subst_support (infix "supports" 50) where
   "\<theta> supports \<delta> \<equiv> (\<forall>x. \<theta> x \<cdot> \<delta> = \<delta> x)"
 
 abbreviation rm_var where
   "rm_var v s \<equiv> s(v := Var v)"
 
 abbreviation rm_vars where
   "rm_vars vs \<sigma> \<equiv> (\<lambda>v. if v \<in> vs then Var v else \<sigma> v)"
 
 definition subst_elim where
   "subst_elim \<sigma> v \<equiv> \<forall>t. v \<notin> fv (t \<cdot> \<sigma>)"
 
 definition subst_idem where
   "subst_idem s \<equiv> s \<circ>\<^sub>s s = s"
 
 lemma subst_support_def: "\<theta> supports \<tau> \<longleftrightarrow> \<tau> = \<theta> \<circ>\<^sub>s \<tau>"
 unfolding subst_compose_def by metis
 
 lemma subst_supportD: "\<theta> supports \<delta> \<Longrightarrow> \<theta> \<preceq>\<^sub>\<circ> \<delta>"
 using subst_support_def by auto
 
 lemma rm_vars_empty[simp]: "rm_vars {} s = s" "rm_vars (set []) s = s"
 by simp_all
 
 lemma rm_vars_singleton: "rm_vars {v} s = rm_var v s"
 by auto
 
 lemma subst_apply_terms_empty: "M \<cdot>\<^sub>s\<^sub>e\<^sub>t Var = M"
 by simp
 
 lemma subst_agreement: "(t \<cdot> r = t \<cdot> s) \<longleftrightarrow> (\<forall>v \<in> fv t. Var v \<cdot> r = Var v \<cdot> s)"
 by (induct t) auto
 
 lemma repl_invariance[dest?]: "v \<notin> fv t \<Longrightarrow> t \<cdot> s(v := u) = t \<cdot> s"
 by (simp add: subst_agreement)
 
 lemma subst_idx_map:
   assumes "\<forall>i \<in> set I. i < length T"
   shows "(map ((!) T) I) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta> = map ((!) (map (\<lambda>t. t \<cdot> \<delta>) T)) I"
 using assms by auto
 
 lemma subst_idx_map':
   assumes "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K). i < length T"
   shows "(K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta> = K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t ((!) (map (\<lambda>t. t \<cdot> \<delta>) T))" (is "?A = ?B")
 proof -
   have "T ! i \<cdot> \<delta> = (map (\<lambda>t. t \<cdot> \<delta>) T) ! i"
     when "i < length T" for i
     using that by auto
   hence "T ! i \<cdot> \<delta> = (map (\<lambda>t. t \<cdot> \<delta>) T) ! i"
     when "i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K)" for i
     using that assms by auto
   hence "k \<cdot> (!) T \<cdot> \<delta> = k \<cdot> (!) (map (\<lambda>t. t \<cdot> \<delta>) T)"
     when "fv k \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (set K)" for k
     using that by (induction k) force+
   thus ?thesis by auto
 qed
 
 lemma subst_remove_var: "v \<notin> fv s \<Longrightarrow> v \<notin> fv (t \<cdot> Var(v := s))"
 by (induct t) simp_all
 
 lemma subst_set_map: "x \<in> set X \<Longrightarrow> x \<cdot> s \<in> set (map (\<lambda>x. x \<cdot> s) X)"
 by simp
 
 lemma subst_set_idx_map:
   assumes "\<forall>i \<in> I. i < length T"
   shows "(!) T ` I \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> = (!) (map (\<lambda>t. t \<cdot> \<delta>) T) ` I" (is "?A = ?B")
 proof
   have *: "T ! i \<cdot> \<delta> = (map (\<lambda>t. t \<cdot> \<delta>) T) ! i"
     when "i < length T" for i
     using that by auto
   
   show "?A \<subseteq> ?B" using * assms by blast
   show "?B \<subseteq> ?A" using * assms by auto
 qed
 
 lemma subst_set_idx_map':
   assumes "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t K. i < length T"
   shows "K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> = K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) (map (\<lambda>t. t \<cdot> \<delta>) T)" (is "?A = ?B")
 proof
   have "T ! i \<cdot> \<delta> = (map (\<lambda>t. t \<cdot> \<delta>) T) ! i"
     when "i < length T" for i
     using that by auto
   hence "T ! i \<cdot> \<delta> = (map (\<lambda>t. t \<cdot> \<delta>) T) ! i"
     when "i \<in> fv\<^sub>s\<^sub>e\<^sub>t K" for i
     using that assms by auto
   hence *: "k \<cdot> (!) T \<cdot> \<delta> = k \<cdot> (!) (map (\<lambda>t. t \<cdot> \<delta>) T)"
     when "fv k \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t K" for k
     using that by (induction k) force+
 
   show "?A \<subseteq> ?B" using * by auto
   show "?B \<subseteq> ?A" using * by force
 qed
 
 lemma subst_term_list_obtain:
   assumes "\<forall>i < length T. \<exists>s. P (T ! i) s \<and> S ! i = s \<cdot> \<delta>"
     and "length T = length S"
   shows "\<exists>U. length T = length U \<and> (\<forall>i < length T. P (T ! i) (U ! i)) \<and> S = map (\<lambda>u. u \<cdot> \<delta>) U"
 using assms
 proof (induction T arbitrary: S)
   case (Cons t T S')
   then obtain s S where S': "S' = s#S" by (cases S') auto
 
   have "\<forall>i < length T. \<exists>s. P (T ! i) s \<and> S ! i = s \<cdot> \<delta>" "length T = length S"
     using Cons.prems S' by force+
   then obtain U where U:
       "length T = length U" "\<forall>i < length T. P (T ! i) (U ! i)" "S = map (\<lambda>u. u \<cdot> \<delta>) U"
     using Cons.IH by moura
 
   obtain u where u: "P t u" "s = u \<cdot> \<delta>"
     using Cons.prems(1) S' by auto
 
   have 1: "length (t#T) = length (u#U)"
     using Cons.prems(2) U(1) by fastforce
 
   have 2: "\<forall>i < length (t#T). P ((t#T) ! i) ((u#U) ! i)"
     using u(1) U(2) by (simp add: nth_Cons')
 
   have 3: "S' = map (\<lambda>u. u \<cdot> \<delta>) (u#U)"
     using U u S' by simp
 
   show ?case using 1 2 3 by blast
 qed simp
 
 lemma subst_mono: "t \<sqsubseteq> u \<Longrightarrow> t \<cdot> s \<sqsubseteq> u \<cdot> s"
 by (induct u) auto
 
 lemma subst_mono_fv: "x \<in> fv t \<Longrightarrow> s x \<sqsubseteq> t \<cdot> s"
 by (induct t) auto
 
 lemma subst_mono_neq:
   assumes "t \<sqsubset> u"
   shows "t \<cdot> s \<sqsubset> u \<cdot> s"
 proof (cases u)
   case (Var v)
   hence False using \<open>t \<sqsubset> u\<close> by simp
   thus ?thesis ..
 next
   case (Fun f X)
   then obtain x where "x \<in> set X" "t \<sqsubseteq> x" using \<open>t \<sqsubset> u\<close> by auto
   hence "t \<cdot> s \<sqsubseteq> x \<cdot> s" using subst_mono by metis
 
   obtain Y where "Fun f X \<cdot> s = Fun f Y" by auto
   hence "x \<cdot> s \<in> set Y" using \<open>x \<in> set X\<close> by auto
   hence "x \<cdot> s \<sqsubset> Fun f X \<cdot> s" using \<open>Fun f X \<cdot> s = Fun f Y\<close> Fun_param_is_subterm by simp
   hence "t \<cdot> s \<sqsubset> Fun f X \<cdot> s" using \<open>t \<cdot> s \<sqsubseteq> x \<cdot> s\<close> by (metis term.dual_order.trans term.order.eq_iff)
   thus ?thesis using \<open>u = Fun f X\<close> \<open>t \<sqsubset> u\<close> by metis
 qed
 
 lemma subst_no_occs[dest]: "\<not>Var v \<sqsubseteq> t \<Longrightarrow> t \<cdot> Var(v := s) = t"
 by (induct t) (simp_all add: map_idI)
 
 lemma var_comp[simp]: "\<sigma> \<circ>\<^sub>s Var = \<sigma>" "Var \<circ>\<^sub>s \<sigma> = \<sigma>"
 unfolding subst_compose_def by simp_all
 
 lemma subst_comp_all: "M \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<delta> \<circ>\<^sub>s \<theta>) = (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
-using subst_subst_compose[of _ \<delta> \<theta>] by auto
+unfolding subst_subst_compose by auto
 
 lemma subst_all_mono: "M \<subseteq> M' \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t s \<subseteq> M' \<cdot>\<^sub>s\<^sub>e\<^sub>t s"
 by auto
 
 lemma subst_comp_set_image: "(\<delta> \<circ>\<^sub>s \<theta>) ` X = \<delta> ` X \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using subst_compose by fastforce
 
 lemma subst_ground_ident[dest?]: "fv t = {} \<Longrightarrow> t \<cdot> s = t"
 by (induct t, simp, metis subst_agreement empty_iff subst_apply_term_empty)
 
 lemma subst_ground_ident_compose:
   "fv (\<sigma> x) = {} \<Longrightarrow> (\<sigma> \<circ>\<^sub>s \<theta>) x = \<sigma> x"
   "fv (t \<cdot> \<sigma>) = {} \<Longrightarrow> t \<cdot> (\<sigma> \<circ>\<^sub>s \<theta>) = t \<cdot> \<sigma>"
-using subst_subst_compose[of t \<sigma> \<theta>]
+unfolding subst_subst_compose
 by (simp_all add: subst_compose_def subst_ground_ident)
 
 lemma subst_all_ground_ident[dest?]: "ground M \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t s = M"
 proof -
   assume "ground M"
   hence "\<And>t. t \<in> M \<Longrightarrow> fv t = {}" by auto
   hence "\<And>t. t \<in> M \<Longrightarrow> t \<cdot> s = t" by (metis subst_ground_ident)
   moreover have "\<And>t. t \<in> M \<Longrightarrow> t \<cdot> s \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t s" by (metis imageI)
   ultimately show "M \<cdot>\<^sub>s\<^sub>e\<^sub>t s = M" by (simp add: image_cong)
 qed
 
-lemma subst_eqI[intro]: "(\<And>t. t \<cdot> \<sigma> = t \<cdot> \<theta>) \<Longrightarrow> \<sigma> = \<theta>"
-proof -
-  assume "\<And>t. t \<cdot> \<sigma> = t \<cdot> \<theta>"
-  hence "\<And>v. Var v \<cdot> \<sigma> = Var v \<cdot> \<theta>" by auto
-  thus "\<sigma> = \<theta>" by auto
-qed
-
 lemma subst_cong: "\<lbrakk>\<sigma> = \<sigma>'; \<theta> = \<theta>'\<rbrakk> \<Longrightarrow> (\<sigma> \<circ>\<^sub>s \<theta>) = (\<sigma>' \<circ>\<^sub>s \<theta>')"
 by auto
 
 lemma subst_mgt_bot[simp]: "Var \<preceq>\<^sub>\<circ> \<theta>"
 by simp
 
 lemma subst_mgt_refl[simp]: "\<theta> \<preceq>\<^sub>\<circ> \<theta>"
 by (metis var_comp(1))
 
 lemma subst_mgt_trans: "\<lbrakk>\<theta> \<preceq>\<^sub>\<circ> \<delta>; \<delta> \<preceq>\<^sub>\<circ> \<sigma>\<rbrakk> \<Longrightarrow> \<theta> \<preceq>\<^sub>\<circ> \<sigma>"
 by (metis subst_compose_assoc)
 
 lemma subst_mgt_comp: "\<theta> \<preceq>\<^sub>\<circ> \<theta> \<circ>\<^sub>s \<delta>"
 by auto
 
 lemma subst_mgt_comp': "\<theta> \<circ>\<^sub>s \<delta> \<preceq>\<^sub>\<circ> \<sigma> \<Longrightarrow> \<theta> \<preceq>\<^sub>\<circ> \<sigma>"
 by (metis subst_compose_assoc)
 
 lemma var_self: "(\<lambda>w. if w = v then Var v else Var w) = Var"
 using subst_agreement by auto
 
 lemma var_same[simp]: "Var(v := t) = Var \<longleftrightarrow> t = Var v"
 by (intro iffI, metis fun_upd_same, simp add: var_self)
 
 lemma subst_eq_if_eq_vars: "(\<And>v. (Var v) \<cdot> \<theta> = (Var v) \<cdot> \<sigma>) \<Longrightarrow> \<theta> = \<sigma>"
 by (auto simp add: subst_agreement)
 
 lemma subst_all_empty[simp]: "{} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = {}"
 by simp
 
 lemma subst_all_insert:"(insert t M) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> = insert (t \<cdot> \<delta>) (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
 by auto
 
 lemma subst_apply_fv_subset: "fv t \<subseteq> V \<Longrightarrow> fv (t \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
 by (induct t) auto
 
 lemma subst_apply_fv_empty:
   assumes "fv t = {}"
   shows "fv (t \<cdot> \<sigma>) = {}"
 using assms subst_apply_fv_subset[of t "{}" \<sigma>]
 by auto
 
 lemma subst_compose_fv:
   assumes "fv (\<theta> x) = {}"
   shows "fv ((\<theta> \<circ>\<^sub>s \<sigma>) x) = {}"
 using assms subst_apply_fv_empty
 unfolding subst_compose_def by fast
 
 lemma subst_compose_fv':
   fixes \<theta> \<sigma>::"('a,'b) subst"
   assumes "y \<in> fv ((\<theta> \<circ>\<^sub>s \<sigma>) x)"
   shows "\<exists>z. z \<in> fv (\<theta> x)"
 using assms subst_compose_fv
 by fast
 
 lemma subst_apply_fv_unfold: "fv (t \<cdot> \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv t)"
 by (induct t) auto
 
 lemma subst_apply_fv_unfold_set: "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>s\<^sub>e\<^sub>t (set ts)) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
 by (simp add: subst_apply_fv_unfold)
 
 lemma subst_apply_fv_unfold': "fv (t \<cdot> \<delta>) = (\<Union>v \<in> fv t. fv (\<delta> v))"
 using subst_apply_fv_unfold by simp
 
 lemma subst_apply_fv_union: "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv (t \<cdot> \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> fv t))"
 proof -
   have "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> fv t)) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv t)" by auto
   thus ?thesis using subst_apply_fv_unfold by metis
 qed
 
 lemma fv\<^sub>s\<^sub>e\<^sub>t_subst:
   "fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv\<^sub>s\<^sub>e\<^sub>t M)"
-using subst_apply_fv_unfold[of _ \<theta>] by auto
+by (simp add: subst_apply_fv_unfold)
 
 lemma subst_list_set_fv:
   "fv\<^sub>s\<^sub>e\<^sub>t (set (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)) = fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv\<^sub>s\<^sub>e\<^sub>t (set ts))"
 using subst_apply_fv_unfold_set[of \<theta> ts] by simp
 
 lemma subst_elimI[intro]: "(\<And>t. v \<notin> fv (t \<cdot> \<sigma>)) \<Longrightarrow> subst_elim \<sigma> v"
 by (auto simp add: subst_elim_def)
 
 lemma subst_elimI'[intro]: "(\<And>w. v \<notin> fv (Var w \<cdot> \<theta>)) \<Longrightarrow> subst_elim \<theta> v"
 by (simp add: subst_elim_def subst_apply_fv_unfold') 
 
 lemma subst_elimD[dest]: "subst_elim \<sigma> v \<Longrightarrow> v \<notin> fv (t \<cdot> \<sigma>)"
 by (auto simp add: subst_elim_def)
 
 lemma subst_elimD'[dest]: "subst_elim \<sigma> v \<Longrightarrow> \<sigma> v \<noteq> Var v"
-by (metis subst_elim_def subst_apply_term.simps(1) term.set_intros(3))
+by (metis subst_elim_def eval_term.simps(1) term.set_intros(3))
 
 lemma subst_elimD''[dest]: "subst_elim \<sigma> v \<Longrightarrow> v \<notin> fv (\<sigma> w)"
-by (metis subst_elim_def subst_apply_term.simps(1))
+by (metis subst_elim_def eval_term.simps(1))
 
 lemma subst_elim_rm_vars_dest[dest]:
   "subst_elim (\<sigma>::('a,'b) subst) v \<Longrightarrow> v \<notin> vs \<Longrightarrow> subst_elim (rm_vars vs \<sigma>) v"
 proof -
   assume assms: "subst_elim \<sigma> v" "v \<notin> vs"
   obtain f::"('a, 'b) subst \<Rightarrow> 'b \<Rightarrow> 'b" where
       "\<forall>\<sigma> v. (\<exists>w. v \<in> fv (Var w \<cdot> \<sigma>)) = (v \<in> fv (Var (f \<sigma> v) \<cdot> \<sigma>))"
     by moura
   hence *: "\<forall>a \<sigma>. a \<in> fv (Var (f \<sigma> a) \<cdot> \<sigma>) \<or> subst_elim \<sigma> a" by blast
   have "Var (f (rm_vars vs \<sigma>) v) \<cdot> \<sigma> \<noteq> Var (f (rm_vars vs \<sigma>) v) \<cdot> rm_vars vs \<sigma>
         \<or> v \<notin> fv (Var (f (rm_vars vs \<sigma>) v) \<cdot> rm_vars vs \<sigma>)"
     using assms(1) by fastforce
   moreover
   { assume "Var (f (rm_vars vs \<sigma>) v) \<cdot> \<sigma> \<noteq> Var (f (rm_vars vs \<sigma>) v) \<cdot> rm_vars vs \<sigma>"
     hence "rm_vars vs \<sigma> (f (rm_vars vs \<sigma>) v) \<noteq> \<sigma> (f (rm_vars vs \<sigma>) v)" by auto
     hence "f (rm_vars vs \<sigma>) v \<in> vs" by meson
     hence ?thesis using * assms(2) by force
   }
   ultimately show ?thesis using * by blast
 qed
 
 lemma occs_subst_elim: "\<not>Var v \<sqsubset> t \<Longrightarrow> subst_elim (Var(v := t)) v \<or> (Var(v := t)) = Var"
 proof (cases "Var v = t")
   assume "Var v \<noteq> t" "\<not>Var v \<sqsubset> t"
   hence "v \<notin> fv t" by (simp add: vars_iff_subterm_or_eq)
   thus ?thesis by (auto simp add: subst_remove_var)
 qed auto
 
 lemma occs_subst_elim': "\<not>Var v \<sqsubseteq> t \<Longrightarrow> subst_elim (Var(v := t)) v"
 proof -
   assume "\<not>Var v \<sqsubseteq> t"
   hence "v \<notin> fv t" by (auto simp add: vars_iff_subterm_or_eq)
   thus "subst_elim (Var(v := t)) v" by (simp add: subst_elim_def subst_remove_var)
 qed
 
 lemma subst_elim_comp: "subst_elim \<theta> v \<Longrightarrow> subst_elim (\<delta> \<circ>\<^sub>s \<theta>) v"
 by (auto simp add: subst_elim_def)
 
 lemma var_subst_idem: "subst_idem Var"
 by (simp add: subst_idem_def)
 
 lemma var_upd_subst_idem:
   assumes "\<not>Var v \<sqsubseteq> t" shows "subst_idem (Var(v := t))"
-unfolding subst_idem_def
-proof
-  let ?\<theta> = "Var(v := t)"
-  from assms have t_\<theta>_id: "t \<cdot> ?\<theta> = t" by blast
-  fix s show "s \<cdot> (?\<theta> \<circ>\<^sub>s ?\<theta>) = s \<cdot> ?\<theta>"
-    unfolding subst_compose_def
-    by (induction s, metis t_\<theta>_id fun_upd_def subst_apply_term.simps(1), simp) 
-qed
+  using subst_no_occs[OF assms] by (simp add: subst_idem_def subst_def[symmetric])
 
 lemma zip_map_subst:
   "zip xs (xs \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>) = map (\<lambda>t. (t, t \<cdot> \<delta>)) xs"
 by (induction xs) auto
 
 lemma map2_map_subst:
   "map2 f xs (xs \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>) = map (\<lambda>t. f t (t \<cdot> \<delta>)) xs"
 by (induction xs) auto
 
 
 subsection \<open>Lemmata: Domain and Range of Substitutions\<close>
 lemma range_vars_alt_def: "range_vars s \<equiv> fv\<^sub>s\<^sub>e\<^sub>t (subst_range s)"
 unfolding range_vars_def by simp
 
 lemma subst_dom_var_finite[simp]: "finite (subst_domain Var)" by simp
 
 lemma subst_range_Var[simp]: "subst_range Var = {}" by simp
 
 lemma range_vars_Var[simp]: "range_vars Var = {}" by fastforce
 
 lemma finite_subst_img_if_finite_dom: "finite (subst_domain \<sigma>) \<Longrightarrow> finite (range_vars \<sigma>)"
 unfolding range_vars_alt_def by auto
 
 lemma finite_subst_img_if_finite_dom': "finite (subst_domain \<sigma>) \<Longrightarrow> finite (subst_range \<sigma>)"
 by auto
 
 lemma subst_img_alt_def: "subst_range s = {t. \<exists>v. s v = t \<and> t \<noteq> Var v}"
 by (auto simp add: subst_domain_def)
 
 lemma subst_fv_img_alt_def: "range_vars s = (\<Union>t \<in> {t. \<exists>v. s v = t \<and> t \<noteq> Var v}. fv t)"
 unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
 
 lemma subst_domI[intro]: "\<sigma> v \<noteq> Var v \<Longrightarrow> v \<in> subst_domain \<sigma>"
 by (simp add: subst_domain_def)
 
 lemma subst_imgI[intro]: "\<sigma> v \<noteq> Var v \<Longrightarrow> \<sigma> v \<in> subst_range \<sigma>"
 by (simp add: subst_domain_def)
 
 lemma subst_fv_imgI[intro]: "\<sigma> v \<noteq> Var v \<Longrightarrow> fv (\<sigma> v) \<subseteq> range_vars \<sigma>"
 unfolding range_vars_alt_def by auto
 
 lemma subst_eqI':
   assumes "t \<cdot> \<delta> = t \<cdot> \<theta>" "subst_domain \<delta> = subst_domain \<theta>" "subst_domain \<delta> \<subseteq> fv t"
   shows "\<delta> = \<theta>"
 by (metis assms(2,3) term_subst_eq_rev[OF assms(1)] in_mono ext subst_domI)
 
 lemma subst_domain_subst_Fun_single[simp]:
   "subst_domain (Var(x := Fun f T)) = {x}" (is "?A = ?B")
 unfolding subst_domain_def by simp
 
 lemma subst_range_subst_Fun_single[simp]:
   "subst_range (Var(x := Fun f T)) = {Fun f T}" (is "?A = ?B")
 by simp
 
 lemma range_vars_subst_Fun_single[simp]:
   "range_vars (Var(x := Fun f T)) = fv (Fun f T)"
 unfolding range_vars_alt_def by force
 
 lemma var_renaming_is_Fun_iff:
   assumes "subst_range \<delta> \<subseteq> range Var"
   shows "is_Fun t = is_Fun (t \<cdot> \<delta>)"
 proof (cases t)
   case (Var x)
   hence "\<exists>y. \<delta> x = Var y" using assms by auto
   thus ?thesis using Var by auto
 qed simp
 
 lemma subst_fv_dom_img_subset: "fv t \<subseteq> subst_domain \<theta> \<Longrightarrow> fv (t \<cdot> \<theta>) \<subseteq> range_vars \<theta>"
 unfolding range_vars_alt_def by (induct t) auto
 
 lemma subst_fv_dom_img_subset_set: "fv\<^sub>s\<^sub>e\<^sub>t M \<subseteq> subst_domain \<theta> \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<subseteq> range_vars \<theta>"
 proof -
   assume assms: "fv\<^sub>s\<^sub>e\<^sub>t M \<subseteq> subst_domain \<theta>"
   obtain f::"'a set \<Rightarrow> (('b, 'a) term \<Rightarrow> 'a set) \<Rightarrow> ('b, 'a) terms \<Rightarrow> ('b, 'a) term" where
       "\<forall>x y z. (\<exists>v. v \<in> z \<and> \<not> y v \<subseteq> x) \<longleftrightarrow> (f x y z \<in> z \<and> \<not> y (f x y z) \<subseteq> x)"
     by moura
   hence *:
       "\<forall>T g A. (\<not> \<Union> (g ` T) \<subseteq> A \<or> (\<forall>t. t \<notin> T \<or> g t \<subseteq> A)) \<and>
                (\<Union> (g ` T) \<subseteq> A \<or> f A g T \<in> T \<and> \<not> g (f A g T) \<subseteq> A)"
     by (metis (no_types) SUP_le_iff)
   hence **: "\<forall>t. t \<notin> M \<or> fv t \<subseteq> subst_domain \<theta>" by (metis (no_types) assms fv\<^sub>s\<^sub>e\<^sub>t.simps)
   have "\<forall>t::('b, 'a) term. \<forall>f T. t \<notin> f ` T \<or> (\<exists>t'::('b, 'a) term. t = f t' \<and> t' \<in> T)" by blast
   hence "f (range_vars \<theta>) fv (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<notin> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<or>
          fv (f (range_vars \<theta>) fv (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)) \<subseteq> range_vars \<theta>"
     by (metis (full_types) ** subst_fv_dom_img_subset)
   thus ?thesis by (metis (no_types) * fv\<^sub>s\<^sub>e\<^sub>t.simps)
 qed
 
 lemma subst_fv_dom_ground_if_ground_img:
   assumes "fv t \<subseteq> subst_domain s" "ground (subst_range s)"
   shows "fv (t \<cdot> s) = {}"
 using subst_fv_dom_img_subset[OF assms(1)] assms(2) by force
 
 lemma subst_fv_dom_ground_if_ground_img':
   assumes "fv t \<subseteq> subst_domain s" "\<And>x. x \<in> subst_domain s \<Longrightarrow> fv (s x) = {}"
   shows "fv (t \<cdot> s) = {}"
 using subst_fv_dom_ground_if_ground_img[OF assms(1)] assms(2) by auto
 
 lemma subst_fv_unfold: "fv (t \<cdot> s) = (fv t - subst_domain s) \<union> fv\<^sub>s\<^sub>e\<^sub>t (s ` (fv t \<inter> subst_domain s))"
 proof (induction t)
   case (Var v) thus ?case
   proof (cases "v \<in> subst_domain s")
     case True thus ?thesis by auto
   next
     case False
     hence "fv (Var v \<cdot> s) = {v}" "fv (Var v) \<inter> subst_domain s = {}" by auto
     thus ?thesis by auto
   qed
 next
   case Fun thus ?case by auto
 qed
 
 lemma subst_fv_unfold_ground_img: "range_vars s = {} \<Longrightarrow> fv (t \<cdot> s) = fv t - subst_domain s"
-using subst_fv_unfold[of t s] unfolding range_vars_alt_def by auto
+by (auto simp: range_vars_alt_def subst_fv_unfold)
 
 lemma subst_img_update:
   "\<lbrakk>\<sigma> v = Var v; t \<noteq> Var v\<rbrakk> \<Longrightarrow> range_vars (\<sigma>(v := t)) = range_vars \<sigma> \<union> fv t"
 proof -
   assume "\<sigma> v = Var v" "t \<noteq> Var v"
   hence "(\<Union>s \<in> {s. \<exists>w. (\<sigma>(v := t)) w = s \<and> s \<noteq> Var w}. fv s) = fv t \<union> range_vars \<sigma>"
     unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
   thus "range_vars (\<sigma>(v := t)) = range_vars \<sigma> \<union> fv t"
     by (metis Un_commute subst_fv_img_alt_def)
 qed
 
 lemma subst_dom_update1: "v \<notin> subst_domain \<sigma> \<Longrightarrow> subst_domain (\<sigma>(v := Var v)) = subst_domain \<sigma>"
 by (auto simp add: subst_domain_def)
 
 lemma subst_dom_update2: "t \<noteq> Var v \<Longrightarrow> subst_domain (\<sigma>(v := t)) = insert v (subst_domain \<sigma>)"
 by (auto simp add: subst_domain_def)
 
 lemma subst_dom_update3: "t = Var v \<Longrightarrow> subst_domain (\<sigma>(v := t)) = subst_domain \<sigma> - {v}"
 by (auto simp add: subst_domain_def)
 
 lemma var_not_in_subst_dom[elim]: "v \<notin> subst_domain s \<Longrightarrow> s v = Var v"
 by (simp add: subst_domain_def)
 
 lemma subst_dom_vars_in_subst[elim]: "v \<in> subst_domain s \<Longrightarrow> s v \<noteq> Var v"
 by (simp add: subst_domain_def)
 
 lemma subst_not_dom_fixed: "\<lbrakk>v \<in> fv t; v \<notin> subst_domain s\<rbrakk> \<Longrightarrow> v \<in> fv (t \<cdot> s)" by (induct t) auto
 
 lemma subst_not_img_fixed: "\<lbrakk>v \<in> fv (t \<cdot> s); v \<notin> range_vars s\<rbrakk> \<Longrightarrow> v \<in> fv t"
 unfolding range_vars_alt_def by (induct t) force+
 
 lemma ground_range_vars[intro]: "ground (subst_range s) \<Longrightarrow> range_vars s = {}"
 unfolding range_vars_alt_def by metis
 
 lemma ground_subst_no_var[intro]: "ground (subst_range s) \<Longrightarrow> x \<notin> range_vars s"
 using ground_range_vars[of s] by blast
 
 lemma ground_img_obtain_fun:
   assumes "ground (subst_range s)" "x \<in> subst_domain s"
   obtains f T where "s x = Fun f T" "Fun f T \<in> subst_range s" "fv (Fun f T) = {}"
 proof -
   from assms(2) obtain t where t: "s x = t" "t \<in> subst_range s" by moura
   hence "fv t = {}" using assms(1) by auto
   thus ?thesis using t that by (cases t) simp_all
 qed
 
 lemma ground_term_subst_domain_fv_subset:
   "fv (t \<cdot> \<delta>) = {} \<Longrightarrow> fv t \<subseteq> subst_domain \<delta>"
 by (induct t) auto
 
 lemma ground_subst_range_empty_fv:
   "ground (subst_range \<theta>) \<Longrightarrow> x \<in> subst_domain \<theta> \<Longrightarrow> fv (\<theta> x) = {}"
 by simp
 
 lemma subst_Var_notin_img: "x \<notin> range_vars s \<Longrightarrow> t \<cdot> s = Var x \<Longrightarrow> t = Var x"
 using subst_not_img_fixed[of x t s] by (induct t) auto
 
 lemma fv_in_subst_img: "\<lbrakk>s v = t; t \<noteq> Var v\<rbrakk> \<Longrightarrow> fv t \<subseteq> range_vars s"
 unfolding range_vars_alt_def by auto
 
 lemma empty_dom_iff_empty_subst: "subst_domain \<theta> = {} \<longleftrightarrow> \<theta> = Var" by auto
 
 lemma subst_dom_cong: "(\<And>v t. \<theta> v = t \<Longrightarrow> \<delta> v = t) \<Longrightarrow> subst_domain \<theta> \<subseteq> subst_domain \<delta>"
 by (auto simp add: subst_domain_def)
 
 lemma subst_img_cong: "(\<And>v t. \<theta> v = t \<Longrightarrow> \<delta> v = t) \<Longrightarrow> range_vars \<theta> \<subseteq> range_vars \<delta>"
 unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
 
 lemma subst_dom_elim: "subst_domain s \<inter> range_vars s = {} \<Longrightarrow> fv (t \<cdot> s) \<inter> subst_domain s = {}"
 proof (induction t)
   case (Var v) thus ?case
     using fv_in_subst_img[of s] 
     by (cases "s v = Var v") (auto simp add: subst_domain_def)
 next
   case Fun thus ?case by auto
 qed
 
 lemma subst_dom_insert_finite: "finite (subst_domain s) = finite (subst_domain (s(v := t)))"
 proof
   assume "finite (subst_domain s)"
   have "subst_domain (s(v := t)) \<subseteq> insert v (subst_domain s)" by (auto simp add: subst_domain_def)
   thus "finite (subst_domain (s(v := t)))"
     by (meson \<open>finite (subst_domain s)\<close> finite_insert rev_finite_subset)
 next
   assume *: "finite (subst_domain (s(v := t)))"
   hence "finite (insert v (subst_domain s))"
   proof (cases "t = Var v")
     case True
     hence "finite (subst_domain s - {v})" by (metis * subst_dom_update3)
     thus ?thesis by simp
   qed (metis * subst_dom_update2[of t v s])
   thus "finite (subst_domain s)" by simp
 qed
 
 lemma trm_subst_disj: "t \<cdot> \<theta> = t \<Longrightarrow> fv t \<inter> subst_domain \<theta> = {}"
 proof (induction t)
   case (Fun f X)
   hence "map (\<lambda>x. x \<cdot> \<theta>) X = X" by simp
   hence "\<And>x. x \<in> set X \<Longrightarrow> x \<cdot> \<theta> = x" using map_eq_conv by fastforce
   thus ?case using Fun.IH by auto
 qed (simp add: subst_domain_def)
 
-lemma trm_subst_ident[intro]: "fv t \<inter> subst_domain \<theta> = {} \<Longrightarrow> t \<cdot> \<theta> = t"
-proof -
-  assume "fv t \<inter> subst_domain \<theta> = {}"
-  hence "\<forall>v \<in> fv t. \<forall>w \<in> subst_domain \<theta>. v \<noteq> w" by auto
-  thus ?thesis
-    by (metis subst_agreement subst_apply_term.simps(1) subst_apply_term_empty subst_domI)
-qed
+declare subst_apply_term_ident[intro]
 
 lemma trm_subst_ident'[intro]: "v \<notin> subst_domain \<theta> \<Longrightarrow> (Var v) \<cdot> \<theta> = Var v"
-using trm_subst_ident by (simp add: subst_domain_def)
+using subst_apply_term_ident by (simp add: subst_domain_def)
 
 lemma trm_subst_ident''[intro]: "(\<And>x. x \<in> fv t \<Longrightarrow> \<theta> x = Var x) \<Longrightarrow> t \<cdot> \<theta> = t"
 proof -
   assume "\<And>x. x \<in> fv t \<Longrightarrow> \<theta> x = Var x"
   hence "fv t \<inter> subst_domain \<theta> = {}" by (auto simp add: subst_domain_def)
-  thus ?thesis using trm_subst_ident by auto
+  thus ?thesis using subst_apply_term_ident by auto
 qed
 
 lemma set_subst_ident: "fv\<^sub>s\<^sub>e\<^sub>t M \<inter> subst_domain \<theta> = {} \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = M"
 proof -
   assume "fv\<^sub>s\<^sub>e\<^sub>t M \<inter> subst_domain \<theta> = {}"
   hence "\<forall>t \<in> M. t \<cdot> \<theta> = t" by auto
   thus ?thesis by force
 qed
 
 lemma trm_subst_ident_subterms[intro]:
   "fv t \<inter> subst_domain \<theta> = {} \<Longrightarrow> subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = subterms t"
 using set_subst_ident[of "subterms t" \<theta>] fv_subterms[of t] by simp
 
 lemma trm_subst_ident_subterms'[intro]:
   "v \<notin> fv t \<Longrightarrow> subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t Var(v := s) = subterms t"
 using trm_subst_ident_subterms[of t "Var(v := s)"]
 by (meson subst_no_occs trm_subst_disj vars_iff_subtermeq) 
 
 lemma const_mem_subst_cases:
   assumes "Fun c [] \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
   shows "Fun c [] \<in> M \<or> Fun c [] \<in> \<theta> ` fv\<^sub>s\<^sub>e\<^sub>t M"
 proof -
   obtain m where m: "m \<in> M" "m \<cdot> \<theta> = Fun c []" using assms by auto
   thus ?thesis by (cases m) force+
 qed
 
 lemma const_mem_subst_cases':
   assumes "Fun c [] \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
   shows "Fun c [] \<in> M \<or> Fun c [] \<in> subst_range \<theta>"
 using const_mem_subst_cases[OF assms] by force
 
 lemma fv_subterms_substI[intro]: "y \<in> fv t \<Longrightarrow> \<theta> y \<in> subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using image_iff vars_iff_subtermeq by fastforce 
 
 lemma fv_subterms_subst_eq[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (subterms (t \<cdot> \<theta>)) = fv\<^sub>s\<^sub>e\<^sub>t (subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
 using fv_subterms by (induct t) force+
 
 lemma fv_subterms_set_subst: "fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>))"
 using fv_subterms_subst_eq[of _ \<theta>] by auto
 
 lemma fv_subterms_set_subst': "fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
 using fv_subterms_set[of "M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"] fv_subterms_set_subst[of \<theta> M] by simp
 
 lemma fv_subst_subset: "x \<in> fv t \<Longrightarrow> fv (\<theta> x) \<subseteq> fv (t \<cdot> \<theta>)"
 by (metis fv_subset image_eqI subst_apply_fv_unfold)
 
 lemma fv_subst_subset': "fv s \<subseteq> fv t \<Longrightarrow> fv (s \<cdot> \<theta>) \<subseteq> fv (t \<cdot> \<theta>)"
 using fv_subst_subset by (induct s) force+
 
 lemma fv_subst_obtain_var:
   fixes \<delta>::"('a,'b) subst"
   assumes "x \<in> fv (t \<cdot> \<delta>)"
   shows "\<exists>y \<in> fv t. x \<in> fv (\<delta> y)"
 using assms by (induct t) force+
 
 lemma set_subst_all_ident: "fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<inter> subst_domain \<delta> = {} \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<theta> \<circ>\<^sub>s \<delta>) = M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 by (metis set_subst_ident subst_comp_all)
 
 lemma subterms_subst:
   "subterms (t \<cdot> d) = (subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t d) \<union> subterms\<^sub>s\<^sub>e\<^sub>t (d ` (fv t \<inter> subst_domain d))"
 by (induct t) (auto simp add: subst_domain_def)
 
 lemma subterms_subst':
   fixes \<theta>::"('a,'b) subst"
   assumes "\<forall>x \<in> fv t. (\<exists>f. \<theta> x = Fun f []) \<or> (\<exists>y. \<theta> x = Var y)"
   shows "subterms (t \<cdot> \<theta>) = subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using assms
 proof (induction t)
   case (Var x) thus ?case
   proof (cases "x \<in> subst_domain \<theta>")
     case True
     hence "(\<exists>f. \<theta> x = Fun f []) \<or> (\<exists>y. \<theta> x = Var y)" using Var by simp
     hence "subterms (\<theta> x) = {\<theta> x}" by auto
     thus ?thesis by simp
   qed auto
 qed auto
 
 lemma subterms_subst'':
   fixes \<theta>::"('a,'b) subst"
   assumes "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. (\<exists>f. \<theta> x = Fun f []) \<or> (\<exists>y. \<theta> x = Var y)"
   shows "subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) = subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using subterms_subst'[of _ \<theta>] assms by auto
 
 lemma subterms_subst_subterm:
   fixes \<theta>::"('a,'b) subst"
   assumes "\<forall>x \<in> fv a. (\<exists>f. \<theta> x = Fun f []) \<or> (\<exists>y. \<theta> x = Var y)"
     and "b \<in> subterms (a \<cdot> \<theta>)"
   shows "\<exists>c \<in> subterms a. c \<cdot> \<theta> = b"
 using subterms_subst'[OF assms(1)] assms(2) by auto
 
 lemma subterms_subst_subset: "subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<subseteq> subterms (t \<cdot> \<sigma>)"
 by (induct t) auto
 
 lemma subterms_subst_subset': "subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>)"
 using subterms_subst_subset by fast
 
 lemma subterms\<^sub>s\<^sub>e\<^sub>t_subst:
   fixes \<theta>::"('a,'b) subst"
   assumes "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   shows "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<or> (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. t \<in> subterms (\<theta> x))"
 using assms subterms_subst[of _ \<theta>] by auto
 
 lemma rm_vars_dom: "subst_domain (rm_vars V s) = subst_domain s - V"
 by (auto simp add: subst_domain_def)
 
 lemma rm_vars_dom_subset: "subst_domain (rm_vars V s) \<subseteq> subst_domain s"
 by (auto simp add: subst_domain_def)
 
 lemma rm_vars_dom_eq':
   "subst_domain (rm_vars (UNIV - V) s) = subst_domain s \<inter> V"
 using rm_vars_dom[of "UNIV - V" s] by blast
 
 lemma rm_vars_dom_eqI:
   assumes "t \<cdot> \<delta> = t \<cdot> \<theta>"
   shows "subst_domain (rm_vars (UNIV - fv t) \<delta>) = subst_domain (rm_vars (UNIV - fv t) \<theta>)"
 by (meson assms Diff_iff UNIV_I term_subst_eq_rev)
 
 lemma rm_vars_img: "subst_range (rm_vars V s) = s ` subst_domain (rm_vars V s)"
 by (auto simp add: subst_domain_def)
 
 lemma rm_vars_img_subset: "subst_range (rm_vars V s) \<subseteq> subst_range s"
 by (auto simp add: subst_domain_def)
 
 lemma rm_vars_img_fv_subset: "range_vars (rm_vars V s) \<subseteq> range_vars s"
 unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
 
 lemma rm_vars_fv_obtain:
   assumes "x \<in> fv (t \<cdot> rm_vars X \<theta>) - X"
   shows "\<exists>y \<in> fv t - X. x \<in> fv (rm_vars X \<theta> y)"
 using assms by (induct t) (fastforce, force)
 
 lemma rm_vars_apply: "v \<in> subst_domain (rm_vars V s) \<Longrightarrow> (rm_vars V s) v = s v"
 by (auto simp add: subst_domain_def)
 
 lemma rm_vars_apply': "subst_domain \<delta> \<inter> vs = {} \<Longrightarrow> rm_vars vs \<delta> = \<delta>"
 by force
 
 lemma rm_vars_ident: "fv t \<inter> vs = {} \<Longrightarrow> t \<cdot> (rm_vars vs \<theta>) = t \<cdot> \<theta>"
 by (induct t) auto
 
 lemma rm_vars_fv_subset: "fv (t \<cdot> rm_vars X \<theta>) \<subseteq> fv t \<union> fv (t \<cdot> \<theta>)"
 by (induct t) auto
 
 lemma rm_vars_fv_disj:
   assumes "fv t \<inter> X = {}" "fv (t \<cdot> \<theta>) \<inter> X = {}"
   shows "fv (t \<cdot> rm_vars X \<theta>) \<inter> X = {}"
 using rm_vars_ident[OF assms(1)] assms(2) by auto
 
 lemma rm_vars_ground_supports:
   assumes "ground (subst_range \<theta>)"
   shows "rm_vars X \<theta> supports \<theta>"
 proof
   fix x
   have *: "ground (subst_range (rm_vars X \<theta>))"
     using rm_vars_img_subset[of X \<theta>] assms
     by (auto simp add: subst_domain_def)
   show "rm_vars X \<theta> x \<cdot> \<theta> = \<theta> x "
   proof (cases "x \<in> subst_domain (rm_vars X \<theta>)")
     case True
     hence "fv (rm_vars X \<theta> x) = {}" using * by auto
     thus ?thesis using True by auto
   qed (simp add: subst_domain_def)
 qed
 
 lemma rm_vars_split:
   assumes "ground (subst_range \<theta>)"
   shows "\<theta> = rm_vars X \<theta> \<circ>\<^sub>s rm_vars (subst_domain \<theta> - X) \<theta>"
 proof -
   let ?s1 = "rm_vars X \<theta>"
   let ?s2 = "rm_vars (subst_domain \<theta> - X) \<theta>"
 
   have doms: "subst_domain ?s1 \<subseteq> subst_domain \<theta>" "subst_domain ?s2 \<subseteq> subst_domain \<theta>"
     by (auto simp add: subst_domain_def)
 
   { fix x assume "x \<notin> subst_domain \<theta>"
     hence "\<theta> x = Var x" "?s1 x = Var x" "?s2 x = Var x" using doms by auto
     hence "\<theta> x = (?s1 \<circ>\<^sub>s ?s2) x" by (simp add: subst_compose_def)
   } moreover {
     fix x assume "x \<in> subst_domain \<theta>" "x \<in> X"
     hence "?s1 x = Var x" "?s2 x = \<theta> x" using doms by auto
     hence "\<theta> x = (?s1 \<circ>\<^sub>s ?s2) x" by (simp add: subst_compose_def)
   } moreover {
     fix x assume "x \<in> subst_domain \<theta>" "x \<notin> X"
     hence "?s1 x = \<theta> x" "fv (\<theta> x) = {}" using assms doms by auto
     hence "\<theta> x = (?s1 \<circ>\<^sub>s ?s2) x" by (simp add: subst_compose subst_ground_ident)
   } ultimately show ?thesis by blast
 qed
 
 lemma rm_vars_fv_img_disj:
   assumes "fv t \<inter> X = {}" "X \<inter> range_vars \<theta> = {}"
   shows "fv (t \<cdot> rm_vars X \<theta>) \<inter> X = {}"
 using assms
 proof (induction t)
   case (Var x)
   hence *: "(rm_vars X \<theta>) x = \<theta> x" by auto
   show ?case
   proof (cases "x \<in> subst_domain \<theta>")
     case True
     hence "\<theta> x \<in> subst_range \<theta>" by auto
     hence "fv (\<theta> x) \<inter> X = {}" using Var.prems(2) unfolding range_vars_alt_def by fastforce
     thus ?thesis using * by auto
   next
     case False thus ?thesis using Var.prems(1) by auto
   qed
 next
   case Fun thus ?case by auto
 qed
 
 lemma subst_apply_dom_ident: "t \<cdot> \<theta> = t \<Longrightarrow> subst_domain \<delta> \<subseteq> subst_domain \<theta> \<Longrightarrow> t \<cdot> \<delta> = t"
 proof (induction t)
   case (Fun f T) thus ?case by (induct T) auto
 qed (auto simp add: subst_domain_def)
 
 lemma rm_vars_subst_apply_ident:
   assumes "t \<cdot> \<theta> = t"
   shows "t \<cdot> (rm_vars vs \<theta>) = t"
 using rm_vars_dom[of vs \<theta>] subst_apply_dom_ident[OF assms, of "rm_vars vs \<theta>"] by auto
 
 lemma rm_vars_subst_eq:
   "t \<cdot> \<delta> = t \<cdot> rm_vars (subst_domain \<delta> - subst_domain \<delta> \<inter> fv t) \<delta>"
 by (auto intro: term_subst_eq)
 
 lemma rm_vars_subst_eq':
   "t \<cdot> \<delta> = t \<cdot> rm_vars (UNIV - fv t) \<delta>"
 by (auto intro: term_subst_eq)
 
 lemma rm_vars_comp:
   assumes "range_vars \<delta> \<inter> vs = {}"
   shows "t \<cdot> rm_vars vs (\<delta> \<circ>\<^sub>s \<theta>) = t \<cdot> (rm_vars vs \<delta> \<circ>\<^sub>s rm_vars vs \<theta>)"
 using assms
 proof (induction t)
   case (Var x) thus ?case
   proof (cases "x \<in> vs")
-    case True thus ?thesis using Var by auto
+    case True thus ?thesis using Var
+      by (simp add: subst_compose_def)
   next
     case False
     have "subst_domain (rm_vars vs \<theta>) \<inter> vs = {}" by (auto simp add: subst_domain_def)
     moreover have "fv (\<delta> x) \<inter> vs = {}"
       using Var False unfolding range_vars_alt_def by force
     ultimately have "\<delta> x \<cdot> (rm_vars vs \<theta>) = \<delta> x \<cdot> \<theta>"
       using rm_vars_ident by (simp add: subst_domain_def)
     moreover have "(rm_vars vs (\<delta> \<circ>\<^sub>s \<theta>)) x = (\<delta> \<circ>\<^sub>s \<theta>) x" by (metis False)
-    ultimately show ?thesis using subst_compose by auto
+    ultimately show ?thesis by (auto simp: subst_compose)
   qed
 next
   case Fun thus ?case by auto
 qed
 
 lemma rm_vars_fv\<^sub>s\<^sub>e\<^sub>t_subst:
   assumes "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (rm_vars X \<theta> ` Y)"
   shows "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` Y) \<or> x \<in> X"
 using assms by auto
 
 lemma disj_dom_img_var_notin:
   assumes "subst_domain \<theta> \<inter> range_vars \<theta> = {}" "\<theta> v = t" "t \<noteq> Var v"
   shows "v \<notin> fv t" "\<forall>v \<in> fv (t \<cdot> \<theta>). v \<notin> subst_domain \<theta>"
 proof -
   have "v \<in> subst_domain \<theta>" "fv t \<subseteq> range_vars \<theta>"
     using fv_in_subst_img[of \<theta> v t, OF assms(2)] assms(2,3)
     by (auto simp add: subst_domain_def)
   thus "v \<notin> fv t" using assms(1) by auto
 
   have *: "fv t \<inter> subst_domain \<theta> = {}"
     using assms(1) \<open>fv t \<subseteq> range_vars \<theta>\<close>
     by auto
   hence "t \<cdot> \<theta> = t" by blast
   thus "\<forall>v \<in> fv (t \<cdot> \<theta>). v \<notin> subst_domain \<theta>" using * by auto
 qed
 
 lemma subst_sends_dom_to_img: "v \<in> subst_domain \<theta> \<Longrightarrow> fv (Var v \<cdot> \<theta>) \<subseteq> range_vars \<theta>"
 unfolding range_vars_alt_def by auto
 
 lemma subst_sends_fv_to_img: "fv (t \<cdot> s) \<subseteq> fv t \<union> range_vars s"
 proof (induction t)
   case (Var v) thus ?case
   proof (cases "Var v \<cdot> s = Var v")
     case True thus ?thesis by simp
   next
     case False
     hence "v \<in> subst_domain s" by (meson trm_subst_ident') 
     hence "fv (Var v \<cdot> s) \<subseteq> range_vars s"
       using subst_sends_dom_to_img by simp
     thus ?thesis by auto
   qed
 next
   case Fun thus ?case by auto
 qed 
 
 lemma ident_comp_subst_trm_if_disj:
   assumes "subst_domain \<sigma> \<inter> range_vars \<theta> = {}" "v \<in> subst_domain \<theta>"
   shows "(\<theta> \<circ>\<^sub>s \<sigma>) v = \<theta> v"
 proof -
   from assms have " subst_domain \<sigma> \<inter> fv (\<theta> v) = {}"
     using fv_in_subst_img unfolding range_vars_alt_def by auto
   thus "(\<theta> \<circ>\<^sub>s \<sigma>) v = \<theta> v" unfolding subst_compose_def by blast
 qed
 
 lemma ident_comp_subst_trm_if_disj': "fv (\<theta> v) \<inter> subst_domain \<sigma> = {} \<Longrightarrow> (\<theta> \<circ>\<^sub>s \<sigma>) v = \<theta> v"
 unfolding subst_compose_def by blast
 
 lemma subst_idemI[intro]: "subst_domain \<sigma> \<inter> range_vars \<sigma> = {} \<Longrightarrow> subst_idem \<sigma>"
 using ident_comp_subst_trm_if_disj[of \<sigma> \<sigma>]
       var_not_in_subst_dom[of _ \<sigma>]
       subst_eq_if_eq_vars[of \<sigma>]
 by (metis subst_idem_def subst_compose_def var_comp(2)) 
 
 lemma subst_idemI'[intro]: "ground (subst_range \<sigma>) \<Longrightarrow> subst_idem \<sigma>"
 proof (intro subst_idemI)
   assume "ground (subst_range \<sigma>)"
   hence "range_vars \<sigma> = {}" by (metis ground_range_vars)
   thus "subst_domain \<sigma> \<inter> range_vars \<sigma> = {}" by blast
 qed
 
 lemma subst_idemE: "subst_idem \<sigma> \<Longrightarrow> subst_domain \<sigma> \<inter> range_vars \<sigma> = {}"
 proof -
   assume "subst_idem \<sigma>"
   hence "\<And>v. fv (\<sigma> v) \<inter> subst_domain \<sigma> = {}"
     unfolding subst_idem_def subst_compose_def by (metis trm_subst_disj)
   thus ?thesis
     unfolding range_vars_alt_def by auto
 qed
 
 lemma subst_idem_rm_vars: "subst_idem \<theta> \<Longrightarrow> subst_idem (rm_vars X \<theta>)"
 proof -
   assume "subst_idem \<theta>"
   hence "subst_domain \<theta> \<inter> range_vars \<theta> = {}" by (metis subst_idemE)
   moreover have
       "subst_domain (rm_vars X \<theta>) \<subseteq> subst_domain \<theta>"
       "range_vars (rm_vars X \<theta>) \<subseteq> range_vars \<theta>"
     unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
   ultimately show ?thesis by blast
 qed
 
 lemma subst_fv_bounded_if_img_bounded: "range_vars \<theta> \<subseteq> fv t \<union> V \<Longrightarrow> fv (t \<cdot> \<theta>) \<subseteq> fv t \<union> V"
 proof (induction t)
   case (Var v) thus ?case unfolding range_vars_alt_def by (cases "\<theta> v = Var v") auto
 qed (metis (no_types, lifting) Un_assoc Un_commute subst_sends_fv_to_img sup.absorb_iff2)
 
 lemma subst_fv_bound_singleton: "fv (t \<cdot> Var(v := t')) \<subseteq> fv t \<union> fv t'"
 using subst_fv_bounded_if_img_bounded[of "Var(v := t')" t "fv t'"]
 unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
 
 lemma subst_fv_bounded_if_img_bounded':
   assumes "range_vars \<theta> \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
   shows "fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
 proof
   fix v assume *:  "v \<in> fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   
   obtain t where t: "t \<in> M" "t \<cdot> \<theta> \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>" "v \<in> fv (t \<cdot> \<theta>)"
   proof -
     assume **: "\<And>t. \<lbrakk>t \<in> M; t \<cdot> \<theta> \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>; v \<in> fv (t \<cdot> \<theta>)\<rbrakk> \<Longrightarrow> thesis"
     have "v \<in> \<Union> (fv ` ((\<lambda>t. t \<cdot> \<theta>) ` M))" using * by (metis fv\<^sub>s\<^sub>e\<^sub>t.simps)
     hence "\<exists>t. t \<in> M \<and> v \<in> fv (t \<cdot> \<theta>)" by blast
     thus ?thesis using ** imageI by blast
   qed
 
   from \<open>t \<in> M\<close> obtain M' where "t \<notin> M'" "M = insert t M'" by (meson Set.set_insert) 
   hence "fv\<^sub>s\<^sub>e\<^sub>t M = fv t \<union> fv\<^sub>s\<^sub>e\<^sub>t M'" by simp
   hence "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M" using subst_fv_bounded_if_img_bounded assms by simp
   thus "v \<in> fv\<^sub>s\<^sub>e\<^sub>t M" using assms \<open>v \<in> fv (t \<cdot> \<theta>)\<close> by auto
 qed
 
 lemma ground_img_if_ground_subst: "(\<And>v t. s v = t \<Longrightarrow> fv t = {}) \<Longrightarrow> range_vars s = {}"
 unfolding range_vars_alt_def by auto
 
 lemma ground_subst_fv_subset: "ground (subst_range \<theta>) \<Longrightarrow> fv (t \<cdot> \<theta>) \<subseteq> fv t"
 using subst_fv_bounded_if_img_bounded[of \<theta>]
 unfolding range_vars_alt_def by force
 
 lemma ground_subst_fv_subset': "ground (subst_range \<theta>) \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
 using subst_fv_bounded_if_img_bounded'[of \<theta> M]
 unfolding range_vars_alt_def by auto
 
 lemma subst_to_var_is_var[elim]: "t \<cdot> s = Var v \<Longrightarrow> \<exists>w. t = Var w"
-using subst_apply_term.elims by blast
+by (auto elim!: eval_term.elims)
 
 lemma subst_dom_comp_inI:
   assumes "y \<notin> subst_domain \<sigma>"
     and "y \<in> subst_domain \<delta>"
   shows "y \<in> subst_domain (\<sigma> \<circ>\<^sub>s \<delta>)"
 using assms subst_domain_subst_compose[of \<sigma> \<delta>] by blast
 
 lemma subst_comp_notin_dom_eq:
   "x \<notin> subst_domain \<theta>1 \<Longrightarrow> (\<theta>1 \<circ>\<^sub>s \<theta>2) x = \<theta>2 x"
 unfolding subst_compose_def by fastforce
 
 lemma subst_dom_comp_eq:
   assumes "subst_domain \<theta> \<inter> range_vars \<sigma> = {}"
   shows "subst_domain (\<theta> \<circ>\<^sub>s \<sigma>) = subst_domain \<theta> \<union> subst_domain \<sigma>"
 proof (rule ccontr)
   assume "subst_domain (\<theta> \<circ>\<^sub>s \<sigma>) \<noteq> subst_domain \<theta> \<union> subst_domain \<sigma>"
   hence "subst_domain (\<theta> \<circ>\<^sub>s \<sigma>) \<subset> subst_domain \<theta> \<union> subst_domain \<sigma>"
     using subst_domain_compose[of \<theta> \<sigma>] by (simp add: subst_domain_def)
   then obtain v where "v \<notin> subst_domain (\<theta> \<circ>\<^sub>s \<sigma>)" "v \<in> subst_domain \<theta> \<union> subst_domain \<sigma>" by auto
   hence v_in_some_subst: "\<theta> v \<noteq> Var v \<or> \<sigma> v \<noteq> Var v" and "\<theta> v \<cdot> \<sigma> = Var v"
     unfolding subst_compose_def by (auto simp add: subst_domain_def)
   then obtain w where "\<theta> v = Var w" using subst_to_var_is_var by fastforce
   show False
   proof (cases "v = w")
     case True
     hence "\<theta> v = Var v" using \<open>\<theta> v = Var w\<close> by simp
     hence "\<sigma> v \<noteq> Var v" using v_in_some_subst by simp
     thus False using \<open>\<theta> v = Var v\<close> \<open>\<theta> v \<cdot> \<sigma> = Var v\<close> by simp
   next
     case False
     hence "v \<in> subst_domain \<theta>" using v_in_some_subst \<open>\<theta> v \<cdot> \<sigma> = Var v\<close> by auto 
     hence "v \<notin> range_vars \<sigma>" using assms by auto
     moreover have "\<sigma> w = Var v" using \<open>\<theta> v \<cdot> \<sigma> = Var v\<close> \<open>\<theta> v = Var w\<close> by simp
     hence "v \<in> range_vars \<sigma>" using \<open>v \<noteq> w\<close> subst_fv_imgI[of \<sigma> w] by simp
     ultimately show False ..
   qed
 qed
 
 lemma subst_img_comp_subset[simp]:
   "range_vars (\<theta>1 \<circ>\<^sub>s \<theta>2) \<subseteq> range_vars \<theta>1 \<union> range_vars \<theta>2"
 proof
   let ?img = "range_vars"
   fix x assume "x \<in> ?img (\<theta>1 \<circ>\<^sub>s \<theta>2)"
   then obtain v t where vt: "x \<in> fv t" "t = (\<theta>1 \<circ>\<^sub>s \<theta>2) v" "t \<noteq> Var v"
     unfolding range_vars_alt_def subst_compose_def by (auto simp add: subst_domain_def)
 
   { assume "x \<notin> ?img \<theta>1" hence "x \<in> ?img \<theta>2"
       by (metis (no_types, opaque_lifting) fv_in_subst_img Un_iff subst_compose_def 
-                vt subsetCE subst_apply_term.simps(1) subst_sends_fv_to_img)
+                vt subsetCE eval_term.simps(1) subst_sends_fv_to_img)
   }
   thus "x \<in> ?img \<theta>1 \<union> ?img \<theta>2" by auto
 qed
 
 lemma subst_img_comp_subset':
   assumes "t \<in> subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2)"
   shows "t \<in> subst_range \<theta>2 \<or> (\<exists>t' \<in> subst_range \<theta>1. t = t' \<cdot> \<theta>2)"
 proof -
   obtain x where x: "x \<in> subst_domain (\<theta>1 \<circ>\<^sub>s \<theta>2)" "(\<theta>1 \<circ>\<^sub>s \<theta>2) x = t" "t \<noteq> Var x"
     using assms by (auto simp add: subst_domain_def)
   { assume "x \<notin> subst_domain \<theta>1"
     hence "(\<theta>1 \<circ>\<^sub>s \<theta>2) x = \<theta>2 x" unfolding subst_compose_def by auto
     hence ?thesis using x by auto
   } moreover {
     assume "x \<in> subst_domain \<theta>1" hence ?thesis using subst_compose x(2) by fastforce 
   } ultimately show ?thesis by metis
 qed
 
 lemma subst_img_comp_subset'':
   "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2)) \<subseteq>
    subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>2) \<union> ((subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>1)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2)"
 proof
   fix t assume "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2))"
   then obtain x where x: "x \<in> subst_domain (\<theta>1 \<circ>\<^sub>s \<theta>2)" "t \<in> subterms ((\<theta>1 \<circ>\<^sub>s \<theta>2) x)"
     by auto
   show "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>2) \<union> (subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>1) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2)"
   proof (cases "x \<in> subst_domain \<theta>1")
     case True thus ?thesis
       using subst_compose[of \<theta>1 \<theta>2] x(2) subterms_subst
       by fastforce
   next
     case False
     hence "(\<theta>1 \<circ>\<^sub>s \<theta>2) x = \<theta>2 x" unfolding subst_compose_def by auto
     thus ?thesis using x by (auto simp add: subst_domain_def)
   qed
 qed
 
 lemma subst_img_comp_subset''':
   "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2)) - range Var \<subseteq>
    subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>2) - range Var \<union> ((subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>1) - range Var) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2)"
 proof
   fix t assume t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2)) - range Var"
   then obtain f T where fT: "t = Fun f T" by (cases t) simp_all
   then obtain x where x: "x \<in> subst_domain (\<theta>1 \<circ>\<^sub>s \<theta>2)" "Fun f T \<in> subterms ((\<theta>1 \<circ>\<^sub>s \<theta>2) x)"
     using t by auto
   have "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>2) \<union> (subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>1) - range Var \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2)"
   proof (cases "x \<in> subst_domain \<theta>1")
     case True
     hence "Fun f T \<in> (subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>2)) \<union> (subterms (\<theta>1 x) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2)"
-      using x(2) subterms_subst[of "\<theta>1 x" \<theta>2]
-      unfolding subst_compose[of \<theta>1 \<theta>2 x] by auto
+      using x(2)
+      by (auto simp: subst_compose subterms_subst)
     moreover have ?thesis when *: "Fun f T \<in> subterms (\<theta>1 x) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2"
     proof -
       obtain s where s: "s \<in> subterms (\<theta>1 x)" "Fun f T = s \<cdot> \<theta>2" using * by moura
       show ?thesis
       proof (cases s)
         case (Var y)
         hence "Fun f T \<in> subst_range \<theta>2" using s by force
         thus ?thesis by blast
       next
         case (Fun g S)
         hence "Fun f T \<in> (subterms (\<theta>1 x) - range Var) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2" using s by blast
         thus ?thesis using True by auto
       qed
     qed
     ultimately show ?thesis by blast
   next
     case False
     hence "(\<theta>1 \<circ>\<^sub>s \<theta>2) x = \<theta>2 x" unfolding subst_compose_def by auto
     thus ?thesis using x by (auto simp add: subst_domain_def)
   qed
   thus "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>2) - range Var \<union>
             (subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>1) - range Var \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2)"
     using fT by auto
 qed
 
 lemma subst_img_comp_subset_const:
   assumes "Fun c [] \<in> subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2)"
   shows "Fun c [] \<in> subst_range \<theta>2 \<or> Fun c [] \<in> subst_range \<theta>1 \<or>
          (\<exists>x. Var x \<in> subst_range \<theta>1 \<and> \<theta>2 x = Fun c [])"
 proof (cases "Fun c [] \<in> subst_range \<theta>2")
   case False
   then obtain t where t: "t \<in> subst_range \<theta>1" "Fun c [] = t \<cdot> \<theta>2" 
     using subst_img_comp_subset'[OF assms] by auto
   thus ?thesis by (cases t) auto
 qed (simp add: subst_img_comp_subset'[OF assms])
 
 lemma subst_img_comp_subset_const':
   fixes \<delta> \<tau>::"('f,'v) subst"
   assumes "(\<delta> \<circ>\<^sub>s \<tau>) x = Fun c []"
   shows "\<delta> x = Fun c [] \<or> (\<exists>z. \<delta> x = Var z \<and> \<tau> z = Fun c [])"
 proof (cases "\<delta> x = Fun c []")
   case False
   then obtain t where "\<delta> x = t" "t \<cdot> \<tau> = Fun c []" using assms unfolding subst_compose_def by auto
   thus ?thesis by (cases t) auto
 qed simp
 
 lemma subst_img_comp_subset_ground:
   assumes "ground (subst_range \<theta>1)"
   shows "subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2) \<subseteq> subst_range \<theta>1 \<union> subst_range \<theta>2"
 proof
   fix t assume t: "t \<in> subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2)"
   then obtain x where x: "x \<in> subst_domain (\<theta>1 \<circ>\<^sub>s \<theta>2)" "t = (\<theta>1 \<circ>\<^sub>s \<theta>2) x" by auto
 
   show "t \<in> subst_range \<theta>1 \<union> subst_range \<theta>2"
   proof (cases "x \<in> subst_domain \<theta>1")
     case True
     hence "fv (\<theta>1 x) = {}" using assms ground_subst_range_empty_fv by fast
     hence "t = \<theta>1 x" using x(2) unfolding subst_compose_def by blast
     thus ?thesis using True by simp
   next
     case False
     hence "t = \<theta>2 x" "x \<in> subst_domain \<theta>2"
       using x subst_domain_compose[of \<theta>1 \<theta>2]
       by (metis subst_comp_notin_dom_eq, blast)
     thus ?thesis using x by simp
   qed
 qed
 
 lemma subst_fv_dom_img_single:
   assumes "v \<notin> fv t" "\<sigma> v = t" "\<And>w. v \<noteq> w \<Longrightarrow> \<sigma> w = Var w"
   shows "subst_domain \<sigma> = {v}" "range_vars \<sigma> = fv t"
 proof -
   show "subst_domain \<sigma> = {v}" using assms by (fastforce simp add: subst_domain_def)
   have "fv t \<subseteq> range_vars \<sigma>" by (metis fv_in_subst_img assms(1,2) vars_iff_subterm_or_eq) 
   moreover have "\<And>v. \<sigma> v \<noteq> Var v \<Longrightarrow> \<sigma> v = t" using assms by fastforce
   ultimately show "range_vars \<sigma> = fv t"
     unfolding range_vars_alt_def
     by (auto simp add: subst_domain_def)
 qed
 
 lemma subst_comp_upd1:
   "\<theta>(v := t) \<circ>\<^sub>s \<sigma> = (\<theta> \<circ>\<^sub>s \<sigma>)(v := t \<cdot> \<sigma>)"
 unfolding subst_compose_def by auto
 
 lemma subst_comp_upd2:
   assumes "v \<notin> subst_domain s" "v \<notin> range_vars s"
   shows "s(v := t) = s \<circ>\<^sub>s (Var(v := t))"
 unfolding subst_compose_def
 proof -
   { fix w
     have "(s(v := t)) w = s w \<cdot> Var(v := t)"
     proof (cases "w = v")
       case True
       hence "s w = Var w" using \<open>v \<notin> subst_domain s\<close> by (simp add: subst_domain_def)
       thus ?thesis using \<open>w = v\<close> by simp
     next
       case False
       hence "(s(v := t)) w = s w" by simp
       moreover have "s w \<cdot> Var(v := t) = s w" using \<open>w \<noteq> v\<close> \<open>v \<notin> range_vars s\<close> 
         by (metis fv_in_subst_img fun_upd_apply insert_absorb insert_subset
-                  repl_invariance subst_apply_term.simps(1) subst_apply_term_empty)
+                  repl_invariance eval_term.simps(1) subst_apply_term_empty)
       ultimately show ?thesis ..
     qed
   }
   thus "s(v := t) = (\<lambda>w. s w \<cdot> Var(v := t))" by auto
 qed
 
 lemma ground_subst_dom_iff_img:
   "ground (subst_range \<sigma>) \<Longrightarrow> x \<in> subst_domain \<sigma> \<longleftrightarrow> \<sigma> x \<in> subst_range \<sigma>"
 by (auto simp add: subst_domain_def)
 
 lemma finite_dom_subst_exists:
   "finite S \<Longrightarrow> \<exists>\<sigma>::('f,'v) subst. subst_domain \<sigma> = S"
 proof (induction S rule: finite.induct)
   case (insertI A a)
   then obtain \<sigma>::"('f,'v) subst" where "subst_domain \<sigma> = A" by blast
   fix f::'f
   have "subst_domain (\<sigma>(a := Fun f [])) = insert a A"
     using \<open>subst_domain \<sigma> = A\<close>
     by (auto simp add: subst_domain_def)
   thus ?case by metis
 qed (auto simp add: subst_domain_def)
 
 lemma subst_inj_is_bij_betw_dom_img_if_ground_img:
   assumes "ground (subst_range \<sigma>)"
   shows "inj \<sigma> \<longleftrightarrow> bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)" (is "?A \<longleftrightarrow> ?B")
 proof
   show "?A \<Longrightarrow> ?B" by (metis bij_betw_def injD inj_onI subst_range.simps)
 next
   assume ?B
   hence "inj_on \<sigma> (subst_domain \<sigma>)" unfolding bij_betw_def by auto
   moreover have "\<And>x. x \<in> UNIV - subst_domain \<sigma> \<Longrightarrow> \<sigma> x = Var x" by auto
   hence "inj_on \<sigma> (UNIV - subst_domain \<sigma>)"
     using inj_onI[of "UNIV - subst_domain \<sigma>"]
     by (metis term.inject(1))
   moreover have "\<And>x y. x \<in> subst_domain \<sigma> \<Longrightarrow> y \<notin> subst_domain \<sigma> \<Longrightarrow> \<sigma> x \<noteq> \<sigma> y"
     using assms by (auto simp add: subst_domain_def)
   ultimately show ?A by (metis injI inj_onD subst_domI term.inject(1))
 qed
 
 lemma bij_finite_ground_subst_exists:
   assumes "finite (S::'v set)" "infinite (U::('f,'v) term set)" "ground U"
   shows "\<exists>\<sigma>::('f,'v) subst. subst_domain \<sigma> = S
                           \<and> bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)
                           \<and> subst_range \<sigma> \<subseteq> U"
 proof -
   obtain T' where "T' \<subseteq> U" "card T' = card S" "finite T'"
     by (meson assms(2) finite_Diff2 infinite_arbitrarily_large)
   then obtain f::"'v \<Rightarrow> ('f,'v) term" where f_bij: "bij_betw f S T'"
     using finite_same_card_bij[OF assms(1)] by metis
   hence *: "\<And>v. v \<in> S \<Longrightarrow> f v \<noteq> Var v"
     using \<open>ground U\<close> \<open>T' \<subseteq> U\<close> bij_betwE
     by fastforce
 
   let ?\<sigma> = "\<lambda>v. if v \<in> S then f v else Var v"
   have "subst_domain ?\<sigma> = S"
   proof
     show "subst_domain ?\<sigma> \<subseteq> S" by (auto simp add: subst_domain_def)
 
     { fix v assume "v \<in> S" "v \<notin> subst_domain ?\<sigma>"
       hence "f v = Var v" by (simp add: subst_domain_def)
       hence False using *[OF \<open>v \<in> S\<close>] by metis
     }
     thus "S \<subseteq> subst_domain ?\<sigma>" by blast
   qed
   hence "\<And>v w. \<lbrakk>v \<in> subst_domain ?\<sigma>; w \<notin> subst_domain ?\<sigma>\<rbrakk> \<Longrightarrow> ?\<sigma> w \<noteq> ?\<sigma> v"
     using \<open>ground U\<close> bij_betwE[OF f_bij] set_rev_mp[OF _ \<open>T' \<subseteq> U\<close>]
     by (metis (no_types, lifting) UN_iff empty_iff vars_iff_subterm_or_eq fv\<^sub>s\<^sub>e\<^sub>t.simps) 
   hence "inj_on ?\<sigma> (subst_domain ?\<sigma>)"
     using f_bij \<open>subst_domain ?\<sigma> = S\<close>
     unfolding bij_betw_def inj_on_def
     by metis
   hence "bij_betw ?\<sigma> (subst_domain ?\<sigma>) (subst_range ?\<sigma>)"
     using inj_on_imp_bij_betw[of ?\<sigma>] by simp
   moreover have "subst_range ?\<sigma> = T'"
     using \<open>bij_betw f S T'\<close> \<open>subst_domain ?\<sigma> = S\<close>
     unfolding bij_betw_def by auto 
   hence "subst_range ?\<sigma> \<subseteq> U" using \<open>T' \<subseteq> U\<close> by auto
   ultimately show ?thesis using \<open>subst_domain ?\<sigma> = S\<close> by (metis (lifting))
 qed
 
 lemma bij_finite_const_subst_exists:
   assumes "finite (S::'v set)" "finite (T::'f set)" "infinite (U::'f set)"
   shows "\<exists>\<sigma>::('f,'v) subst. subst_domain \<sigma> = S
                           \<and> bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)
                           \<and> subst_range \<sigma> \<subseteq> (\<lambda>c. Fun c []) ` (U - T)"
 proof -
   obtain T' where "T' \<subseteq> U - T" "card T' = card S" "finite T'"
     by (meson assms(2,3) finite_Diff2 infinite_arbitrarily_large)
   then obtain f::"'v \<Rightarrow> 'f" where f_bij: "bij_betw f S T'"
     using finite_same_card_bij[OF assms(1)] by metis
 
   let ?\<sigma> = "\<lambda>v. if v \<in> S then Fun (f v) [] else Var v"
   have "subst_domain ?\<sigma> = S" by (simp add: subst_domain_def)
   moreover have "\<And>v w. \<lbrakk>v \<in> subst_domain ?\<sigma>; w \<notin> subst_domain ?\<sigma>\<rbrakk> \<Longrightarrow> ?\<sigma> w \<noteq> ?\<sigma> v" by auto
   hence "inj_on ?\<sigma> (subst_domain ?\<sigma>)"
     using f_bij unfolding bij_betw_def inj_on_def
     by (metis \<open>subst_domain ?\<sigma> = S\<close> term.inject(2))
   hence "bij_betw ?\<sigma> (subst_domain ?\<sigma>) (subst_range ?\<sigma>)"
     using inj_on_imp_bij_betw[of ?\<sigma>] by simp
   moreover have "subst_range ?\<sigma> = ((\<lambda>c. Fun c []) ` T')"
     using \<open>bij_betw f S T'\<close> unfolding bij_betw_def inj_on_def by (auto simp add: subst_domain_def)
   hence "subst_range ?\<sigma> \<subseteq> ((\<lambda>c. Fun c []) ` (U - T))" using \<open>T' \<subseteq> U - T\<close> by auto
   ultimately show ?thesis by (metis (lifting))
 qed
 
 lemma bij_finite_const_subst_exists':
   assumes "finite (S::'v set)" "finite (T::('f,'v) terms)" "infinite (U::'f set)"
   shows "\<exists>\<sigma>::('f,'v) subst. subst_domain \<sigma> = S
                           \<and> bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)
                           \<and> subst_range \<sigma> \<subseteq> ((\<lambda>c. Fun c []) ` U) - T"
 proof -
   have "finite (\<Union>(funs_term ` T))" using assms(2) by auto
   then 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 - (\<Union>(funs_term ` T)))"
     using bij_finite_const_subst_exists[OF assms(1) _ assms(3)] by blast
   moreover have "(\<lambda>c. Fun c []) ` (U - (\<Union>(funs_term ` T))) \<subseteq> ((\<lambda>c. Fun c []) ` U) - T" by auto
   ultimately show ?thesis by blast
 qed
 
 lemma bij_betw_iteI:
   assumes "bij_betw f A B" "bij_betw g C D" "A \<inter> C = {}" "B \<inter> D = {}"
   shows "bij_betw (\<lambda>x. if x \<in> A then f x else g x) (A \<union> C) (B \<union> D)"
 proof -
   have "bij_betw (\<lambda>x. if x \<in> A then f x else g x) A B"
     by (metis bij_betw_cong[of A f "\<lambda>x. if x \<in> A then f x else g x" B] assms(1))
   moreover have "bij_betw (\<lambda>x. if x \<in> A then f x else g x) C D"
     using bij_betw_cong[of C g "\<lambda>x. if x \<in> A then f x else g x" D] assms(2,3) by force
   ultimately show ?thesis using bij_betw_combine[OF _ _ assms(4)] by metis
 qed
 
 lemma subst_comp_split:
   assumes "subst_domain \<theta> \<inter> range_vars \<theta> = {}"
   shows "\<theta> = (rm_vars (subst_domain \<theta> - V) \<theta>) \<circ>\<^sub>s (rm_vars V \<theta>)" (is ?P)
     and "\<theta> = (rm_vars V \<theta>) \<circ>\<^sub>s (rm_vars (subst_domain \<theta> - V) \<theta>)" (is ?Q)
 proof -
   let ?rm1 = "rm_vars (subst_domain \<theta> - V) \<theta>" and ?rm2 = "rm_vars V \<theta>"
   have "subst_domain ?rm2 \<inter> range_vars ?rm1 = {}"
        "subst_domain ?rm1 \<inter> range_vars ?rm2 = {}"
     using assms unfolding range_vars_alt_def by (force simp add: subst_domain_def)+
   hence *: "\<And>v. v \<in> subst_domain ?rm1 \<Longrightarrow> (?rm1 \<circ>\<^sub>s ?rm2) v = \<theta> v"
            "\<And>v. v \<in> subst_domain ?rm2 \<Longrightarrow> (?rm2 \<circ>\<^sub>s ?rm1) v = \<theta> v"
     using ident_comp_subst_trm_if_disj[of ?rm2 ?rm1]
           ident_comp_subst_trm_if_disj[of ?rm1 ?rm2]
     by (auto simp add: subst_domain_def)
   hence "\<And>v. v \<notin> subst_domain ?rm1 \<Longrightarrow> (?rm1 \<circ>\<^sub>s ?rm2) v = \<theta> v"
         "\<And>v. v \<notin> subst_domain ?rm2 \<Longrightarrow> (?rm2 \<circ>\<^sub>s ?rm1) v = \<theta> v"
     unfolding subst_compose_def by (auto simp add: subst_domain_def)
   hence "\<And>v. (?rm1 \<circ>\<^sub>s ?rm2) v = \<theta> v" "\<And>v. (?rm2 \<circ>\<^sub>s ?rm1) v = \<theta> v" using * by blast+
   thus ?P ?Q by auto
 qed
 
 lemma subst_comp_eq_if_disjoint_vars:
   assumes "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> (subst_domain \<gamma> \<union> range_vars \<gamma>) = {}"
   shows "\<gamma> \<circ>\<^sub>s \<delta> = \<delta> \<circ>\<^sub>s \<gamma>"
 proof -
   { fix x assume "x \<in> subst_domain \<gamma>"
     hence "(\<gamma> \<circ>\<^sub>s \<delta>) x = \<gamma> x" "(\<delta> \<circ>\<^sub>s \<gamma>) x = \<gamma> x"
       using assms unfolding range_vars_alt_def by (force simp add: subst_compose)+
     hence "(\<gamma> \<circ>\<^sub>s \<delta>) x = (\<delta> \<circ>\<^sub>s \<gamma>) x" by metis
   } moreover
   { fix x assume "x \<in> subst_domain \<delta>"
     hence "(\<gamma> \<circ>\<^sub>s \<delta>) x = \<delta> x" "(\<delta> \<circ>\<^sub>s \<gamma>) x = \<delta> x"
       using assms
       unfolding range_vars_alt_def by (auto simp add: subst_compose subst_domain_def)
     hence "(\<gamma> \<circ>\<^sub>s \<delta>) x = (\<delta> \<circ>\<^sub>s \<gamma>) x" by metis
   } moreover
   { fix x assume "x \<notin> subst_domain \<gamma>" "x \<notin> subst_domain \<delta>"
     hence "(\<gamma> \<circ>\<^sub>s \<delta>) x = (\<delta> \<circ>\<^sub>s \<gamma>) x" by (simp add: subst_compose subst_domain_def)
   } ultimately show ?thesis by auto
 qed
 
 lemma subst_eq_if_disjoint_vars_ground:
   fixes \<xi> \<delta>::"('f,'v) subst"
   assumes "subst_domain \<delta> \<inter> subst_domain \<xi> = {}" "ground (subst_range \<xi>)" "ground (subst_range \<delta>)" 
   shows "t \<cdot> \<delta> \<cdot> \<xi> = t \<cdot> \<xi> \<cdot> \<delta>"
 by (metis assms subst_comp_eq_if_disjoint_vars range_vars_alt_def
           subst_subst_compose sup_bot.right_neutral)
 
 lemma subst_img_bound: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv t \<Longrightarrow> range_vars \<delta> \<subseteq> fv (t \<cdot> \<delta>)"
 proof -
   assume "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv t"
   hence "subst_domain \<delta> \<subseteq> fv t" by blast
   thus ?thesis
     by (metis (no_types) range_vars_alt_def le_iff_sup subst_apply_fv_unfold
               subst_apply_fv_union subst_range.simps)
 qed
 
 lemma subst_all_fv_subset: "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M \<Longrightarrow> fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
 proof -
   assume *: "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
   { fix v assume "v \<in> fv t"
     hence "v \<in> fv\<^sub>s\<^sub>e\<^sub>t M" using * by auto
     then obtain t' where "t' \<in> M" "v \<in> fv t'" by auto
     hence "fv (\<theta> v) \<subseteq> fv (t' \<cdot> \<theta>)"
-      by (metis subst_apply_term.simps(1) subst_apply_fv_subset subst_apply_fv_unfold
+      by (metis eval_term.simps(1) subst_apply_fv_subset subst_apply_fv_unfold
                 subtermeq_vars_subset vars_iff_subtermeq) 
     hence "fv (\<theta> v) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)" using \<open>t' \<in> M\<close> by auto
   }
-  thus ?thesis using subst_apply_fv_unfold[of t \<theta>] by auto
+  thus ?thesis by (auto simp: subst_apply_fv_unfold)
 qed
 
 lemma subst_support_if_mgt_subst_idem:
   assumes "\<theta> \<preceq>\<^sub>\<circ> \<delta>" "subst_idem \<theta>"
   shows "\<theta> supports \<delta>"
 proof -
   from \<open>\<theta> \<preceq>\<^sub>\<circ> \<delta>\<close> obtain \<sigma> where \<sigma>: "\<delta> = \<theta> \<circ>\<^sub>s \<sigma>" by blast
-  hence "\<And>v. \<theta> v \<cdot> \<delta> = Var v \<cdot> (\<theta> \<circ>\<^sub>s \<theta> \<circ>\<^sub>s \<sigma>)" by simp
+  hence "\<And>v. \<theta> v \<cdot> \<delta> = Var v \<cdot> (\<theta> \<circ>\<^sub>s \<theta> \<circ>\<^sub>s \<sigma>)" by (simp add: subst_compose)
   hence "\<And>v. \<theta> v \<cdot> \<delta> = Var v \<cdot> (\<theta> \<circ>\<^sub>s \<sigma>)" using \<open>subst_idem \<theta> \<close> unfolding subst_idem_def by simp
   hence "\<And>v. \<theta> v \<cdot> \<delta> = Var v \<cdot> \<delta>" using \<sigma> by simp
   thus "\<theta> supports \<delta>" by simp
 qed
 
 lemma subst_support_iff_mgt_if_subst_idem:
   assumes "subst_idem \<theta>"
   shows "\<theta> \<preceq>\<^sub>\<circ> \<delta> \<longleftrightarrow> \<theta> supports \<delta>"
 proof
   show "\<theta> \<preceq>\<^sub>\<circ> \<delta> \<Longrightarrow> \<theta> supports \<delta>" by (fact subst_support_if_mgt_subst_idem[OF _ \<open>subst_idem \<theta>\<close>])
   show "\<theta> supports \<delta> \<Longrightarrow> \<theta> \<preceq>\<^sub>\<circ> \<delta>" by (fact subst_supportD)
 qed
 
 lemma subst_support_comp:
   fixes \<theta> \<delta> \<I>::"('a,'b) subst"
   assumes "\<theta> supports \<I>" "\<delta> supports \<I>"
   shows "(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>"
-by (metis (no_types) assms subst_agreement subst_apply_term.simps(1) subst_subst_compose)
+by (metis (no_types) assms subst_agreement eval_term.simps(1) subst_subst_compose)
 
 lemma subst_support_comp':
   fixes \<theta> \<delta> \<sigma>::"('a,'b) subst"
   assumes "\<theta> supports \<delta>"
   shows "\<theta> supports (\<delta> \<circ>\<^sub>s \<sigma>)" "\<sigma> supports \<delta> \<Longrightarrow> \<theta> supports (\<sigma> \<circ>\<^sub>s \<delta>)"
 using assms unfolding subst_support_def by (metis subst_compose_assoc, metis)
 
 lemma subst_support_comp_split:
   fixes \<theta> \<delta> \<I>::"('a,'b) subst"
   assumes "(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>"
   shows "subst_domain \<theta> \<inter> range_vars \<theta> = {} \<Longrightarrow> \<theta> supports \<I>"
   and "subst_domain \<theta> \<inter> subst_domain \<delta> = {} \<Longrightarrow> \<delta> supports \<I>"
 proof -
   assume "subst_domain \<theta> \<inter> range_vars \<theta> = {}"
   hence "subst_idem \<theta>" by (metis subst_idemI)
   have "\<theta> \<preceq>\<^sub>\<circ> \<I>" using assms subst_compose_assoc[of \<theta> \<delta> \<I>] unfolding subst_compose_def by metis
   show "\<theta> supports \<I>" using subst_support_if_mgt_subst_idem[OF \<open>\<theta> \<preceq>\<^sub>\<circ> \<I>\<close> \<open>subst_idem \<theta>\<close>] by auto
 next
   assume "subst_domain \<theta> \<inter> subst_domain \<delta> = {}"
   moreover have "\<forall>v \<in> subst_domain (\<theta> \<circ>\<^sub>s \<delta>). (\<theta> \<circ>\<^sub>s \<delta>) v \<cdot> \<I> = \<I> v" using assms by metis
   ultimately have "\<forall>v \<in> subst_domain \<delta>. \<delta> v \<cdot> \<I> = \<I> v"
     using var_not_in_subst_dom unfolding subst_compose_def
-    by (metis IntI empty_iff subst_apply_term.simps(1))
+    by (metis IntI empty_iff eval_term.simps(1))
   thus "\<delta> supports \<I>" by force
 qed
 
 lemma subst_idem_support: "subst_idem \<theta> \<Longrightarrow> \<theta> supports \<theta> \<circ>\<^sub>s \<delta>"
 unfolding subst_idem_def by (metis subst_support_def subst_compose_assoc)
 
 lemma subst_idem_iff_self_support: "subst_idem \<theta> \<longleftrightarrow> \<theta> supports \<theta>"
 using subst_support_def[of \<theta> \<theta>] unfolding subst_idem_def by auto
 
 lemma subterm_subst_neq: "t \<sqsubset> t' \<Longrightarrow> t \<cdot> s \<noteq> t' \<cdot> s"
 by (metis subst_mono_neq)
 
 lemma fv_Fun_subst_neq: "x \<in> fv (Fun f T) \<Longrightarrow> \<sigma> x \<noteq> Fun f T \<cdot> \<sigma>"
 using subterm_subst_neq[of "Var x" "Fun f T"] vars_iff_subterm_or_eq[of x "Fun f T"] by auto
 
 lemma subterm_subst_unfold:
   assumes "t \<sqsubseteq> s \<cdot> \<theta>"
   shows "(\<exists>s'. s' \<sqsubseteq> s \<and> t = s' \<cdot> \<theta>) \<or> (\<exists>x \<in> fv s. t \<sqsubset> \<theta> x)"
 using assms
 proof (induction s)
   case (Fun f T) thus ?case
   proof (cases "t = Fun f T \<cdot> \<theta>")
     case True thus ?thesis using Fun by auto
   next
     case False
     then obtain s' where s': "s' \<in> set T" "t \<sqsubseteq> s' \<cdot> \<theta>" using Fun by auto
     hence "(\<exists>s''. s'' \<sqsubseteq> s' \<and> t = s'' \<cdot> \<theta>) \<or> (\<exists>x \<in> fv s'. t \<sqsubset> \<theta> x)" by (metis Fun.IH)
     thus ?thesis using s'(1) by auto
   qed
 qed simp
 
 lemma subterm_subst_img_subterm:
   assumes "t \<sqsubseteq> s \<cdot> \<theta>" "\<And>s'. s' \<sqsubseteq> s \<Longrightarrow> t \<noteq> s' \<cdot> \<theta>"
   shows "\<exists>w \<in> fv s. t \<sqsubset> \<theta> w"
 using subterm_subst_unfold[OF assms(1)] assms(2) by force
 
 lemma subterm_subst_not_img_subterm:
   assumes "t \<sqsubseteq> s \<cdot> \<I>" "\<not>(\<exists>w \<in> fv s. t \<sqsubseteq> \<I> w)"
   shows "\<exists>f T. Fun f T \<sqsubseteq> s \<and> t = Fun f T \<cdot> \<I>"
 proof (rule ccontr)
   assume "\<not>(\<exists>f T. Fun f T \<sqsubseteq> s \<and> t = Fun f T \<cdot> \<I>)"
   hence "\<And>f T. Fun f T \<sqsubseteq> s \<Longrightarrow> t \<noteq> Fun f T \<cdot> \<I>" by simp
   moreover have "\<And>x. Var x \<sqsubseteq> s \<Longrightarrow> t \<noteq> Var x \<cdot> \<I>"
     using assms(2) vars_iff_subtermeq by force
   ultimately have "\<And>s'. s' \<sqsubseteq> s \<Longrightarrow> t \<noteq> s' \<cdot> \<I>" by (metis "term.exhaust")
   thus False using assms subterm_subst_img_subterm by blast
 qed
 
 lemma subst_apply_img_var:
   assumes "v \<in> fv (t \<cdot> \<delta>)" "v \<notin> fv t"
   obtains w where "w \<in> fv t" "v \<in> fv (\<delta> w)"
 using assms by (induct t) auto
 
 lemma subst_apply_img_var':
   assumes "x \<in> fv (t \<cdot> \<delta>)" "x \<notin> fv t"
   shows "\<exists>y \<in> fv t. x \<in> fv (\<delta> y)"
 by (metis assms subst_apply_img_var)
 
 lemma nth_map_subst:
   fixes \<theta>::"('f,'v) subst" and T::"('f,'v) term list" and i::nat
   shows "i < length T \<Longrightarrow> (map (\<lambda>t. t \<cdot> \<theta>) T) ! i = (T ! i) \<cdot> \<theta>"
 by (fact nth_map)
 
 lemma subst_subterm:
   assumes "Fun f T \<sqsubseteq> t \<cdot> \<theta>"
   shows "(\<exists>S. Fun f S \<sqsubseteq> t \<and> Fun f S \<cdot> \<theta> = Fun f T) \<or>
          (\<exists>s \<in> subst_range \<theta>. Fun f T \<sqsubseteq> s)"
 using assms subterm_subst_not_img_subterm by (cases "\<exists>s \<in> subst_range \<theta>. Fun f T \<sqsubseteq> s") fastforce+
 
 lemma subst_subterm':
   assumes "Fun f T \<sqsubseteq> t \<cdot> \<theta>"
   shows "\<exists>S. length S = length T \<and> (Fun f S \<sqsubseteq> t \<or> (\<exists>s \<in> subst_range \<theta>. Fun f S \<sqsubseteq> s))"
 using subst_subterm[OF assms] by auto
 
 lemma subst_subterm'':
   assumes "s \<in> subterms (t \<cdot> \<theta>)"
   shows "(\<exists>u \<in> subterms t. s = u \<cdot> \<theta>) \<or> s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>)"
 proof (cases s)
   case (Var x)
   thus ?thesis
     using assms subterm_subst_not_img_subterm vars_iff_subtermeq
     by (cases "s = t \<cdot> \<theta>") fastforce+
 next
   case (Fun f T)
   thus ?thesis
-    using subst_subterm[of f T t \<theta>] assms
+    using subst_subterm assms
     by fastforce
 qed
 
 lemma fv_ground_subst_compose:
   assumes "subst_domain \<delta> = subst_domain \<sigma>"
     and "range_vars \<delta> = {}" "range_vars \<sigma> = {}"
   shows "fv (t \<cdot> \<delta> \<circ>\<^sub>s \<theta>) = fv (t \<cdot> \<sigma> \<circ>\<^sub>s \<theta>)"
 proof (induction t)
   case (Var x) show ?case
   proof (cases "x \<in> subst_domain \<delta>")
     case True thus ?thesis
-      using assms unfolding range_vars_alt_def by (auto simp add: subst_apply_fv_empty)
+      using assms unfolding range_vars_alt_def by (auto simp: subst_compose subst_apply_fv_empty)
   next
     case False
     hence "\<delta> x = Var x" "\<sigma> x = Var x" using assms(1) by (blast,blast)
-    thus ?thesis by simp
+    thus ?thesis by (simp add: subst_compose)
   qed
 qed simp
 
 
 subsection \<open>More Small Lemmata\<close>
 lemma funs_term_subst: "funs_term (t \<cdot> \<theta>) = funs_term t \<union> (\<Union>x \<in> fv t. funs_term (\<theta> x))"
 by (induct t) auto
 
 lemma fv\<^sub>s\<^sub>e\<^sub>t_subst_img_eq:
   assumes "X \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (Y - X)) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` Y) - X"
 using assms unfolding range_vars_alt_def by force
 
 lemma subst_Fun_index_eq:
   assumes "i < length T" "Fun f T \<cdot> \<delta> = Fun g T' \<cdot> \<delta>"
   shows "T ! i \<cdot> \<delta> = T' ! i \<cdot> \<delta>"
 proof -
   have "map (\<lambda>x. x \<cdot> \<delta>) T = map (\<lambda>x. x \<cdot> \<delta>) T'" using assms by simp
   thus ?thesis by (metis assms(1) length_map nth_map)
 qed
 
 lemma fv_exists_if_unifiable_and_neq:
   fixes t t'::"('a,'b) term" and \<delta> \<theta>::"('a,'b) subst"
   assumes "t \<noteq> t'" "t \<cdot> \<theta> = t' \<cdot> \<theta>"
   shows "fv t \<union> fv t' \<noteq> {}"
 proof
   assume "fv t \<union> fv t' = {}"
   hence "fv t = {}" "fv t' = {}" by auto
   hence "t \<cdot> \<theta> = t" "t' \<cdot> \<theta> = t'" by auto
   hence "t = t'" using assms(2) by metis
   thus False using assms(1) by auto
 qed
 
 lemma const_subterm_subst: "Fun c [] \<sqsubseteq> t \<Longrightarrow> Fun c [] \<sqsubseteq> t \<cdot> \<sigma>"
 by (induct t) auto
 
 lemma const_subterm_subst_var_obtain:
   assumes "Fun c [] \<sqsubseteq> t \<cdot> \<sigma>" "\<not>Fun c [] \<sqsubseteq> t"
   obtains x where "x \<in> fv t" "Fun c [] \<sqsubseteq> \<sigma> x"
 using assms by (induct t) auto
 
 lemma const_subterm_subst_cases:
   assumes "Fun c [] \<sqsubseteq> t \<cdot> \<sigma>"
   shows "Fun c [] \<sqsubseteq> t \<or> (\<exists>x \<in> fv t. x \<in> subst_domain \<sigma> \<and> Fun c [] \<sqsubseteq> \<sigma> x)"
 proof (cases "Fun c [] \<sqsubseteq> t")
   case False
   then obtain x where "x \<in> fv t" "Fun c [] \<sqsubseteq> \<sigma> x"
     using const_subterm_subst_var_obtain[OF assms] by moura
   thus ?thesis by (cases "x \<in> subst_domain \<sigma>") auto
 qed simp
 
 lemma const_subterms_subst_cases:
   assumes "Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>"
   shows "Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<or> (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. x \<in> subst_domain \<sigma> \<and> Fun c [] \<sqsubseteq> \<sigma> x)"
 using assms const_subterm_subst_cases[of c _ \<sigma>] by auto
 
 lemma const_subterms_subst_cases':
   assumes "Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>"
   shows "Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<or> Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t subst_range \<sigma>"
 using const_subterms_subst_cases[OF assms] by auto
 
 lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_fv_subset:
   assumes "x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
   shows "fv (\<theta> x) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)"
   using assms
 proof (induction F)
   case (Cons f F)
   then obtain t t' where f: "f = (t,t')" by (metis surj_pair)
   show ?case
   proof (cases "x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F")
     case True thus ?thesis
       using Cons.IH
       unfolding subst_apply_pairs_def
       by auto
   next
     case False
     hence "x \<in> fv t \<union> fv t'" using Cons.prems f by simp
     hence "fv (\<theta> x) \<subseteq> fv (t \<cdot> \<theta>) \<union> fv (t' \<cdot> \<theta>)" using fv_subst_subset[of x] by force
     thus ?thesis using f unfolding subst_apply_pairs_def by auto
   qed
 qed simp
 
 lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_step_subst: "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
 proof (induction F)
   case (Cons f F)
   obtain t t' where "f = (t,t')" by moura
   thus ?case
     using Cons
     by (simp add: subst_apply_pairs_def subst_apply_fv_unfold)
 qed (simp_all add: subst_apply_pairs_def)
 
 lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_obtain_var:
   fixes \<delta>::"('a,'b) subst"
   assumes "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 \<delta>)"
   shows "\<exists>y \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. x \<in> fv (\<delta> y)"
   using assms 
 proof (induction F)
   case (Cons f F)
   then obtain t s where f: "f = (t,s)" by (metis surj_pair)
 
   from Cons.IH show ?case
   proof (cases "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 \<delta>)")
     case False
     hence "x \<in> fv (t \<cdot> \<delta>) \<or> x \<in> fv (s \<cdot> \<delta>)"
       using f Cons.prems
       by (simp add: subst_apply_pairs_def)
     hence "(\<exists>y \<in> fv t. x \<in> fv (\<delta> y)) \<or> (\<exists>y \<in> fv s. x \<in> fv (\<delta> y))" by (metis fv_subst_obtain_var)
     thus ?thesis using f by (auto simp add: subst_apply_pairs_def)
   qed (auto simp add: Cons.IH)
 qed (simp add: subst_apply_pairs_def)
 
 lemma pair_subst_ident[intro]: "(fv t \<union> fv t') \<inter> subst_domain \<theta> = {} \<Longrightarrow> (t,t') \<cdot>\<^sub>p \<theta> = (t,t')"
 by auto
 
 lemma pairs_substI[intro]:
   assumes "subst_domain \<theta> \<inter> (\<Union>(s,t) \<in> M. fv s \<union> fv t) = {}"
   shows "M \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta> = M"
 proof -
   { fix m assume M: "m \<in> M"
     then obtain s t where m: "m = (s,t)" by (metis surj_pair)
     hence "(fv s \<union> fv t) \<inter> subst_domain \<theta> = {}" using assms M by auto
     hence "m \<cdot>\<^sub>p \<theta> = m" using m by auto
   } thus ?thesis by (simp add: image_cong) 
 qed
 
 lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F))"
 proof (induction F)
   case (Cons g G)
   obtain t t' where "g = (t,t')" by (metis surj_pair)
   thus ?case
     using Cons.IH
     by (simp add: subst_apply_pairs_def subst_apply_fv_unfold)
 qed (simp add: subst_apply_pairs_def)
 
 lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_subset:
   assumes "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>"
   shows  "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<subseteq> subst_domain \<sigma> \<union> subst_domain \<delta>"
   using assms
 proof (induction F)
   case (Cons g G)
   hence IH: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \<subseteq> subst_domain \<sigma> \<union> subst_domain \<delta>"
     by (simp add: subst_apply_pairs_def)
   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 (simp_all add: subst_apply_pairs_def)
   hence "fv t \<subseteq> subst_domain \<sigma> \<union> subst_domain \<delta>" "fv t' \<subseteq> subst_domain \<sigma> \<union> subst_domain \<delta>"
-    using subst_apply_fv_unfold[of _ \<delta>] by force+
+    unfolding subst_apply_fv_unfold by force+
   thus ?case using IH g by (simp add: subst_apply_pairs_def)
 qed (simp add: subst_apply_pairs_def)
 
 lemma pairs_subst_comp: "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta> \<circ>\<^sub>s \<theta> = ((F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)"
 by (induct F) (auto simp add: subst_apply_pairs_def)
 
 lemma pairs_substI'[intro]:
   "subst_domain \<theta> \<inter> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = {} \<Longrightarrow> F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta> = F"
 by (induct F) (force simp add: subst_apply_pairs_def)+
 
 lemma subst_pair_compose[simp]: "d \<cdot>\<^sub>p (\<delta> \<circ>\<^sub>s \<I>) = d \<cdot>\<^sub>p \<delta> \<cdot>\<^sub>p \<I>"
 proof -
   obtain t s where "d = (t,s)" by moura
   thus ?thesis by auto
 qed
 
 lemma subst_pairs_compose[simp]: "D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t (\<delta> \<circ>\<^sub>s \<I>) = D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<delta> \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>"
 by auto
 
 lemma subst_apply_pair_pair: "(t, s) \<cdot>\<^sub>p \<I> = (t \<cdot> \<I>, s \<cdot> \<I>)"
 by (rule prod.case)
 
 lemma subst_apply_pairs_nil[simp]: "[] \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta> = []"
 unfolding subst_apply_pairs_def by simp
 
 lemma subst_apply_pairs_singleton[simp]: "[(t,s)] \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta> = [(t \<cdot> \<delta>,s \<cdot> \<delta>)]"
 unfolding subst_apply_pairs_def by simp
 
 lemma subst_apply_pairs_Var[iff]: "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s Var = F" by (simp add: subst_apply_pairs_def)
 
 lemma subst_apply_pairs_pset_subst: "set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>) = set F \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>"
 unfolding subst_apply_pairs_def by force
 
 lemma subst_subterms:
   "t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<Longrightarrow> t \<cdot> \<theta> \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using subst_mono_neq by fastforce
 
 lemma subst_subterms_fv:
   "x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<Longrightarrow> \<theta> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using fv_subterms_substI by fastforce
 
 lemma subst_subterms_Var:
   "Var x \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<Longrightarrow> \<theta> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using subst_subterms_fv[of x M \<theta>] by force
 
 lemma fv_subset_subterms_subset:
   "\<delta> ` fv\<^sub>s\<^sub>e\<^sub>t M \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
 using subst_subterms_fv by fast
 
 lemma subst_const_swap_eq:
   fixes \<theta> \<sigma>::"('a,'b) subst"
   assumes t: "t \<cdot> \<theta> = s \<cdot> \<theta>"
     and \<theta>: "\<forall>x \<in> fv t \<union> fv s. \<exists>k. \<theta> x = Fun k []"
            "\<forall>x \<in> fv t. \<not>(\<theta> x \<sqsubseteq> s)"
            "\<forall>x \<in> fv s. \<not>(\<theta> x \<sqsubseteq> t)"
     and \<sigma>_def: "\<sigma> \<equiv> \<lambda>x. p (\<theta> x)"
   shows "t \<cdot> \<sigma> = s \<cdot> \<sigma>"
 using t \<theta>
 proof (induction t arbitrary: s)
   case (Var x) thus ?case unfolding \<sigma>_def by (cases s) auto
 next
   case (Fun f ts)
   note prems = Fun.prems
 
   obtain ss where s: "s = Fun f ss" and ss: "ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta> = ss \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>" using prems by (cases s) auto
 
   have "ts ! i \<cdot> \<sigma> = ss ! i \<cdot> \<sigma>" when i: "i < length ts" for i
   proof -
     have *: "ts ! i \<in> set ts" using i by simp
     have **: "ts ! i \<cdot> \<theta> = ss ! i \<cdot> \<theta>" using i prems(1) unfolding s by (metis subst_Fun_index_eq)
     have ***: "ss ! i \<in> set ss" using i ss by (metis length_map nth_mem)
 
     show ?thesis using Fun.IH[OF * **] prems(2,3,4) * *** unfolding s by auto
   qed
   hence IH: "ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma> = ss \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma>"
     using ss by (metis (mono_tags, lifting) length_map nth_equalityI nth_map)
 
   show ?case using IH unfolding s by auto
 qed
 
 lemma term_subst_set_eq:
   assumes "\<And>x. x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<Longrightarrow> \<delta> x = \<sigma> x"
   shows "M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> = M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>"
 proof -
   have "t \<cdot> \<delta> = t \<cdot> \<sigma>" when "t \<in> M" for t
     using that assms term_subst_eq[of _ \<delta> \<sigma>] by fastforce
   thus ?thesis by simp
 qed
 
 lemma subst_const_swap_eq':
   assumes "t \<cdot> \<theta> = s \<cdot> \<theta>"
     and "\<forall>x \<in> fv t \<union> fv s. \<theta> x = \<sigma> x \<or> \<not>(\<theta> x \<sqsubseteq> t) \<and> \<not>(\<theta> x \<sqsubseteq> s)" (is "?A t s")
     and "\<forall>x \<in> fv t \<union> fv s. \<exists>c. \<theta> x = Fun c []" (is "?B t s")
     and "\<forall>x \<in> fv t \<union> fv s. \<exists>c. \<sigma> x = Fun c []" (is "?C t s")
     and "\<forall>x \<in> fv t \<union> fv s. \<forall>y \<in> fv t \<union> fv s. \<theta> x = \<theta> y \<longleftrightarrow> \<sigma> x = \<sigma> y" (is "?D t s")
   shows "t \<cdot> \<sigma> = s \<cdot> \<sigma>"
 using assms
 proof (induction t arbitrary: s)
   case (Var x)
   note prems = Var.prems
   have "(\<exists>y. s = Var y) \<or> (\<exists>c. s = Fun c [])" using prems(1,3) by (cases s) auto
   thus ?case
   proof
     assume "\<exists>y. s = Var y"
     then obtain y where y: "s = Var y" by blast
     hence "\<theta> x = \<theta> y" using prems(1) by simp
     hence "\<sigma> x = \<sigma> y" using prems(5) y by fastforce
     thus ?thesis using y by force
   next
     assume "\<exists>c. s = Fun c []"
     then obtain c where c: "s = Fun c []" by blast
     have "\<theta> x = \<sigma> x \<or> \<not>(\<theta> x \<sqsubseteq> Fun c [])" using prems(2) c by auto
     thus ?thesis using prems(1) c by simp
   qed
 next
   case (Fun f ts)
   note prems = Fun.prems
   note IH = Fun.IH
 
   show ?case
   proof (cases s)
     case (Var x)
     note s = this
     hence ts: "ts = []" using prems(1,3) by auto
     show ?thesis using prems unfolding s ts by auto
   next
     case (Fun g ss)
     note s = this
     hence g: "f = g" using prems(1) by fastforce
 
     have ss: "ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta> = ss \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>" using prems(1) unfolding s by (cases s) auto
 
     have len: "length ts = length ss" using ss by (metis length_map)
 
     have "ts ! i \<cdot> \<sigma> = ss ! i \<cdot> \<sigma>" when i: "i < length ts" for i
     proof -
       have 0: "ts ! i \<in> set ts" using i by simp
       have 1: "ts ! i \<cdot> \<theta> = ss ! i \<cdot> \<theta>" using i prems(1) unfolding s by (metis subst_Fun_index_eq)
       have 2: "ss ! i \<in> set ss" using i by (metis len nth_mem)
 
       have 3: "fv (ts ! i) \<subseteq> fv (Fun f ts)" "fv (ss ! i) \<subseteq> fv (Fun g ss)"
               "subterms (ts ! i) \<subseteq> subterms (Fun f ts)" "subterms (ss ! i) \<subseteq> subterms (Fun g ss)"
         subgoal by (meson index_Fun_fv_subset i)
         subgoal by (metis index_Fun_fv_subset i len)
         subgoal using ss i by fastforce
         subgoal using ss i len by fastforce
         done
       
       have 4: "?A (ts ! i) (ss ! i)" "?B (ts ! i) (ss ! i)"
               "?C (ts ! i) (ss ! i)" "?D (ts ! i) (ss ! i)"
         subgoal using 3 prems(2) unfolding s by blast
         subgoal using 3(1,2) prems(3) unfolding s by blast
         subgoal using 3(1,2) prems(4) unfolding s by blast
         subgoal using 3(1,2) prems(5) unfolding s by blast
         done
         
       thus ?thesis using IH[OF 0 1 4] prems(2-) 0 2 unfolding s by blast
     qed
     hence "ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma> = ss \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma>" by (metis (mono_tags, lifting) ss length_map nth_equalityI nth_map)
     thus ?thesis unfolding s g by auto
   qed
 qed
 
 lemma subst_const_swap_eq_mem:
   assumes "t \<cdot> \<theta> \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
     and "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. \<theta> x = \<sigma> x \<or> \<not>(\<theta> x \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t insert t M)"
     and "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. \<exists>c. \<theta> x = Fun c []" (is "?B (fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t)")
     and "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. \<exists>c. \<sigma> x = Fun c []" (is "?C (fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t)")
     and "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. \<forall>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t. \<theta> x = \<theta> y \<longleftrightarrow> \<sigma> x = \<sigma> y" (is "?D (fv\<^sub>s\<^sub>e\<^sub>t M \<union> fv t)")
   shows "t \<cdot> \<sigma> \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>"
 proof -
   let ?A = "\<lambda>t s. \<forall>x \<in> fv t \<union> fv s. \<theta> x = \<sigma> x \<or> \<not>(\<theta> x \<sqsubseteq> t) \<and> \<not>(\<theta> x \<sqsubseteq> s)" 
 
   obtain s where s: "s \<in> M" "s \<cdot> \<theta> = t \<cdot> \<theta>" using assms(1) by fastforce
 
   have 0: "fv s \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M" "subterms s \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (insert t M)"
           "subterms t \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (insert t M)"
     using s(1) by auto
 
   have 1: "?A s t" "?B (fv s \<union> fv t)" "?C (fv s \<union> fv t)" "?D (fv s \<union> fv t)"
     subgoal using assms(2) 0 by fast
     subgoal using assms(3) 0 by blast
     subgoal using assms(4) 0 by blast
     subgoal using assms(5) 0 by blast
     done
 
   have "s \<cdot> \<sigma> = t \<cdot> \<sigma>" by (rule subst_const_swap_eq'[OF s(2) 1])
   thus ?thesis by (metis s(1) imageI)
 qed
 
 
 subsection \<open>Finite Substitutions\<close>
 inductive_set fsubst::"('a,'b) subst set" where
   fvar:     "Var \<in> fsubst"
 | FUpdate:  "\<lbrakk>\<theta> \<in> fsubst; v \<notin> subst_domain \<theta>; t \<noteq> Var v\<rbrakk> \<Longrightarrow> \<theta>(v := t) \<in> fsubst"
 
 lemma finite_dom_iff_fsubst:
   "finite (subst_domain \<theta>) \<longleftrightarrow> \<theta> \<in> fsubst"
 proof
   assume "finite (subst_domain \<theta>)" thus "\<theta> \<in> fsubst"
   proof (induction "subst_domain \<theta>" arbitrary: \<theta> rule: finite.induct)
     case emptyI
     hence "\<theta> = Var" using empty_dom_iff_empty_subst by metis
     thus ?case using fvar by simp
   next
     case (insertI \<theta>'\<^sub>d\<^sub>o\<^sub>m v) thus ?case
     proof (cases "v \<in> \<theta>'\<^sub>d\<^sub>o\<^sub>m")
       case True
       hence "\<theta>'\<^sub>d\<^sub>o\<^sub>m = subst_domain \<theta>" using \<open>insert v \<theta>'\<^sub>d\<^sub>o\<^sub>m = subst_domain \<theta>\<close> by auto
       thus ?thesis using insertI.hyps(2) by metis
     next
       case False
       let ?\<theta>' = "\<lambda>w. if w \<in> \<theta>'\<^sub>d\<^sub>o\<^sub>m then \<theta> w else Var w"
       have "subst_domain ?\<theta>' = \<theta>'\<^sub>d\<^sub>o\<^sub>m"
         using \<open>v \<notin> \<theta>'\<^sub>d\<^sub>o\<^sub>m\<close> \<open>insert v \<theta>'\<^sub>d\<^sub>o\<^sub>m = subst_domain \<theta>\<close>
         by (auto simp add: subst_domain_def)
       hence "?\<theta>' \<in> fsubst" using insertI.hyps(2) by simp
       moreover have "?\<theta>'(v := \<theta> v) = (\<lambda>w. if w \<in> insert v \<theta>'\<^sub>d\<^sub>o\<^sub>m then \<theta> w else Var w)" by auto
       hence "?\<theta>'(v := \<theta> v) = \<theta>"
         using \<open>insert v \<theta>'\<^sub>d\<^sub>o\<^sub>m = subst_domain \<theta>\<close>
         by (auto simp add: subst_domain_def)
       ultimately show ?thesis
         using FUpdate[of ?\<theta>' v "\<theta> v"] False insertI.hyps(3)
         by (auto simp add: subst_domain_def)
     qed
   qed
 next
   assume "\<theta> \<in> fsubst" thus "finite (subst_domain \<theta>)"
   by (induct \<theta>, simp, metis subst_dom_insert_finite)
 qed
 
 lemma fsubst_induct[case_names fvar FUpdate, induct set: finite]:
   assumes "finite (subst_domain \<delta>)" "P Var"
   and "\<And>\<theta> v t. \<lbrakk>finite (subst_domain \<theta>); v \<notin> subst_domain \<theta>; t \<noteq> Var v; P \<theta>\<rbrakk> \<Longrightarrow> P (\<theta>(v := t))"
   shows "P \<delta>"
 using assms finite_dom_iff_fsubst fsubst.induct by metis
 
 lemma fun_upd_fsubst: "s(v := t) \<in> fsubst \<longleftrightarrow> s \<in> fsubst"
 using subst_dom_insert_finite[of s] finite_dom_iff_fsubst by blast 
 
 lemma finite_img_if_fsubst: "s \<in> fsubst \<Longrightarrow> finite (subst_range s)"
 using finite_dom_iff_fsubst finite_subst_img_if_finite_dom' by blast
 
 
 subsection \<open>Unifiers and Most General Unifiers (MGUs)\<close>
 
 abbreviation Unifier::"('f,'v) subst \<Rightarrow> ('f,'v) term \<Rightarrow> ('f,'v) term \<Rightarrow> bool" where
   "Unifier \<sigma> t u \<equiv> (t \<cdot> \<sigma> = u \<cdot> \<sigma>)"
 
 abbreviation MGU::"('f,'v) subst \<Rightarrow> ('f,'v) term \<Rightarrow> ('f,'v) term \<Rightarrow> bool" where
   "MGU \<sigma> t u \<equiv> Unifier \<sigma> t u \<and> (\<forall>\<theta>. Unifier \<theta> t u \<longrightarrow> \<sigma> \<preceq>\<^sub>\<circ> \<theta>)"
 
 lemma MGUI[intro]:
   shows "\<lbrakk>t \<cdot> \<sigma> = u \<cdot> \<sigma>; \<And>\<theta>::('f,'v) subst. t \<cdot> \<theta> = u \<cdot> \<theta> \<Longrightarrow> \<sigma> \<preceq>\<^sub>\<circ> \<theta>\<rbrakk> \<Longrightarrow> MGU \<sigma> t u"
 by auto
 
 lemma UnifierD[dest]:
   fixes \<sigma>::"('f,'v) subst" and f g::'f and X Y::"('f,'v) term list"
   assumes "Unifier \<sigma> (Fun f X) (Fun g Y)"
   shows "f = g" "length X = length Y"
 proof -
   from assms show "f = g" by auto
 
   from assms have "Fun f X \<cdot> \<sigma> = Fun g Y \<cdot> \<sigma>" by auto
   hence "length (map (\<lambda>x. x \<cdot> \<sigma>) X) = length (map (\<lambda>x. x \<cdot> \<sigma>) Y)" by auto
   thus "length X = length Y" by auto
 qed
 
 lemma MGUD[dest]:
   fixes \<sigma>::"('f,'v) subst" and f g::'f and X Y::"('f,'v) term list"
   assumes "MGU \<sigma> (Fun f X) (Fun g Y)"
   shows "f = g" "length X = length Y"
-using assms by (auto intro!: UnifierD[of f X \<sigma> g Y])
+using assms by (auto dest: map_eq_imp_length_eq)
 
 lemma MGU_sym[sym]: "MGU \<sigma> s t \<Longrightarrow> MGU \<sigma> t s" by auto
 lemma Unifier_sym[sym]: "Unifier \<sigma> s t \<Longrightarrow> Unifier \<sigma> t s" by auto
 
 lemma MGU_nil: "MGU Var s t \<longleftrightarrow> s = t" by fastforce
 
 lemma Unifier_comp: "Unifier (\<theta> \<circ>\<^sub>s \<delta>) t u \<Longrightarrow> Unifier \<delta> (t \<cdot> \<theta>) (u \<cdot> \<theta>)"
 by simp
 
 lemma Unifier_comp': "Unifier \<delta> (t \<cdot> \<theta>) (u \<cdot> \<theta>) \<Longrightarrow> Unifier (\<theta> \<circ>\<^sub>s \<delta>) t u"
 by simp
 
 lemma Unifier_excludes_subterm:
   assumes \<theta>: "Unifier \<theta> t u"
   shows "\<not>t \<sqsubset> u"
 proof
   assume "t \<sqsubset> u"
   hence "t \<cdot> \<theta> \<sqsubset> u \<cdot> \<theta>" using subst_mono_neq by metis
   hence "t \<cdot> \<theta> \<noteq> u \<cdot> \<theta>" by simp
   moreover from \<theta> have "t \<cdot> \<theta> = u \<cdot> \<theta>" by auto
   ultimately show False ..
 qed
 
 lemma MGU_is_Unifier: "MGU \<sigma> t u \<Longrightarrow> Unifier \<sigma> t u" by (rule conjunct1)
 
 lemma MGU_Var1:
   assumes "\<not>Var v \<sqsubset> t"
   shows "MGU (Var(v := t)) (Var v) t"
 proof (intro MGUI exI)
   show "Var v \<cdot> (Var(v := t)) = t \<cdot> (Var(v := t))" using assms subst_no_occs by fastforce
 next
   fix \<theta>::"('a,'b) subst" assume th: "Var v \<cdot> \<theta> = t \<cdot> \<theta>" 
   show "\<theta> = (Var(v := t)) \<circ>\<^sub>s \<theta>" 
-  proof
-    fix s show "s \<cdot> \<theta> = s \<cdot> ((Var(v := t)) \<circ>\<^sub>s \<theta>)" using th by (induct s) auto
-  qed
+    using th by (auto simp: subst_compose_def)
 qed
 
 lemma MGU_Var2: "v \<notin> fv t \<Longrightarrow> MGU (Var(v := t)) (Var v) t"
 by (metis (no_types) MGU_Var1 vars_iff_subterm_or_eq)
 
 lemma MGU_Var3: "MGU Var (Var v) (Var w) \<longleftrightarrow> v = w" by fastforce
 
 lemma MGU_Const1: "MGU Var (Fun c []) (Fun d []) \<longleftrightarrow> c = d" by fastforce
 
 lemma MGU_Const2: "MGU \<theta> (Fun c []) (Fun d []) \<Longrightarrow> c = d" by auto
 
 lemma MGU_Fun:
   assumes "MGU \<theta> (Fun f X) (Fun g Y)"
   shows "f = g" "length X = length Y"
 proof -
   let ?F = "\<lambda>\<theta> X. map (\<lambda>x. x \<cdot> \<theta>) X"
   from assms have
     "\<lbrakk>f = g; ?F \<theta> X = ?F \<theta> Y; \<forall>\<theta>'. f = g \<and> ?F \<theta>' X = ?F \<theta>' Y \<longrightarrow> \<theta> \<preceq>\<^sub>\<circ> \<theta>'\<rbrakk> \<Longrightarrow> length X = length Y"
     using map_eq_imp_length_eq by auto
   thus "f = g" "length X = length Y" using assms by auto
 qed
 
 lemma Unifier_Fun:
   assumes "Unifier \<theta> (Fun f (x#X)) (Fun g (y#Y))"
   shows "Unifier \<theta> x y" "Unifier \<theta> (Fun f X) (Fun g Y)"
 using assms by simp_all
 
 lemma Unifier_subst_idem_subst: 
   "subst_idem r \<Longrightarrow> Unifier s (t \<cdot> r) (u \<cdot> r) \<Longrightarrow> Unifier (r \<circ>\<^sub>s s) (t \<cdot> r) (u \<cdot> r)"
 by (metis (no_types, lifting) subst_idem_def subst_subst_compose)
 
 lemma subst_idem_comp:
   "subst_idem r \<Longrightarrow> Unifier s (t \<cdot> r) (u \<cdot> r) \<Longrightarrow> 
     (\<And>q. Unifier q (t \<cdot> r) (u \<cdot> r) \<Longrightarrow> s \<circ>\<^sub>s q = q) \<Longrightarrow>
     subst_idem (r \<circ>\<^sub>s s)"
 by (frule Unifier_subst_idem_subst, blast, metis subst_idem_def subst_compose_assoc)
 
 lemma Unifier_mgt: "\<lbrakk>Unifier \<delta> t u; \<delta> \<preceq>\<^sub>\<circ> \<theta>\<rbrakk> \<Longrightarrow> Unifier \<theta> t u" by auto
 
 lemma Unifier_support: "\<lbrakk>Unifier \<delta> t u; \<delta> supports \<theta>\<rbrakk> \<Longrightarrow> Unifier \<theta> t u"
 using subst_supportD Unifier_mgt by metis
 
 lemma MGU_mgt: "\<lbrakk>MGU \<sigma> t u; MGU \<delta> t u\<rbrakk> \<Longrightarrow> \<sigma> \<preceq>\<^sub>\<circ> \<delta>" by auto
 
 lemma Unifier_trm_fv_bound:
   "\<lbrakk>Unifier s t u; v \<in> fv t\<rbrakk> \<Longrightarrow> v \<in> subst_domain s \<union> range_vars s \<union> fv u"
 proof (induction t arbitrary: s u)
   case (Fun f X)
   hence "v \<in> fv (u \<cdot> s) \<or> v \<in> subst_domain s" by (metis subst_not_dom_fixed)
   thus ?case by (metis (no_types) Un_iff contra_subsetD subst_sends_fv_to_img)
 qed (metis (no_types) UnI1 UnI2 subsetCE no_var_subterm subst_sends_dom_to_img
             subst_to_var_is_var trm_subst_ident' vars_iff_subterm_or_eq)
 
 lemma Unifier_rm_var: "\<lbrakk>Unifier \<theta> s t; v \<notin> fv s \<union> fv t\<rbrakk> \<Longrightarrow> Unifier (rm_var v \<theta>) s t"
 by (auto simp add: repl_invariance)
 
 lemma Unifier_ground_rm_vars:
   assumes "ground (subst_range s)" "Unifier (rm_vars X s) t t'"
   shows "Unifier s t t'"
 by (rule Unifier_support[OF assms(2) rm_vars_ground_supports[OF assms(1)]])
 
 lemma Unifier_dom_restrict:
   assumes "Unifier s t t'" "fv t \<union> fv t' \<subseteq> S"
   shows "Unifier (rm_vars (UNIV - S) s) t t'"
 proof -
   let ?s = "rm_vars (UNIV - S) s"
   show ?thesis using term_subst_eq_conv[of t s ?s] term_subst_eq_conv[of t' s ?s] assms by auto
 qed
 
 
 subsection \<open>Well-formedness of Substitutions and Unifiers\<close>
 inductive_set wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set::"('a,'b) subst set" where
   Empty[simp]: "Var \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set"
 | Insert[simp]:
     "\<lbrakk>\<theta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set; v \<notin> subst_domain \<theta>;
       v \<notin> range_vars \<theta>; fv t \<inter> (insert v (subst_domain \<theta>)) = {}\<rbrakk>
       \<Longrightarrow> \<theta>(v := t) \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set"
 
 definition wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t::"('a,'b) subst \<Rightarrow> bool" where
   "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<equiv> subst_domain \<theta> \<inter> range_vars \<theta> = {} \<and> finite (subst_domain \<theta>)"
 
 definition wf\<^sub>M\<^sub>G\<^sub>U::"('a,'b) subst \<Rightarrow> ('a,'b) term \<Rightarrow> ('a,'b) term \<Rightarrow> bool" where
   "wf\<^sub>M\<^sub>G\<^sub>U \<theta> s t \<equiv> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> MGU \<theta> s t \<and> subst_domain \<theta> \<union> range_vars \<theta> \<subseteq> fv s \<union> fv t"
 
 lemma wf_subst_subst_idem: "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> subst_idem \<theta>" using subst_idemI[of \<theta>] unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by fast
 
 lemma wf_subst_properties: "\<theta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set = wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
 proof
   show "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> \<theta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set" unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
   proof -
     assume "subst_domain \<theta> \<inter> range_vars \<theta> = {} \<and> finite (subst_domain \<theta>)"
     hence "finite (subst_domain \<theta>)" "subst_domain \<theta> \<inter> range_vars \<theta> = {}"
       by auto
     thus "\<theta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set"
     proof (induction \<theta> rule: fsubst_induct)
       case fvar thus ?case by simp
     next
       case (FUpdate \<delta> v t)
       have "subst_domain \<delta> \<subseteq> subst_domain (\<delta>(v := t))" "range_vars \<delta> \<subseteq> range_vars (\<delta>(v := t))"
         using FUpdate.hyps(2,3) subst_img_update
         unfolding range_vars_alt_def by (fastforce simp add: subst_domain_def)+
       hence "subst_domain \<delta> \<inter> range_vars \<delta> = {}" using FUpdate.prems(1) by blast
       hence "\<delta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set" using FUpdate.IH by metis
 
       have *: "range_vars (\<delta>(v := t)) = range_vars \<delta> \<union> fv t"
         using FUpdate.hyps(2) subst_img_update[OF _ FUpdate.hyps(3)]
         by fastforce
       hence "fv t \<inter> insert v (subst_domain \<delta>) = {}"
         using FUpdate.prems subst_dom_update2[OF FUpdate.hyps(3)] by blast
       moreover have "subst_domain (\<delta>(v := t)) = insert v (subst_domain \<delta>)"
         by (meson FUpdate.hyps(3) subst_dom_update2)
       hence "v \<notin> range_vars \<delta>" using FUpdate.prems * by blast
       ultimately show ?case using Insert[OF \<open>\<delta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set\<close> \<open>v \<notin> subst_domain \<delta>\<close>] by metis
     qed
   qed
 
   show "\<theta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set \<Longrightarrow> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
   proof (induction \<theta> rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set.induct)
     case Empty thus ?case by simp
   next
     case (Insert \<sigma> v t)
     hence 1: "subst_domain \<sigma> \<inter> range_vars \<sigma> = {}" by simp
     hence 2: "subst_domain (\<sigma>(v := t)) \<inter> range_vars \<sigma> = {}"
       using Insert.hyps(3) by (auto simp add: subst_domain_def)
     have 3: "fv t \<inter> subst_domain (\<sigma>(v := t)) = {}"
       using Insert.hyps(4) by (auto simp add: subst_domain_def)
     have 4: "\<sigma> v = Var v" using \<open>v \<notin> subst_domain \<sigma>\<close> by (simp add: subst_domain_def)
   
     from Insert.IH have "finite (subst_domain \<sigma>)" by simp
     hence 5: "finite (subst_domain (\<sigma>(v := t)))" using subst_dom_insert_finite[of \<sigma>] by simp
   
     have "subst_domain (\<sigma>(v := t)) \<inter> range_vars (\<sigma>(v := t)) = {}"
     proof (cases "t = Var v")
       case True
       hence "range_vars (\<sigma>(v := t)) = range_vars \<sigma>"
         using 4 fun_upd_triv term.inject(1)
         unfolding range_vars_alt_def by (auto simp add: subst_domain_def) 
       thus "subst_domain (\<sigma>(v := t)) \<inter> range_vars (\<sigma>(v := t)) = {}"
         using 1 2 3 by auto
     next
       case False
       hence "range_vars (\<sigma>(v := t)) = fv t \<union> (range_vars \<sigma>)"
         using 4 subst_img_update[of \<sigma> v] by auto
       thus "subst_domain (\<sigma>(v := t)) \<inter> range_vars (\<sigma>(v := t)) = {}" using 1 2 3 by blast
     qed
     thus ?case using 5 by blast 
   qed
 qed
 
 lemma wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct[consumes 1, case_names Empty Insert]:
   assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "P Var"
   and "\<And>\<theta> v t. \<lbrakk>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>; P \<theta>; v \<notin> subst_domain \<theta>; v \<notin> range_vars \<theta>;
                 fv t \<inter> insert v (subst_domain \<theta>) = {}\<rbrakk>
                 \<Longrightarrow> P (\<theta>(v := t))"
   shows "P \<delta>"
 proof -
   from assms(1,3) wf_subst_properties have
     "\<delta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set"
     "\<And>\<theta> v t. \<lbrakk>\<theta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set; P \<theta>; v \<notin> subst_domain \<theta>; v \<notin> range_vars \<theta>;
               fv t \<inter> insert v (subst_domain \<theta>) = {}\<rbrakk>
               \<Longrightarrow> P (\<theta>(v := t))"
     by blast+
   thus "P \<delta>" using wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set.induct assms(2) by blast
 qed  
 
 lemma wf_subst_fsubst: "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<Longrightarrow> \<delta> \<in> fsubst"
 unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def using finite_dom_iff_fsubst by blast 
 
 lemma wf_subst_nil: "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp
 
 lemma wf_MGU_nil: "MGU Var s t \<Longrightarrow> wf\<^sub>M\<^sub>G\<^sub>U Var s t"
 using wf_subst_nil subst_domain_Var range_vars_Var
 unfolding wf\<^sub>M\<^sub>G\<^sub>U_def by fast
 
 lemma wf_MGU_dom_bound: "wf\<^sub>M\<^sub>G\<^sub>U \<theta> s t \<Longrightarrow> subst_domain \<theta> \<subseteq> fv s \<union> fv t" unfolding wf\<^sub>M\<^sub>G\<^sub>U_def by blast
 
 lemma wf_subst_single:
   assumes "v \<notin> fv t" "\<sigma> v = t" "\<And>w. v \<noteq> w \<Longrightarrow> \<sigma> w = Var w"
   shows "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>"
 proof -
   have *: "subst_domain \<sigma> = {v}" by (metis subst_fv_dom_img_single(1)[OF assms])
 
   have "subst_domain \<sigma> \<inter> range_vars \<sigma> = {}"
     using * assms subst_fv_dom_img_single(2)
     by (metis inf_bot_left insert_disjoint(1))
   moreover have "finite (subst_domain \<sigma>)" using * by simp
   ultimately show ?thesis by (metis wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
 qed
 
 lemma wf_subst_reduction:
   "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t s \<Longrightarrow> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (rm_var v s)"
 proof -
   assume "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t s"
   moreover have "subst_domain (rm_var v s) \<subseteq> subst_domain s" by (auto simp add: subst_domain_def)
   moreover have "range_vars (rm_var v s) \<subseteq> range_vars s"
     unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
   ultimately have "subst_domain (rm_var v s) \<inter> range_vars (rm_var v s) = {}"
     by (meson compl_le_compl_iff disjoint_eq_subset_Compl subset_trans wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
   moreover have "finite (subst_domain (rm_var v s))"
     using \<open>subst_domain (rm_var v s) \<subseteq> subst_domain s\<close> \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t s\<close> rev_finite_subset
     unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by blast
   ultimately show "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (rm_var v s)" by (metis wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
 qed
 
 lemma wf_subst_compose:
   assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>1" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>2"
     and "subst_domain \<theta>1 \<inter> subst_domain \<theta>2 = {}"
     and "subst_domain \<theta>1 \<inter> range_vars \<theta>2 = {}"
   shows "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta>1 \<circ>\<^sub>s \<theta>2)"
 using assms
 proof (induction \<theta>1 rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct)
   case Empty thus ?case unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp
 next
   case (Insert \<sigma>1 v t)
   have "t \<noteq> Var v" using Insert.hyps(4) by auto
   hence dom1v_unfold: "subst_domain (\<sigma>1(v := t)) = insert v (subst_domain \<sigma>1)"
     using subst_dom_update2 by metis
   hence doms_disj: "subst_domain \<sigma>1 \<inter> subst_domain \<theta>2 = {}" 
     using Insert.prems(2) disjoint_insert(1) by blast
   moreover have dom_img_disj: "subst_domain \<sigma>1 \<inter> range_vars \<theta>2 = {}"
     using Insert.hyps(2) Insert.prems(3)
     by (fastforce simp add: subst_domain_def)
   ultimately have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma>1 \<circ>\<^sub>s \<theta>2)" using Insert.IH[OF \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>2\<close>] by metis
 
   have dom_comp_is_union: "subst_domain (\<sigma>1 \<circ>\<^sub>s \<theta>2) = subst_domain \<sigma>1 \<union> subst_domain \<theta>2"
     using subst_dom_comp_eq[OF dom_img_disj] .
 
   have "v \<notin> subst_domain \<theta>2"
     using Insert.prems(2) \<open>t \<noteq> Var v\<close>
     by (fastforce simp add: subst_domain_def)
   hence "\<theta>2 v = Var v" "\<sigma>1 v = Var v" using Insert.hyps(2) by (simp_all add: subst_domain_def)
   hence "(\<sigma>1 \<circ>\<^sub>s \<theta>2) v = Var v" "(\<sigma>1(v := t) \<circ>\<^sub>s \<theta>2) v = t \<cdot> \<theta>2" "((\<sigma>1 \<circ>\<^sub>s \<theta>2)(v := t)) v = t"
     unfolding subst_compose_def by simp_all
   
   have fv_t2_bound: "fv (t \<cdot> \<theta>2) \<subseteq> fv t \<union> range_vars \<theta>2" by (meson subst_sends_fv_to_img)
 
   have 1: "v \<notin> subst_domain (\<sigma>1 \<circ>\<^sub>s \<theta>2)"
     using \<open>(\<sigma>1 \<circ>\<^sub>s \<theta>2) v = Var v\<close>
     by (auto simp add: subst_domain_def)
 
   have "insert v (subst_domain \<sigma>1) \<inter> range_vars \<theta>2 = {}"
     using Insert.prems(3) dom1v_unfold by blast
   hence "v \<notin> range_vars \<sigma>1 \<union> range_vars \<theta>2" using Insert.hyps(3) by blast
   hence 2: "v \<notin> range_vars (\<sigma>1 \<circ>\<^sub>s \<theta>2)" by (meson set_rev_mp subst_img_comp_subset)
 
   have "subst_domain \<theta>2 \<inter> range_vars \<theta>2 = {}"
     using \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>2\<close> unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp
   hence "fv (t \<cdot> \<theta>2) \<inter> subst_domain \<theta>2 = {}"
     using subst_dom_elim unfolding range_vars_alt_def by simp
   moreover have "v \<notin> range_vars \<theta>2" using Insert.prems(3) dom1v_unfold by blast
   hence "v \<notin> fv t \<union> range_vars \<theta>2" using Insert.hyps(4) by blast
   hence "v \<notin> fv (t \<cdot> \<theta>2)" using \<open>fv (t \<cdot> \<theta>2) \<subseteq> fv t \<union> range_vars \<theta>2\<close> by blast
   moreover have "fv (t \<cdot> \<theta>2) \<inter> subst_domain \<sigma>1 = {}"
     using dom_img_disj fv_t2_bound \<open>fv t \<inter> insert v (subst_domain \<sigma>1) = {}\<close> by blast
   ultimately have 3: "fv (t \<cdot> \<theta>2) \<inter> insert v (subst_domain (\<sigma>1 \<circ>\<^sub>s \<theta>2)) = {}"
     using dom_comp_is_union by blast
 
   have "\<sigma>1(v := t) \<circ>\<^sub>s \<theta>2 = (\<sigma>1 \<circ>\<^sub>s \<theta>2)(v := t \<cdot> \<theta>2)" using subst_comp_upd1[of \<sigma>1 v t \<theta>2] .
   moreover have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t ((\<sigma>1 \<circ>\<^sub>s \<theta>2)(v := t \<cdot> \<theta>2))"
     using "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set.Insert"[OF _ 1 2 3] \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma>1 \<circ>\<^sub>s \<theta>2)\<close> wf_subst_properties by metis
   ultimately show ?case by presburger
 qed
 
 lemma wf_subst_append:
   fixes \<theta>1 \<theta>2::"('f,'v) subst"
   assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>1" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>2"
     and "subst_domain \<theta>1 \<inter> subst_domain \<theta>2 = {}"
     and "subst_domain \<theta>1 \<inter> range_vars \<theta>2 = {}"
     and "range_vars \<theta>1 \<inter> subst_domain \<theta>2 = {}"
   shows "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<lambda>v. if \<theta>1 v = Var v then \<theta>2 v else \<theta>1 v)"
 using assms
 proof (induction \<theta>1 rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct)
   case Empty thus ?case unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp
 next
   case (Insert \<sigma>1 v t)
   let ?if = "\<lambda>w. if \<sigma>1 w = Var w then \<theta>2 w else \<sigma>1 w"
   let ?if_upd = "\<lambda>w. if (\<sigma>1(v := t)) w = Var w then \<theta>2 w else (\<sigma>1(v := t)) w"
 
   from Insert.hyps(4) have "?if_upd = ?if(v := t)" by fastforce
 
   have dom_insert: "subst_domain (\<sigma>1(v := t)) = insert v (subst_domain \<sigma>1)"
     using Insert.hyps(4) by (auto simp add: subst_domain_def)
 
   have "\<sigma>1 v = Var v" "t \<noteq> Var v" using Insert.hyps(2,4) by auto
   hence img_insert: "range_vars (\<sigma>1(v := t)) = range_vars \<sigma>1 \<union> fv t"
     using subst_img_update by metis
 
   from Insert.prems(2) dom_insert have "subst_domain \<sigma>1 \<inter> subst_domain \<theta>2 = {}"
     by (auto simp add: subst_domain_def)
   moreover have "subst_domain \<sigma>1 \<inter> range_vars \<theta>2 = {}"
     using Insert.prems(3) dom_insert
     by (simp add: subst_domain_def)
   moreover have "range_vars \<sigma>1 \<inter> subst_domain \<theta>2 = {}"
     using Insert.prems(4) img_insert
     by blast
   ultimately have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t ?if" using Insert.IH[OF Insert.prems(1)] by metis
   
   have dom_union: "subst_domain ?if = subst_domain \<sigma>1 \<union> subst_domain \<theta>2"
     by (auto simp add: subst_domain_def)
   hence "v \<notin> subst_domain ?if"
     using Insert.hyps(2) Insert.prems(2) dom_insert
     by (auto simp add: subst_domain_def)
   moreover have "v \<notin> range_vars ?if"
     using Insert.prems(3) Insert.hyps(3) dom_insert
     unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
   moreover have "fv t \<inter> insert v (subst_domain ?if) = {}"
     using Insert.hyps(4) Insert.prems(4) img_insert
     unfolding range_vars_alt_def by (fastforce simp add: subst_domain_def)
   ultimately show ?case
     using wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set.Insert \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t ?if\<close> \<open>?if_upd = ?if(v := t)\<close> wf_subst_properties
     by (metis (no_types, lifting))  
 qed
 
 lemma wf_subst_elim_append:
   assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "subst_elim \<theta> v" "v \<notin> fv t"
   shows "subst_elim (\<theta>(w := t)) v"
 using assms
 proof (induction \<theta> rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct)
   case (Insert \<theta> v' t')
   hence "\<And>q. v \<notin> fv (Var q \<cdot> \<theta>(v' := t'))" using subst_elimD by blast
   hence "\<And>q. v \<notin> fv (Var q \<cdot> \<theta>(v' := t', w := t))" using \<open>v \<notin> fv t\<close> by simp
-  thus ?case by (metis subst_elimI' subst_apply_term.simps(1)) 
+  thus ?case by (metis subst_elimI' eval_term.simps(1)) 
 qed (simp add: subst_elim_def)
 
 lemma wf_subst_elim_dom:
   assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
   shows "\<forall>v \<in> subst_domain \<theta>. subst_elim \<theta> v"
 using assms
 proof (induction \<theta> rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct)
   case (Insert \<theta> w t)
   have dom_insert: "subst_domain (\<theta>(w := t)) \<subseteq> insert w (subst_domain \<theta>)"
     by (auto simp add: subst_domain_def)
   hence "\<forall>v \<in> subst_domain \<theta>. subst_elim (\<theta>(w := t)) v" using Insert.IH Insert.hyps(2,4)
     by (metis Insert.hyps(1) IntI disjoint_insert(2) empty_iff wf_subst_elim_append) 
   moreover have "w \<notin> fv t" using Insert.hyps(4) by simp
   hence "\<And>q. w \<notin> fv (Var q \<cdot> \<theta>(w := t))"
     by (metis fv_simps(1) fv_in_subst_img Insert.hyps(3) contra_subsetD 
-              fun_upd_def singletonD subst_apply_term.simps(1)) 
+              fun_upd_def singletonD eval_term.simps(1)) 
   hence "subst_elim (\<theta>(w := t)) w" by (metis subst_elimI')
   ultimately show ?case using dom_insert by blast
 qed simp
 
 lemma wf_subst_support_iff_mgt: "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> \<theta> supports \<delta> \<longleftrightarrow> \<theta> \<preceq>\<^sub>\<circ> \<delta>"
 using subst_support_def subst_support_if_mgt_subst_idem wf_subst_subst_idem by blast 
 
 
 subsection \<open>Interpretations\<close>
 abbreviation interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t::"('a,'b) subst \<Rightarrow> bool" where
   "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<equiv> subst_domain \<theta> = UNIV \<and> ground (subst_range \<theta>)"
 
 lemma interpretation_substI:
   "(\<And>v. fv (\<theta> v) = {}) \<Longrightarrow> interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
 proof -
   assume "\<And>v. fv (\<theta> v) = {}"
   moreover { fix v assume "fv (\<theta> v) = {}" hence "v \<in> subst_domain \<theta>" by auto }
   ultimately show ?thesis by auto
 qed
 
 lemma interpretation_grounds[simp]:
   "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> fv (t \<cdot> \<theta>) = {}"
 using subst_fv_dom_ground_if_ground_img[of t \<theta>] by blast
 
 lemma interpretation_grounds_all:
   "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> (\<And>v. fv (\<theta> v) = {})"
 by (metis range_vars_alt_def UNIV_I fv_in_subst_img subset_empty subst_dom_vars_in_subst)
 
 lemma interpretation_grounds_all':
   "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> ground (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
 using subst_fv_dom_ground_if_ground_img[of _ \<theta>]
 by simp
 
 lemma interpretation_comp:
   assumes "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" 
   shows "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<theta>)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<sigma>)"
 proof -
   have \<theta>_fv: "fv (\<theta> v) = {}" for v using interpretation_grounds_all[OF assms] by simp
   hence \<theta>_fv': "fv (t \<cdot> \<theta>) = {}" for t
-    by (metis all_not_in_conv subst_elimD subst_elimI' subst_apply_term.simps(1))
+    by (metis all_not_in_conv subst_elimD subst_elimI' eval_term.simps(1))
 
   from assms have "(\<sigma> \<circ>\<^sub>s \<theta>) v \<noteq> Var v" for v
     unfolding subst_compose_def by (metis fv_simps(1) \<theta>_fv' insert_not_empty)
   hence "subst_domain (\<sigma> \<circ>\<^sub>s \<theta>) = UNIV" by (simp add: subst_domain_def)
   moreover have "fv ((\<sigma> \<circ>\<^sub>s \<theta>) v) = {}" for v unfolding subst_compose_def using \<theta>_fv' by simp
   hence "ground (subst_range (\<sigma> \<circ>\<^sub>s \<theta>))" by simp
   ultimately show "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<theta>)" ..
 
   from assms have "(\<theta> \<circ>\<^sub>s \<sigma>) v \<noteq> Var v" for v
     unfolding subst_compose_def by (metis fv_simps(1) \<theta>_fv insert_not_empty subst_to_var_is_var)
   hence "subst_domain (\<theta> \<circ>\<^sub>s \<sigma>) = UNIV" by (simp add: subst_domain_def)
   moreover have "fv ((\<theta> \<circ>\<^sub>s \<sigma>) v) = {}" for v
-    unfolding subst_compose_def by (simp add: \<theta>_fv trm_subst_ident) 
+    unfolding subst_compose_def by (simp add: \<theta>_fv subst_apply_term_ident) 
   hence "ground (subst_range (\<theta> \<circ>\<^sub>s \<sigma>))" by simp
   ultimately show "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<sigma>)" ..
 qed
 
 lemma interpretation_subst_exists:
   "\<exists>\<I>::('f,'v) subst. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
 proof -
   obtain c::"'f" where "c \<in> UNIV" by simp
   then obtain \<I>::"('f,'v) subst" where "\<And>v. \<I> v = Fun c []" by simp
   hence "subst_domain \<I> = UNIV" "ground (subst_range \<I>)"
     by (simp_all add: subst_domain_def)
   thus ?thesis by auto
 qed
 
 lemma interpretation_subst_exists':
   "\<exists>\<theta>::('f,'v) subst. subst_domain \<theta> = X \<and> ground (subst_range \<theta>)"
 proof -
   obtain \<I>::"('f,'v) subst" where \<I>: "subst_domain \<I> = UNIV" "ground (subst_range \<I>)"
     using interpretation_subst_exists by moura
   let ?\<theta> = "rm_vars (UNIV - X) \<I>"
   have 1: "subst_domain ?\<theta> = X" using \<I> by (auto simp add: subst_domain_def)
   hence 2: "ground (subst_range ?\<theta>)" using \<I> by force
   show ?thesis using 1 2 by blast
 qed
 
 lemma interpretation_subst_idem:
   "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> subst_idem \<theta>"
 unfolding subst_idem_def
-using interpretation_grounds_all[of \<theta>] trm_subst_ident subst_eq_if_eq_vars
-by fastforce
+  using interpretation_grounds_all[of \<theta>] subst_apply_term_ident subst_eq_if_eq_vars
+by (fastforce simp: subst_compose)
 
 lemma subst_idem_comp_upd_eq:
   assumes "v \<notin> subst_domain \<I>" "subst_idem \<theta>"
   shows "\<I> \<circ>\<^sub>s \<theta> = \<I>(v := \<theta> v) \<circ>\<^sub>s \<theta>"
 proof -
   from assms(1) have "(\<I> \<circ>\<^sub>s \<theta>) v = \<theta> v" unfolding subst_compose_def by auto
   moreover have "\<And>w. w \<noteq> v \<Longrightarrow> (\<I> \<circ>\<^sub>s \<theta>) w = (\<I>(v := \<theta> v) \<circ>\<^sub>s \<theta>) w" unfolding subst_compose_def by auto
   moreover have "(\<I>(v := \<theta> v) \<circ>\<^sub>s \<theta>) v = \<theta> v" using assms(2) unfolding subst_idem_def subst_compose_def
     by (metis fun_upd_same) 
   ultimately show ?thesis by (metis fun_upd_same fun_upd_triv subst_comp_upd1)
 qed
 
 lemma interpretation_dom_img_disjoint:
   "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I> \<Longrightarrow> subst_domain \<I> \<inter> range_vars \<I> = {}"
 unfolding range_vars_alt_def by auto
 
 
 subsection \<open>Basic Properties of MGUs\<close>
 lemma MGU_is_mgu_singleton: "MGU \<theta> t u = is_mgu \<theta> {(t,u)}"
 unfolding is_mgu_def unifiers_def by auto
 
 lemma Unifier_in_unifiers_singleton: "Unifier \<theta> s t \<longleftrightarrow> \<theta> \<in> unifiers {(s,t)}"
 unfolding unifiers_def by auto
 
 lemma subst_list_singleton_fv_subset:
   "(\<Union>x \<in> set (subst_list (subst v t) E). fv (fst x) \<union> fv (snd x))
     \<subseteq> fv t \<union> (\<Union>x \<in> set E. fv (fst x) \<union> fv (snd x))"
 proof (induction E)
   case (Cons x E)
   let ?fvs = "\<lambda>L. \<Union>x \<in> set L. fv (fst x) \<union> fv (snd x)"
   let ?fvx = "fv (fst x) \<union> fv (snd x)"
   let ?fvxsubst = "fv (fst x \<cdot> Var(v := t)) \<union> fv (snd x \<cdot> Var(v := t))"
   have "?fvs (subst_list (subst v t) (x#E)) = ?fvxsubst \<union> ?fvs (subst_list (subst v t) E)"
     unfolding subst_list_def subst_def by auto
   hence "?fvs (subst_list (subst v t) (x#E)) \<subseteq> ?fvxsubst \<union> fv t \<union> ?fvs E"
     using Cons.IH by blast
   moreover have "?fvs (x#E) = ?fvx \<union> ?fvs E" by auto
   moreover have "?fvxsubst \<subseteq> ?fvx \<union> fv t" using subst_fv_bound_singleton[of _ v t] by blast
   ultimately show ?case unfolding range_vars_alt_def by auto
 qed (simp add: subst_list_def)
 
 lemma subst_of_dom_subset: "subst_domain (subst_of L) \<subseteq> set (map fst L)"
 proof (induction L rule: List.rev_induct)
   case (snoc x L)
   then obtain v t where x: "x = (v,t)" by (metis surj_pair)
   hence "subst_of (L@[x]) = Var(v := t) \<circ>\<^sub>s subst_of L"
-    unfolding subst_of_def subst_def by (induct L) auto
+    unfolding subst_of_def subst_def by (induct L) (auto simp: subst_compose)
   hence "subst_domain (subst_of (L@[x])) \<subseteq> insert v (subst_domain (subst_of L))"
     using x subst_domain_compose[of "Var(v := t)" "subst_of L"]
     by (auto simp add: subst_domain_def)
   thus ?case using snoc.IH x by auto
 qed simp
 
 lemma wf_MGU_is_imgu_singleton: "wf\<^sub>M\<^sub>G\<^sub>U \<theta> s t \<Longrightarrow> is_imgu \<theta> {(s,t)}"
 proof -
   assume 1: "wf\<^sub>M\<^sub>G\<^sub>U \<theta> s t"
 
   have 2: "subst_idem \<theta>" by (metis wf_subst_subst_idem 1 wf\<^sub>M\<^sub>G\<^sub>U_def)
 
   have 3: "\<forall>\<theta>' \<in> unifiers {(s,t)}. \<theta> \<preceq>\<^sub>\<circ> \<theta>'" "\<theta> \<in> unifiers {(s,t)}"
     by (metis 1 Unifier_in_unifiers_singleton wf\<^sub>M\<^sub>G\<^sub>U_def)+
 
   have "\<forall>\<tau> \<in> unifiers {(s,t)}. \<tau> = \<theta> \<circ>\<^sub>s \<tau>" by (metis 2 3 subst_idem_def subst_compose_assoc)
   thus "is_imgu \<theta> {(s,t)}" by (metis is_imgu_def \<open>\<theta> \<in> unifiers {(s,t)}\<close>)
 qed
 
 lemmas mgu_subst_range_vars = mgu_range_vars
 
 lemmas mgu_same_empty = mgu_same
 
 lemma mgu_var: assumes "x \<notin> fv t" shows "mgu (Var x) t = Some (Var(x := t))"
 proof -
   have "unify [(Var x,t)] [] = Some [(x,t)]" using assms by (auto simp add: subst_list_def)
   moreover have "subst_of [(x,t)] = Var(x := t)" unfolding subst_of_def subst_def by simp
   ultimately show ?thesis by (simp add: mgu_def)
 qed
 
 lemma mgu_gives_wellformed_subst:
   assumes "mgu s t = Some \<theta>" shows "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
 using mgu_finite_subst_domain[OF assms] mgu_subst_domain_range_vars_disjoint[OF assms]
 unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
 by auto
 
 lemma mgu_gives_wellformed_MGU:
   assumes "mgu s t = Some \<theta>" shows "wf\<^sub>M\<^sub>G\<^sub>U \<theta> s t"
 using mgu_subst_domain[OF assms] mgu_sound[OF assms] mgu_subst_range_vars [OF assms]
       MGU_is_mgu_singleton[of s \<theta> t] is_imgu_imp_is_mgu[of \<theta> "{(s,t)}"]
       mgu_gives_wellformed_subst[OF assms]
 unfolding wf\<^sub>M\<^sub>G\<^sub>U_def by blast
 
 lemma mgu_gives_subst_idem: "mgu s t = Some \<theta> \<Longrightarrow> subst_idem \<theta>"
 using mgu_sound[of s t \<theta>] unfolding is_imgu_def subst_idem_def by auto
 
 lemma mgu_always_unifies: "Unifier \<theta> M N \<Longrightarrow> \<exists>\<delta>. mgu M N = Some \<delta>"
 using mgu_complete Unifier_in_unifiers_singleton by blast
 
 lemma mgu_gives_MGU: "mgu s t = Some \<theta> \<Longrightarrow> MGU \<theta> s t"
 using mgu_sound[of s t \<theta>, THEN is_imgu_imp_is_mgu] MGU_is_mgu_singleton by metis
 
 lemma mgu_vars_bounded[dest?]:
   "mgu M N = Some \<sigma> \<Longrightarrow> subst_domain \<sigma> \<union> range_vars \<sigma> \<subseteq> fv M \<union> fv N"
 using mgu_gives_wellformed_MGU unfolding wf\<^sub>M\<^sub>G\<^sub>U_def by blast
 
 lemma mgu_vars_bounded':
   assumes \<sigma>: "mgu M N = Some \<sigma>"
     and MN: "fv M = {} \<or> fv N = {}"
   shows "subst_domain \<sigma> = fv M \<union> fv N" (is ?A)
     and "range_vars \<sigma> = {}" (is ?B)
 proof -
   let ?C = "\<lambda>t. subst_domain \<sigma> = fv t"
 
   have 0: "fv N = {} \<Longrightarrow> subst_domain \<sigma> \<subseteq> fv M" "fv N = {} \<Longrightarrow> range_vars \<sigma> \<subseteq> fv M"
           "fv M = {} \<Longrightarrow> subst_domain \<sigma> \<subseteq> fv N" "fv M = {} \<Longrightarrow> range_vars \<sigma> \<subseteq> fv N"
     using mgu_vars_bounded[OF \<sigma>] by simp_all
 
   note 1 = mgu_gives_MGU[OF \<sigma>] mgu_subst_domain_range_vars_disjoint[OF \<sigma>]
   note 2 = subst_fv_imgI[of \<sigma>] subst_dom_vars_in_subst[of _ \<sigma>]
   note 3 = ground_term_subst_domain_fv_subset[of _ \<sigma>]
   note 4 = subst_apply_fv_empty[of _ \<sigma>]
 
   have "fv (\<sigma> x) = {}" when x: "x \<in> fv M" and N: "fv N = {}" for x
     using x N 0(1,2) 1 2[of x] 3[of M] 4[of N] by auto
   hence "?C M" ?B when N: "fv N = {}" using 0(1,2)[OF N] N by (fastforce, fastforce)
   moreover have "fv (\<sigma> x) = {}" when x: "x \<in> fv N" and M: "fv M = {}" for x
     using x M 0(3,4) 1 2[of x] 3[of N] 4[of M] by auto
   hence "?C N" ?B when M: "fv M = {}" using 0(3,4)[OF M] M by (fastforce, fastforce)
   ultimately show ?A ?B using MN by auto
 qed
 
 lemma mgu_eliminates[dest?]:
   assumes "mgu M N = Some \<sigma>"
   shows "(\<exists>v \<in> fv M \<union> fv N. subst_elim \<sigma> v) \<or> \<sigma> = Var"
   (is "?P M N \<sigma>")
 proof (cases "\<sigma> = Var")
   case False
   then obtain v where v: "v \<in> subst_domain \<sigma>" by auto
   hence "v \<in> fv M \<union> fv N" using mgu_vars_bounded[OF assms] by blast
   thus ?thesis using wf_subst_elim_dom[OF mgu_gives_wellformed_subst[OF assms]] v by blast
 qed simp
 
 lemma mgu_eliminates_dom:
   assumes "mgu x y = Some \<theta>" "v \<in> subst_domain \<theta>"
   shows "subst_elim \<theta> v"
 using mgu_gives_wellformed_subst[OF assms(1)]
 unfolding wf\<^sub>M\<^sub>G\<^sub>U_def wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_elim_def
 by (metis disjoint_iff_not_equal subst_dom_elim assms(2))
 
 lemma unify_list_distinct:
   assumes "Unification.unify E B = Some U" "distinct (map fst B)"
   and "(\<Union>x \<in> set E. fv (fst x) \<union> fv (snd x)) \<inter> set (map fst B) = {}"
   shows "distinct (map fst U)"
 using assms
 proof (induction E B arbitrary: U rule: Unification.unify.induct)
   case 1 thus ?case by simp
 next
   case (2 f X g Y E B U)
   let ?fvs = "\<lambda>L. \<Union>x \<in> set L. fv (fst x) \<union> fv (snd x)"
   from "2.prems"(1) obtain E' where *: "decompose (Fun f X) (Fun g Y) = Some E'"
     and [simp]: "f = g" "length X = length Y" "E' = zip X Y"
     and **: "Unification.unify (E'@E) B = Some U"
     by (auto split: option.splits)
   hence "\<And>t t'. (t,t') \<in> set E' \<Longrightarrow> fv t \<subseteq> fv (Fun f X) \<and> fv t' \<subseteq> fv (Fun g Y)"
     by (metis zip_arg_subterm subtermeq_vars_subset)
   hence "?fvs E' \<subseteq> fv (Fun f X) \<union> fv (Fun g Y)" by fastforce
   moreover have "fv (Fun f X) \<inter> set (map fst B) = {}" "fv (Fun g Y) \<inter> set (map fst B) = {}"
     using "2.prems"(3) by auto
   ultimately have "?fvs E' \<inter> set (map fst B) = {}" by blast
   moreover have "?fvs E \<inter> set (map fst B) = {}" using "2.prems"(3) by auto
   ultimately have "?fvs (E'@E) \<inter> set (map fst B) = {}" by auto
   thus ?case using "2.IH"[OF * ** "2.prems"(2)] by metis
 next
   case (3 v t E B)
   let ?fvs = "\<lambda>L. \<Union>x \<in> set L. fv (fst x) \<union> fv (snd x)"
   let ?E' = "subst_list (subst v t) E"
   from "3.prems"(3) have "v \<notin> set (map fst B)" "fv t \<inter> set (map fst B) = {}" by force+
   hence *: "distinct (map fst ((v, t)#B))" using "3.prems"(2) by auto
 
   show ?case
   proof (cases "t = Var v")
     case True thus ?thesis using "3.prems" "3.IH"(1) by auto
   next
     case False
     hence "v \<notin> fv t" using "3.prems"(1) by auto
     hence "Unification.unify (subst_list (subst v t) E) ((v, t)#B) = Some U"
       using \<open>t \<noteq> Var v\<close> "3.prems"(1) by auto
     moreover have "?fvs ?E' \<inter> set (map fst ((v, t)#B)) = {}"
     proof -
       have "v \<notin> ?fvs ?E'"
         unfolding subst_list_def subst_def
         by (simp add: \<open>v \<notin> fv t\<close> subst_remove_var)
       moreover have "?fvs ?E' \<subseteq> fv t \<union> ?fvs E" by (metis subst_list_singleton_fv_subset)
       hence "?fvs ?E' \<inter> set (map fst B) = {}" using "3.prems"(3) by auto
       ultimately show ?thesis by auto
     qed 
     ultimately show ?thesis using "3.IH"(2)[OF \<open>t \<noteq> Var v\<close> \<open>v \<notin> fv t\<close> _ *] by metis
   qed
 next
   case (4 f X v E B U)
   let ?fvs = "\<lambda>L. \<Union>x \<in> set L. fv (fst x) \<union> fv (snd x)"
   let ?E' = "subst_list (subst v (Fun f X)) E"
   have *: "?fvs E \<inter> set (map fst B) = {}" using "4.prems"(3) by auto
   from "4.prems"(1) have "v \<notin> fv (Fun f X)" by force
   from "4.prems"(3) have **: "v \<notin> set (map fst B)" "fv (Fun f X) \<inter> set (map fst B) = {}" by force+
   hence ***: "distinct (map fst ((v, Fun f X)#B))" using "4.prems"(2) by auto
   from "4.prems"(3) have ****: "?fvs ?E' \<inter> set (map fst ((v, Fun f X)#B)) = {}"
   proof -
     have "v \<notin> ?fvs ?E'"
       unfolding subst_list_def subst_def
       using \<open>v \<notin> fv (Fun f X)\<close> subst_remove_var[of v "Fun f X"] by simp
     moreover have "?fvs ?E' \<subseteq> fv (Fun f X) \<union> ?fvs E" by (metis subst_list_singleton_fv_subset)
     hence "?fvs ?E' \<inter> set (map fst B) = {}" using * ** by blast
     ultimately show ?thesis by auto
   qed
   have "Unification.unify (subst_list (subst v (Fun f X)) E) ((v, Fun f X) # B) = Some U"
     using \<open>v \<notin> fv (Fun f X)\<close> "4.prems"(1) by auto
   thus ?case using "4.IH"[OF \<open>v \<notin> fv (Fun f X)\<close> _ *** ****] by metis
 qed
 
 lemma mgu_None_is_subst_neq:
   fixes s t::"('a,'b) term" and \<delta>::"('a,'b) subst"
   assumes "mgu s t = None"
   shows "s \<cdot> \<delta> \<noteq> t \<cdot> \<delta>"
 using assms mgu_always_unifies by force
 
 lemma mgu_None_if_neq_ground:
   assumes "t \<noteq> t'" "fv t = {}" "fv t' = {}"
   shows "mgu t t' = None"
 proof (rule ccontr)
   assume "mgu t t' \<noteq> None"
   then obtain \<delta> where \<delta>: "mgu t t' = Some \<delta>" by auto
   hence "t \<cdot> \<delta> = t" "t' \<cdot> \<delta> = t'" using assms subst_ground_ident by auto
   thus False using assms(1) MGU_is_Unifier[OF mgu_gives_MGU[OF \<delta>]] by auto
 qed
 
 lemma mgu_None_commutes:
   "mgu s t = None \<Longrightarrow> mgu t s = None"
+  thm mgu_complete[of s t] Unifier_in_unifiers_singleton[of ]
 using mgu_complete[of s t]
       Unifier_in_unifiers_singleton[of s _ t]
       Unifier_sym[of t _ s]
       Unifier_in_unifiers_singleton[of t _ s]
       mgu_sound[of t s]
 unfolding is_imgu_def
 by fastforce
 
 lemma mgu_img_subterm_subst:
   fixes \<delta>::"('f,'v) subst" and s t u::"('f,'v) term"
   assumes "mgu s t = Some \<delta>" "u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<delta>) - range Var"
   shows "u \<in> ((subterms s \<union> subterms t) - range Var) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
 proof -
   define subterms_tuples::"('f,'v) equation list \<Rightarrow> ('f,'v) terms" where subtt_def:
     "subterms_tuples \<equiv> \<lambda>E. subterms\<^sub>s\<^sub>e\<^sub>t (fst ` set E) \<union> subterms\<^sub>s\<^sub>e\<^sub>t (snd ` set E)"
   define subterms_img::"('f,'v) subst \<Rightarrow> ('f,'v) terms" where subti_def:
     "subterms_img \<equiv> \<lambda>d. subterms\<^sub>s\<^sub>e\<^sub>t (subst_range d)"
 
   define d where "d \<equiv> \<lambda>v t. subst v t::('f,'v) subst"
   define V where "V \<equiv> range Var::('f,'v) terms"
   define R where "R \<equiv> \<lambda>d::('f,'v) subst. ((subterms s \<union> subterms t) - V) \<cdot>\<^sub>s\<^sub>e\<^sub>t d"
   define M where "M \<equiv> \<lambda>E d. subterms_tuples E \<union> subterms_img d"
   define Q where "Q \<equiv> (\<lambda>E d. M E d - V \<subseteq> R d - V)"
   define Q' where "Q' \<equiv> (\<lambda>E d d'. (M E d - V) \<cdot>\<^sub>s\<^sub>e\<^sub>t d' \<subseteq> (R d - V) \<cdot>\<^sub>s\<^sub>e\<^sub>t (d'::('f,'v) subst))"
 
   have Q_subst: "Q (subst_list (subst v t') E) (subst_of ((v, t')#B))" 
     when v_fv: "v \<notin> fv t'" and Q_assm: "Q ((Var v, t')#E) (subst_of B)"
     for v t' E B
   proof -
     define E' where "E' \<equiv> subst_list (subst v t') E"
     define B' where "B' \<equiv> subst_of ((v, t')#B)"
 
     have E': "E' = subst_list (d v t') E"
         and B': "B' = subst_of B \<circ>\<^sub>s d v t'"
       using subst_of_simps(3)[of "(v, t')"]
       unfolding subst_def E'_def B'_def d_def by simp_all
 
     have vt_img_subt: "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (d v t')) = subterms t'"
          and vt_dom: "subst_domain (d v t') = {v}"
       using v_fv by (auto simp add: subst_domain_def d_def subst_def)
 
     have *: "subterms u1 \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (fst ` set E)" "subterms u2 \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (snd ` set E)"
       when "(u1,u2) \<in> set E" for u1 u2
       using that by auto
 
     have **: "subterms\<^sub>s\<^sub>e\<^sub>t (d v t' ` (fv u \<inter> subst_domain (d v t'))) \<subseteq> subterms t'"
       for u::"('f,'v) term"
       using vt_dom unfolding d_def by force
 
     have 1: "subterms_tuples E' - V \<subseteq> (subterms t' - V) \<union> (subterms_tuples E - V \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t')"
       (is "?A \<subseteq> ?B")
     proof
       fix u assume "u \<in> ?A"
       then obtain u1 u2 where u12:
           "(u1,u2) \<in> set E"
           "u \<in> (subterms (u1 \<cdot> (d v t')) - V) \<union> (subterms (u2 \<cdot> (d v t')) - V)"
         unfolding subtt_def subst_list_def E'_def d_def by moura
       hence "u \<in> (subterms t' - V) \<union> (((subterms_tuples E) \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t') - V)"
         using subterms_subst[of u1 "d v t'"] subterms_subst[of u2 "d v t'"]
               *[OF u12(1)] **[of u1] **[of u2]
         unfolding subtt_def subst_list_def by auto
       moreover have
           "(subterms_tuples E \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t') - V \<subseteq>
            (subterms_tuples E - V \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t') \<union> {t'}"
         unfolding subst_def subtt_def V_def d_def by force
       ultimately show "u \<in> ?B" using u12 v_fv by auto
     qed
 
     have 2: "subterms_img B' - V \<subseteq>
              (subterms t' - V) \<union> (subterms_img (subst_of B) - V \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t')"
       using B' vt_img_subt subst_img_comp_subset'''[of "subst_of B" "d v t'"]
       unfolding subti_def subst_def V_def by argo
 
     have 3: "subterms_tuples ((Var v, t')#E) - V = (subterms t' - V) \<union> (subterms_tuples E - V)"
       by (auto simp add: subst_def subtt_def V_def)
 
     have "fv\<^sub>s\<^sub>e\<^sub>t (subterms t' - V) \<inter> subst_domain (d v t') = {}"
       using v_fv vt_dom fv_subterms[of t'] by fastforce
     hence 4: "subterms t' - V \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t' = subterms t' - V"
       using set_subst_ident[of "subterms t' - range Var" "d v t'"] by (simp add: V_def)
 
     have "M E' B' - V \<subseteq> M ((Var v, t')#E) (subst_of B) - V \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t'"
       using 1 2 3 4 unfolding M_def by blast
     moreover have "Q' ((Var v, t')#E) (subst_of B) (d v t')"
       using Q_assm unfolding Q_def Q'_def by auto
     moreover have "R (subst_of B) \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t' = R (subst_of ((v,t')#B))"
       unfolding R_def d_def by auto 
     ultimately have
       "M (subst_list (d v t') E) (subst_of ((v, t')#B)) - V \<subseteq> R (subst_of ((v, t')#B)) - V"
       unfolding Q'_def E'_def B'_def d_def by blast
     thus ?thesis unfolding Q_def M_def R_def d_def by blast
   qed
 
   have "u \<in> subterms s \<union> subterms t - V \<cdot>\<^sub>s\<^sub>e\<^sub>t subst_of U"
     when assms':
       "unify E B = Some U"
       "u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (subst_of U)) - V"
       "Q E (subst_of B)"
     for E B U and T::"('f,'v) term list"
     using assms'
   proof (induction E B arbitrary: U rule: Unification.unify.induct)
     case (1 B) thus ?case by (auto simp add: Q_def M_def R_def subti_def)
   next
     case (2 g X h Y E B U)
     from "2.prems"(1) obtain E' where E':
         "decompose (Fun g X) (Fun h Y) = Some E'"
         "g = h" "length X = length Y" "E' = zip X Y"
         "Unification.unify (E'@E) B = Some U"
       by (auto split: option.splits)
     moreover have "subterms_tuples (E'@E) \<subseteq> subterms_tuples ((Fun g X, Fun h Y)#E)"
     proof
       fix u assume "u \<in> subterms_tuples (E'@E)"
       then obtain u1 u2 where u12: "(u1,u2) \<in> set (E'@E)" "u \<in> subterms u1 \<union> subterms u2"
         unfolding subtt_def by fastforce
       thus "u \<in> subterms_tuples ((Fun g X, Fun h Y)#E)"
       proof (cases "(u1,u2) \<in> set E'")
         case True
         hence "subterms u1 \<subseteq> subterms (Fun g X)" "subterms u2 \<subseteq> subterms (Fun h Y)"
           using E'(4) subterms_subset params_subterms subsetCE
           by (metis set_zip_leftD, metis set_zip_rightD)
         thus ?thesis using u12 unfolding subtt_def by auto
       next
         case False thus ?thesis using u12 unfolding subtt_def by fastforce
       qed
      qed
     hence "Q (E'@E) (subst_of B)" using "2.prems"(3) unfolding Q_def M_def by blast
     ultimately show ?case using "2.IH"[of E' U] "2.prems" by meson
   next
     case (3 v t' E B)
     show ?case
     proof (cases "t' = Var v")
       case True thus ?thesis
         using "3.prems" "3.IH"(1) unfolding Q_def M_def V_def subtt_def by auto
     next
       case False
       hence 1: "v \<notin> fv t'" using "3.prems"(1) by auto
       hence "unify (subst_list (subst v t') E) ((v, t')#B) = Some U"
         using False "3.prems"(1) by auto
       thus ?thesis
         using Q_subst[OF 1 "3.prems"(3)]
               "3.IH"(2)[OF False 1 _ "3.prems"(2)]
         by metis
     qed
   next
     case (4 g X v E B U)
     have 1: "v \<notin> fv (Fun g X)" using "4.prems"(1) not_None_eq by fastforce
     hence 2: "unify (subst_list (subst v (Fun g X)) E) ((v, Fun g X)#B) = Some U"
       using "4.prems"(1) by auto
 
     have 3: "Q ((Var v, Fun g X)#E) (subst_of B)"
       using "4.prems"(3) unfolding Q_def M_def subtt_def by auto
     
     show ?case
       using Q_subst[OF 1 3] "4.IH"[OF 1 2 "4.prems"(2)]
       by metis
   qed
   moreover obtain D where "unify [(s, t)] [] = Some D" "\<delta> = subst_of D"
     using assms(1) by (auto simp: mgu_def split: option.splits)
   moreover have "Q [(s,t)] (subst_of [])"
     unfolding Q_def M_def R_def subtt_def subti_def
     by force
   ultimately show ?thesis using assms(2) unfolding V_def by auto
 qed
 
 lemma mgu_img_consts:
   fixes \<delta>::"('f,'v) subst" and s t::"('f,'v) term" and c::'f and z::'v
   assumes "mgu s t = Some \<delta>" "Fun c [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<delta>)"
   shows "Fun c [] \<in> subterms s \<union> subterms t"
 proof -
   obtain u where "u \<in> (subterms s \<union> subterms t) - range Var" "u \<cdot> \<delta> = Fun c []"
     using mgu_img_subterm_subst[OF assms(1), of "Fun c []"] assms(2) by force
   thus ?thesis by (cases u) auto
 qed
 
 lemma mgu_img_consts':
   fixes \<delta>::"('f,'v) subst" and s t::"('f,'v) term" and c::'f and z::'v
   assumes "mgu s t = Some \<delta>" "\<delta> z = Fun c []"
   shows "Fun c [] \<sqsubseteq> s \<or> Fun c [] \<sqsubseteq> t"
 using mgu_img_consts[OF assms(1)] assms(2)
 by (metis Un_iff in_subterms_Union subst_imgI term.distinct(1)) 
 
 lemma mgu_img_composed_var_term:
   fixes \<delta>::"('f,'v) subst" and s t::"('f,'v) term" and f::'f and Z::"'v list"
   assumes "mgu s t = Some \<delta>" "Fun f (map Var Z) \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<delta>)"
   shows "\<exists>Z'. map \<delta> Z' = map Var Z \<and> Fun f (map Var Z') \<in> subterms s \<union> subterms t"
 proof -
   obtain u where u: "u \<in> (subterms s \<union> subterms t) - range Var" "u \<cdot> \<delta> = Fun f (map Var Z)"
     using mgu_img_subterm_subst[OF assms(1), of "Fun f (map Var Z)"] assms(2) by fastforce
   then obtain T where T: "u = Fun f T" "map (\<lambda>t. t \<cdot> \<delta>) T = map Var Z" by (cases u) auto
   have "\<forall>t \<in> set T. \<exists>x. t = Var x" using T(2) by (induct T arbitrary: Z) auto
   then obtain Z' where Z': "map Var Z' = T" by (metis ex_map_conv) 
   hence "map \<delta> Z' = map Var Z" using T(2) by (induct Z' arbitrary: T Z) auto
   thus ?thesis using u(1) T(1) Z' by auto
 qed
 
 lemma mgu_ground_instance_case:
   assumes t: "fv (t \<cdot> \<delta>) = {}"
   shows "mgu t (t \<cdot> \<delta>) = Some (rm_vars (UNIV - fv t) \<delta>)" (is ?A)
     and mgu_ground_commutes: "mgu t (t \<cdot> \<delta>) = mgu (t \<cdot> \<delta>) t" (is ?B)
 proof -
   define \<theta> where "\<theta> \<equiv> rm_vars (UNIV - fv t) \<delta>"
 
   have \<delta>: "t \<cdot> \<delta> = t \<cdot> \<theta>"
     using rm_vars_subst_eq'[of t \<delta>] unfolding \<theta>_def by metis
 
   have 0: "Unifier \<theta> t (t \<cdot> \<delta>)"
     using subst_ground_ident[OF t, of \<theta>] term_subst_eq[of t \<delta> \<theta>]
     unfolding \<theta>_def by (metis Diff_iff)
 
   obtain \<sigma> where \<sigma>: "mgu t (t \<cdot> \<theta>) = Some \<sigma>" "MGU \<sigma> t (t \<cdot> \<theta>)"
     using mgu_always_unifies[OF 0] mgu_gives_MGU[of t "t \<cdot> \<theta>"]
     unfolding \<delta> by blast
 
   have 1: "subst_domain \<sigma> = fv t"
     using t MGU_is_Unifier[OF \<sigma>(2)]
           subset_antisym[OF mgu_subst_domain[OF \<sigma>(1)]]
           ground_term_subst_domain_fv_subset[of t \<sigma>]
           subst_apply_fv_empty[OF t, of \<sigma>]
     unfolding \<delta> by auto
 
   have 2: "subst_domain \<theta> = fv t"
     using 0 rm_vars_dom[of "UNIV - fv t" \<delta>]
           ground_term_subst_domain_fv_subset[of t \<theta>]
           subst_apply_fv_empty[OF t, of \<theta>]
     unfolding \<theta>_def by auto
 
   have "\<sigma> x = \<theta> x" for x
     using 1 2 MGU_is_Unifier[OF \<sigma>(2)] term_subst_eq_conv[of t \<sigma> \<theta>]
           subst_ground_ident[OF t[unfolded \<delta>], of \<sigma>] subst_domI[of _ x]
     by metis
   hence "\<sigma> = \<theta>" by presburger
   thus A: ?A using \<sigma>(1) unfolding \<delta> \<theta>_def by blast
 
   have "Unifier \<theta> (t \<cdot> \<delta>) t" using 0 by simp
   then obtain \<sigma>' where \<sigma>': "mgu (t \<cdot> \<theta>) t = Some \<sigma>'" "MGU \<sigma>' (t \<cdot> \<theta>) t"
     using mgu_always_unifies mgu_gives_MGU[of "t \<cdot> \<theta>" t]
     unfolding \<delta> by fastforce
 
   have 3: "subst_domain \<sigma>' = fv t"
     using t MGU_is_Unifier[OF \<sigma>'(2)]
           subset_antisym[OF mgu_subst_domain[OF \<sigma>'(1)]]
           ground_term_subst_domain_fv_subset[of t \<sigma>']
           subst_apply_fv_empty[OF t, of \<sigma>']
     unfolding \<delta> by auto
 
   have "\<sigma>' x = \<theta> x" for x
     using 2 3 MGU_is_Unifier[OF \<sigma>'(2)] term_subst_eq_conv[of t \<sigma>' \<theta>]
           subst_ground_ident[OF t[unfolded \<delta>], of \<sigma>'] subst_domI[of _ x]
     by metis
   hence "\<sigma>' = \<theta>" by presburger
   thus ?B using A \<sigma>'(1) unfolding \<delta> \<theta>_def by argo
 qed
 
 
 subsection \<open>Lemmata: The "Inequality Lemmata"\<close>
 text \<open>Subterm injectivity (a stronger injectivity property)\<close>
 definition subterm_inj_on where
   "subterm_inj_on f A \<equiv> \<forall>x\<in>A. \<forall>y\<in>A. (\<exists>v. v \<sqsubseteq> f x \<and> v \<sqsubseteq> f y) \<longrightarrow> x = y"
 
 lemma subterm_inj_on_imp_inj_on: "subterm_inj_on f A \<Longrightarrow> inj_on f A"
 unfolding subterm_inj_on_def inj_on_def by fastforce
 
 lemma subst_inj_on_is_bij_betw:
   "inj_on \<theta> (subst_domain \<theta>) = bij_betw \<theta> (subst_domain \<theta>) (subst_range \<theta>)"
 unfolding inj_on_def bij_betw_def by auto
 
 lemma subterm_inj_on_alt_def:
     "subterm_inj_on f A \<longleftrightarrow>
      (inj_on f A \<and> (\<forall>s \<in> f`A. \<forall>u \<in> f`A. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u))"
     (is "?A \<longleftrightarrow> ?B")
 unfolding subterm_inj_on_def inj_on_def by fastforce
 
 lemma subterm_inj_on_alt_def':
     "subterm_inj_on \<theta> (subst_domain \<theta>) \<longleftrightarrow>
      (inj_on \<theta> (subst_domain \<theta>) \<and>
       (\<forall>s \<in> subst_range \<theta>. \<forall>u \<in> subst_range \<theta>. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u))"
     (is "?A \<longleftrightarrow> ?B")
 by (metis subterm_inj_on_alt_def subst_range.simps)
 
 lemma subterm_inj_on_subset:
   assumes "subterm_inj_on f A"
     and "B \<subseteq> A"
   shows "subterm_inj_on f B"
 proof -
   have "inj_on f A" "\<forall>s\<in>f ` A. \<forall>u\<in>f ` A. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u"
     using subterm_inj_on_alt_def[of f A] assms(1) by auto
   moreover have "f ` B \<subseteq> f ` A" using assms(2) by auto
   ultimately have "inj_on f B" "\<forall>s\<in>f ` B. \<forall>u\<in>f ` B. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u"
     using inj_on_subset[of f A] assms(2) by blast+
   thus ?thesis by (metis subterm_inj_on_alt_def)
 qed
 
 lemma inj_subst_unif_consts:
   fixes \<I> \<theta> \<sigma>::"('f,'v) subst" and s t::"('f,'v) term"
   assumes \<theta>: "subterm_inj_on \<theta> (subst_domain \<theta>)" "\<forall>x \<in> (fv s \<union> fv t) - X. \<exists>c. \<theta> x = Fun c []"
              "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>) \<inter> (subterms s \<union> subterms t) = {}" "ground (subst_range \<theta>)"
              "subst_domain \<theta> \<inter> X = {}"
   and \<I>: "ground (subst_range \<I>)" "subst_domain \<I> = subst_domain \<theta>"
   and unif: "Unifier \<sigma> (s \<cdot> \<theta>) (t \<cdot> \<theta>)"
   shows "\<exists>\<delta>. Unifier \<delta> (s \<cdot> \<I>) (t \<cdot> \<I>)"
 proof -
   let ?xs = "subst_domain \<theta>"
   let ?ys = "(fv s \<union> fv t) - ?xs"
 
   have "\<exists>\<delta>::('f,'v) subst. s \<cdot> \<delta> = t \<cdot> \<delta>" by (metis subst_subst_compose unif)
   then obtain \<delta>::"('f,'v) subst" where \<delta>: "mgu s t = Some \<delta>"
     using mgu_always_unifies by moura
   have 1: "\<exists>\<sigma>::('f,'v) subst. s \<cdot> \<theta> \<cdot> \<sigma> = t \<cdot> \<theta> \<cdot> \<sigma>" by (metis unif)
   have 2: "\<And>\<gamma>::('f,'v) subst. s \<cdot> \<theta> \<cdot> \<gamma> = t \<cdot> \<theta> \<cdot> \<gamma> \<Longrightarrow> \<delta> \<preceq>\<^sub>\<circ> \<theta> \<circ>\<^sub>s \<gamma>" using mgu_gives_MGU[OF \<delta>] by simp
   have 3: "\<And>(z::'v) (c::'f). \<delta> z = Fun c [] \<Longrightarrow> Fun c [] \<sqsubseteq> s \<or> Fun c [] \<sqsubseteq> t"
     by (rule mgu_img_consts'[OF \<delta>])
   have 4: "subst_domain \<delta> \<inter> range_vars \<delta> = {}"
     by (metis mgu_gives_wellformed_subst[OF \<delta>] wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
   have 5: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv s \<union> fv t"
     by (metis mgu_gives_wellformed_MGU[OF \<delta>] wf\<^sub>M\<^sub>G\<^sub>U_def)
 
   { fix x and \<gamma>::"('f,'v) subst" assume "x \<in> subst_domain \<theta>"
     hence "(\<theta> \<circ>\<^sub>s \<gamma>) x = \<theta> x"
       using \<theta>(4) ident_comp_subst_trm_if_disj[of \<gamma> \<theta>]
       unfolding range_vars_alt_def by fast
   }
   then obtain \<tau>::"('f,'v) subst" where \<tau>: "\<forall>x \<in> subst_domain \<theta>. \<theta> x = (\<delta> \<circ>\<^sub>s \<tau>) x" using 1 2 by moura
 
   have *: "\<And>x. x \<in> subst_domain \<delta> \<inter> subst_domain \<theta> \<Longrightarrow> \<exists>y \<in> ?ys. \<delta> x = Var y"
   proof -
     fix x assume "x \<in> subst_domain \<delta> \<inter> ?xs"
     hence x: "x \<in> subst_domain \<delta>" "x \<in> subst_domain \<theta>" by auto
     then obtain c where c: "\<theta> x = Fun c []" using \<theta>(2,5) 5 by moura
     hence *: "(\<delta> \<circ>\<^sub>s \<tau>) x = Fun c []" using \<tau> x by fastforce
     hence **: "x \<in> subst_domain (\<delta> \<circ>\<^sub>s \<tau>)" "Fun c [] \<in> subst_range (\<delta> \<circ>\<^sub>s \<tau>)"
       by (auto simp add: subst_domain_def)
     have "\<delta> x = Fun c [] \<or> (\<exists>z. \<delta> x = Var z \<and> \<tau> z = Fun c [])"
       by (rule subst_img_comp_subset_const'[OF *])
     moreover have "\<delta> x \<noteq> Fun c []"
     proof (rule ccontr)
       assume "\<not>\<delta> x \<noteq> Fun c []"
       hence "Fun c [] \<sqsubseteq> s \<or> Fun c [] \<sqsubseteq> t" using 3 by metis
       moreover have "\<forall>u \<in> subst_range \<theta>. u \<notin> subterms s \<union> subterms t"
         using \<theta>(3) by force
       hence "Fun c [] \<notin> subterms s \<union> subterms t"
         by (metis c \<open>ground (subst_range \<theta>)\<close>x(2) ground_subst_dom_iff_img) 
       ultimately show False by auto
     qed
     moreover have "\<forall>x' \<in> subst_domain \<theta>. \<delta> x \<noteq> Var x'"
     proof (rule ccontr)
       assume "\<not>(\<forall>x' \<in> subst_domain \<theta>. \<delta> x \<noteq> Var x')"
       then obtain x' where x': "x' \<in> subst_domain \<theta>" "\<delta> x = Var x'" by moura
       hence "\<tau> x' = Fun c []" "(\<delta> \<circ>\<^sub>s \<tau>) x = Fun c []" using * unfolding subst_compose_def by auto
       moreover have "x \<noteq> x'"
         using x(1) x'(2) 4
         by (auto simp add: subst_domain_def)
       moreover have "x' \<notin> subst_domain \<delta>"
         using x'(2) mgu_eliminates_dom[OF \<delta>]
-        by (metis (no_types) subst_elim_def subst_apply_term.simps(1) vars_iff_subterm_or_eq)
+        by (metis (no_types) subst_elim_def eval_term.simps(1) vars_iff_subterm_or_eq)
       moreover have "(\<delta> \<circ>\<^sub>s \<tau>) x = \<theta> x" "(\<delta> \<circ>\<^sub>s \<tau>) x' = \<theta> x'" using \<tau> x(2) x'(1) by auto
       ultimately show False
         using subterm_inj_on_imp_inj_on[OF \<theta>(1)] *
         by (simp add: inj_on_def subst_compose_def x'(2) subst_domain_def)
     qed
     ultimately show "\<exists>y \<in> ?ys. \<delta> x = Var y"
       by (metis 5 x(2) subtermeqI' vars_iff_subtermeq DiffI Un_iff subst_fv_imgI sup.orderE)
   qed
 
   have **: "inj_on \<delta> (subst_domain \<delta> \<inter> ?xs)"
   proof (intro inj_onI)
     fix x y assume *:
       "x \<in> subst_domain \<delta> \<inter> subst_domain \<theta>" "y \<in> subst_domain \<delta> \<inter> subst_domain \<theta>" "\<delta> x = \<delta> y"
     hence "(\<delta> \<circ>\<^sub>s \<tau>) x = (\<delta> \<circ>\<^sub>s \<tau>) y" unfolding subst_compose_def by auto
     hence "\<theta> x = \<theta> y" using \<tau> * by auto
     thus "x = y" using inj_onD[OF subterm_inj_on_imp_inj_on[OF \<theta>(1)]] *(1,2) by simp
   qed
 
   define \<alpha> where "\<alpha> = (\<lambda>y'. if Var y' \<in> \<delta> ` (subst_domain \<delta> \<inter> ?xs)
                             then Var ((inv_into (subst_domain \<delta> \<inter> ?xs) \<delta>) (Var y'))
                             else Var y'::('f,'v) term)"
   have a1: "Unifier (\<delta> \<circ>\<^sub>s \<alpha>) s t" using mgu_gives_MGU[OF \<delta>] by auto
 
   define \<delta>' where "\<delta>' = \<delta> \<circ>\<^sub>s \<alpha>"
   have d1: "subst_domain \<delta>' \<subseteq> ?ys"
   proof
     fix z assume z: "z \<in> subst_domain \<delta>'"
     have "z \<in> ?xs \<Longrightarrow> z \<notin> subst_domain \<delta>'"
     proof (cases "z \<in> subst_domain \<delta>")
       case True
       moreover assume "z \<in> ?xs"
       ultimately have z_in: "z \<in> subst_domain \<delta> \<inter> ?xs" by simp
       then obtain y where y: "\<delta> z = Var y" "y \<in> ?ys" using * by moura
       hence "\<alpha> y = Var ((inv_into (subst_domain \<delta> \<inter> ?xs) \<delta>) (Var y))"
         using \<alpha>_def z_in by simp
       hence "\<alpha> y = Var z" by (metis y(1) z_in ** inv_into_f_eq)
       hence "\<delta>' z = Var z" using \<delta>'_def y(1) subst_compose_def[of \<delta> \<alpha>] by simp
       thus ?thesis by (simp add: subst_domain_def)
     next
       case False
       hence "\<delta> z = Var z" by (simp add: subst_domain_def)
       moreover assume "z \<in> ?xs"
       hence "\<alpha> z = Var z" using \<alpha>_def * by force
       ultimately show ?thesis
         using \<delta>'_def subst_compose_def[of \<delta> \<alpha>]
         by (simp add: subst_domain_def)
     qed
     moreover have "subst_domain \<alpha> \<subseteq> range_vars \<delta>"
       unfolding \<delta>'_def \<alpha>_def range_vars_alt_def
       by (auto simp add: subst_domain_def)
     hence "subst_domain \<delta>' \<subseteq> subst_domain \<delta> \<union> range_vars \<delta>"
       using subst_domain_compose[of \<delta> \<alpha>] unfolding \<delta>'_def by blast
     ultimately show "z \<in> ?ys" using 5 z by auto
   qed
   have d2: "Unifier (\<delta>' \<circ>\<^sub>s \<I>) s t" using a1 \<delta>'_def by auto
   have d3: "\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I> = \<delta>' \<circ>\<^sub>s \<I>"
   proof -
     { fix z::'v assume z: "z \<in> ?xs"
       then obtain u where u: "\<I> z = u" "fv u = {}" using \<I> by auto
       hence "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = u" by (simp add: subst_compose subst_ground_ident)
       moreover have "z \<notin> subst_domain \<delta>'" using d1 z by auto
       hence "\<delta>' z = Var z" by (simp add: subst_domain_def)
       hence "(\<delta>' \<circ>\<^sub>s \<I>) z = u" using u(1) by (simp add: subst_compose)
       ultimately have "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = (\<delta>' \<circ>\<^sub>s \<I>) z" by metis
     } moreover {
       fix z::'v assume "z \<in> ?ys"
       hence "z \<notin> subst_domain \<I>" using \<I>(2) by auto
       hence "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = (\<delta>' \<circ>\<^sub>s \<I>) z" by (simp add: subst_compose subst_domain_def)
     } moreover {
       fix z::'v assume "z \<notin> ?xs" "z \<notin> ?ys"
       hence "\<I> z = Var z" "\<delta>' z = Var z" using \<I>(2) d1 by blast+
       hence "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = (\<delta>' \<circ>\<^sub>s \<I>) z" by (simp add: subst_compose)
     } ultimately show ?thesis by auto
   qed
 
   from d2 d3 have "Unifier (\<delta>' \<circ>\<^sub>s \<I>) (s \<cdot> \<I>) (t \<cdot> \<I>)" by (metis subst_subst_compose) 
   thus ?thesis by metis
 qed
 
 lemma inj_subst_unif_comp_terms:
   fixes \<I> \<theta> \<sigma>::"('f,'v) subst" and s t::"('f,'v) term"
   assumes \<theta>: "subterm_inj_on \<theta> (subst_domain \<theta>)" "ground (subst_range \<theta>)"
              "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>) \<inter> (subterms s \<union> subterms t) = {}"
              "(fv s \<union> fv t) - subst_domain \<theta> \<subseteq> X"
   and tfr: "\<forall>f U. Fun f U \<in> subterms s \<union> subterms t \<longrightarrow> U = [] \<or> (\<exists>u \<in> set U. u \<notin> Var ` X)"
   and \<I>: "ground (subst_range \<I>)" "subst_domain \<I> = subst_domain \<theta>"
   and unif: "Unifier \<sigma> (s \<cdot> \<theta>) (t \<cdot> \<theta>)"
   shows "\<exists>\<delta>. Unifier \<delta> (s \<cdot> \<I>) (t \<cdot> \<I>)"
 proof -
   let ?xs = "subst_domain \<theta>"
   let ?ys = "(fv s \<union> fv t) - ?xs"
 
   have "ground (subst_range \<theta>)" using \<theta>(2) by auto
 
   have "\<exists>\<delta>::('f,'v) subst. s \<cdot> \<delta> = t \<cdot> \<delta>" by (metis subst_subst_compose unif)
   then obtain \<delta>::"('f,'v) subst" where \<delta>: "mgu s t = Some \<delta>"
     using mgu_always_unifies by moura
   have 1: "\<exists>\<sigma>::('f,'v) subst. s \<cdot> \<theta> \<cdot> \<sigma> = t \<cdot> \<theta> \<cdot> \<sigma>" by (metis unif)
   have 2: "\<And>\<gamma>::('f,'v) subst. s \<cdot> \<theta> \<cdot> \<gamma> = t \<cdot> \<theta> \<cdot> \<gamma> \<Longrightarrow> \<delta> \<preceq>\<^sub>\<circ> \<theta> \<circ>\<^sub>s \<gamma>" using mgu_gives_MGU[OF \<delta>] by simp
   have 3: "\<And>(z::'v) (c::'f).  Fun c [] \<sqsubseteq> \<delta> z \<Longrightarrow> Fun c [] \<sqsubseteq> s \<or> Fun c [] \<sqsubseteq> t"
     using mgu_img_consts[OF \<delta>] by force
   have 4: "subst_domain \<delta> \<inter> range_vars \<delta> = {}"
     using mgu_gives_wellformed_subst[OF \<delta>]
     by (metis wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
   have 5: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv s \<union> fv t"
     using mgu_gives_wellformed_MGU[OF \<delta>]
     by (metis wf\<^sub>M\<^sub>G\<^sub>U_def)
 
   { fix x and \<gamma>::"('f,'v) subst" assume "x \<in> subst_domain \<theta>"
     hence "(\<theta> \<circ>\<^sub>s \<gamma>) x = \<theta> x"
       using \<open>ground (subst_range \<theta>)\<close> ident_comp_subst_trm_if_disj[of \<gamma> \<theta> x]
       unfolding range_vars_alt_def by blast
   }
   then obtain \<tau>::"('f,'v) subst" where \<tau>: "\<forall>x \<in> subst_domain \<theta>. \<theta> x = (\<delta> \<circ>\<^sub>s \<tau>) x" using 1 2 by moura
 
   have ***: "\<And>x. x \<in> subst_domain \<delta> \<inter> subst_domain \<theta> \<Longrightarrow> fv (\<delta> x) \<subseteq> ?ys"
   proof -
     fix x assume "x \<in> subst_domain \<delta> \<inter> ?xs"
     hence x: "x \<in> subst_domain \<delta>" "x \<in> subst_domain \<theta>" by auto
     moreover have "\<not>(\<exists>x' \<in> ?xs. x' \<in> fv (\<delta> x))"
     proof (rule ccontr)
       assume "\<not>\<not>(\<exists>x' \<in> ?xs. x' \<in> fv (\<delta> x))"
       then obtain x' where x': "x' \<in> fv (\<delta> x)" "x' \<in> ?xs" by metis
       have "x \<noteq> x'" "x' \<notin> subst_domain \<delta>" "\<delta> x' = Var x'"
         using 4 x(1) x'(1) unfolding range_vars_alt_def by auto
       hence "(\<delta> \<circ>\<^sub>s \<tau>) x' \<sqsubseteq> (\<delta> \<circ>\<^sub>s \<tau>) x" "\<tau> x' = (\<delta> \<circ>\<^sub>s \<tau>) x'"
         using \<tau> x(2) x'(2)
         by (metis subst_compose subst_mono vars_iff_subtermeq x'(1),
-            metis subst_apply_term.simps(1) subst_compose_def)
+            metis eval_term.simps(1) subst_compose_def)
       hence "\<theta> x' \<sqsubseteq> \<theta> x" using \<tau> x(2) x'(2) by auto
       thus False
         using \<theta>(1) x'(2) x(2) \<open>x \<noteq> x'\<close>
         unfolding subterm_inj_on_def 
         by (meson subtermeqI') 
     qed
     ultimately show "fv (\<delta> x) \<subseteq> ?ys"
       using 5 subst_dom_vars_in_subst[of x \<delta>] subst_fv_imgI[of \<delta> x]
       by blast
   qed
 
   have **: "inj_on \<delta> (subst_domain \<delta> \<inter> ?xs)"
   proof (intro inj_onI)
     fix x y assume *:
       "x \<in> subst_domain \<delta> \<inter> subst_domain \<theta>" "y \<in> subst_domain \<delta> \<inter> subst_domain \<theta>" "\<delta> x = \<delta> y"
     hence "(\<delta> \<circ>\<^sub>s \<tau>) x = (\<delta> \<circ>\<^sub>s \<tau>) y" unfolding subst_compose_def by auto
     hence "\<theta> x = \<theta> y" using \<tau> * by auto
     thus "x = y" using inj_onD[OF subterm_inj_on_imp_inj_on[OF \<theta>(1)]] *(1,2) by simp
   qed
 
   have *: "\<And>x. x \<in> subst_domain \<delta> \<inter> subst_domain \<theta> \<Longrightarrow> \<exists>y \<in> ?ys. \<delta> x = Var y"
   proof (rule ccontr)
     fix xi assume xi_assms: "xi \<in> subst_domain \<delta> \<inter> subst_domain \<theta>" "\<not>(\<exists>y \<in> ?ys. \<delta> xi = Var y)"
     hence xi_\<theta>: "xi \<in> subst_domain \<theta>" and \<delta>_xi_comp: "\<not>(\<exists>y. \<delta> xi = Var y)"
       using ***[of xi] 5 by auto
     then obtain f T where f: "\<delta> xi = Fun f T" by (cases "\<delta> xi") moura
 
     have "\<exists>g Y'. Y' \<noteq> [] \<and> Fun g (map Var Y') \<sqsubseteq> \<delta> xi \<and> set Y' \<subseteq> ?ys"
     proof -
       have "\<forall>c. Fun c [] \<sqsubseteq> \<delta> xi \<longrightarrow> Fun c [] \<sqsubseteq> \<theta> xi"
         using \<tau> xi_\<theta> by (metis const_subterm_subst subst_compose)
       hence 1: "\<forall>c. \<not>(Fun c [] \<sqsubseteq> \<delta> xi)"
         using 3[of _ xi] xi_\<theta> \<theta>(3)
         by auto
       
       have "\<not>(\<exists>x. \<delta> xi = Var x)" using f by auto
       hence "\<exists>g S. Fun g S \<sqsubseteq> \<delta> xi \<and> (\<forall>s \<in> set S. (\<exists>c. s = Fun c []) \<or> (\<exists>x. s = Var x))"
         using nonvar_term_has_composed_shallow_term[of "\<delta> xi"] by auto
       then obtain g S where gS: "Fun g S \<sqsubseteq> \<delta> xi" "\<forall>s \<in> set S. (\<exists>c. s = Fun c []) \<or> (\<exists>x. s = Var x)"
         by moura
 
       have "\<forall>s \<in> set S. \<exists>x. s = Var x"
         using 1 term.order_trans gS
         by (metis (no_types, lifting) UN_I term.order_refl subsetCE subterms.simps(2) sup_ge2)
       then obtain S' where 2: "map Var S' = S" by (metis ex_map_conv)
 
       have "S \<noteq> []" using 1 term.order_trans[OF _ gS(1)] by fastforce
       hence 3: "S' \<noteq> []" "Fun g (map Var S') \<sqsubseteq> \<delta> xi" using gS(1) 2 by auto
 
       have "set S' \<subseteq> fv (Fun g (map Var S'))" by simp
       hence 4: "set S' \<subseteq> fv (\<delta> xi)" using 3(2) fv_subterms by force
       
       show ?thesis using ***[OF xi_assms(1)] 2 3 4 by auto
     qed
     then obtain g Y' where g: "Y' \<noteq> []" "Fun g (map Var Y') \<sqsubseteq> \<delta> xi" "set Y' \<subseteq> ?ys" by moura
     then obtain X where X: "map \<delta> X = map Var Y'" "Fun g (map Var X) \<in> subterms s \<union> subterms t"
       using mgu_img_composed_var_term[OF \<delta>, of g Y'] by force
     hence "\<exists>(u::('f,'v) term) \<in> set (map Var X). u \<notin> Var ` ?ys"
       using \<theta>(4) tfr g(1) by fastforce
     then obtain j where j: "j < length X" "X ! j \<notin> ?ys"
       by (metis image_iff[of _ Var "fv s \<union> fv t - subst_domain \<theta>"] nth_map[of _ X Var]
                 in_set_conv_nth[of _ "map Var X"] length_map[of Var X])
 
     define yj' where yj': "yj' \<equiv> Y' ! j"
     define xj where xj: "xj \<equiv> X ! j"
 
     have "xj \<in> fv s \<union> fv t"
       using j X(1) g(3) 5 xj yj'
       by (metis length_map nth_map term.simps(1) in_set_conv_nth le_supE subsetCE subst_domI) 
     hence xj_\<theta>: "xj \<in> subst_domain \<theta>" using j unfolding xj by simp
 
     have len: "length X = length Y'" by (rule map_eq_imp_length_eq[OF X(1)])
     
     have "Var yj' \<sqsubseteq> \<delta> xi"
       using term.order_trans[OF _ g(2)] j(1) len unfolding yj' by auto
     hence "\<tau> yj' \<sqsubseteq> \<theta> xi"
-      using \<tau> xi_\<theta> by (metis subst_apply_term.simps(1) subst_compose_def subst_mono) 
+      using \<tau> xi_\<theta> by (metis eval_term.simps(1) subst_compose_def subst_mono) 
     moreover have \<delta>_xj_var: "Var yj' = \<delta> xj"
       using X(1) len j(1) nth_map
       unfolding xj yj' by metis
-    hence "\<tau> yj' = \<theta> xj" using \<tau> xj_\<theta> by (metis subst_apply_term.simps(1) subst_compose_def) 
+    hence "\<tau> yj' = \<theta> xj" using \<tau> xj_\<theta> by (metis eval_term.simps(1) subst_compose_def) 
     moreover have "xi \<noteq> xj" using \<delta>_xi_comp \<delta>_xj_var by auto
     ultimately show False using \<theta>(1) xi_\<theta> xj_\<theta> unfolding subterm_inj_on_def by blast
   qed
 
   define \<alpha> where "\<alpha> = (\<lambda>y'. if Var y' \<in> \<delta> ` (subst_domain \<delta> \<inter> ?xs)
                             then Var ((inv_into (subst_domain \<delta> \<inter> ?xs) \<delta>) (Var y'))
                             else Var y'::('f,'v) term)"
   have a1: "Unifier (\<delta> \<circ>\<^sub>s \<alpha>) s t" using mgu_gives_MGU[OF \<delta>] by auto
 
   define \<delta>' where "\<delta>' = \<delta> \<circ>\<^sub>s \<alpha>"
   have d1: "subst_domain \<delta>' \<subseteq> ?ys"
   proof
     fix z assume z: "z \<in> subst_domain \<delta>'"
     have "z \<in> ?xs \<Longrightarrow> z \<notin> subst_domain \<delta>'"
     proof (cases "z \<in> subst_domain \<delta>")
       case True
       moreover assume "z \<in> ?xs"
       ultimately have z_in: "z \<in> subst_domain \<delta> \<inter> ?xs" by simp
       then obtain y where y: "\<delta> z = Var y" "y \<in> ?ys" using * by moura
       hence "\<alpha> y = Var ((inv_into (subst_domain \<delta> \<inter> ?xs) \<delta>) (Var y))"
         using \<alpha>_def z_in by simp
       hence "\<alpha> y = Var z" by (metis y(1) z_in ** inv_into_f_eq)
       hence "\<delta>' z = Var z" using \<delta>'_def y(1) subst_compose_def[of \<delta> \<alpha>] by simp
       thus ?thesis by (simp add: subst_domain_def)
     next
       case False
       hence "\<delta> z = Var z" by (simp add: subst_domain_def)
       moreover assume "z \<in> ?xs"
       hence "\<alpha> z = Var z" using \<alpha>_def * by force
       ultimately show ?thesis using \<delta>'_def subst_compose_def[of \<delta> \<alpha>] by (simp add: subst_domain_def)
     qed
     moreover have "subst_domain \<alpha> \<subseteq> range_vars \<delta>"
       unfolding \<delta>'_def \<alpha>_def range_vars_alt_def subst_domain_def
       by auto
     hence "subst_domain \<delta>' \<subseteq> subst_domain \<delta> \<union> range_vars \<delta>"
       using subst_domain_compose[of \<delta> \<alpha>]
       unfolding \<delta>'_def by blast
     ultimately show "z \<in> ?ys" using 5 z by blast
   qed
   have d2: "Unifier (\<delta>' \<circ>\<^sub>s \<I>) s t" using a1 \<delta>'_def by auto
   have d3: "\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I> = \<delta>' \<circ>\<^sub>s \<I>"
   proof -
     { fix z::'v assume z: "z \<in> ?xs"
       then obtain u where u: "\<I> z = u" "fv u = {}" using \<I> by auto
       hence "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = u" by (simp add: subst_compose subst_ground_ident)
       moreover have "z \<notin> subst_domain \<delta>'" using d1 z by auto
       hence "\<delta>' z = Var z" by (simp add: subst_domain_def)
       hence "(\<delta>' \<circ>\<^sub>s \<I>) z = u" using u(1) by (simp add: subst_compose)
       ultimately have "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = (\<delta>' \<circ>\<^sub>s \<I>) z" by metis
     } moreover {
       fix z::'v assume "z \<in> ?ys"
       hence "z \<notin> subst_domain \<I>" using \<I>(2) by auto
       hence "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = (\<delta>' \<circ>\<^sub>s \<I>) z" by (simp add: subst_compose subst_domain_def)
     } moreover {
       fix z::'v assume "z \<notin> ?xs" "z \<notin> ?ys"
       hence "\<I> z = Var z" "\<delta>' z = Var z" using \<I>(2) d1 by blast+
       hence "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = (\<delta>' \<circ>\<^sub>s \<I>) z" by (simp add: subst_compose)
     } ultimately show ?thesis by auto
   qed
 
   from d2 d3 have "Unifier (\<delta>' \<circ>\<^sub>s \<I>) (s \<cdot> \<I>) (t \<cdot> \<I>)" by (metis subst_subst_compose) 
   thus ?thesis by metis
 qed
 
 context
 begin
 private lemma sat_ineq_subterm_inj_subst_aux:
   fixes \<I>::"('f,'v) subst"
   assumes "Unifier \<sigma> (s \<cdot> \<I>) (t \<cdot> \<I>)" "ground (subst_range \<I>)"
           "(fv s \<union> fv t) - X \<subseteq> subst_domain \<I>" "subst_domain \<I> \<inter> X = {}"
   shows "\<exists>\<delta>::('f,'v) subst. subst_domain \<delta> = X \<and> ground (subst_range \<delta>) \<and> s \<cdot> \<delta> \<cdot> \<I> = t \<cdot> \<delta> \<cdot> \<I>"
 proof -
   have "\<exists>\<sigma>. Unifier \<sigma> (s \<cdot> \<I>) (t \<cdot> \<I>) \<and> interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>"
   proof -
     obtain \<I>'::"('f,'v) subst" where *: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>'"
       using interpretation_subst_exists by metis
     hence "Unifier (\<sigma> \<circ>\<^sub>s \<I>') (s \<cdot> \<I>) (t \<cdot> \<I>)" using assms(1) by simp
     thus ?thesis using * interpretation_comp by blast
   qed
   then obtain \<sigma>' where \<sigma>': "Unifier \<sigma>' (s \<cdot> \<I>) (t \<cdot> \<I>)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>'" by moura
   
   define \<sigma>'' where "\<sigma>'' = rm_vars (UNIV - X) \<sigma>'"
   
   have *: "fv (s \<cdot> \<I>) \<subseteq> X" "fv (t \<cdot> \<I>) \<subseteq> X"
     using assms(2,3) subst_fv_unfold_ground_img[of \<I>]
     unfolding range_vars_alt_def
     by (simp_all add: Diff_subset_conv Un_commute)
   hence **: "subst_domain \<sigma>'' = X" "ground (subst_range \<sigma>'')"
     using rm_vars_img_subset[of "UNIV - X" \<sigma>'] rm_vars_dom[of "UNIV - X" \<sigma>'] \<sigma>'(2)
     unfolding \<sigma>''_def by auto
   hence "\<And>t. t \<cdot> \<I> \<cdot> \<sigma>'' = t \<cdot> \<sigma>'' \<cdot> \<I>"
     using subst_eq_if_disjoint_vars_ground[OF _ _ assms(2)] assms(4) by blast
   moreover have "Unifier \<sigma>'' (s \<cdot> \<I>) (t \<cdot> \<I>)"
     using Unifier_dom_restrict[OF \<sigma>'(1)] \<sigma>''_def * by blast
   ultimately show ?thesis using ** by auto
 qed
 
 text \<open>
   The "inequality lemma": This lemma gives sufficient syntactic conditions for finding substitutions
   \<open>\<theta>\<close> under which terms \<open>s\<close> and \<open>t\<close> are not unifiable.
 
   This is useful later when establishing the typing results since we there want to find well-typed
   solutions to inequality constraints / "negative checks" constraints, and this lemma gives
   conditions for protocols under which such constraints are well-typed satisfiable if satisfiable.
 \<close>
 lemma sat_ineq_subterm_inj_subst:
   fixes \<theta> \<I> \<delta>::"('f,'v) subst"
   assumes \<theta>: "subterm_inj_on \<theta> (subst_domain \<theta>)"
              "ground (subst_range \<theta>)"
              "subst_domain \<theta> \<inter> X = {}"
              "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>) \<inter> (subterms s \<union> subterms t) = {}"
              "(fv s \<union> fv t) - subst_domain \<theta> \<subseteq> X"
   and tfr: "(\<forall>x \<in> (fv s \<union> fv t) - X. \<exists>c. \<theta> x = Fun c []) \<or>
             (\<forall>f U. Fun f U \<in> subterms s \<union> subterms t \<longrightarrow> U = [] \<or> (\<exists>u \<in> set U. u \<notin> Var ` X))"
   and \<I>: "\<forall>\<delta>::('f,'v) subst. subst_domain \<delta> = X \<and> ground (subst_range \<delta>) \<longrightarrow> s \<cdot> \<delta> \<cdot> \<I> \<noteq> t \<cdot> \<delta> \<cdot> \<I>"
          "(fv s \<union> fv t) - X \<subseteq> subst_domain \<I>" "subst_domain \<I> \<inter> X = {}" "ground (subst_range \<I>)"
          "subst_domain \<I> = subst_domain \<theta>"
   and \<delta>: "subst_domain \<delta> = X" "ground (subst_range \<delta>)"
   shows "s \<cdot> \<delta> \<cdot> \<theta> \<noteq> t \<cdot> \<delta> \<cdot> \<theta>"
 proof -
   have "\<forall>\<sigma>. \<not>Unifier \<sigma> (s \<cdot> \<I>) (t \<cdot> \<I>)"
     by (metis \<I>(1) sat_ineq_subterm_inj_subst_aux[OF _ \<I>(4,2,3)])
   hence "\<not>Unifier \<delta> (s \<cdot> \<theta>) (t \<cdot> \<theta>)"
     using inj_subst_unif_consts[OF \<theta>(1) _ \<theta>(4,2,3) \<I>(4,5)]
           inj_subst_unif_comp_terms[OF \<theta>(1,2,4,5) _ \<I>(4,5)]
           tfr
     by metis
   moreover have "subst_domain \<delta> \<inter> subst_domain \<theta> = {}" using \<theta>(2,3) \<delta>(1) by auto
   ultimately show ?thesis using \<delta> subst_eq_if_disjoint_vars_ground[OF _ \<theta>(2) \<delta>(2)] by metis
 qed
 end
 
 lemma ineq_subterm_inj_cond_subst:
   assumes "X \<inter> range_vars \<theta> = {}"
   and "\<forall>f T. Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t S \<longrightarrow> T = [] \<or> (\<exists>u \<in> set T. u \<notin> Var`X)"
   shows "\<forall>f T. Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<longrightarrow> T = [] \<or> (\<exists>u \<in> set T. u \<notin> Var`X)"
 proof (intro allI impI)
   let ?M = "\<lambda>S. subterms\<^sub>s\<^sub>e\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
   let ?N = "\<lambda>S. subterms\<^sub>s\<^sub>e\<^sub>t (\<theta> ` (fv\<^sub>s\<^sub>e\<^sub>t S \<inter> subst_domain \<theta>))"
 
   fix f T assume "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   hence 1: "Fun f T \<in> ?M S \<or> Fun f T \<in> ?N S"
     using subterms_subst[of _ \<theta>] by auto
 
   have 2: "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>) \<Longrightarrow> \<forall>u \<in> set T. u \<notin> Var`X"
     using fv_subset_subterms[of "Fun f T" "subst_range \<theta>"] assms(1)
     unfolding range_vars_alt_def by force
 
   have 3: "\<forall>x \<in> subst_domain \<theta>. \<theta> x \<notin> Var`X"
   proof
     fix x assume "x \<in> subst_domain \<theta>"
     hence "fv (\<theta> x) \<subseteq> range_vars \<theta>"
       using subst_dom_vars_in_subst subst_fv_imgI
       unfolding range_vars_alt_def by auto
     thus "\<theta> x \<notin> Var`X" using assms(1) by auto
   qed
 
   show "T = [] \<or> (\<exists>s \<in> set T. s \<notin> Var`X)" using 1
   proof
     assume "Fun f T \<in> ?M S"
     then obtain u where u: "u \<in> subterms\<^sub>s\<^sub>e\<^sub>t S" "u \<cdot> \<theta> = Fun f T" by fastforce
     show ?thesis
     proof (cases u)
       case (Var x)
       hence "Fun f T \<in> subst_range \<theta>" using u(2) by (simp add: subst_domain_def)
       hence "\<forall>u \<in> set T. u \<notin> Var`X" using 2 by force
       thus ?thesis by auto
     next
       case (Fun g S)
       hence "S = [] \<or> (\<exists>u \<in> set S. u \<notin> Var`X)" using assms(2) u(1) by metis
       thus ?thesis
       proof
         assume "S = []" thus ?thesis using u(2) Fun by simp
       next
         assume "\<exists>u \<in> set S. u \<notin> Var`X"
         then obtain u' where u': "u' \<in> set S" "u' \<notin> Var`X" by moura
         hence "u' \<cdot> \<theta> \<in> set T" using u(2) Fun by auto
         thus ?thesis using u'(2) 3 by (cases u') force+
       qed
     qed
   next
     assume "Fun f T \<in> ?N S"
     thus ?thesis using 2 by force
   qed
 qed
 
 
 subsection \<open>Lemmata: Sufficient Conditions for Term Matching\<close>
 definition subst_var_inv::"('a,'b) subst \<Rightarrow> 'b set \<Rightarrow> ('a,'b) subst" where
   "subst_var_inv \<delta> X \<equiv> (\<lambda>x. if Var x \<in> \<delta> ` X then Var ((inv_into X \<delta>) (Var x)) else Var x)"
 
 lemma subst_var_inv_subst_domain:
   assumes "x \<in> subst_domain (subst_var_inv \<delta> X)"
   shows "Var x \<in> \<delta> ` X"
 by (meson assms subst_dom_vars_in_subst subst_var_inv_def)
 
 lemma subst_var_inv_subst_domain':
   assumes "X \<subseteq> subst_domain \<delta>"
   shows "x \<in> subst_domain (subst_var_inv \<delta> X) \<longleftrightarrow> Var x \<in> \<delta> ` X"
 proof
   show "Var x \<in> \<delta> ` X \<Longrightarrow> x \<in> subst_domain (subst_var_inv \<delta> X)"
     by (metis (no_types, lifting) assms f_inv_into_f in_mono inv_into_into
           subst_domI subst_dom_vars_in_subst subst_var_inv_def term.inject(1))
 qed (rule subst_var_inv_subst_domain)
 
 lemma subst_var_inv_Var_range:
   "subst_range (subst_var_inv \<delta> X) \<subseteq> range Var"
 unfolding subst_var_inv_def by auto
 
 text \<open>Injective substitutions from variables to variables are invertible\<close>
 lemma inj_var_ran_subst_is_invertible:
   assumes \<delta>_inj_on_X: "inj_on \<delta> X"
     and \<delta>_var_on_X: "\<delta> ` X \<subseteq> range Var"
     and fv_t: "fv t \<subseteq> X"
   shows "t = t \<cdot> \<delta> \<circ>\<^sub>s subst_var_inv \<delta> X"
 proof -
   have "\<delta> x \<cdot> subst_var_inv \<delta> X = Var x" when x: "x \<in> X" for x
   proof -
     obtain y where y: "\<delta> x = Var y" using x \<delta>_var_on_X fv_t by auto
     hence "Var y \<in> \<delta> ` X" using x by simp
     thus ?thesis using y inv_into_f_eq[OF \<delta>_inj_on_X x y] unfolding subst_var_inv_def by simp
   qed
   thus ?thesis using fv_t by (simp add: subst_compose_def trm_subst_ident'' subset_eq)
 qed
 
 lemma inj_var_ran_subst_is_invertible':
   assumes \<delta>_inj_on_t: "inj_on \<delta> (fv t)"
     and \<delta>_var_on_t: "\<delta> ` fv t \<subseteq> range Var"
   shows "t = t \<cdot> \<delta> \<circ>\<^sub>s subst_var_inv \<delta> (fv t)"
 using assms inj_var_ran_subst_is_invertible by fast
 
 text \<open>Sufficient conditions for matching unifiable terms\<close>
 lemma inj_var_ran_unifiable_has_subst_match:
   assumes "t \<cdot> \<delta> = s \<cdot> \<delta>" "inj_on \<delta> (fv t)" "\<delta> ` fv t \<subseteq> range Var"
   shows "t = s \<cdot> \<delta> \<circ>\<^sub>s subst_var_inv \<delta> (fv t)"
 using assms inj_var_ran_subst_is_invertible by fastforce
 
 end
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,3795 +1,3795 @@
 (*  Title:      Stateful_Compositionality.thy
     Author:     Andreas Viktor Hess, DTU
     SPDX-License-Identifier: BSD-3-Clause
 *)
 
 
 section \<open>Stateful Protocol Compositionality\<close>
 
 theory Stateful_Compositionality
 imports Stateful_Typing Parallel_Compositionality Labeled_Stateful_Strands
 begin
 text\<open>\label{sec:Stateful-Compositionality}\<close>
 
 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 simp add: dbproj_def)
   next
     case False thus ?thesis using Cons.prems(1) dl by (auto simp add: dbproj_def)
   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 dbproj_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 simp add: dbproj_def)
 qed (simp add: dbproj_def)
 
 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" unfolding dbproj_def 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 unfolding dbproj_def 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_typing_result) 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>ts\<rangle>)) = {}"
   "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,receive\<langle>ts\<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> 
     (\<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>
     (\<forall>s \<in> Secrets. \<not>{} \<turnstile>\<^sub>c s) \<and> ground 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> {s. \<Union>{set ts | ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>)} \<turnstile> s}"
 
 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>]))"
 
 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"
 
 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>"
 
 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>ts\<rangle>)#A) D = map ((#) (i,send\<langle>ts\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>c A D)"
 | "tr\<^sub>p\<^sub>c ((i,receive\<langle>ts\<rangle>)#A) D = map ((#) (i,receive\<langle>ts\<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)"
 
 end
 
 locale labeled_stateful_typing =
   labeled_stateful_typed_model arity public Ana \<Gamma> Pair label_witness1 label_witness2
 + stateful_typing_result arity public Ana \<Gamma> Pair
   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
 
 sublocale labeled_typing
 by unfold_locales
 
 end
 
 
 subsection \<open>Small Lemmata\<close>
 context labeled_stateful_typed_model
 begin
 
 lemma declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_alt_def:
   "declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I> = {s. \<Union>{set ts | ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set \<A>} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> s}"
 proof -
   have 0: "(l, receive\<langle>ts\<rangle>) \<in> set (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>) = (\<exists>ts'. (l, receive\<langle>ts'\<rangle>) \<in> set \<A> \<and> ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>)"
     (is "?A \<A> = ?B \<A>")
     for ts l
   proof
     show "?A \<A> \<Longrightarrow> ?B \<A>"
     proof (induction \<A>)
       case (Cons a \<A>)
       obtain k b where a: "a = (k,b)" by (metis surj_pair)
       show ?case
       proof (cases "?A \<A>")
         case False
         hence "(l,receive\<langle>ts\<rangle>) = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<I>" using Cons.prems subst_lsst_cons[of a \<A> \<I>] by auto
         thus ?thesis unfolding a by (cases b) auto
       qed (use Cons.IH in auto)
     qed simp
 
     show "?B \<A> \<Longrightarrow> ?A \<A>"
     proof (induction \<A>)
       case (Cons a \<A>)
       obtain k b where a: "a = (k,b)" by (metis surj_pair)
       show ?case
       proof (cases "?B \<A>")
         case False
         hence "\<exists>ts'. a = (l, receive\<langle>ts'\<rangle>) \<and> ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>" using Cons.prems by auto
         thus ?thesis using subst_lsst_cons[of a \<A> \<I>] unfolding a by (cases b) auto
       qed (use Cons.IH subst_lsst_cons[of a \<A> \<I>] in auto)
     qed simp
   qed
 
   let ?M = "\<lambda>A. \<Union>{set ts |ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set A}"
 
   have 1: "?M (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>) = ?M \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" (is "?A = ?B")
   proof
     show "?A \<subseteq> ?B"
     proof
       fix t assume t: "t \<in> ?A"
       then obtain ts where ts: "t \<in> set ts" "\<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>)" by blast
       thus "t \<in> ?B" using 0[of \<star> ts] by fastforce
     qed
     show "?B \<subseteq> ?A"
     proof
       fix t assume t: "t \<in> ?B"
       then obtain ts where ts: "t \<in> set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "\<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set \<A>" by blast
       hence "\<langle>\<star>, receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>\<rangle>\<rangle> \<in> set (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>)" using 0[of \<star> "ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>"] by blast
       thus "t \<in> ?A" using ts(1) by force
     qed
   qed
 
   show ?thesis using 1 unfolding declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by argo
 qed
 
 lemma declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_prefix_subset:
   assumes AB: "prefix A B"
   shows "declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I \<subseteq> declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t B I"
 proof
   fix t assume t: "t \<in> declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I"
   obtain C where C: "B = A@C" using prefixE[OF AB] by metis
   show "t \<in> declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t B I"
     using t ideduct_mono[of
               "\<Union>{set ts |ts. (\<star>, receive\<langle>ts\<rangle>) \<in> set A} \<cdot>\<^sub>s\<^sub>e\<^sub>t I" t 
               "\<Union>{set ts |ts. (\<star>, receive\<langle>ts\<rangle>) \<in> set B} \<cdot>\<^sub>s\<^sub>e\<^sub>t I"]
     unfolding C declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_alt_def by auto
 qed
 
 lemma declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_star_receive_supset:
   "{t | t ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set \<A> \<and> t \<in> set ts} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>"
 unfolding declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_alt_def by (fastforce intro: intruder_deduct.Axiom)
 
 lemma declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj_eq:
   "declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) I"
 using proj_mem_iff(2)[of _ A] unfolding declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_alt_def by simp
 
 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" "\<forall>s \<in> Sec. \<not>{} \<turnstile>\<^sub>c s"
   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. \<not>{} \<turnstile>\<^sub>c 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. \<not>{} \<turnstile>\<^sub>c 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 
   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'" 
           "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'" 
           "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" 
     using assms(3) subseqs_set_subset(1)[OF assms(2)]
     unfolding unlabel_def dbproj_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
 
 lemma deduct_proj_priv_term_prefix_ex_stateful:
   assumes A: "ik\<^sub>s\<^sub>s\<^sub>t (proj_unl l A) \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> t"
     and t: "\<not>{} \<turnstile>\<^sub>c t"
   shows "\<exists>B k s. (k = \<star> \<or> k = ln l) \<and> prefix (B@[(k,receive\<langle>s\<rangle>)]) A \<and>
                  declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((B@[(k,receive\<langle>s\<rangle>)])) I = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I \<and>
                  ik\<^sub>s\<^sub>s\<^sub>t (proj_unl l (B@[(k,receive\<langle>s\<rangle>)])) = ik\<^sub>s\<^sub>s\<^sub>t (proj_unl l A)"
 using A
 proof (induction A rule: List.rev_induct)
   case Nil
   have "ik\<^sub>s\<^sub>s\<^sub>t (proj_unl l []) \<cdot>\<^sub>s\<^sub>e\<^sub>t I = {}" by auto
   thus ?case using Nil t deducts_eq_if_empty_ik[of t] by argo
 next
   case (snoc a A)
   obtain k b where a: "a = (k,b)" by (metis surj_pair)
   let ?P = "k = \<star> \<or> k = (ln l)"
   let ?Q = "\<exists>s. b = receive\<langle>s\<rangle>"
 
   have 0: "ik\<^sub>s\<^sub>s\<^sub>t (proj_unl l (A@[a])) = ik\<^sub>s\<^sub>s\<^sub>t (proj_unl l A)" when "?P \<Longrightarrow> \<not>?Q"
     using that ik\<^sub>s\<^sub>s\<^sub>t_snoc_no_receive_eq[OF that, of I "proj_unl l A"]
     unfolding ik\<^sub>s\<^sub>s\<^sub>t_def a by (cases "k = \<star> \<or> k = (ln l)") auto
 
   have 1: "declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a]) I = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I" when "?P \<Longrightarrow> \<not>?Q"
     using that snoc.prems unfolding declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_alt_def a
     by (metis (no_types, lifting) UnCI UnE empty_iff insert_iff list.set prod.inject set_append)
 
   note 2 = snoc.prems snoc.IH 0 1
 
   show ?case
   proof (cases ?P)
     case True
     note T = this
     thus ?thesis
     proof (cases ?Q)
       case True thus ?thesis using T unfolding a by blast
     qed (use 2 in auto)
   qed (use 2 in auto)
 qed
 
 lemma constr_sem_stateful_proj_priv_term_prefix_obtain:
   assumes \<A>': "prefix \<A>' \<A>" "constr_sem_stateful \<I>\<^sub>\<tau> (proj_unl n \<A>'@[send\<langle>[t]\<rangle>])"
     and t: "t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>" "\<not>{} \<turnstile>\<^sub>c t" "t \<cdot> \<I>\<^sub>\<tau> = t"
   obtains B k' s where
     "k' = \<star> \<or> k' = ln n" "prefix B \<A>'" "suffix [(k', receive\<langle>s\<rangle>)] B"
     "declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<I>\<^sub>\<tau> = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>"
     "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n B) = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n \<A>')"
     "constr_sem_stateful \<I>\<^sub>\<tau> (proj_unl n B@[send\<langle>[t]\<rangle>])"
     "prefix (proj n B) (proj n \<A>)" "suffix [(k', receive\<langle>s\<rangle>)] (proj n B)"
     "t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n B) \<I>\<^sub>\<tau>"
 proof -
   have "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n \<A>') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>\<^sub>\<tau> \<turnstile> t"
     using \<A>'(2) t(3) strand_sem_append_stateful[of "{}" "{}" "proj_unl n \<A>'" "[send\<langle>[t]\<rangle>]" \<I>\<^sub>\<tau>]
     by simp
   then obtain B k' s where B:
       "k' = \<star> \<or> k' = ln n" "prefix B \<A>'" "suffix [(k', receive\<langle>s\<rangle>)] B"
       "declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<I>\<^sub>\<tau> = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>"
       "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n B) = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n \<A>')"
     using deduct_proj_priv_term_prefix_ex_stateful[OF _ t(2), of \<I>\<^sub>\<tau> n \<A>']
     unfolding suffix_def by blast
 
   have B': "constr_sem_stateful \<I>\<^sub>\<tau> (proj_unl n B@[send\<langle>[t]\<rangle>])"
     using B(5) \<A>'(2) strand_sem_append_stateful[of "{}" "{}" "proj_unl n \<A>'" "[send\<langle>[t]\<rangle>]" \<I>\<^sub>\<tau>]
           strand_sem_append_stateful[of "{}" "{}" "proj_unl n B" _ \<I>\<^sub>\<tau>]
           prefix_proj(2)[OF B(2), of n]
     by (metis (no_types, lifting) append_Nil2 prefix_def strand_sem_stateful.simps(2))
 
   have B'': "prefix (proj n B) (proj n \<A>)" "suffix [(k', receive\<langle>s\<rangle>)] (proj n B)"
             "t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n B) \<I>\<^sub>\<tau>"
     using \<A>' t B(1-4) declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj_eq[of B \<I>\<^sub>\<tau> n]
     unfolding suffix_def prefix_def proj_def by auto
 
   show ?thesis by (rule that[OF B B' B''])
 qed
 
 lemma constr_sem_stateful_star_proj_no_leakage:
   fixes Sec P lbls k
   defines "no_leakage \<equiv> \<lambda>\<A>. \<nexists>\<I>\<^sub>\<tau> \<B> s.
       prefix \<B> \<A> \<and> s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<B> \<I>\<^sub>\<tau> \<and> \<I>\<^sub>\<tau> \<Turnstile>\<^sub>s (unlabel \<B>@[send\<langle>[s]\<rangle>])"
   assumes Sec: "ground Sec"
     and \<A>: "\<forall>(l,a) \<in> set \<A>. l = \<star>"
   shows "no_leakage \<A>"
 proof (rule ccontr)
   assume "\<not>no_leakage \<A>"
   then obtain I B s where B:
       "prefix B \<A>" "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t B I" "I \<Turnstile>\<^sub>s (unlabel B@[send\<langle>[s]\<rangle>])"
     unfolding no_leakage_def by blast
 
   have 1: "\<not>(\<Union>{set ts | ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)} \<turnstile> s)"
     using B(2) unfolding declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by fast
 
   have 2: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I) \<turnstile> s"
     using B(2,3) Sec strand_sem_append_stateful[of "{}" "{}" "unlabel B" "[send\<langle>[s]\<rangle>]" I]
-          trm_subst_ident[of s I] unlabel_subst[of B] ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel B"]
+          subst_apply_term_ident[of s I] unlabel_subst[of B] ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel B"]
     by force
 
   have "l = \<star>" when "(l,c) \<in> set B" for l c
     using that \<A> B(1) set_mono_prefix by blast
   hence "l = \<star>" when "(l,c) \<in> set (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)" for l c
     using that unfolding subst_apply_labeled_stateful_strand_def by auto
   hence 3: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I) = (\<Union>{set ts | ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I)})"
     using in_ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t_iff[of _ "B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t I"] unfolding ik\<^sub>s\<^sub>s\<^sub>t_def unlabel_def by auto
 
   show False using 1 2 3 by force
 qed
 
 end
 
 subsection \<open>Lemmata: Properties of the Constraint Translation Function\<close>
 context labeled_stateful_typed_model
 begin
 
 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_alt_def declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_alt_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 unfolding ik\<^sub>s\<^sub>s\<^sub>t_def ik\<^sub>s\<^sub>t_is_rcv_set by fast
 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 dbproj_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 dbproj_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 dbproj_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)] unfolding dbproj_def 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) unfolding dbproj_def 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" unfolding dbproj_def 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 ts)
       note si = Receive i
       then obtain A'' where A'':
           "A' = (i,receive\<langle>ts\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A D)" "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<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 ts)
       note si = Send i
       then obtain A'' where A'': "A' = (i,send\<langle>ts\<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\<^sub>s\<^sub>e\<^sub>t (set ts)) (unlabel A)"
               "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<subseteq> X \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
               "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 (auto simp add: dbproj_def)
       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_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_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. \<not>{} \<turnstile>\<^sub>c s"
     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_preserves_receives:
   assumes "E \<in> set (tr\<^sub>p\<^sub>c F D)" "(l, receive\<langle>t\<rangle>) \<in> set F"
   shows "(l, receive\<langle>t\<rangle>\<^sub>s\<^sub>t) \<in> set E"
 using assms by (induct F D arbitrary: E rule: tr\<^sub>p\<^sub>c.induct) auto
 
 lemma tr_preserves_last_receive:
   assumes "E \<in> set (tr\<^sub>p\<^sub>c F D)" "suffix [(l, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E"
   shows "\<exists>G. suffix ((l, receive\<langle>t\<rangle>)#G) F \<and> list_all (Not \<circ> is_Receive \<circ> snd) G"
     (is "\<exists>G. ?P G F \<and> ?Q G")
 using assms
 proof (induction F D arbitrary: 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 E' where E': "E = (i,send\<langle>t'\<rangle>\<^sub>s\<^sub>t)#E'" "E' \<in> set (tr\<^sub>p\<^sub>c S D)"
     using prems(1) by auto
 
   obtain G where G: "?P G S" "?Q G"
     using suffix_Cons'[OF prems(2)[unfolded E'(1)]] IH[OF E'(2)] by blast
 
   show ?case by (metis suffix_Cons G)
 next
   case (3 i t' S D)
   note prems = "3.prems"
   note IH = "3.IH"
 
   obtain E' where E': "E = (i,receive\<langle>t'\<rangle>\<^sub>s\<^sub>t)#E'" "E' \<in> set (tr\<^sub>p\<^sub>c S D)"
     using prems(1) by auto
 
   show ?case using suffix_Cons'[OF prems(2)[unfolded E'(1)]]
   proof
     assume "suffix [(l, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E'"
     then obtain G where G: "?P G S" "?Q G"
       using IH[OF E'(2)] by blast
     show ?thesis by (metis suffix_Cons G)
   next
     assume "(i, receive\<langle>t'\<rangle>\<^sub>s\<^sub>t) = (l, receive\<langle>t\<rangle>\<^sub>s\<^sub>t) \<and> E' = []"
     hence *: "i = l" "t' = t" "E' = []" by simp_all
     show ?thesis
       using tr_preserves_receives[OF E'(2)]
       unfolding * list_all_iff is_Receive_def by fastforce
   qed
 next
   case (4 i ac t' t'' S D)
   note prems = "4.prems"
   note IH = "4.IH"
 
   obtain E' where E': "E = (i,\<langle>ac: t' \<doteq> t''\<rangle>\<^sub>s\<^sub>t)#E'" "E' \<in> set (tr\<^sub>p\<^sub>c S D)"
     using prems(1) by auto
 
   obtain G where G: "?P G S" "?Q G"
     using suffix_Cons'[OF prems(2)[unfolded E'(1)]] IH[OF E'(2)] by blast
 
   show ?case by (metis suffix_Cons G)
 next
   case (5 i t' s S D)
   note prems = "5.prems"
   note IH = "5.IH"
 
   have "E \<in> set (tr\<^sub>p\<^sub>c S (List.insert (i,t',s) D))" using prems(1) by auto
   thus ?case by (metis IH[OF _ prems(2)] suffix_Cons)
 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 E' Di where E':
       "E = constr Di@E'" "E' \<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(1) unfolding constr_def by auto
 
   have "receive\<langle>t\<rangle>\<^sub>s\<^sub>t \<notin> snd ` set (constr Di)" unfolding constr_def by force
   hence "\<not>suffix [(l, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] (constr Di)" unfolding suffix_def by auto
   hence "1 \<le> length E'" using prems(2) E'(1) by (cases E') auto
   hence "suffix [(l, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E'"
     using suffix_length_suffix[OF prems(2) suffixI[OF E'(1)]] by simp
   thus ?case by (metis IH[OF E'(3,2)] suffix_Cons)
 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 E' d where E': "E = constr d#E'" "E' \<in> set (tr\<^sub>p\<^sub>c S D)" "d \<in> set (dbproj i D)"
     using prems(1) unfolding constr_def by auto
 
   have "receive\<langle>t\<rangle>\<^sub>s\<^sub>t \<noteq> snd (constr d)" unfolding constr_def by force
   hence "suffix [(l, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E'" using prems(2) E'(1) suffix_Cons' by fastforce
   thus ?case by (metis IH[OF E'(2)] suffix_Cons)
 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 E' where E': "E = constr@E'" "E' \<in> set (tr\<^sub>p\<^sub>c S D)"
     using prems(1) constr_def by auto
 
   have "receive\<langle>t\<rangle>\<^sub>s\<^sub>t \<notin> snd ` set constr" unfolding constr_def by force
   hence "\<not>suffix [(l, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] constr" unfolding suffix_def by auto
   hence "1 \<le> length E'" using prems(2) E'(1) by (cases E') auto
   hence "suffix [(l, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E'"
     using suffix_length_suffix[OF prems(2) suffixI[OF E'(1)]] by simp
   thus ?case by (metis IH[OF E'(2)] suffix_Cons)
 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"
   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) \<and>
                (\<not>{} \<turnstile>\<^sub>c t \<longrightarrow> (\<exists>l s G. suffix ((l, receive\<langle>s\<rangle>)#G) D \<and> list_all (Not \<circ> is_Receive \<circ> snd) G))"
 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 blast
   hence 3: "ik\<^sub>s\<^sub>t (proj_unl n C) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t" by (metis ideduct_mono[OF assms(3)] subst_all_mono)
 
   have "\<exists>F. prefix F A \<and> E \<in> set (tr\<^sub>p\<^sub>c F D)"
     when "suffix [(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E" "prefix E A'" "A' \<in> set (tr\<^sub>p\<^sub>c A D)" for D E m t
     using that
   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, opaque_lifting) 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, opaque_lifting) 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
   moreover have "{} \<turnstile>\<^sub>c t" when "C = []" using 3 by (simp add: deducts_eq_if_empty_ik that)
   ultimately have 4:
       "\<exists>D. prefix D A \<and> C \<in> set (tr\<^sub>p\<^sub>c D []) \<and>
            (\<not>{} \<turnstile>\<^sub>c t \<longrightarrow> (\<exists>l s G. suffix ((l, receive\<langle>s\<rangle>)#G) D \<and>
                                   list_all (Not \<circ> is_Receive \<circ> snd) G))"
     using C(3) assms(1) 2 by (meson tr_preserves_last_receive)
 
   show ?thesis by (metis 1 3 4)
 qed
 
 end
 
 context labeled_stateful_typing
 begin
 
 
 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 dbproj_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)]] 
       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 dbproj_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] unfolding dbproj_def 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_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
 
 end
 
 
 
 subsection \<open>Theorem: Semantic Equivalence of Translation\<close>
 context labeled_stateful_typed_model
 begin
 
 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/correctness.
 \<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>ts\<rangle>)#A) D = map ((#) (i,send\<langle>ts\<rangle>\<^sub>s\<^sub>t)) (tr'\<^sub>p\<^sub>c A D)"
 | "tr'\<^sub>p\<^sub>c ((i,receive\<langle>ts\<rangle>)#A) D = map ((#) (i,receive\<langle>ts\<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': 
           "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 ts S D)
       note prems = "2.prems"
       note IH = "2.IH"
 
       obtain B' where B': "B = (i,send\<langle>ts\<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: "\<forall>t \<in> set ts. 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>ts\<rangle>\<^sub>s\<^sub>t)#C) \<in> set (tr'\<^sub>p\<^sub>c ((i,Send ts)#S) D)" "\<lbrakk>M; unlabel ((i,send\<langle>ts\<rangle>\<^sub>s\<^sub>t)#C)\<rbrakk>\<^sub>d \<I>"
         using 7 by auto
       thus ?case by metis
     next
       case (3 i ts S D)
       note prems = "3.prems"
       note IH = "3.IH"
 
       obtain B' where B': "B = (i,receive\<langle>ts\<rangle>\<^sub>s\<^sub>t)#B'" "B' \<in> set (tr\<^sub>p\<^sub>c S D)" using prems(1) by moura
           
       have 1: "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> 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>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> M; unlabel C\<rbrakk>\<^sub>d \<I>"
         using IH[OF B'(2) 1 4 5 6] by moura
       hence "((i,receive\<langle>ts\<rangle>\<^sub>s\<^sub>t)#C) \<in> set (tr'\<^sub>p\<^sub>c ((i,receive\<langle>ts\<rangle>)#S) D)"
             "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> M; unlabel ((i,receive\<langle>ts\<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 
       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) unfolding dbproj_def 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" 
         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 
       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 ts S D)
       note prems = "2.prems"
       note IH = "2.IH"
 
       obtain C' where C': "C = (i,send\<langle>ts\<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: "\<forall>t \<in> set ts. 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>ts\<rangle>\<^sub>s\<^sub>t)#B) \<in> set (tr\<^sub>p\<^sub>c ((i,Send ts)#S) D)"
             "\<lbrakk>M; unlabel ((i,send\<langle>ts\<rangle>\<^sub>s\<^sub>t)#B)\<rbrakk>\<^sub>d \<I>"
         using 7 by auto
       thus ?case by metis
     next
       case (3 i ts S D)
       note prems = "3.prems"
       note IH = "3.IH"
 
       obtain C' where C': "C = (i,receive\<langle>ts\<rangle>\<^sub>s\<^sub>t)#C'" "C' \<in> set (tr'\<^sub>p\<^sub>c S D)"
         using prems(1) by moura
           
       have 1: "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> 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>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> M; unlabel B\<rbrakk>\<^sub>d \<I>"
         using IH[OF C'(2) 1 4 5 6] by moura
       hence "((i,receive\<langle>ts\<rangle>\<^sub>s\<^sub>t)#B) \<in> set (tr\<^sub>p\<^sub>c ((i,receive\<langle>ts\<rangle>)#S) D)"
             "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> M; unlabel ((i,receive\<langle>ts\<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 
       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 
       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 
       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) unfolding dbproj_def 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" 
         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 
       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
 
 end
 
 
 subsection \<open>Theorem: The Stateful Compositionality Result, on the Constraint Level\<close>
 theorem (in labeled_stateful_typed_model) par_comp_constr_stateful_typed:
   assumes \<A>: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> Sec" "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
   and \<I>: "\<I> \<Turnstile>\<^sub>s unlabel \<A>" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
   shows "(\<forall>n. \<I> \<Turnstile>\<^sub>s proj_unl n \<A>) \<or>
          (\<exists>\<A>' l' ts. prefix \<A>' \<A> \<and> suffix [(l', receive\<langle>ts\<rangle>)] \<A>' \<and> (\<A>' leaks Sec under \<I>))"
 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) 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 sst_vars_proj_subset[of _ \<A>] by fast+
 
   note 3 = par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj[OF \<A>(1)]
 
   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
 
   have \<I>':
       "(\<forall>n. (\<I> \<Turnstile> \<langle>proj_unl n \<A>'\<rangle>)) \<or>
         (\<exists>\<A>'' l' ts. prefix \<A>'' \<A>' \<and> suffix [(l', receive\<langle>ts\<rangle>\<^sub>s\<^sub>t)] \<A>'' \<and>
                     (strand_leaks\<^sub>l\<^sub>s\<^sub>t \<A>'' Sec \<I>))"
     using par_comp_constr_typed[OF tr_par_preserves_par_comp[OF \<A>(1) \<A>'(1)] \<A>'(2) \<I>(2-)] by blast
 
   show ?thesis
   proof (cases "\<forall>n. (\<I> \<Turnstile> \<langle>proj_unl n \<A>'\<rangle>)")
     case True
     { fix n assume "\<I> \<Turnstile> \<langle>proj_unl n \<A>'\<rangle>"
       hence "\<lbrakk>{}; {}; unlabel (proj n \<A>)\<rbrakk>\<^sub>s \<I>"
         using tr_par_proj[OF \<A>'(1), of n]
               tr_par_sem_equiv[OF 2(1,2) 1(3) _ \<I>(2), 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>(1,2,3) \<I>(1) 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>"
       using \<I>' by blast
     
     have "\<exists>t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>t \<A>'' \<I>. \<exists>l.
             (\<I> \<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> \<turnstile> t \<cdot> \<I>"
     proof -
       obtain s m where sm:
           "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>t \<A>'' \<I>" "\<lbrakk>{}; proj_unl m \<A>''@[send\<langle>[s]\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>d \<I>"
         using \<A>'' unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>t_def constr_sem_d_def by blast
 
       show ?thesis using strand_sem_split(3,4)[OF sm(2)] sm(1) unfolding constr_sem_d_def by auto
     qed
     then obtain s m where sm:
         "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>t \<A>'' \<I>"
         "\<I> \<Turnstile> \<langle>unlabel (proj m \<A>'')\<rangle>"
         "ik\<^sub>s\<^sub>t (unlabel (proj m \<A>'')) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> s \<cdot> \<I>"
       by moura
     hence s': "\<not>{} \<turnstile>\<^sub>c s \<cdot> \<I>" "s \<cdot> \<I> = s"
       using \<A>(1) subst_ground_ident[of s \<I>] unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
 
     \<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 G::"('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> \<turnstile> s \<cdot> \<I>"
         "prefix B \<A>''" "\<exists>l t. suffix ((l, receive\<langle>t\<rangle>)#G) C"
       and G: "list_all (Not \<circ> is_Receive \<circ> snd) G"
       using tr_leaking_prefix_exists[OF \<A>'(1) \<A>''(1) sm(3)]
             prefix_order.order_trans[OF _ \<A>''(1)] s'
       by blast
     
     obtain C' where C': "C = C'@G" "\<exists>l t. suffix [(l, receive\<langle>t\<rangle>)] C'"
       using BC(6) unfolding suffix_def by (metis append_Cons append_assoc append_self_conv2)
 
     have "\<lbrakk>{}; unlabel (proj m B)\<rbrakk>\<^sub>d \<I>"
       using sm(2) BC(5) unfolding prefix_def unlabel_def proj_def constr_sem_d_def by auto
     hence BC': "\<I> \<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>"
       using BC(5) sm(1) declassified_prefix_subset by auto
 
     have "\<exists>n. \<I> \<Turnstile>\<^sub>s (proj_unl n C'@[Send [s]])"
     proof -
       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 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
 
       obtain n where n: "\<I> \<Turnstile>\<^sub>s proj_unl n C" "ik\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> s \<cdot> \<I>"
         using s'(2) tr_par_proj[OF BC(3), of m] BC'(1)
               tr_par_sem_equiv[OF 6 7 \<I>(2), of m]
               tr_par_deduct_iff[OF tr_par_proj(1)[OF BC(3)], of \<I> m s]
         unfolding proj_def constr_sem_d_def by auto
 
       have "ik\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) = ik\<^sub>s\<^sub>s\<^sub>t (proj_unl n C')"
         using C'(1) G unfolding ik\<^sub>s\<^sub>s\<^sub>t_def unlabel_def proj_def list_all_iff by fastforce
       hence 8: "ik\<^sub>s\<^sub>s\<^sub>t (proj_unl n C') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> s \<cdot> \<I>" using n(2) by simp
 
       have 9: "\<I> \<Turnstile>\<^sub>s proj_unl n C'"
         using n(1) C'(1) strand_sem_append_stateful by simp
 
       show ?thesis using 8 9 strand_sem_append_stateful by auto
     qed
     moreover have "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t C \<I>" by (metis tr_par_declassified_eq BC(3) BC'')
     hence "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t C' \<I>"
       using ideduct_mono[of
               "\<Union>{set ts |ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set C'} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" _
               "\<Union>{set ts |ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set (C'@G)} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"]
       unfolding declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_alt_def C'(1) by auto
     moreover have "prefix C' \<A>" using BC(2) C' unfolding prefix_def by auto
     ultimately show ?thesis using C'(2) unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by meson
   qed
 qed
 
 theorem (in labeled_stateful_typing) 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>' l' ts. prefix \<A>' \<A> \<and> suffix [(l', receive\<langle>ts\<rangle>)] \<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>'' l' ts. prefix \<A>'' \<A>' \<and> suffix [(l', receive\<langle>ts\<rangle>\<^sub>s\<^sub>t)] \<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 ts l assume *: "\<lbrakk>{}; unlabel (proj l \<A>'')@[send\<langle>ts\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>d \<I>\<^sub>\<tau>"
       have "\<I>\<^sub>\<tau> \<Turnstile> \<langle>unlabel (proj l \<A>'')\<rangle>"
            "\<forall>t \<in> set ts. 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 force
     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
     hence s': "\<not>{} \<turnstile>\<^sub>c s \<cdot> \<I>\<^sub>\<tau>" "s \<cdot> \<I>\<^sub>\<tau> = s"
       using \<A>(1) subst_ground_ident[of s \<I>\<^sub>\<tau>] unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
 
     \<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 G::"('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>''" "\<exists>l t. suffix ((l, receive\<langle>t\<rangle>)#G) C"
       and G: "list_all (Not \<circ> is_Receive \<circ> snd) G"
       using tr_leaking_prefix_exists[OF \<A>'(1) \<A>''(1) sm(3)]
             prefix_order.order_trans[OF _ \<A>''(1)] s'
       by blast
     
     obtain C' where C': "C = C'@G" "\<exists>l t. suffix [(l, receive\<langle>t\<rangle>)] C'"
       using BC(6) unfolding suffix_def by (metis append_Cons append_assoc append_self_conv2)
 
     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) declassified_prefix_subset by auto
 
     have "\<exists>n. \<I>\<^sub>\<tau> \<Turnstile>\<^sub>s (proj_unl n C'@[Send [s]])"
     proof -
       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
 
       obtain n where n: "\<I>\<^sub>\<tau> \<Turnstile>\<^sub>s proj_unl n C" "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 s'(2) 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
 
       have "ik\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) = ik\<^sub>s\<^sub>s\<^sub>t (proj_unl n C')"
         using C'(1) G unfolding ik\<^sub>s\<^sub>s\<^sub>t_def unlabel_def proj_def list_all_iff by fastforce
       hence 8: "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 n(2) by simp
 
       have 9: "\<I>\<^sub>\<tau> \<Turnstile>\<^sub>s proj_unl n C'"
         using n(1) C'(1) strand_sem_append_stateful by simp
 
       show ?thesis using 8 9 strand_sem_append_stateful by auto
     qed
     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'')
     hence "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t C' \<I>\<^sub>\<tau>"
       using ideduct_mono[of
               "\<Union>{set ts |ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set C'} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>\<^sub>\<tau>" _
               "\<Union>{set ts |ts. \<langle>\<star>, receive\<langle>ts\<rangle>\<rangle> \<in> set (C'@G)} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>\<^sub>\<tau>"]
       unfolding declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_alt_def C'(1) by auto
     moreover have "prefix C' \<A>" using BC(2) C' unfolding prefix_def by auto
     ultimately show ?thesis
       using \<I>\<^sub>\<tau>(1,2,3) \<I>\<^sub>\<tau>' C'(2) unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by meson
   qed
 qed
 
 
 subsection \<open>Theorem: The Stateful Compositionality Result, on the Protocol Level\<close>
 context labeled_stateful_typing
 begin
 
 context
 begin
 
 subsubsection \<open>Definitions: Labeled Protocols\<close>
 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>
 private definition wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s::"('fun,'var,'lbl) labeled_strand set \<Rightarrow> bool" where
   "wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s \<S> \<equiv> (\<forall>\<A> \<in> \<S>. wf\<^sub>l\<^sub>s\<^sub>t {} \<A>) \<and> (\<forall>\<A> \<in> \<S>. \<forall>\<A>' \<in> \<S>. fv\<^sub>l\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>l\<^sub>s\<^sub>t \<A>' = {})"
 
 private definition wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s'::
   "('fun,'var,'lbl) labeled_strand set \<Rightarrow> ('fun,'var,'lbl) labeled_strand \<Rightarrow> bool"
 where
   "wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s' \<S> \<A> \<equiv> (\<forall>\<A>' \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t \<A>) (unlabel \<A>')) \<and>
                  (\<forall>\<A>' \<in> \<S>. \<forall>\<A>'' \<in> \<S>. fv\<^sub>l\<^sub>s\<^sub>t \<A>' \<inter> bvars\<^sub>l\<^sub>s\<^sub>t \<A>'' = {}) \<and>
                  (\<forall>\<A>' \<in> \<S>. fv\<^sub>l\<^sub>s\<^sub>t \<A>' \<inter> bvars\<^sub>l\<^sub>s\<^sub>t \<A> = {}) \<and>
                  (\<forall>\<A>' \<in> \<S>. fv\<^sub>l\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>l\<^sub>s\<^sub>t \<A>' = {})"
 
 private definition typing_cond_prot where
   "typing_cond_prot \<P> \<equiv>
     wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s \<P> \<and>
     tfr\<^sub>s\<^sub>e\<^sub>t (\<Union>(trms\<^sub>l\<^sub>s\<^sub>t ` \<P>)) \<and>
     wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union>(trms\<^sub>l\<^sub>s\<^sub>t ` \<P>)) \<and>
     (\<forall>\<A> \<in> \<P>. list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel \<A>)) \<and>
     Ana_invar_subst (\<Union>(ik\<^sub>s\<^sub>t ` unlabel ` \<P>) \<union> \<Union>(assignment_rhs\<^sub>s\<^sub>t ` unlabel ` \<P>))"
 
 private definition par_comp_prot where
   "par_comp_prot \<P> Sec \<equiv>
     (\<forall>l1 l2. l1 \<noteq> l2 \<longrightarrow>
       GSMP_disjoint (\<Union>\<A> \<in> \<P>. trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \<A>) (\<Union>\<A> \<in> \<P>. trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \<A>) Sec) \<and>
     ground Sec \<and> (\<forall>s \<in> Sec. \<not>{} \<turnstile>\<^sub>c s) \<and>
     typing_cond_prot \<P>"
 
 
 subsubsection \<open>Lemmata: Labeled Protocols\<close>
 private lemma wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s_eqs_wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s': "wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s S = wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s' S []"
 unfolding wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s_def wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s'_def unlabel_def by auto
 
 private lemma par_comp_prot_impl_par_comp:
   assumes "par_comp_prot \<P> Sec" "\<A> \<in> \<P>"
   shows "par_comp \<A> Sec"
 proof -
   have *: "\<forall>l1 l2. l1 \<noteq> l2 \<longrightarrow>
               GSMP_disjoint (\<Union>\<A> \<in> \<P>. trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \<A>) (\<Union>\<A> \<in> \<P>. trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \<A>) Sec"
     using assms(1) unfolding par_comp_prot_def by metis
   { fix l1 l2::'lbl assume **: "l1 \<noteq> l2"
     hence ***: "GSMP_disjoint (\<Union>\<A> \<in> \<P>. trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \<A>) (\<Union>\<A> \<in> \<P>. trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \<A>) Sec"
       using * by auto
     have "GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \<A>) (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \<A>) Sec"
       using GSMP_disjoint_subset[OF ***] assms(2) by auto
   } hence "\<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" by metis
   thus ?thesis using assms unfolding par_comp_prot_def par_comp_def by metis
 qed
 
 private lemma typing_cond_prot_impl_typing_cond:
   assumes "typing_cond_prot \<P>" "\<A> \<in> \<P>"
   shows "typing_cond (unlabel \<A>)"
 proof -
   have 1: "wf\<^sub>s\<^sub>t {} (unlabel \<A>)" "fv\<^sub>l\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>l\<^sub>s\<^sub>t \<A> = {}"
     using assms unfolding typing_cond_prot_def wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s_def by auto
 
   have "tfr\<^sub>s\<^sub>e\<^sub>t (\<Union>(trms\<^sub>l\<^sub>s\<^sub>t ` \<P>))"
        "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union>(trms\<^sub>l\<^sub>s\<^sub>t ` \<P>))"
        "trms\<^sub>l\<^sub>s\<^sub>t \<A> \<subseteq> \<Union>(trms\<^sub>l\<^sub>s\<^sub>t ` \<P>)"
        "SMP (trms\<^sub>l\<^sub>s\<^sub>t \<A>) - Var`\<V> \<subseteq> SMP (\<Union>(trms\<^sub>l\<^sub>s\<^sub>t ` \<P>)) - Var`\<V>"
     using assms SMP_mono[of "trms\<^sub>l\<^sub>s\<^sub>t \<A>" "\<Union>(trms\<^sub>l\<^sub>s\<^sub>t ` \<P>)"]
     unfolding typing_cond_prot_def
     by (metis, metis, auto)
   hence 2: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>t \<A>)" and 3: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^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>t\<^sub>p (unlabel \<A>)" using assms unfolding typing_cond_prot_def by auto
 
   have "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t (unlabel \<A>) \<union> assignment_rhs\<^sub>s\<^sub>t (unlabel \<A>)) \<subseteq>
         subterms\<^sub>s\<^sub>e\<^sub>t (\<Union>(ik\<^sub>s\<^sub>t ` unlabel ` \<P>) \<union> \<Union>(assignment_rhs\<^sub>s\<^sub>t ` unlabel ` \<P>))"
     using assms(2) by auto
   hence 5: "Ana_invar_subst (ik\<^sub>s\<^sub>t (unlabel \<A>) \<union> assignment_rhs\<^sub>s\<^sub>t (unlabel \<A>))"
     using assms SMP_mono unfolding typing_cond_prot_def Ana_invar_subst_def by (meson subsetD)
 
   show ?thesis using 1 2 3 4 5 unfolding typing_cond_def tfr\<^sub>s\<^sub>t_def by blast
 qed
 
 
 subsubsection \<open>Theorem: Parallel Compositionality for Labeled Protocols\<close>
 private definition component_prot where
   "component_prot n P \<equiv> (\<forall>l \<in> P. \<forall>s \<in> set l. has_LabelN n s \<or> has_LabelS s)"
 
 private definition composed_prot where
   "composed_prot \<P>\<^sub>i \<equiv> {\<A>. \<forall>n. proj n \<A> \<in> \<P>\<^sub>i n}"
 
 private definition component_secure_prot where
   "component_secure_prot n P Sec attack \<equiv> (\<forall>\<A> \<in> P. suffix [(ln n, Send1 (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> \<langle>proj_unl n \<A>\<rangle>) \<and>
             (\<forall>\<A>'. prefix \<A>' \<A> \<longrightarrow>
                     (\<forall>t \<in> Sec-declassified\<^sub>l\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>. \<not>(\<I>\<^sub>\<tau> \<Turnstile> \<langle>proj_unl n \<A>'@[Send1 t]\<rangle>)))))"
 
 private definition component_leaks where
   "component_leaks 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>t \<A>' \<I>\<^sub>\<tau>. (\<I>\<^sub>\<tau> \<Turnstile> \<langle>proj_unl n \<A>'@[Send1 t]\<rangle>)))"
 
 private definition unsat where
   "unsat \<A> \<equiv> (\<forall>\<I>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I> \<longrightarrow> \<not>(\<I> \<Turnstile> \<langle>unlabel \<A>\<rangle>))"
 
 private theorem par_comp_constr_prot:
   assumes P: "P = composed_prot Pi" "par_comp_prot P Sec" "\<forall>n. component_prot n (Pi n)"
   and left_secure: "component_secure_prot n (Pi n) Sec attack"
   shows "\<forall>\<A> \<in> P. suffix [(ln n, Send1 (Fun attack []))] \<A> \<longrightarrow>
                   unsat \<A> \<or> (\<exists>m. n \<noteq> m \<and> component_leaks m \<A> Sec)"
 proof -
   { fix \<A> \<A>' assume \<A>: "\<A> = \<A>'@[(ln n, Send1 (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>t \<A>' \<I>\<^sub>\<tau>. \<exists>m. n \<noteq> m \<and> (\<I>\<^sub>\<tau> \<Turnstile> \<langle>proj_unl m \<A>'@[Send1 t]\<rangle>))"
     have tcp: "typing_cond_prot P" using P(2) unfolding par_comp_prot_def by simp
     have par_comp: "par_comp \<A> Sec" "typing_cond (unlabel \<A>)"
       using par_comp_prot_impl_par_comp[OF P(2) \<A>(2)]
             typing_cond_prot_impl_typing_cond[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" 
          "proj n \<A> = (proj n \<A>')@[(ln n, Send1 (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>t A I = declassified\<^sub>l\<^sub>s\<^sub>t (proj n A) I"
         unfolding proj_def declassified\<^sub>l\<^sub>s\<^sub>t_alt_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>t A I = declassified\<^sub>l\<^sub>s\<^sub>t B I)"
         using * by metis
         
     }
     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> \<langle>proj_unl n \<A>\<rangle>) \<and> (\<forall>\<A>'. prefix \<A>' \<A> \<longrightarrow>
                         (\<forall>t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>. \<not>(\<I>\<^sub>\<tau> \<Turnstile> \<langle>proj_unl n \<A>'@[Send1 t]\<rangle>)))"
       using left_secure unfolding component_secure_prot_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> \<langle>unlabel \<A>\<rangle>"
       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> (strand_leaks\<^sub>l\<^sub>s\<^sub>t \<A>' Sec \<I>\<^sub>\<tau>)"
         using par_comp_constr[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>t \<A>' \<I>\<^sub>\<tau>. \<exists>m.
                   n \<noteq> m \<and> (\<I>\<^sub>\<tau> \<Turnstile> \<langle>proj_unl m \<A>'@[Send1 t]\<rangle>))"
         using \<I>\<^sub>\<tau>(4) * unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>t_def by metis
       hence ?P using \<I>\<^sub>\<tau>(1,2,3) by auto
     } hence "unsat \<A> \<or> (\<exists>m. n \<noteq> m \<and> component_leaks m \<A> Sec)"
       by (metis unsat_def component_leaks_def)
   } thus ?thesis unfolding suffix_def by metis
 qed
 
 subsubsection \<open>Theorem: Parallel Compositionality for Stateful Protocols\<close>
 private 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>
 private 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>' = {})"
 
 private 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>' = {})"
 
 private 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))"
 
 private 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. \<not>{} \<turnstile>\<^sub>c s) \<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>"
 
 private 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>\<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]]))))))"
 
 private 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]]))))"
 
 private 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>))"
 
 private lemma wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s_eqs_wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s': "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
 
 private 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 *: 
       "\<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 ***: 
         "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
 
 private 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
 
 private 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" 
          "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"
         by (simp, metis declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj_eq)
       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 *: 
         "\<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
 
 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>s\<^sub>e\<^sub>t var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t A))
     in has_all_wt_instances_of \<Gamma> A' A \<and>
        has_all_wt_instances_of \<Gamma> B' B\<delta> \<and>
        finite_SMP_representation arity Ana \<Gamma> A \<and>
        finite_SMP_representation arity Ana \<Gamma> B\<delta> \<and>
        (\<forall>t \<in> A. \<forall>s \<in> B\<delta>. \<Gamma> t = \<Gamma> s \<and> mgu t s \<noteq> None \<longrightarrow>
          (intruder_synth' public arity {} t) \<or> (\<exists>u \<in> C. is_wt_instance_of_cond \<Gamma> t 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>
     wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity 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. if i = j then True else
       (let s = pair' pair_fun p; t = pair' pair_fun q
        in mgu s (t \<cdot> var_rename (max_var s)) = None))"
 
 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> has_LabelS) A));
       MP0 = \<lambda>B. trms\<^sub>s\<^sub>s\<^sub>t B \<union> (pair' pair_fun) ` setops\<^sub>s\<^sub>s\<^sub>t B;
       pr = \<lambda>l. MP0 (proj_unl l A)
   in length L > 1 \<and>
      comp_par_comp'\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> pair_fun A M C \<and>
      wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (MP0 (unlabel A)) \<and>
      (\<forall>i \<in> set L. \<forall>j \<in> set L. if i = j then True else
         comp_GSMP_disjoint public arity Ana \<Gamma> (pr i) (pr j) (M i) (M j) C)"
 
 lemma comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>tI:
   fixes pair_fun A MP0 pr
   defines "MP0 \<equiv> \<lambda>B. trms\<^sub>s\<^sub>s\<^sub>t B \<union> (pair' pair_fun) ` setops\<^sub>s\<^sub>s\<^sub>t B"
     and "pr \<equiv> \<lambda>l. MP0 (proj_unl l A)"
   assumes L_def: "L = remdups (map (the_LabelN \<circ> fst) (filter (Not \<circ> has_LabelS) A))"
     and L_gt: "length L > 1"
     and cpc': "comp_par_comp'\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> pair_fun A M C"
     and MP0_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (MP0 (unlabel A))"
     and GSMP_disj: "\<forall>i \<in> set L. \<forall>j \<in> set L. if i = j then True else
                       comp_GSMP_disjoint public arity Ana \<Gamma> (pr i) (pr j) (M i) (M j) C"
   shows "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t  public arity Ana \<Gamma> pair_fun A M C"
 using assms unfolding comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by presburger
 
 lemma comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>tI':
   fixes pair_fun A MP0 pr Ms
   defines "MP0 \<equiv> \<lambda>B. trms\<^sub>s\<^sub>s\<^sub>t B \<union> (pair' pair_fun) ` setops\<^sub>s\<^sub>s\<^sub>t B"
     and "pr \<equiv> \<lambda>l. MP0 (proj_unl l A)"
     and "M \<equiv> \<lambda>l. case find ((=) l \<circ> fst) Ms of Some M \<Rightarrow> set (snd M) | None \<Rightarrow> {}"
   assumes L_def: "map fst Ms = remdups (map (the_LabelN \<circ> fst) (filter (Not \<circ> has_LabelS) A))"
     and L_gt: "length (map fst Ms) > 1"
     and cpc': "comp_par_comp'\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> pair_fun A M C"
     and MP0_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (MP0 (unlabel A))"
     and GSMP_disj: "\<forall>i \<in> set (map fst Ms). \<forall>j \<in> set (map fst Ms). if i = j then True else
                       comp_GSMP_disjoint public arity Ana \<Gamma> (pr i) (pr j) (M i) (M j) C"
   shows "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t  public arity Ana \<Gamma> pair_fun A M C"
 by (rule comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>tI[OF L_def L_gt cpc' MP0_wf[unfolded MP0_def]
                               GSMP_disj[unfolded pr_def MP0_def]])
 
 
 locale labeled_stateful_typed_model' =
   labeled_typed_model' arity public Ana \<Gamma> label_witness1 label_witness2
 + stateful_typed_model' arity public Ana \<Gamma> Pair
   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: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity A'" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity B'"
     and C_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity C"
     and AB'_disj: "comp_GSMP_disjoint public arity Ana \<Gamma> A' B' A B C"
   shows "GSMP_disjoint A' B' (f C - {m. {} \<turnstile>\<^sub>c m})"
 using GSMP_disjointI[of A' B' A B] AB'_wf AB'_disj C_wf
 unfolding wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s'_def comp_GSMP_disjoint_def f_def wf\<^sub>t\<^sub>r\<^sub>m_code list_all_iff Let_def by blast 
 
 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 C - {m. {} \<turnstile>\<^sub>c m})"
 proof (unfold par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def; intro conjI)
   let ?Sec = "f C - {m. {} \<turnstile>\<^sub>c m}"
   let ?L = "remdups (map (the_LabelN \<circ> fst) (filter (Not \<circ> has_LabelS) A))"
   let ?N1 = "\<lambda>B. trms\<^sub>s\<^sub>s\<^sub>t B \<union> (pair' Pair) ` setops\<^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))"
 
   note defs = pair_code wf\<^sub>t\<^sub>r\<^sub>m_code wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s'_def 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
 
   have 0:
       "length ?L > 1"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (?N1 (unlabel A))"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity C"
       (* "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t C) 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 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. has_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 defs 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': "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (?N1 (proj_unl l A))" for l
     unfolding defs by auto
 
   note C_wf_trms = 0(3)[unfolded list_all_iff wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s'_def 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 (?N1 (proj_unl l1 A)) (?N1 (proj_unl l2 A)) ?Sec"
       using 0(4) 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(5) 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> 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> 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 *)
 
   show "\<forall>s \<in> ?Sec. \<not>{} \<turnstile>\<^sub>c s" by simp
 qed
 
 end
 
 locale labeled_stateful_typing' =
   labeled_stateful_typed_model' arity public Ana \<Gamma> Pair label_witness1 label_witness2
 + stateful_typing_result' arity public Ana \<Gamma> Pair
   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_typing
 by unfold_locales
 
 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 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.
     trms\<^sub>s\<^sub>s\<^sub>t B \<union> (pair' Pair) ` setops\<^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> has_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 C - {m. {} \<turnstile>\<^sub>c m}"
 
   have 0:
       "length (L A) > 1"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (N1 (unlabel A))"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity C"
      (*  "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t C) 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 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: "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. has_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 wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s'_def 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': "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' 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 wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s'_def list_all_iff by presburger
 
   note C_wf_trms = 0(3)[unfolded list_all_iff wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s'_def 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 (N1 (proj_unl l1 A)) (N1 (proj_unl l2 A)) ?Sec"
       using 0(4) 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(5)
       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> 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> 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 *)
 
   show "\<forall>s \<in> ?Sec. \<not>{} \<turnstile>\<^sub>c s" by simp
 qed
 
 end
 
 end
diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Strands.thy b/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Strands.thy
--- a/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Strands.thy
+++ b/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Strands.thy
@@ -1,2814 +1,2814 @@
 (*  Title:      Stateful_Strands.thy
     Author:     Andreas Viktor Hess, DTU
     SPDX-License-Identifier: BSD-3-Clause
 *)
 
 
 section \<open>Stateful Strands\<close>
 theory Stateful_Strands
 imports Strands_and_Constraints
 begin
 
 subsection \<open>Stateful Constraints\<close>
 datatype (funs\<^sub>s\<^sub>s\<^sub>t\<^sub>p: 'a, vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p: 'b) stateful_strand_step = 
   Send (the_msgs: "('a,'b) term list") ("send\<langle>_\<rangle>" 80)
 | Receive (the_msgs: "('a,'b) term list") ("receive\<langle>_\<rangle>" 80)
 | Equality (the_check: poscheckvariant) (the_lhs: "('a,'b) term") (the_rhs: "('a,'b) term")
     ("\<langle>_: _ \<doteq> _\<rangle>" [80,80])
 | Insert (the_elem_term: "('a,'b) term") (the_set_term: "('a,'b) term") ("insert\<langle>_,_\<rangle>" 80)
 | Delete (the_elem_term: "('a,'b) term") (the_set_term: "('a,'b) term") ("delete\<langle>_,_\<rangle>" 80)
 | InSet (the_check: poscheckvariant) (the_elem_term: "('a,'b) term") (the_set_term: "('a,'b) term")
     ("\<langle>_: _ \<in> _\<rangle>" [80,80])
 | NegChecks (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p: "'b list")
     (the_eqs: "(('a,'b) term \<times> ('a,'b) term) list")
     (the_ins: "(('a,'b) term \<times> ('a,'b) term) list")
     ("\<forall>_\<langle>\<or>\<noteq>: _ \<or>\<notin>: _\<rangle>" [80,80])
 where
   "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Send _) = []"
 | "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Receive _) = []"
 | "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Equality _ _ _) = []"
 | "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Insert _ _) = []"
 | "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Delete _ _) = []"
 | "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (InSet _ _ _) = []"
 
 type_synonym ('a,'b) stateful_strand = "('a,'b) stateful_strand_step list"
 type_synonym ('a,'b) dbstatelist = "(('a,'b) term \<times> ('a,'b) term) list"
 type_synonym ('a,'b) dbstate = "(('a,'b) term \<times> ('a,'b) term) set"
 
 abbreviation
   "is_Assignment x \<equiv> (is_Equality x \<or> is_InSet x) \<and> the_check x = Assign"
 
 abbreviation
   "is_Check x \<equiv> ((is_Equality x \<or> is_InSet x) \<and> the_check x = Check) \<or> is_NegChecks x"
 
 abbreviation
   "is_Check_or_Assignment x \<equiv> is_Equality x \<or> is_InSet x \<or> is_NegChecks x"
 
 abbreviation
   "is_Update x \<equiv> is_Insert x \<or> is_Delete x"
 
 abbreviation InSet_select ("select\<langle>_,_\<rangle>") where "select\<langle>t,s\<rangle> \<equiv> InSet Assign t s"
 abbreviation InSet_check ("\<langle>_ in _\<rangle>") where "\<langle>t in s\<rangle> \<equiv> InSet Check t s"
 abbreviation Equality_assign ("\<langle>_ := _\<rangle>") where "\<langle>t := s\<rangle> \<equiv> Equality Assign t s"
 abbreviation Equality_check ("\<langle>_ == _\<rangle>") where "\<langle>t == s\<rangle> \<equiv> Equality Check t s"
 
 abbreviation NegChecks_Inequality1 ("\<langle>_ != _\<rangle>") where
   "\<langle>t != s\<rangle> \<equiv> NegChecks [] [(t,s)] []"
 
 abbreviation NegChecks_Inequality2 ("\<forall>_\<langle>_ != _\<rangle>") where
   "\<forall>x\<langle>t != s\<rangle> \<equiv> NegChecks [x] [(t,s)] []"
 
 abbreviation NegChecks_Inequality3 ("\<forall>_,_\<langle>_ != _\<rangle>") where
   "\<forall>x,y\<langle>t != s\<rangle> \<equiv> NegChecks [x,y] [(t,s)] []"
 
 abbreviation NegChecks_Inequality4 ("\<forall>_,_,_\<langle>_ != _\<rangle>") where
   "\<forall>x,y,z\<langle>t != s\<rangle> \<equiv> NegChecks [x,y,z] [(t,s)] []"
 
 abbreviation NegChecks_NotInSet1 ("\<langle>_ not in _\<rangle>") where
   "\<langle>t not in s\<rangle> \<equiv> NegChecks [] [] [(t,s)]"
 
 abbreviation NegChecks_NotInSet2 ("\<forall>_\<langle>_ not in _\<rangle>") where
   "\<forall>x\<langle>t not in s\<rangle> \<equiv> NegChecks [x] [] [(t,s)]"
 
 abbreviation NegChecks_NotInSet3 ("\<forall>_,_\<langle>_ not in _\<rangle>") where
   "\<forall>x,y\<langle>t not in s\<rangle> \<equiv> NegChecks [x,y] [] [(t,s)]"
 
 abbreviation NegChecks_NotInSet4 ("\<forall>_,_,_\<langle>_ not in _\<rangle>") where
   "\<forall>x,y,z\<langle>t not in s\<rangle> \<equiv> NegChecks [x,y,z] [] [(t,s)]"
 
 fun trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p where
   "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Send ts) = set ts"
 | "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Receive ts) = set ts"
 | "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = {t,t'}"
 | "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Insert t t') = {t,t'}"
 | "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Delete t t') = {t,t'}"
 | "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (InSet _ t t') = {t,t'}"
 | "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (NegChecks _ F F') = trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F'"
 
 definition trms\<^sub>s\<^sub>s\<^sub>t where "trms\<^sub>s\<^sub>s\<^sub>t S \<equiv> \<Union>(trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p ` set S)"
 declare trms\<^sub>s\<^sub>s\<^sub>t_def[simp]
 
 fun trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p where
   "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Send ts) = ts"
 | "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Receive ts) = ts"
 | "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = [t,t']"
 | "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Insert t t') = [t,t']"
 | "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Delete t t') = [t,t']"
 | "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (InSet _ t t') = [t,t']"
 | "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (NegChecks _ F F') = concat (map (\<lambda>(t,t'). [t,t']) (F@F'))"
 
 definition trms_list\<^sub>s\<^sub>s\<^sub>t where "trms_list\<^sub>s\<^sub>s\<^sub>t S \<equiv> remdups (concat (map trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))"
 
 definition ik\<^sub>s\<^sub>s\<^sub>t where "ik\<^sub>s\<^sub>s\<^sub>t A \<equiv> {t | t ts. Receive ts \<in> set A \<and> t \<in> set ts}"
 
 definition bvars\<^sub>s\<^sub>s\<^sub>t::"('a,'b) stateful_strand \<Rightarrow> 'b set" where
   "bvars\<^sub>s\<^sub>s\<^sub>t S \<equiv> \<Union>(set (map (set \<circ> bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p) S))"
 
 fun fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p::"('a,'b) stateful_strand_step \<Rightarrow> 'b set" where
   "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Send ts) = fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
 | "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Receive ts) = fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
 | "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = fv t \<union> fv t'"
 | "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Insert t t') = fv t \<union> fv t'"
 | "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Delete t t') = fv t \<union> fv t'"
 | "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (InSet _ t t') = fv t \<union> fv t'"
 | "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (NegChecks X F F') = 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"
 
 definition fv\<^sub>s\<^sub>s\<^sub>t::"('a,'b) stateful_strand \<Rightarrow> 'b set" where
   "fv\<^sub>s\<^sub>s\<^sub>t S \<equiv> \<Union>(set (map fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))"
 
 fun fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p where
   "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\<langle>ts\<rangle>) = concat (map fv_list ts)"
 | "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (receive\<langle>ts\<rangle>) = concat (map fv_list ts)"
 | "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>_: t \<doteq> s\<rangle>) = fv_list t@fv_list s"
 | "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\<langle>t,s\<rangle>) = fv_list t@fv_list s"
 | "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (delete\<langle>t,s\<rangle>) = fv_list t@fv_list s"
 | "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>_: t \<in> s\<rangle>) = fv_list t@fv_list s"
 | "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle>) = filter (\<lambda>x. x \<notin> set X) (fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F@F'))"
 
 definition fv_list\<^sub>s\<^sub>s\<^sub>t where
   "fv_list\<^sub>s\<^sub>s\<^sub>t S \<equiv> remdups (concat (map fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))"
 
 declare bvars\<^sub>s\<^sub>s\<^sub>t_def[simp]
 declare fv\<^sub>s\<^sub>s\<^sub>t_def[simp]
 
 definition vars\<^sub>s\<^sub>s\<^sub>t::"('a,'b) stateful_strand \<Rightarrow> 'b set" where
   "vars\<^sub>s\<^sub>s\<^sub>t S \<equiv> \<Union>(set (map vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))"
 
 abbreviation wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p::"('a,'b) stateful_strand_step \<Rightarrow> 'b set" where
   "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \<equiv>
     case x of
       NegChecks _ _ _ \<Rightarrow> {}
     | Equality Check _ _ \<Rightarrow> {}
     | InSet Check _ _ \<Rightarrow> {}
     | Delete _ _ \<Rightarrow> {}
     | _ \<Rightarrow> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x"
 
 definition wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t::"('a,'b) stateful_strand \<Rightarrow> 'b set" where
   "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \<equiv> \<Union>(set (map wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))"
 
 abbreviation wfvarsoccs\<^sub>s\<^sub>s\<^sub>t\<^sub>p where
   "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \<equiv> 
     case x of
       Send ts \<Rightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set ts)
     | Equality Assign s t \<Rightarrow> fv s
     | InSet Assign s t \<Rightarrow> fv s \<union> fv t
     | _ \<Rightarrow> {}"
 
 definition wfvarsoccs\<^sub>s\<^sub>s\<^sub>t where
   "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S \<equiv> \<Union>(set (map wfvarsoccs\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))"
 
 fun wf'\<^sub>s\<^sub>s\<^sub>t::"'b set \<Rightarrow> ('a,'b) stateful_strand \<Rightarrow> bool" where
   "wf'\<^sub>s\<^sub>s\<^sub>t V [] = True"
 | "wf'\<^sub>s\<^sub>s\<^sub>t V (Receive ts#S) = (fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> V \<and> wf'\<^sub>s\<^sub>s\<^sub>t V S)"
 | "wf'\<^sub>s\<^sub>s\<^sub>t V (Send ts#S) = wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)) S"
 | "wf'\<^sub>s\<^sub>s\<^sub>t V (Equality Assign t t'#S) = (fv t' \<subseteq> V \<and> wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv t) S)"
 | "wf'\<^sub>s\<^sub>s\<^sub>t V (Equality Check _ _#S) = wf'\<^sub>s\<^sub>s\<^sub>t V S"
 | "wf'\<^sub>s\<^sub>s\<^sub>t V (Insert t s#S) = (fv t \<subseteq> V \<and> fv s \<subseteq> V \<and> wf'\<^sub>s\<^sub>s\<^sub>t V S)"
 | "wf'\<^sub>s\<^sub>s\<^sub>t V (Delete _ _#S) = wf'\<^sub>s\<^sub>s\<^sub>t V S"
 | "wf'\<^sub>s\<^sub>s\<^sub>t V (InSet Assign t s#S) = wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv t \<union> fv s) S"
 | "wf'\<^sub>s\<^sub>s\<^sub>t V (InSet Check _ _#S) = wf'\<^sub>s\<^sub>s\<^sub>t V S"
 | "wf'\<^sub>s\<^sub>s\<^sub>t V (NegChecks _ _ _#S) = wf'\<^sub>s\<^sub>s\<^sub>t V S"
 
 abbreviation "wf\<^sub>s\<^sub>s\<^sub>t S \<equiv> wf'\<^sub>s\<^sub>s\<^sub>t {} S \<and> fv\<^sub>s\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>s\<^sub>t S = {}"
 
 fun subst_apply_stateful_strand_step::
   "('a,'b) stateful_strand_step \<Rightarrow> ('a,'b) subst \<Rightarrow> ('a,'b) stateful_strand_step"
   (infix "\<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p" 51) where
   "send\<langle>ts\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = send\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>"
 | "receive\<langle>ts\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>"
 | "\<langle>a: t \<doteq> s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<langle>a: (t \<cdot> \<theta>) \<doteq> (s \<cdot> \<theta>)\<rangle>"
 | "\<langle>a: t \<in> s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<langle>a: (t \<cdot> \<theta>) \<in> (s \<cdot> \<theta>)\<rangle>"
 | "insert\<langle>t,s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = insert\<langle>t \<cdot> \<theta>, s \<cdot> \<theta>\<rangle>"
 | "delete\<langle>t,s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = delete\<langle>t \<cdot> \<theta>, s \<cdot> \<theta>\<rangle>"
 | "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<forall>X\<langle>\<or>\<noteq>: (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>) \<or>\<notin>: (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>)\<rangle>"
 
 definition subst_apply_stateful_strand::
   "('a,'b) stateful_strand \<Rightarrow> ('a,'b) subst \<Rightarrow> ('a,'b) stateful_strand"
   (infix "\<cdot>\<^sub>s\<^sub>s\<^sub>t" 51) where
   "S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta> \<equiv> map (\<lambda>x. x \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) S"
 
 fun dbupd\<^sub>s\<^sub>s\<^sub>t::"('f,'v) stateful_strand \<Rightarrow> ('f,'v) subst \<Rightarrow> ('f,'v) dbstate \<Rightarrow> ('f,'v) dbstate"
 where
   "dbupd\<^sub>s\<^sub>s\<^sub>t [] I D = D"
 | "dbupd\<^sub>s\<^sub>s\<^sub>t (Insert t s#A) I D = dbupd\<^sub>s\<^sub>s\<^sub>t A I (insert ((t,s) \<cdot>\<^sub>p I) D)"
 | "dbupd\<^sub>s\<^sub>s\<^sub>t (Delete t s#A) I D = dbupd\<^sub>s\<^sub>s\<^sub>t A I (D - {((t,s) \<cdot>\<^sub>p I)})"
 | "dbupd\<^sub>s\<^sub>s\<^sub>t (_#A) I D = dbupd\<^sub>s\<^sub>s\<^sub>t A I D"
 
 fun db'\<^sub>s\<^sub>s\<^sub>t::"('f,'v) stateful_strand \<Rightarrow> ('f,'v) subst \<Rightarrow> ('f,'v) dbstatelist \<Rightarrow> ('f,'v) dbstatelist"
 where
   "db'\<^sub>s\<^sub>s\<^sub>t [] I D = D"
 | "db'\<^sub>s\<^sub>s\<^sub>t (Insert t s#A) I D = db'\<^sub>s\<^sub>s\<^sub>t A I (List.insert ((t,s) \<cdot>\<^sub>p I) D)"
 | "db'\<^sub>s\<^sub>s\<^sub>t (Delete t s#A) I D = db'\<^sub>s\<^sub>s\<^sub>t A I (List.removeAll ((t,s) \<cdot>\<^sub>p I) D)"
 | "db'\<^sub>s\<^sub>s\<^sub>t (_#A) I D = db'\<^sub>s\<^sub>s\<^sub>t A I D"
 
 definition db\<^sub>s\<^sub>s\<^sub>t where
   "db\<^sub>s\<^sub>s\<^sub>t S I \<equiv> db'\<^sub>s\<^sub>s\<^sub>t S I []"
 
 fun setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p where
   "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Insert t s) = {(t,s)}"
 | "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Delete t s) = {(t,s)}"
 | "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (InSet _ t s) = {(t,s)}"
 | "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (NegChecks _ _ F') = set F'"
 | "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p _ = {}"
 
 text \<open>The set-operations of a stateful strand\<close>
 definition setops\<^sub>s\<^sub>s\<^sub>t where
   "setops\<^sub>s\<^sub>s\<^sub>t S \<equiv> \<Union>(setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p ` set S)"
 
 fun setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p where
   "setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Insert t s) = [(t,s)]"
 | "setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Delete t s) = [(t,s)]"
 | "setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (InSet _ t s) = [(t,s)]"
 | "setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (NegChecks _ _ F') = F'"
 | "setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p _ = []"
 
 text \<open>The set-operations of a stateful strand (list variant)\<close>
 definition setops_list\<^sub>s\<^sub>s\<^sub>t where
   "setops_list\<^sub>s\<^sub>s\<^sub>t S \<equiv> remdups (concat (map setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))"
 
 
 subsection \<open>Small Lemmata\<close>
 lemma is_Check_or_Assignment_iff[simp]:
   "is_Check x \<or> is_Assignment x \<longleftrightarrow> is_Check_or_Assignment x"
 by (cases x) (blast intro: poscheckvariant.exhaust)+
 
 lemma subst_apply_stateful_strand_step_Inequality[simp]:
   "\<langle>t != s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<langle>t \<cdot> \<theta> != s \<cdot> \<theta>\<rangle>"
   "\<forall>x\<langle>t != s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<forall>x\<langle>t \<cdot> rm_vars {x} \<theta> != s \<cdot> rm_vars {x} \<theta>\<rangle>"
   "\<forall>x,y\<langle>t != s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<forall>x,y\<langle>t \<cdot> rm_vars {x,y} \<theta> != s \<cdot> rm_vars {x,y} \<theta>\<rangle>"
   "\<forall>x,y,z\<langle>t != s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<forall>x,y,z\<langle>t \<cdot> rm_vars {x,y,z} \<theta> != s \<cdot> rm_vars {x,y,z} \<theta>\<rangle>"
 by simp_all
 
 lemma subst_apply_stateful_strand_step_NotInSet[simp]:
   "\<langle>t not in s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<langle>t \<cdot> \<theta> not in s \<cdot> \<theta>\<rangle>"
   "\<forall>x\<langle>t not in s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<forall>x\<langle>t \<cdot> rm_vars {x} \<theta> not in s \<cdot> rm_vars {x} \<theta>\<rangle>"
   "\<forall>x,y\<langle>t not in s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<forall>x,y\<langle>t \<cdot> rm_vars {x,y} \<theta> not in s \<cdot> rm_vars {x,y} \<theta>\<rangle>"
   "\<forall>x,y,z\<langle>t not in s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<forall>x,y,z\<langle>t \<cdot> rm_vars {x,y,z} \<theta> not in s \<cdot> rm_vars {x,y,z} \<theta>\<rangle>"
 by simp_all
 
 lemma trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t: "trms\<^sub>s\<^sub>s\<^sub>t S = set (trms_list\<^sub>s\<^sub>s\<^sub>t S)"
 unfolding trms\<^sub>s\<^sub>t_def trms_list\<^sub>s\<^sub>s\<^sub>t_def
 proof (induction S)
   case (Cons x S) thus ?case by (cases x) auto
 qed simp
 
 lemma setops_list\<^sub>s\<^sub>s\<^sub>t_is_setops\<^sub>s\<^sub>s\<^sub>t: "setops\<^sub>s\<^sub>s\<^sub>t S = set (setops_list\<^sub>s\<^sub>s\<^sub>t S)"
 unfolding setops\<^sub>s\<^sub>s\<^sub>t_def setops_list\<^sub>s\<^sub>s\<^sub>t_def
 proof (induction S)
   case (Cons x S) thus ?case by (cases x) auto
 qed simp
 
 lemma fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = set (fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p a)"
 proof (cases a)
   case (NegChecks X F G) thus ?thesis
     using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_append[of F G] fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_append[of F G]
           fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of "F@G"]
     by auto
 qed (simp_all add: fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s fv_list_is_fv)
 
 lemma fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t: "fv\<^sub>s\<^sub>s\<^sub>t S = set (fv_list\<^sub>s\<^sub>s\<^sub>t S)"
 unfolding fv\<^sub>s\<^sub>s\<^sub>t_def fv_list\<^sub>s\<^sub>s\<^sub>t_def by (induct S) (simp_all add: fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p)
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite[simp]: "finite (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p x)"
 by (cases x) auto
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_finite[simp]: "finite (trms\<^sub>s\<^sub>s\<^sub>t S)"
 using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by (induct S) auto
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite[simp]: "finite (vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x)"
 by (cases x) auto
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t_finite[simp]: "finite (vars\<^sub>s\<^sub>s\<^sub>t S)"
 using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite unfolding vars\<^sub>s\<^sub>s\<^sub>t_def by (induct S) auto
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite[simp]: "finite (fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p x)"
 by (cases x) auto
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_finite[simp]: "finite (fv\<^sub>s\<^sub>s\<^sub>t S)"
 using fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite unfolding fv\<^sub>s\<^sub>s\<^sub>t_def by (induct S) auto
 
 lemma bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite[simp]: "finite (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x))"
 by (rule finite_set)
 
 lemma bvars\<^sub>s\<^sub>s\<^sub>t_finite[simp]: "finite (bvars\<^sub>s\<^sub>s\<^sub>t S)"
 using bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def by (induct S) auto
 
 lemma subst_sst_nil[simp]: "[] \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta> = []"
 by (simp add: subst_apply_stateful_strand_def)
 
 lemma db\<^sub>s\<^sub>s\<^sub>t_nil[simp]: "db\<^sub>s\<^sub>s\<^sub>t [] \<I> = []"
 by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma ik\<^sub>s\<^sub>s\<^sub>t_nil[simp]: "ik\<^sub>s\<^sub>s\<^sub>t [] = {}"
 by (simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma in_ik\<^sub>s\<^sub>s\<^sub>t_iff: "t \<in> ik\<^sub>s\<^sub>s\<^sub>t A \<longleftrightarrow> (\<exists>ts. receive\<langle>ts\<rangle> \<in> set A \<and> t \<in> set ts)"
 unfolding ik\<^sub>s\<^sub>s\<^sub>t_def by blast
 
 lemma ik\<^sub>s\<^sub>s\<^sub>t_append[simp]: "ik\<^sub>s\<^sub>s\<^sub>t (A@B) = ik\<^sub>s\<^sub>s\<^sub>t A \<union> ik\<^sub>s\<^sub>s\<^sub>t B"
 by (auto simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma ik\<^sub>s\<^sub>s\<^sub>t_concat: "ik\<^sub>s\<^sub>s\<^sub>t (concat xs) = \<Union>(ik\<^sub>s\<^sub>s\<^sub>t ` set xs)"
 by (induct xs) auto
 
 lemma ik\<^sub>s\<^sub>s\<^sub>t_subst: "ik\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>) = ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
 proof (induction A)
   case (Cons a A)
   have "ik\<^sub>s\<^sub>s\<^sub>t ([a] \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>) = ik\<^sub>s\<^sub>s\<^sub>t [a] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
   proof (cases a)
     case (Receive ts) thus ?thesis
       using in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of _ "[a]"] in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of _ "[a] \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>"]
       unfolding subst_apply_stateful_strand_def by auto
   qed (simp_all add: ik\<^sub>s\<^sub>s\<^sub>t_def subst_apply_stateful_strand_def)
   thus ?case
     using Cons.IH ik\<^sub>s\<^sub>s\<^sub>t_append
     by (metis append_Cons append_Nil image_Un map_append subst_apply_stateful_strand_def) 
 qed simp
 
 lemma ik\<^sub>s\<^sub>s\<^sub>t_set_subset:
   "set A \<subseteq> set B \<Longrightarrow> ik\<^sub>s\<^sub>s\<^sub>t A \<subseteq> ik\<^sub>s\<^sub>s\<^sub>t B"
 unfolding ik\<^sub>s\<^sub>s\<^sub>t_def by blast
 
 lemma ik\<^sub>s\<^sub>s\<^sub>t_prefix_subset:
   "prefix A B \<Longrightarrow> ik\<^sub>s\<^sub>s\<^sub>t A \<subseteq> ik\<^sub>s\<^sub>s\<^sub>t B" (is "?P A B \<Longrightarrow> ?P' A B")
   "prefix A (C@D) \<Longrightarrow> \<not>prefix A C \<Longrightarrow> ik\<^sub>s\<^sub>s\<^sub>t C \<subseteq> ik\<^sub>s\<^sub>s\<^sub>t A" (is "?Q \<Longrightarrow> ?Q' \<Longrightarrow> ?Q''")
 proof -
   show "?P A B \<Longrightarrow> ?P' A B" for A B by (metis set_mono_prefix ik\<^sub>s\<^sub>s\<^sub>t_set_subset)
   thus "?Q \<Longrightarrow> ?Q' \<Longrightarrow> ?Q''" by (metis prefixI prefix_same_cases)
 qed
 
 lemma ik\<^sub>s\<^sub>s\<^sub>t_snoc_no_receive_empty:
   assumes "\<forall>a \<in> set A. \<not>is_Receive a"
   shows "ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I = {}"
 using assms in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of _ A] by fastforce
 
 lemma ik\<^sub>s\<^sub>s\<^sub>t_snoc_no_receive_eq:
   assumes "\<nexists>s. a = receive\<langle>s\<rangle>"
   shows "ik\<^sub>s\<^sub>s\<^sub>t (A@[a]) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
 using assms ik\<^sub>s\<^sub>s\<^sub>t_snoc_no_receive_empty[of "[a]" \<I>] ik\<^sub>s\<^sub>s\<^sub>t_append[of A "[a]"]
 unfolding is_Receive_def by auto
 
 lemma db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t: "set (db'\<^sub>s\<^sub>s\<^sub>t A I D) = dbupd\<^sub>s\<^sub>s\<^sub>t A I (set D)" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof
     fix t s show "(t,s) \<in> ?A \<Longrightarrow> (t,s) \<in> ?B" by (induct rule: db'\<^sub>s\<^sub>s\<^sub>t.induct) auto
   qed
 
   show "?B \<subseteq> ?A"
   proof
     fix t s show "(t,s) \<in> ?B \<Longrightarrow> (t,s) \<in> ?A" by (induct arbitrary: D rule: dbupd\<^sub>s\<^sub>s\<^sub>t.induct) auto
   qed
 qed
 
 lemma db\<^sub>s\<^sub>s\<^sub>t_no_upd:
   assumes "\<forall>a \<in> set A. \<not>is_Insert a \<and> \<not>is_Delete a"
   shows "db'\<^sub>s\<^sub>s\<^sub>t A I D = D"
 using assms
 proof (induction A)
   case (Cons a A) thus ?case by (cases a) auto
 qed simp
 
 lemma db\<^sub>s\<^sub>s\<^sub>t_no_upd_append:
   assumes "\<forall>b \<in> set B. \<not>is_Insert b \<and> \<not>is_Delete b"
   shows "db'\<^sub>s\<^sub>s\<^sub>t A = db'\<^sub>s\<^sub>s\<^sub>t (A@B)"
   using assms
 proof (induction A)
   case Nil thus ?case by (simp add: db\<^sub>s\<^sub>s\<^sub>t_no_upd)
 next
   case (Cons a A) thus ?case by (cases a) simp_all
 qed
 
 lemma db\<^sub>s\<^sub>s\<^sub>t_append:
   "db'\<^sub>s\<^sub>s\<^sub>t (A@B) I D = db'\<^sub>s\<^sub>s\<^sub>t B I (db'\<^sub>s\<^sub>s\<^sub>t A I D)"
 proof (induction A arbitrary: D)
   case (Cons a A) thus ?case by (cases a) auto
 qed simp
 
 lemma db\<^sub>s\<^sub>s\<^sub>t_in_cases:
   assumes "(t,s) \<in> set (db'\<^sub>s\<^sub>s\<^sub>t A I D)"
   shows "(t,s) \<in> set D \<or> (\<exists>t' s'. insert\<langle>t',s'\<rangle> \<in> set A \<and> t = t' \<cdot> I \<and> s = s' \<cdot> I)"
   using assms
 proof (induction A arbitrary: D)
   case (Cons a A) thus ?case by (cases a) fastforce+
 qed simp
 
 lemma db\<^sub>s\<^sub>s\<^sub>t_in_cases':
   assumes "(t,s) \<in> set (db'\<^sub>s\<^sub>s\<^sub>t A I D)"
     and "(t,s) \<notin> set D"
   shows "\<exists>B C t' s'. A = B@insert\<langle>t',s'\<rangle>#C \<and> t = t' \<cdot> I \<and> s = s' \<cdot> I \<and>
                      (\<forall>t'' s''. delete\<langle>t'',s''\<rangle> \<in> set C \<longrightarrow> t \<noteq> t'' \<cdot> I \<or> s \<noteq> s'' \<cdot> I)"
   using assms(1)
 proof (induction A rule: List.rev_induct)
   case (snoc a A)
   note * = snoc db\<^sub>s\<^sub>s\<^sub>t_append[of A "[a]" I D]
   thus ?case
   proof (cases a)
     case (Insert t' s')
     thus ?thesis using * by (cases "(t,s) \<in> set (db'\<^sub>s\<^sub>s\<^sub>t A I D)") force+
   next
     case (Delete t' s')
     hence **: "t \<noteq> t' \<cdot> I \<or> s \<noteq> s' \<cdot> I" using * by simp
 
     have "(t,s) \<in> set (db'\<^sub>s\<^sub>s\<^sub>t A I D)" using * Delete by force
     then obtain B C u v where B:
         "A = B@insert\<langle>u,v\<rangle>#C" "t = u \<cdot> I" "s = v \<cdot> I"
         "\<forall>t' s'. delete\<langle>t',s'\<rangle> \<in> set C \<longrightarrow> t \<noteq> t' \<cdot> I \<or> s \<noteq> s' \<cdot> I"
       using snoc.IH by moura
 
     have "A@[a] = B@insert\<langle>u,v\<rangle>#(C@[a])"
          "\<forall>t' s'. delete\<langle>t',s'\<rangle> \<in> set (C@[a]) \<longrightarrow> t \<noteq> t' \<cdot> I \<or> s \<noteq> s' \<cdot> I"
       using B(1,4) Delete ** by auto
     thus ?thesis using B(2,3) by blast
   qed force+
 qed (simp add: assms(2))
 
 lemma db\<^sub>s\<^sub>s\<^sub>t_filter:
   "db'\<^sub>s\<^sub>s\<^sub>t A I D = db'\<^sub>s\<^sub>s\<^sub>t (filter is_Update A) I D"
 by (induct A I D rule: db'\<^sub>s\<^sub>s\<^sub>t.induct) simp_all
 
 lemma db\<^sub>s\<^sub>s\<^sub>t_subst_swap:
   assumes "\<forall>x \<in> fv\<^sub>s\<^sub>s\<^sub>t A. I x = J x"
   shows "db'\<^sub>s\<^sub>s\<^sub>t A I D = db'\<^sub>s\<^sub>s\<^sub>t A J D"
 using assms
 proof (induction A arbitrary: D)
   case (Cons a A)
   hence "\<forall>x \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. I x = J x" "\<And>D. db'\<^sub>s\<^sub>s\<^sub>t A I D = db'\<^sub>s\<^sub>s\<^sub>t A J D" by auto
   thus ?case by (cases a) (simp_all add: term_subst_eq[of _ I J])
 qed simp
 
 lemma dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd:
   assumes "\<forall>a \<in> set A. \<not>is_Insert a \<and> \<not>is_Delete a"
   shows "dbupd\<^sub>s\<^sub>s\<^sub>t A I D = D"
 using assms
 proof (induction A)
   case (Cons a A) thus ?case by (cases a) auto
 qed simp
 
 lemma dbupd\<^sub>s\<^sub>s\<^sub>t_no_deletes:
   assumes "list_all (\<lambda>a. \<not>is_Delete a) A"
   shows "dbupd\<^sub>s\<^sub>s\<^sub>t A I D = D \<union> {(t \<cdot> I, s \<cdot> I) | t s. insert\<langle>t,s\<rangle> \<in> set A}" (is "?Q A D")
 using assms
 proof (induction A arbitrary: D)
   case (Cons a A)
   hence IH: "?Q A D" for D by auto
   have "\<not>is_Delete a" using Cons.prems by simp
   thus ?case using IH by (cases a) auto
 qed simp
 
 lemma dbupd\<^sub>s\<^sub>s\<^sub>t_append:
   "dbupd\<^sub>s\<^sub>s\<^sub>t (A@B) I D = dbupd\<^sub>s\<^sub>s\<^sub>t B I (dbupd\<^sub>s\<^sub>s\<^sub>t A I D)"
 proof (induction A arbitrary: D)
   case (Cons a A) thus ?case by (cases a) auto
 qed simp
 
 lemma dbupd\<^sub>s\<^sub>s\<^sub>t_filter:
   "dbupd\<^sub>s\<^sub>s\<^sub>t A I D = dbupd\<^sub>s\<^sub>s\<^sub>t (filter is_Update A) I D"
 by (induct A I D rule: dbupd\<^sub>s\<^sub>s\<^sub>t.induct) simp_all
 
 lemma dbupd\<^sub>s\<^sub>s\<^sub>t_in_cases:
   assumes "(t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I D"
   shows "(t,s) \<in> D \<or> (\<exists>t' s'. insert\<langle>t',s'\<rangle> \<in> set A \<and> t = t' \<cdot> I \<and> s = s' \<cdot> I)" (is ?P)
     and "\<forall>u v B. suffix (delete\<langle>u,v\<rangle>#B) A \<and> (t,s) = (u,v) \<cdot>\<^sub>p I \<longrightarrow>
                   (\<exists>u' v'. (t,s) = (u',v') \<cdot>\<^sub>p I \<and> insert\<langle>u',v'\<rangle> \<in> set B)" (is ?Q)
 proof -
   show ?P using assms
   proof (induction A arbitrary: D)
     case (Cons a A) thus ?case by (cases a) fastforce+
   qed simp
 
   show ?Q using assms
   proof (induction A arbitrary: D rule: List.rev_induct)
     case (snoc a A)
     note 0 = snoc.IH snoc.prems
     note 1 = suffix_snoc[of _ A a]
 
     have 2: "dbupd\<^sub>s\<^sub>s\<^sub>t (A@[a]) I D = dbupd\<^sub>s\<^sub>s\<^sub>t A I D" when "\<not>is_Update a"
       using that dbupd\<^sub>s\<^sub>s\<^sub>t_append[of A "[a]" I D] by (cases a) auto
 
     have 3: "suffix (delete\<langle>u,v\<rangle>#B) A \<Longrightarrow> suffix (delete\<langle>u,v\<rangle>#B@[a]) (A@[a])"
       when "\<not>is_Update a" for u v B
       using that by simp
 
     have 4: "\<exists>C. B = C@[a] \<and> suffix (delete\<langle>u,v\<rangle>#C) A"
       when a: "\<not>is_Delete a" "suffix (delete\<langle>u,v\<rangle>#B) (A@[a])" for u v B
     proof -
       have a': "a \<noteq> delete\<langle>u,v\<rangle>" using a(1) by force
       obtain C where C: "delete\<langle>u,v\<rangle>#B = C@[a]" "suffix C A" using 1 a(2) by blast
       show ?thesis using a' C by (cases C) auto
     qed
 
     note 5 = dbupd\<^sub>s\<^sub>s\<^sub>t_append[of A "[a]" I]
 
     show ?case
     proof (cases "is_Update a")
       case True
       then obtain u v where "a = insert\<langle>u,v\<rangle> \<or> a = delete\<langle>u,v\<rangle>" by (cases a) auto
       thus ?thesis
       proof
         assume a: "a = insert\<langle>u,v\<rangle>"
         hence a': "\<not>is_Delete a" by simp
 
         have 6: "insert\<langle>u,v\<rangle> \<in> set B"
           when B: "suffix (delete\<langle>u',v'\<rangle>#B) (A@[a])" for u' v' B
           using 4[OF a' B] unfolding a by fastforce
 
         have 7: "(t,s) = (u,v) \<cdot>\<^sub>p I \<or> (t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I D" using snoc.prems 5 a by auto
         show ?thesis
         proof (cases "(t,s) = (u,v) \<cdot>\<^sub>p I")
           case True
           have "insert\<langle>u,v\<rangle> \<in> set B"
             when B: "suffix (delete\<langle>u',v'\<rangle>#B) (A@[a])" for u' v' B
             using 4[OF a' B] unfolding a by fastforce
           thus ?thesis using True by blast
         next
           case False
           hence 8: "(t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I D" using 7 by blast
           have "\<exists>u'' v''. (t,s) = (u'',v'') \<cdot>\<^sub>p I \<and> insert\<langle>u'',v''\<rangle> \<in> set B"
             when B: "suffix (delete\<langle>u',v'\<rangle>#B) (A @ [a])" "(t,s) = (u',v') \<cdot>\<^sub>p I" for u' v' B
           proof -
             obtain C where C: "B = C@[a]" "suffix (delete\<langle>u',v'\<rangle>#C) A" using 4[OF a' B(1)] by blast
             thus ?thesis using snoc.IH[OF 8] B(2) unfolding a by fastforce
           qed
           thus ?thesis by blast
         qed
       next
         assume a: "a = delete\<langle>u,v\<rangle>"
         hence "(t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I D - {((u,v) \<cdot>\<^sub>p I)}" using snoc.prems 5 by auto
         hence 6: "(t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I D" "(t,s) \<noteq> (u,v) \<cdot>\<^sub>p I" by (blast,blast)
         
         have "(\<exists>C. B = C@[a] \<and> suffix (delete\<langle>u',v'\<rangle>#C) A) \<or> (B = [] \<and> u' = u \<and> v' = v)"
           when B: "suffix (delete\<langle>u',v'\<rangle>#B) (A@[a])" for B u' v'
         proof -
           obtain C where C: "delete\<langle>u',v'\<rangle>#B = C@[a]" "suffix C A" using B 1 by blast
           show ?thesis
           proof (cases "B = []")
             case True thus ?thesis using C unfolding a by simp
           next
             case False
             then obtain b B' where B': "B = B'@[b]" by (meson rev_exhaust)
             show ?thesis using C unfolding a B' by auto
           qed 
         qed
         hence "\<exists>C. B = C@[a] \<and> suffix (delete\<langle>u',v'\<rangle>#C) A"
           when "suffix (delete\<langle>u',v'\<rangle>#B) (A@[a])" "(t,s) = (u',v') \<cdot>\<^sub>p I" for B u' v'
           using that 6 by blast
         thus ?thesis using snoc.IH[OF 6(1)] unfolding a by fastforce
       qed
     next
       case False
       have "\<exists>u' v'. (t,s) = (u',v') \<cdot>\<^sub>p I \<and> insert\<langle>u',v'\<rangle> \<in> set B"
         when B: "suffix (delete\<langle>u,v\<rangle>#B) (A@[a])" "(t,s) = (u,v) \<cdot>\<^sub>p I" for u v B
       proof -
         obtain C where C: "B = C@[a]" "suffix (delete\<langle>u,v\<rangle>#C) A" using 4[OF _ B(1)] False by blast
         show ?thesis using B(2) snoc.IH[OF snoc.prems[unfolded 2[OF False]]] C by fastforce
       qed
       thus ?thesis by blast
     qed
   qed simp
 qed
 
 lemma dbupd\<^sub>s\<^sub>s\<^sub>t_in_iff:
   "(t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I D \<longleftrightarrow>
    ((\<forall>u v B. suffix (delete\<langle>u,v\<rangle>#B) A \<and> (t,s) = (u,v) \<cdot>\<^sub>p I \<longrightarrow>
               (\<exists>u' v'. (t,s) = (u',v') \<cdot>\<^sub>p I \<and> insert\<langle>u',v'\<rangle> \<in> set B)) \<and>
     ((t,s) \<in> D \<or> (\<exists>u v. (t,s) = (u,v) \<cdot>\<^sub>p I \<and> insert\<langle>u,v\<rangle> \<in> set A)))"
   (is "?P A D \<longleftrightarrow> ?Q1 A \<and> ?Q2 A D")
 proof
   show "?P A D \<Longrightarrow> ?Q1 A \<and> ?Q2 A D" using dbupd\<^sub>s\<^sub>s\<^sub>t_in_cases by fast
 
   show "?Q1 A \<and> ?Q2 A D \<Longrightarrow> ?P A D"
   proof (induction A arbitrary: D)
     case (Cons a A)
     have Q1: "?Q1 A" using Cons.prems suffix_Cons[of _ a A] by blast
 
     show ?case
     proof (cases "is_Update a")
       case False thus ?thesis using Q1 Cons.IH Cons.prems by (cases a) auto
     next
       case True
       then obtain t' s' where "a = insert\<langle>t',s'\<rangle> \<or> a = delete\<langle>t',s'\<rangle>" by (cases a) auto
       thus ?thesis
       proof
         assume a: "a = insert\<langle>t',s'\<rangle>"
         hence "?Q2 A (insert ((t',s') \<cdot>\<^sub>p I) D)" using Cons.prems by auto
         thus ?thesis using Q1 Cons.IH unfolding a by auto
       next
         assume a: "a = delete\<langle>t',s'\<rangle>"
         hence "?Q2 A (D - {(t',s') \<cdot>\<^sub>p I})" using Cons.prems by auto
         thus ?thesis using Q1 Cons.IH unfolding a by auto
       qed
     qed
   qed simp
 qed
 
 lemma dbupd\<^sub>s\<^sub>s\<^sub>t_in_cases':
   fixes A::"('a,'b) stateful_strand"
   assumes "(t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I D"
     and "(t,s) \<notin> D"
   shows "\<exists>B C t' s'. A = B@insert\<langle>t',s'\<rangle>#C \<and> t = t' \<cdot> I \<and> s = s' \<cdot> I \<and>
                      (\<forall>t'' s''. delete\<langle>t'',s''\<rangle> \<in> set C \<longrightarrow> t \<noteq> t'' \<cdot> I \<or> s \<noteq> s'' \<cdot> I)"
 using assms(1)
 proof (induction A rule: List.rev_induct)
   case (snoc a A)
   note 0 = dbupd\<^sub>s\<^sub>s\<^sub>t_append[of A "[a]" I D]
   have 1: "(t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I D" when "\<not>is_Update a" using that snoc.prems 0 by (cases a) auto
   show ?case
   proof (cases "is_Update a")
     case False
     obtain B C t' s' where B:
         "A = B@insert\<langle>t',s'\<rangle>#C" "t = t' \<cdot> I" "s = s' \<cdot> I"
         "\<forall>t'' s''. delete\<langle>t'',s''\<rangle> \<in> set C \<longrightarrow> t \<noteq> t'' \<cdot> I \<or> s \<noteq> s'' \<cdot> I"
       using snoc.IH[OF 1[OF False]] by blast
 
     have "A@[a] = B@insert\<langle>t',s'\<rangle>#(C@[a])"
          "\<forall>t'' s''. delete\<langle>t'',s''\<rangle> \<in> set (C@[a]) \<longrightarrow> t \<noteq> t'' \<cdot> I \<or> s \<noteq> s'' \<cdot> I"
       using False B(1,4) by auto
     thus ?thesis using B(2,3) by blast
   next
     case True
     then obtain t' s' where "a = insert\<langle>t',s'\<rangle> \<or> a = delete\<langle>t',s'\<rangle>" by (cases a) auto
     thus ?thesis
     proof
       assume a: "a = insert\<langle>t',s'\<rangle>"
       hence "dbupd\<^sub>s\<^sub>s\<^sub>t (A@[a]) I D = insert ((t',s') \<cdot>\<^sub>p I) (dbupd\<^sub>s\<^sub>s\<^sub>t A I D)" using 0 by simp
       hence "(t,s) = (t',s') \<cdot>\<^sub>p I \<or> (t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I D" using snoc.prems by blast
       thus ?thesis
       proof
         assume 2: "(t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I D" show ?thesis using snoc.IH[OF 2] unfolding a by force
       qed (force simp add: a)
     next
       assume a: "a = delete\<langle>t',s'\<rangle>"
       hence 2: "t \<noteq> t' \<cdot> I \<or> s \<noteq> s' \<cdot> I" using 0 snoc.prems by simp
   
       have "(t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I D" using 0 snoc.prems a by force
       then obtain B C u v where B:
           "A = B@insert\<langle>u,v\<rangle>#C" "t = u \<cdot> I" "s = v \<cdot> I"
           "\<forall>t' s'. delete\<langle>t',s'\<rangle> \<in> set C \<longrightarrow> t \<noteq> t' \<cdot> I \<or> s \<noteq> s' \<cdot> I"
         using snoc.IH by moura
   
       have "A@[a] = B@insert\<langle>u,v\<rangle>#(C@[a])"
            "\<forall>t' s'. delete\<langle>t',s'\<rangle> \<in> set (C@[a]) \<longrightarrow> t \<noteq> t' \<cdot> I \<or> s \<noteq> s' \<cdot> I"
         using B(1,4) a 2 by auto
       thus ?thesis using B(2,3) by blast
     qed
   qed
 qed (simp add: assms(2))
 
 lemma dbupd\<^sub>s\<^sub>s\<^sub>t_mono:
   assumes "D \<subseteq> E"
   shows "dbupd\<^sub>s\<^sub>s\<^sub>t A I D \<subseteq> dbupd\<^sub>s\<^sub>s\<^sub>t A I E"
 using assms
 proof (induction A arbitrary: D E)
   case (Cons a A) thus ?case
   proof (cases a)
     case (Insert t s)
     have "insert ((t,s) \<cdot>\<^sub>p I) D \<subseteq> insert ((t,s) \<cdot>\<^sub>p I) E" using Cons.prems by fast
     thus ?thesis using Cons.IH unfolding Insert by simp
   next
     case (Delete t s)
     have "D - {(t,s) \<cdot>\<^sub>p I} \<subseteq> E - {(t,s) \<cdot>\<^sub>p I}" using Cons.prems by fast
     thus ?thesis using Cons.IH unfolding Delete by simp
   qed auto
 qed simp
 
 lemma dbupd\<^sub>s\<^sub>s\<^sub>t_db_narrow:
   assumes "(t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I (D \<union> E)"
     and "(t,s) \<notin> D"
   shows "(t,s) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I E"
 using assms
 proof (induction A arbitrary: D E)
   case (Cons a A) thus ?case
   proof (cases a)
     case (Delete t' s') thus ?thesis
       using Cons.prems Cons.IH[of "D - {(t',s') \<cdot>\<^sub>p I}" "E - {(t',s') \<cdot>\<^sub>p I}"] by (simp add: Un_Diff)
   qed auto
 qed simp
 
 lemma dbupd\<^sub>s\<^sub>s\<^sub>t_set_term_neq_in_iff:
   assumes f: "f \<noteq> k"
     and A: "\<forall>t s. insert\<langle>t,s\<rangle> \<in> set A \<longrightarrow> (\<exists>g ts. s = Fun g ts)"
   shows "(t,Fun f ts) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A I D \<longleftrightarrow>
          (t,Fun f ts) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t (filter (\<lambda>a. \<nexists>s ss. a = insert\<langle>s,Fun k ss\<rangle>) A) I D"
     (is "?P A D \<longleftrightarrow> ?P (?f A) D")
 proof
   show "?P A D \<Longrightarrow> ?P (?f A) D" using A
   proof (induction A arbitrary: D)
     case (Cons a A)
     have IH: "?P A D \<Longrightarrow> ?P (?f A) D" for D
       using Cons.prems(2) Cons.IH by simp
 
     show ?case
     proof (cases "is_Update a")
       case True
       then obtain u s where "a = insert\<langle>u,s\<rangle> \<or> a = delete\<langle>u,s\<rangle>" by (cases a) auto
       thus ?thesis
       proof
         assume a: "a = insert\<langle>u,s\<rangle>"
         obtain g ss where s: "s = Fun g ss" using a Cons.prems(2) by fastforce
 
         have 0: "?P A (insert ((u, s) \<cdot>\<^sub>p I) D)" using a Cons.prems(1) by fastforce
         show ?thesis
         proof (cases "g = k")
           case g: True
           have "?f (a#A) = ?f A" unfolding a s g by force
           moreover have "(t,Fun f ts) \<noteq> (u, Fun g ss) \<cdot>\<^sub>p I" using f unfolding g by auto
           ultimately show ?thesis
             using IH[OF 0] dbupd\<^sub>s\<^sub>s\<^sub>t_db_narrow[of t "Fun f ts" "?f A" I "{(u, s) \<cdot>\<^sub>p I}" D]
             unfolding a s g by force
         next
           case g: False
           have "?f (a#A) = a#?f A" using g unfolding a s by force
           thus ?thesis using Cons.prems Cons.IH g unfolding a s by force
         qed
       next
         assume a: "a = delete\<langle>u,s\<rangle>"
         hence "?f (a#A) = a#?f A" by auto
         thus ?thesis using Cons.prems Cons.IH unfolding a by fastforce
       qed
     next
       case a: False
       hence "?P A D" using Cons.prems(1) by (cases a) auto
       hence "?P (?f A) D" using Cons.IH Cons.prems(2) a by fastforce
       thus ?thesis using a by (cases a) auto
     qed
   qed simp
 
   have "dbupd\<^sub>s\<^sub>s\<^sub>t (?f A) I D \<subseteq> dbupd\<^sub>s\<^sub>s\<^sub>t A I D"
   proof (induction A arbitrary: D)
     case (Cons a A) show ?case
     proof (cases a)
       case (Insert t s)
       have "?f (a#A) = a#?f A \<or> ?f (a#A) = ?f A" unfolding Insert by force
       hence "dbupd\<^sub>s\<^sub>s\<^sub>t (?f (a#A)) I D \<subseteq> dbupd\<^sub>s\<^sub>s\<^sub>t (?f A) I (insert ((t,s) \<cdot>\<^sub>p I) D)"
         using dbupd\<^sub>s\<^sub>s\<^sub>t_mono[of D "insert ((t, s) \<cdot>\<^sub>p I) D"] unfolding Insert by auto
       thus ?thesis using Cons.IH unfolding Insert by fastforce
     qed (use Cons.prems Cons.IH in auto)
   qed simp
   thus "?P (?f A) D \<Longrightarrow> ?P A D" by blast
 qed
 
 lemma dbupd\<^sub>s\<^sub>s\<^sub>t_subst_const_swap:
   fixes t s
   defines "fvs \<equiv> \<lambda>A D. fv\<^sub>s\<^sub>s\<^sub>t A \<union> fv t \<union> fv s \<union> \<Union>(fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r ` D)"
   assumes "(t \<cdot> \<delta>, s \<cdot> \<delta>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A \<delta> (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<delta>)" (is "?in \<delta> A D")
     and "\<forall>x \<in> fvs A D.
           \<delta> x = \<theta> x \<or>
           (\<not>(\<delta> x \<sqsubseteq> t) \<and> \<not>(\<delta> x \<sqsubseteq> s) \<and> \<not>(\<theta> x \<sqsubseteq> t) \<and> \<not>(\<theta> x \<sqsubseteq> s) \<and>
            (\<forall>(u,v) \<in> D. \<not>(\<delta> x \<sqsubseteq> u) \<and> \<not>(\<delta> x \<sqsubseteq> v) \<and> \<not>(\<theta> x \<sqsubseteq> u) \<and> \<not>(\<theta> x \<sqsubseteq> v)) \<and>
            (\<forall>u v. insert\<langle>u,v\<rangle> \<in> set A \<or> delete\<langle>u,v\<rangle> \<in> set A \<longrightarrow>
                     \<not>(\<delta> x \<sqsubseteq> u) \<and> \<not>(\<delta> x \<sqsubseteq> v) \<and> \<not>(\<theta> x \<sqsubseteq> u) \<and> \<not>(\<theta> x \<sqsubseteq> v)))"
       (is "?A \<delta> \<theta> D")
     and "\<forall>x \<in> fvs A D. \<exists>c. \<delta> x = Fun c []" (is "?B \<delta>")
     and "\<forall>x \<in> fvs A D. \<exists>c. \<theta> x = Fun c []" (is "?B \<theta>")
     and "\<forall>x \<in> fvs A D. \<forall>y \<in> fvs A D. \<delta> x = \<delta> y \<longleftrightarrow> \<theta> x = \<theta> y" (is "?C \<delta> \<theta> A D")
   shows "(t \<cdot> \<theta>, s \<cdot> \<theta>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A \<theta> (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>)" (is "?in \<theta> A D")
 using assms(2-)
 proof (induction A arbitrary: D rule: List.rev_induct)
   case Nil
   then obtain u v where u: "(u,v) \<in> D" "t \<cdot> \<delta> = u \<cdot> \<delta>" "s \<cdot> \<delta> = v \<cdot> \<delta>" by auto
 
   let ?X = "fv t \<union> fv u"
   let ?Y = "fv s \<union> fv v"
 
   have 0: "fv u \<subseteq> fvs [] D" "fv v \<subseteq> fvs [] D" "fv t \<subseteq> fvs [] D" "fv s \<subseteq> fvs [] D"
     using u(1) unfolding fvs_def by (blast, blast, blast, blast)
 
   have 1: "\<forall>x \<in> ?X. \<delta> x = \<theta> x \<or> (\<not>(\<delta> x \<sqsubseteq> t) \<and> \<not>(\<delta> x \<sqsubseteq> u))"
           "\<forall>x \<in> ?Y. \<delta> x = \<theta> x \<or> (\<not>(\<delta> x \<sqsubseteq> s) \<and> \<not>(\<delta> x \<sqsubseteq> v))"
     using Nil.prems(2) u(1) unfolding fvs_def by (blast,blast)
 
   have 2: "\<forall>x \<in> ?X. \<exists>c. \<delta> x = Fun c []" "\<forall>x \<in> ?X. \<exists>c. \<theta> x = Fun c []"
           "\<forall>x \<in> ?Y. \<exists>c. \<delta> x = Fun c []" "\<forall>x \<in> ?Y. \<exists>c. \<theta> x = Fun c []"
     using Nil.prems(3,4) 0 by (blast,blast,blast,blast)
 
   have 3: "\<forall>x \<in> ?X. \<forall>y \<in> ?X. \<delta> x = \<delta> y \<longleftrightarrow> \<theta> x = \<theta> y"
           "\<forall>x \<in> ?Y. \<forall>y \<in> ?Y. \<delta> x = \<delta> y \<longleftrightarrow> \<theta> x = \<theta> y"
     using Nil.prems(5) 0 by (blast,blast)
 
   have "t \<cdot> \<theta> = u \<cdot> \<theta>" "s \<cdot> \<theta> = v \<cdot> \<theta>"
     using subst_const_swap_eq'[OF u(2) 1(1) 2(1,2) 3(1)]
           subst_const_swap_eq'[OF u(3) 1(2) 2(3,4) 3(2)]
     by argo+
   thus ?case using u(1) by force
 next
   case (snoc a A)
   have 0: "fvs A D \<subseteq> fvs (A@[a]) D" "set A \<subseteq> set (A@[a])" unfolding fvs_def by auto
 
   note 1 = dbupd\<^sub>s\<^sub>s\<^sub>t_append[of A "[a]"]
 
   have IH: "(t \<cdot> \<delta>, s \<cdot> \<delta>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A \<delta> (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<delta>) \<Longrightarrow> (t \<cdot> \<theta>, s \<cdot> \<theta>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A \<theta> (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>)"
     using snoc.IH[of D] snoc.prems(2-) 0 by blast
 
   let ?q0 = "\<lambda>t s \<delta> \<theta>. \<forall>x \<in> fv t \<union> fv s. \<delta> x = \<theta> x \<or> (\<not>(\<delta> x \<sqsubseteq> t) \<and> \<not>(\<delta> x \<sqsubseteq> s))"
   let ?q1 = "\<lambda>t s \<delta>.   \<forall>x \<in> fv t \<union> fv s. \<exists>c. \<delta> x = Fun c []"
   let ?q2 = "\<lambda>t s \<delta> \<theta>. \<forall>x \<in> fv t \<union> fv s. \<forall>y \<in> fv t \<union> fv s. \<delta> x = \<delta> y \<longleftrightarrow> \<theta> x = \<theta> y"
 
   show ?case
   proof (cases "is_Update a")
     case False
     hence "dbupd\<^sub>s\<^sub>s\<^sub>t (A@[a]) \<delta> (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<delta>) = dbupd\<^sub>s\<^sub>s\<^sub>t A \<delta> (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<delta>)"
           "dbupd\<^sub>s\<^sub>s\<^sub>t (A@[a]) \<theta> (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>) = dbupd\<^sub>s\<^sub>s\<^sub>t A \<theta> (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>)"
       using 1 by (cases a; auto)+
     thus ?thesis using IH snoc.prems(1) by blast
   next
     case True
     then obtain u v where u: "a = insert\<langle>u,v\<rangle> \<or> a = delete\<langle>u,v\<rangle>" by (cases a) auto
 
     have uv_in: "insert\<langle>u,v\<rangle> \<in> set (A@[a]) \<or> delete\<langle>u,v\<rangle> \<in> set (A@[a])" using u by force
     hence fv_uv: "fv u \<subseteq> fvs (A@[a]) D" "fv v \<subseteq> fvs (A@[a]) D" unfolding fvs_def by (force,force)
 
     have fv_ts: "fv t \<subseteq> fvs (A@[a]) D" "fv s \<subseteq> fvs (A@[a]) D" unfolding fvs_def by (blast,blast)
 
     have q0: "?q0 t u \<delta> \<theta>" "?q0 s v \<delta> \<theta>"
              "?q0 t u \<theta> \<delta>" "?q0 s v \<theta> \<delta>"
     proof -
       show "?q0 t u \<delta> \<theta>" "?q0 s v \<delta> \<theta>"
         using snoc.prems(2) 0 fv_ts fv_uv uv_in by (blast,blast)
 
       show "?q0 t u \<theta> \<delta>"
       proof
         fix x assume "x \<in> fv t \<union> fv u"
         hence "x \<in> fvs (A@[a]) D" using fv_ts(1) fv_uv(1) by blast
         thus "\<theta> x = \<delta> x \<or> (\<not>(\<theta> x \<sqsubseteq> t) \<and> \<not>(\<theta> x \<sqsubseteq> u))" 
           using snoc.prems(2) uv_in by auto
       qed
 
       show "?q0 s v \<theta> \<delta>"
       proof
         fix x assume "x \<in> fv s \<union> fv v"
         hence "x \<in> fvs (A@[a]) D" using fv_ts(2) fv_uv(2) by blast
         thus "\<theta> x = \<delta> x \<or> (\<not>(\<theta> x \<sqsubseteq> s) \<and> \<not>(\<theta> x \<sqsubseteq> v))" 
           using snoc.prems(2) uv_in by auto
       qed
     qed
 
     have q1: "?q1 t u \<delta>" "?q1 t u \<theta>"
              "?q1 s v \<delta>" "?q1 s v \<theta>"
       using snoc.prems(3,4) 0 fv_ts fv_uv by (blast,blast,blast,blast)
 
     have q2: "?q2 t u \<delta> \<theta>" "?q2 s v \<delta> \<theta>"
              "?q2 t u \<theta> \<delta>" "?q2 s v \<theta> \<delta>"
       using snoc.prems(5) 0 fv_ts fv_uv by (blast,blast,blast,blast)
 
     from u show ?thesis
     proof
       assume a: "a = insert\<langle>u,v\<rangle>"
       show ?thesis
       proof (cases "(t \<cdot> \<delta>, s \<cdot> \<delta>) = (u,v) \<cdot>\<^sub>p \<delta>")
         case True
         hence "(t \<cdot> \<theta>, s \<cdot> \<theta>) = (u,v) \<cdot>\<^sub>p \<theta>"
           using subst_const_swap_eq'[OF _ q0(1) q1(1,2) q2(1)]
                 subst_const_swap_eq'[OF _ q0(2) q1(3,4) q2(2)]
           by fast
         thus ?thesis using 1 unfolding a by simp
       next
         case False
         hence "(t \<cdot> \<delta>, s \<cdot> \<delta>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A \<delta> (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<delta>)"
           using snoc.prems(1) 1 unfolding a by force
         hence "(t \<cdot> \<theta>, s \<cdot> \<theta>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A \<theta> (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>)"
           using IH by blast
         thus ?thesis using 1 unfolding a by simp
       qed
     next
       assume a: "a = delete\<langle>u,v\<rangle>"
       have "(t \<cdot> \<delta>, s \<cdot> \<delta>) \<noteq> (u,v) \<cdot>\<^sub>p \<delta>"
         using snoc.prems(1) dbupd\<^sub>s\<^sub>s\<^sub>t_append[of A "[a]"] unfolding a by fastforce
       hence 2: "(t \<cdot> \<theta>, s \<cdot> \<theta>) \<noteq> (u,v) \<cdot>\<^sub>p \<theta>"
         using subst_const_swap_eq'[OF _ q0(3) q1(2,1) q2(3)]
               subst_const_swap_eq'[OF _ q0(4) q1(4,3) q2(4)]
         by fast
 
       have "(t \<cdot> \<delta>, s \<cdot> \<delta>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A \<delta> (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<delta>)"
         using snoc.prems(1) 1 unfolding a by fastforce
       hence 3: "(t \<cdot> \<theta>, s \<cdot> \<theta>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t A \<theta> (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>)"
         using IH by blast
 
       show ?thesis using 2 3 dbupd\<^sub>s\<^sub>s\<^sub>t_append[of A "[a]"] unfolding a by auto
     qed
   qed
 qed
 
 lemma subst_sst_cons: "a#A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta> = (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)#(A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
 by (simp add: subst_apply_stateful_strand_def)
 
 lemma subst_sst_snoc: "A@[a] \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta> = (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)@[a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>]"
 by (simp add: subst_apply_stateful_strand_def)
 
 lemma subst_sst_append[simp]: "A@B \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta> = (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)@(B \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
 by (simp add: subst_apply_stateful_strand_def)
 
 lemma subst_sst_list_all:
   "list_all is_Send S \<longleftrightarrow> list_all is_Send (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   "list_all is_Receive S \<longleftrightarrow> list_all is_Receive (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   "list_all is_Equality S \<longleftrightarrow> list_all is_Equality (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   "list_all is_Insert S \<longleftrightarrow> list_all is_Insert (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   "list_all is_Delete S \<longleftrightarrow> list_all is_Delete (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   "list_all is_InSet S \<longleftrightarrow> list_all is_InSet (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   "list_all is_NegChecks S \<longleftrightarrow> list_all is_NegChecks (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   "list_all is_Assignment S \<longleftrightarrow> list_all is_Assignment (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   "list_all is_Check S \<longleftrightarrow> list_all is_Check (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   "list_all is_Update S \<longleftrightarrow> list_all is_Update (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   "list_all is_Check_or_Assignment S \<longleftrightarrow> list_all is_Check_or_Assignment (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
 proof (induction S)
   case (Cons x S)
   note * = list_all_def subst_apply_stateful_strand_def
   { case 1 thus ?case using Cons.IH(1) unfolding * by (cases x) auto }
   { case 2 thus ?case using Cons.IH(2) unfolding * by (cases x) auto }
   { case 3 thus ?case using Cons.IH(3) unfolding * by (cases x) auto }
   { case 4 thus ?case using Cons.IH(4) unfolding * by (cases x) auto }
   { case 5 thus ?case using Cons.IH(5) unfolding * by (cases x) auto }
   { case 6 thus ?case using Cons.IH(6) unfolding * by (cases x) auto }
   { case 7 thus ?case using Cons.IH(7) unfolding * by (cases x) auto }
   { case 8 thus ?case using Cons.IH(8) unfolding * by (cases x) fastforce+ }
   { case 9 thus ?case using Cons.IH(9) unfolding * by (cases x) auto }
   { case 10 thus ?case using Cons.IH(10) unfolding * by (cases x) auto }
   { case 11 thus ?case using Cons.IH(11) unfolding * by (cases x) auto }
 qed simp_all
 
 lemma subst_sstp_id_subst: "a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p Var = a"
 by (cases a) auto
 
 lemma subst_sst_id_subst: "A \<cdot>\<^sub>s\<^sub>s\<^sub>t Var = A"
 by (induct A) (simp, metis subst_sstp_id_subst subst_sst_cons)
 
 lemma sst_vars_append_subset:
   "fv\<^sub>s\<^sub>s\<^sub>t A \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (A@B)" "bvars\<^sub>s\<^sub>s\<^sub>t A \<subseteq> bvars\<^sub>s\<^sub>s\<^sub>t (A@B)"
   "fv\<^sub>s\<^sub>s\<^sub>t B \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (A@B)" "bvars\<^sub>s\<^sub>s\<^sub>t B \<subseteq> bvars\<^sub>s\<^sub>s\<^sub>t (A@B)"
 by auto
 
 lemma sst_vars_disj_cons[simp]: "fv\<^sub>s\<^sub>s\<^sub>t (a#A) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (a#A) = {} \<Longrightarrow> fv\<^sub>s\<^sub>s\<^sub>t A \<inter> bvars\<^sub>s\<^sub>s\<^sub>t A = {}"
 unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by auto
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_cons_subset[simp]: "fv\<^sub>s\<^sub>s\<^sub>t A \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (a#A)"
 by auto
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases[simp]:
   "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\<langle>ts\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (receive\<langle>ts\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>c: t \<doteq> s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>)"
   "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\<langle>t,s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>)"
   "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (delete\<langle>t,s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>)"
   "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>c: t \<in> s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>)"
   "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) =
     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>) \<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) \<theta>) - set X"
 by simp_all
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_cases[simp]:
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\<langle>ts\<rangle>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (receive\<langle>ts\<rangle>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>c: t \<doteq> s\<rangle>) = fv t \<union> fv s"
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\<langle>t,s\<rangle>) = fv t \<union> fv s"
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (delete\<langle>t,s\<rangle>) = fv t \<union> fv s"
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>c: t \<in> s\<rangle>) = fv t \<union> fv s"
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) = 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 \<union> set X" (is ?A)
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: [(t,s)] \<or>\<notin>: []\<rangle>) = fv t \<union> fv s \<union> set X" (is ?B)
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: [] \<or>\<notin>: [(t,s)]\<rangle>) = fv t \<union> fv s \<union> set X" (is ?C)
 proof
   show ?A ?B ?C by auto
 qed simp_all
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases[simp]:
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\<langle>ts\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (receive\<langle>ts\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>c: t \<doteq> s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>)"
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\<langle>t,s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>)"
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (delete\<langle>t,s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>)"
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>c: t \<in> s\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>) \<union> fv (s \<cdot> \<theta>)"
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) =
     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>) \<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) \<theta>) \<union> set X" (is ?A)
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: [(t,s)] \<or>\<notin>: []\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) =
     fv (t \<cdot> rm_vars (set X) \<theta>) \<union> fv (s \<cdot> rm_vars (set X) \<theta>) \<union> set X" (is ?B)
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: [] \<or>\<notin>: [(t,s)]\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) =
     fv (t \<cdot> rm_vars (set X) \<theta>) \<union> fv (s \<cdot> rm_vars (set X) \<theta>) \<union> set X" (is ?C)
 proof
   show ?A ?B ?C by auto
 qed simp_all
 
 lemma bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset: "bvars\<^sub>s\<^sub>s\<^sub>t A \<subseteq> bvars\<^sub>s\<^sub>s\<^sub>t (a#A)"
 by auto
 
 lemma bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst: "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a"
 by (cases a) auto
 
 lemma bvars\<^sub>s\<^sub>s\<^sub>t_subst: "bvars\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>s\<^sub>t A"
 using bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[of _ \<delta>]
 by (induct A) (simp_all add: subst_apply_stateful_strand_def)
 
 lemma bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_set_cases[simp]:
   "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\<langle>ts\<rangle>)) = {}"
   "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (receive\<langle>ts\<rangle>)) = {}"
   "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>c: t \<doteq> s\<rangle>)) = {}"
   "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\<langle>t,s\<rangle>)) = {}"
   "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (delete\<langle>t,s\<rangle>)) = {}"
   "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>c: t \<in> s\<rangle>)) = {}"
   "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>)) = set X"
 by simp_all
 
 lemma bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegChecks: "\<not>is_NegChecks a \<Longrightarrow> bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = []"
 by (cases a) simp_all
 
 lemma bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks: "bvars\<^sub>s\<^sub>s\<^sub>t A = bvars\<^sub>s\<^sub>s\<^sub>t (filter is_NegChecks A)" 
 proof (induction A)
   case (Cons a A) thus ?case by (cases a) fastforce+
 qed simp
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t_append[simp]: "vars\<^sub>s\<^sub>s\<^sub>t (A@B) = vars\<^sub>s\<^sub>s\<^sub>t A \<union> vars\<^sub>s\<^sub>s\<^sub>t B"
 by (simp add: vars\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t_Nil[simp]: "vars\<^sub>s\<^sub>s\<^sub>t [] = {}"
 by (simp add: vars\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t_Cons: "vars\<^sub>s\<^sub>s\<^sub>t (a#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<union> vars\<^sub>s\<^sub>s\<^sub>t A"
 by (simp add: vars\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_Cons: "fv\<^sub>s\<^sub>s\<^sub>t (a#A) = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<union> fv\<^sub>s\<^sub>s\<^sub>t A"
 unfolding fv\<^sub>s\<^sub>s\<^sub>t_def by simp
 
 lemma bvars\<^sub>s\<^sub>s\<^sub>t_Cons: "bvars\<^sub>s\<^sub>s\<^sub>t (a#A) = set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) \<union> bvars\<^sub>s\<^sub>s\<^sub>t A"
 unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def by auto
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t_Cons'[simp]:
   "vars\<^sub>s\<^sub>s\<^sub>t (send\<langle>ts\<rangle>#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\<langle>ts\<rangle>) \<union> vars\<^sub>s\<^sub>s\<^sub>t A"
   "vars\<^sub>s\<^sub>s\<^sub>t (receive\<langle>ts\<rangle>#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (receive\<langle>ts\<rangle>) \<union> vars\<^sub>s\<^sub>s\<^sub>t A"
   "vars\<^sub>s\<^sub>s\<^sub>t (\<langle>a: t \<doteq> s\<rangle>#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>a: t \<doteq> s\<rangle>) \<union> vars\<^sub>s\<^sub>s\<^sub>t A"
   "vars\<^sub>s\<^sub>s\<^sub>t (insert\<langle>t,s\<rangle>#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\<langle>t,s\<rangle>) \<union> vars\<^sub>s\<^sub>s\<^sub>t A"
   "vars\<^sub>s\<^sub>s\<^sub>t (delete\<langle>t,s\<rangle>#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (delete\<langle>t,s\<rangle>) \<union> vars\<^sub>s\<^sub>s\<^sub>t A"
   "vars\<^sub>s\<^sub>s\<^sub>t (\<langle>a: t \<in> s\<rangle>#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>a: t \<in> s\<rangle>) \<union> vars\<^sub>s\<^sub>s\<^sub>t A"
   "vars\<^sub>s\<^sub>s\<^sub>t (\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) \<union> vars\<^sub>s\<^sub>s\<^sub>t A"
 by (simp_all add: vars\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_if_no_bvars:
   assumes a: "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = []"
   shows "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a)"
 proof (cases a)
   case (NegChecks X F G)
   hence "set X = {}" using a by fastforce
   thus ?thesis using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst[of _ \<theta>] unfolding NegChecks by simp
 qed (auto simp add: subst_list_set_fv subst_apply_fv_unfold)
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_subst_if_no_bvars:
   assumes A: "bvars\<^sub>s\<^sub>s\<^sub>t A = {}"
   shows "fv\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv\<^sub>s\<^sub>s\<^sub>t A)"
 using assms
 proof (induction A)
   case (Cons a A) thus ?case
     using fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_if_no_bvars[of a \<theta>] fv\<^sub>s\<^sub>s\<^sub>t_Cons[of a A] bvars\<^sub>s\<^sub>s\<^sub>t_Cons[of a A]
           subst_sst_cons[of a A \<theta>]
     by simp
 qed simp
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p:
   fixes x::"('a,'b) stateful_strand_step"
   shows "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \<union> set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x)"
 proof (cases x)
   case (NegChecks X F G) thus ?thesis by (induct F) force+
 qed simp_all
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t:
   fixes S::"('a,'b) stateful_strand"
   shows "vars\<^sub>s\<^sub>s\<^sub>t S = fv\<^sub>s\<^sub>s\<^sub>t S \<union> bvars\<^sub>s\<^sub>s\<^sub>t S"
 proof (induction S)
   case (Cons x S) thus ?case
     using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p[of x]
     by (auto simp add: vars\<^sub>s\<^sub>s\<^sub>t_def)
 qed simp
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck[simp]:
   "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) = set X \<union> 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"
 by (simp_all add: sup_commute sup_left_commute vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p)
 
 lemma bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck[simp]:
   "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) = X"
   "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>[]\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>)) = {}"
 by simp_all
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck[simp]:
   "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) = 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 - set X"
   "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<forall>[]\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) = 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"
   "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>t != s\<rangle>) = fv t \<union> fv s"
   "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>t not in s\<rangle>) = fv t \<union> fv s"
 by simp_all
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_append[simp]: "fv\<^sub>s\<^sub>s\<^sub>t (A@B) = fv\<^sub>s\<^sub>s\<^sub>t A \<union> fv\<^sub>s\<^sub>s\<^sub>t B"
 by simp
 
 lemma bvars\<^sub>s\<^sub>s\<^sub>t_append[simp]: "bvars\<^sub>s\<^sub>s\<^sub>t (A@B) = bvars\<^sub>s\<^sub>s\<^sub>t A \<union> bvars\<^sub>s\<^sub>s\<^sub>t B"
 by auto
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_mono: "set A \<subseteq> set B \<Longrightarrow> fv\<^sub>s\<^sub>s\<^sub>t A \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t B"
 by auto
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p:
   assumes "x \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a"
   shows "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a)"
 using assms var_is_subterm
 proof (cases a)
   case (NegChecks X F F')
   hence "x \<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 F' - set X" using assms by simp
   thus ?thesis using NegChecks var_is_subterm by fastforce
 qed force+
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t A \<Longrightarrow> Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t A)"
 proof (induction A)
   case (Cons a A) thus ?case using fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p by (cases "x \<in> fv\<^sub>s\<^sub>s\<^sub>t A") auto
 qed simp
 
 lemma var_subterm_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p:
   assumes "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a)"
   shows "x \<in> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a"
 using assms vars_iff_subtermeq
 proof (cases a)
   case (NegChecks X F F')
   hence "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F')" using assms by simp
   thus ?thesis using NegChecks vars_iff_subtermeq by force
 qed force+
 
 lemma var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t: "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t A) \<Longrightarrow> x \<in> vars\<^sub>s\<^sub>s\<^sub>t A"
 proof (induction A)
   case (Cons a A)
   show ?case
   proof (cases "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t A)")
     case True thus ?thesis using Cons.IH by (simp add: vars\<^sub>s\<^sub>s\<^sub>t_def)
   next
     case False thus ?thesis
       using Cons.prems var_subterm_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p
       by (fastforce simp add: vars\<^sub>s\<^sub>s\<^sub>t_def)
   qed
 qed simp
 
 lemma var_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t: "Var x \<in> trms\<^sub>s\<^sub>s\<^sub>t A \<Longrightarrow> x \<in> vars\<^sub>s\<^sub>s\<^sub>t A"
 by (meson var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t UN_I term.order_refl)
 
 lemma ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset: "ik\<^sub>s\<^sub>s\<^sub>t A \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t A"
 by (force simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma var_subterm_ik\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t: "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t A) \<Longrightarrow> x \<in> vars\<^sub>s\<^sub>s\<^sub>t A"
 using var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset by fast
 
 lemma var_subterm_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t:
   assumes "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t A)"
   shows "x \<in> fv\<^sub>s\<^sub>s\<^sub>t A"
 proof -
   obtain ts where ts: "Receive ts \<in> set A" "Var x \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts"
     using assms unfolding ik\<^sub>s\<^sub>s\<^sub>t_def by moura
   hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t A" unfolding fv\<^sub>s\<^sub>s\<^sub>t_def by force
   thus ?thesis using ts(2) subterm_is_var by fastforce
 qed
 
 lemma fv_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t:
   assumes "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t A)"
   shows "x \<in> fv\<^sub>s\<^sub>s\<^sub>t A"
 using var_subterm_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t assms var_is_subterm by fastforce
 
 lemma fv_trms\<^sub>s\<^sub>s\<^sub>t_subset:
   "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S) \<subseteq> vars\<^sub>s\<^sub>s\<^sub>t S"
   "fv\<^sub>s\<^sub>s\<^sub>t S \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)"
 proof (induction S)
   case (Cons x S)
   have *: "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t (x#S)) = fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p x) \<union> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)"
           "fv\<^sub>s\<^sub>s\<^sub>t (x#S) = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \<union> fv\<^sub>s\<^sub>s\<^sub>t S" "vars\<^sub>s\<^sub>s\<^sub>t (x#S) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \<union> vars\<^sub>s\<^sub>s\<^sub>t S"
     unfolding trms\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def vars\<^sub>s\<^sub>s\<^sub>t_def
     by auto
 
   { case 1
     show ?case using Cons.IH(1)
     proof (cases x)
       case (NegChecks X F G)
       hence "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G"
             "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = 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 \<union> set X"
         by (simp, meson vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_cases(7))
       hence "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p x) \<subseteq> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x"
         using fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of F] fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of G]
         by auto
       thus ?thesis
         using Cons.IH(1) *(1,3)
         by blast
     qed auto
   }
 
   { case 2
     show ?case using Cons.IH(2)
     proof (cases x)
       case (NegChecks X F G)
       hence "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G"
             "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = (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) - set X"
         by auto
       hence "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p x)"
         using fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of F] fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of G]
         by auto
       thus ?thesis
         using Cons.IH(2) *(1,2)
         by blast
     qed auto
   }
 qed simp_all
 
 lemma fv_ik_subset_fv_sst'[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t S) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t S"
 unfolding ik\<^sub>s\<^sub>s\<^sub>t_def by (induct S) auto
 
 lemma fv_ik_subset_vars_sst'[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t S) \<subseteq> vars\<^sub>s\<^sub>s\<^sub>t S"
 using fv_ik_subset_fv_sst' fv_trms\<^sub>s\<^sub>s\<^sub>t_subset by fast
 
 lemma ik\<^sub>s\<^sub>s\<^sub>t_var_is_fv: "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t A) \<Longrightarrow> x \<in> fv\<^sub>s\<^sub>s\<^sub>t A"
 by (meson fv_ik_subset_fv_sst'[of A] fv_subset_subterms subsetCE term.set_intros(3))
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases':
   assumes x: "x \<in> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
   shows "x \<in> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s \<or> x \<in> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s)"
 using x vars_term_subst[of _ \<theta>] vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_cases(1,2,3,4,5,6) vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(1,2)[of _ \<theta>]
       vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(3,6)[of _ _ _ \<theta>] vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(4,5)[of _ _ \<theta>]
 proof (cases s)
   case (NegChecks X F G)
   let ?\<theta>' = "rm_vars (set X) \<theta>"
   have "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 ?\<theta>') \<or> x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<theta>') \<or> x \<in> set X"
     using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(7)[of X F G \<theta>] x NegChecks by simp
   hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (?\<theta>' ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \<or> x \<in> fv\<^sub>s\<^sub>e\<^sub>t (?\<theta>' ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G) \<or> x \<in> set X"
     using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst[of _ ?\<theta>'] by blast
   hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \<or> x \<in> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G) \<or> x \<in> set X"
     using rm_vars_fv\<^sub>s\<^sub>e\<^sub>t_subst by fast
   thus ?thesis
     using NegChecks vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_cases(7)[of X F G]
     by auto
 qed simp_all
 
 lemma vars\<^sub>s\<^sub>s\<^sub>t_subst_cases:
   assumes "x \<in> vars\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
   shows "x \<in> vars\<^sub>s\<^sub>s\<^sub>t S \<or> x \<in> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` vars\<^sub>s\<^sub>s\<^sub>t S)"
   using assms
 proof (induction S)
   case (Cons s S) thus ?case
   proof (cases "x \<in> vars\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)")
     case False
     note * = subst_sst_cons[of s S \<theta>] vars\<^sub>s\<^sub>s\<^sub>t_Cons[of "s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>" "S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>"] vars\<^sub>s\<^sub>s\<^sub>t_Cons[of s S]
     have **: "x \<in> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)" using Cons.prems False * by simp
     show ?thesis using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases'[OF **] * by auto
   qed (auto simp add: vars\<^sub>s\<^sub>s\<^sub>t_def)
 qed simp
 
 lemma subset_subst_pairs_diff_exists:
   fixes \<I>::"('a,'b) subst" and D D'::"('a,'b) dbstate"
   shows "\<exists>Di. Di \<subseteq> D \<and> Di \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I> = (D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>) - D'"
 by (metis (no_types, lifting) Diff_subset subset_image_iff)
 
 lemma subset_subst_pairs_diff_exists':
   fixes \<I>::"('a,'b) subst" and D::"('a,'b) dbstate"
   assumes "finite D"
   shows "\<exists>Di. Di \<subseteq> D \<and> Di \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> {d \<cdot>\<^sub>p \<I>} \<and> d \<cdot>\<^sub>p \<I> \<notin> (D - Di) \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>"
 using assms
 proof (induction D rule: finite_induct)
   case (insert d' D)
   then obtain Di where IH: "Di \<subseteq> D" "Di \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> {d \<cdot>\<^sub>p \<I>}" "d \<cdot>\<^sub>p \<I> \<notin> (D - Di) \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>" by moura
   show ?case
   proof (cases "d' \<cdot>\<^sub>p \<I> = d \<cdot>\<^sub>p \<I>")
     case True
     hence "insert d' Di \<subseteq> insert d' D" "insert d' Di \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> {d \<cdot>\<^sub>p \<I>}"
           "d \<cdot>\<^sub>p \<I> \<notin> (insert d' D - insert d' Di) \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>" 
       using IH by auto
     thus ?thesis by metis
   next
     case False
     hence "Di \<subseteq> insert d' D" "Di \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> {d \<cdot>\<^sub>p \<I>}"
           "d \<cdot>\<^sub>p \<I> \<notin> (insert d' D - Di) \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>" 
       using IH by auto
     thus ?thesis by metis
   qed
 qed simp
 
 lemma stateful_strand_step_subst_inI[intro]:
   "send\<langle>ts\<rangle> \<in> set A \<Longrightarrow> send\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle> \<in> set (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
   "receive\<langle>ts\<rangle> \<in> set A \<Longrightarrow> receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle> \<in> set (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
   "\<langle>c: t \<doteq> s\<rangle> \<in> set A \<Longrightarrow> \<langle>c: (t \<cdot> \<theta>) \<doteq> (s \<cdot> \<theta>)\<rangle> \<in> set (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
   "insert\<langle>t, s\<rangle> \<in> set A \<Longrightarrow> insert\<langle>t \<cdot> \<theta>, s \<cdot> \<theta>\<rangle> \<in> set (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
   "delete\<langle>t, s\<rangle> \<in> set A \<Longrightarrow> delete\<langle>t \<cdot> \<theta>, s \<cdot> \<theta>\<rangle> \<in> set (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
   "\<langle>c: t \<in> s\<rangle> \<in> set A \<Longrightarrow> \<langle>c: (t \<cdot> \<theta>) \<in> (s \<cdot> \<theta>)\<rangle> \<in> set (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
   "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set A 
     \<Longrightarrow> \<forall>X\<langle>\<or>\<noteq>: (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>) \<or>\<notin>: (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>)\<rangle> \<in> set (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
   "\<langle>t != s\<rangle> \<in> set A \<Longrightarrow> \<langle>t \<cdot> \<theta> != s \<cdot> \<theta>\<rangle> \<in> set (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
   "\<langle>t not in s\<rangle> \<in> set A \<Longrightarrow> \<langle>t \<cdot> \<theta> not in s \<cdot> \<theta>\<rangle> \<in> set (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 proof (induction A)
   case (Cons a A)
   note * = subst_sst_cons[of a A \<theta>]
   { case 1 thus ?case using Cons.IH(1) * by (cases a) auto }
   { case 2 thus ?case using Cons.IH(2) * by (cases a) auto }
   { case 3 thus ?case using Cons.IH(3) * by (cases a) auto }
   { case 4 thus ?case using Cons.IH(4) * by (cases a) auto }
   { case 5 thus ?case using Cons.IH(5) * by (cases a) auto }
   { case 6 thus ?case using Cons.IH(6) * by (cases a) auto }
   { case 7 thus ?case using Cons.IH(7) * by (cases a) auto }
   { case 8 thus ?case using Cons.IH(8) * by (cases a) auto }
   { case 9 thus ?case using Cons.IH(9) * by (cases a) auto }
 qed simp_all
 
 lemma stateful_strand_step_cases_subst:
   "is_Send a = is_Send (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
   "is_Receive a = is_Receive (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
   "is_Equality a = is_Equality (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
   "is_Insert a = is_Insert (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
   "is_Delete a = is_Delete (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
   "is_InSet a = is_InSet (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
   "is_NegChecks a = is_NegChecks (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
   "is_Assignment a = is_Assignment (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
   "is_Check a = is_Check (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
   "is_Update a = is_Update (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
   "is_Check_or_Assignment a = is_Check_or_Assignment (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
 by (cases a; simp_all)+
 
 lemma stateful_strand_step_substD:
   "a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma> = send\<langle>ts\<rangle> \<Longrightarrow> \<exists>ts'. ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma> \<and> a = send\<langle>ts'\<rangle>"
   "a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma> = receive\<langle>ts\<rangle> \<Longrightarrow> \<exists>ts'. ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma> \<and> a = receive\<langle>ts'\<rangle>"
   "a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma> = \<langle>c: t \<doteq> s\<rangle> \<Longrightarrow> \<exists>t' s'. t = t' \<cdot> \<sigma> \<and> s = s' \<cdot> \<sigma> \<and> a = \<langle>c: t' \<doteq> s'\<rangle>"
   "a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma> = insert\<langle>t,s\<rangle> \<Longrightarrow> \<exists>t' s'. t = t' \<cdot> \<sigma> \<and> s = s' \<cdot> \<sigma> \<and> a = insert\<langle>t',s'\<rangle>"
   "a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma> = delete\<langle>t,s\<rangle> \<Longrightarrow> \<exists>t' s'. t = t' \<cdot> \<sigma> \<and> s = s' \<cdot> \<sigma> \<and> a = delete\<langle>t',s'\<rangle>"
   "a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma> = \<langle>c: t \<in> s\<rangle> \<Longrightarrow> \<exists>t' s'. t = t' \<cdot> \<sigma> \<and> s = s' \<cdot> \<sigma> \<and> a = \<langle>c: t' \<in> s'\<rangle>"
   "a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma> = \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<Longrightarrow>
     \<exists>F' G'. F = F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<sigma> \<and> G = G' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<sigma> \<and>
             a = \<forall>X\<langle>\<or>\<noteq>: F' \<or>\<notin>: G'\<rangle>"
   "a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma> = \<langle>t != s\<rangle> \<Longrightarrow> \<exists>t' s'. t = t' \<cdot> \<sigma> \<and> s = s' \<cdot> \<sigma> \<and> a = \<langle>t' != s'\<rangle>"
   "a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma> = \<langle>t not in s\<rangle> \<Longrightarrow> \<exists>t' s'. t = t' \<cdot> \<sigma> \<and> s = s' \<cdot> \<sigma> \<and> a = \<langle>t' not in s'\<rangle>"
 by (cases a; auto simp add: subst_apply_pairs_def; fail)+
 
 lemma stateful_strand_step_mem_substD:
   "send\<langle>ts\<rangle> \<in> set (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<Longrightarrow> \<exists>ts'. ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma> \<and> send\<langle>ts'\<rangle> \<in> set S"
   "receive\<langle>ts\<rangle> \<in> set (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<Longrightarrow> \<exists>ts'. ts = ts' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma> \<and> receive\<langle>ts'\<rangle> \<in> set S"
   "\<langle>c: t \<doteq> s\<rangle> \<in> set (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<Longrightarrow> \<exists>t' s'. t = t' \<cdot> \<sigma> \<and> s = s' \<cdot> \<sigma> \<and> \<langle>c: t' \<doteq> s'\<rangle> \<in> set S"
   "insert\<langle>t,s\<rangle> \<in> set (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<Longrightarrow> \<exists>t' s'. t = t' \<cdot> \<sigma> \<and> s = s' \<cdot> \<sigma> \<and> insert\<langle>t',s'\<rangle> \<in> set S"
   "delete\<langle>t,s\<rangle> \<in> set (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<Longrightarrow> \<exists>t' s'. t = t' \<cdot> \<sigma> \<and> s = s' \<cdot> \<sigma> \<and> delete\<langle>t',s'\<rangle> \<in> set S"
   "\<langle>c: t \<in> s\<rangle> \<in> set (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<Longrightarrow> \<exists>t' s'. t = t' \<cdot> \<sigma> \<and> s = s' \<cdot> \<sigma> \<and> \<langle>c: t' \<in> s'\<rangle> \<in> set S"
   "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<Longrightarrow>
     \<exists>F' G'. F = F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<sigma> \<and> G = G' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<sigma> \<and>
             \<forall>X\<langle>\<or>\<noteq>: F' \<or>\<notin>: G'\<rangle> \<in> set S"
   "\<langle>t != s\<rangle> \<in> set (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<Longrightarrow> \<exists>t' s'. t = t' \<cdot> \<sigma> \<and> s = s' \<cdot> \<sigma> \<and> \<langle>t' != s'\<rangle> \<in> set S"
   "\<langle>t not in s\<rangle> \<in> set (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<Longrightarrow> \<exists>t' s'. t = t' \<cdot> \<sigma> \<and> s = s' \<cdot> \<sigma> \<and> \<langle>t' not in s'\<rangle> \<in> set S"
 proof (induction S)
   case (Cons a S)
   have *: "x \<in> set (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>)"
     when "x \<in> set (a#S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>)" "x \<noteq> a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma>" for x
     using that by (simp add: subst_apply_stateful_strand_def)
 
   { case 1 thus ?case using Cons.IH(1)[OF *] by (cases a) auto }
   { case 2 thus ?case using Cons.IH(2)[OF *] by (cases a) auto }
   { case 3 thus ?case using Cons.IH(3)[OF *] by (cases a) auto }
   { case 4 thus ?case using Cons.IH(4)[OF *] by (cases a) auto }
   { case 5 thus ?case using Cons.IH(5)[OF *] by (cases a) auto }
   { case 6 thus ?case using Cons.IH(6)[OF *] by (cases a) auto }
   { case 7 thus ?case using Cons.IH(7)[OF *] by (cases a) auto }
   { case 8 show ?case
     proof (cases a)
       case (NegChecks Y F' G') thus ?thesis
       proof (cases "\<langle>t != s\<rangle> = a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma>")
         case True thus ?thesis using NegChecks stateful_strand_step_substD(8)[of a \<sigma> t s] by force
       qed (use 8 Cons.IH(8)[OF *] in auto)
     qed (use 8 Cons.IH(8)[OF *] in simp_all)
   }
   { case 9 show ?case
     proof (cases a)
       case (NegChecks Y F' G') thus ?thesis
       proof (cases "\<langle>t not in s\<rangle> = a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma>")
         case True thus ?thesis using NegChecks stateful_strand_step_substD(9)[of a \<sigma> t s] by force
       qed (use 9 Cons.IH(9)[OF *] in auto)
     qed (use 9 Cons.IH(9)[OF *] in simp_all)
   }
 qed simp_all
 
 lemma stateful_strand_step_fv_subset_cases:
   "send\<langle>ts\<rangle> \<in> set S \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t S"
   "receive\<langle>ts\<rangle> \<in> set S \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t S"
   "\<langle>c: t \<doteq> s\<rangle> \<in> set S \<Longrightarrow> fv t \<union> fv s \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t S"
   "insert\<langle>t,s\<rangle> \<in> set S \<Longrightarrow> fv t \<union> fv s \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t S"
   "delete\<langle>t,s\<rangle> \<in> set S \<Longrightarrow> fv t \<union> fv s \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t S"
   "\<langle>c: t \<in> s\<rangle> \<in> set S \<Longrightarrow> fv t \<union> fv s \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t S"
   "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set S \<Longrightarrow> 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 - set X \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t S"
   "\<langle>t != s\<rangle> \<in> set S \<Longrightarrow> fv t \<union> fv s \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t S"
   "\<langle>t not in s\<rangle> \<in> set S \<Longrightarrow> fv t \<union> fv s \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t S"
 proof (induction S)
   case (Cons a S)
   { case 1 thus ?case using Cons.IH(1) by auto }
   { case 2 thus ?case using Cons.IH(2) by auto }
   { case 3 thus ?case using Cons.IH(3) by auto }
   { case 4 thus ?case using Cons.IH(4) by auto }
   { case 5 thus ?case using Cons.IH(5) by auto }
   { case 6 thus ?case using Cons.IH(6) by auto }
   { case 7 thus ?case using Cons.IH(7) by fastforce }
   { case 8 thus ?case using Cons.IH(8) by fastforce }
   { case 9 thus ?case using Cons.IH(9) by fastforce }
 qed simp_all
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_nil[simp]:
   "trms\<^sub>s\<^sub>s\<^sub>t [] = {}"
 unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by simp
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_mono:
   "set M \<subseteq> set N \<Longrightarrow> trms\<^sub>s\<^sub>s\<^sub>t M \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t N"
 by auto
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_memI[intro?]:
   "send\<langle>ts\<rangle> \<in> set S \<Longrightarrow> t \<in> set ts \<Longrightarrow> t \<in> trms\<^sub>s\<^sub>s\<^sub>t S"
   "receive\<langle>ts\<rangle> \<in> set S \<Longrightarrow> t \<in> set ts \<Longrightarrow> t \<in> trms\<^sub>s\<^sub>s\<^sub>t S"
   "\<langle>ac: t \<doteq> s\<rangle> \<in> set S \<Longrightarrow> t \<in> trms\<^sub>s\<^sub>s\<^sub>t S"
   "\<langle>ac: t \<doteq> s\<rangle> \<in> set S \<Longrightarrow> s \<in> trms\<^sub>s\<^sub>s\<^sub>t S"
   "insert\<langle>t,s\<rangle> \<in> set S \<Longrightarrow> t \<in> trms\<^sub>s\<^sub>s\<^sub>t S"
   "insert\<langle>t,s\<rangle> \<in> set S \<Longrightarrow> s \<in> trms\<^sub>s\<^sub>s\<^sub>t S"
   "delete\<langle>t,s\<rangle> \<in> set S \<Longrightarrow> t \<in> trms\<^sub>s\<^sub>s\<^sub>t S"
   "delete\<langle>t,s\<rangle> \<in> set S \<Longrightarrow> s \<in> trms\<^sub>s\<^sub>s\<^sub>t S"
   "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set S \<Longrightarrow> t \<in> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<Longrightarrow> t \<in> trms\<^sub>s\<^sub>s\<^sub>t S"
   "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set S \<Longrightarrow> t \<in> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \<Longrightarrow> t \<in> trms\<^sub>s\<^sub>s\<^sub>t S"
 unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by fastforce+
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_in:
   assumes "t \<in> trms\<^sub>s\<^sub>s\<^sub>t S"
   shows "\<exists>a \<in> set S. t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a"
 using assms unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by simp
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_cons: "trms\<^sub>s\<^sub>s\<^sub>t (a#A) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<union> trms\<^sub>s\<^sub>s\<^sub>t A"
 unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by force
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_append[simp]: "trms\<^sub>s\<^sub>s\<^sub>t (A@B) = trms\<^sub>s\<^sub>s\<^sub>t A \<union> trms\<^sub>s\<^sub>s\<^sub>t B"
 unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by force
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst:
   assumes "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) \<inter> subst_domain \<theta> = {}"
   shows "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 proof (cases a)
   case (NegChecks X F G)
   hence "rm_vars (set X) \<theta> = \<theta>" using assms rm_vars_apply'[of \<theta> "set X"] by auto
   hence "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>) \<union> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)"
         "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
     using NegChecks image_Un by simp_all
   thus ?thesis by (metis trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst)
 qed simp_all
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst':
   assumes "\<not>is_NegChecks a"
   shows "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using assms by (cases a) simp_all
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst'':
   fixes t::"('a,'b) term" and \<delta>::"('a,'b) subst"
   assumes "t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)"
   shows "\<exists>s \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p b. t = s \<cdot> rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b)) \<delta>"
 proof (cases "is_NegChecks b")
   case True
   then obtain X F G where *: "b = NegChecks X F G" by (cases b) moura+
   thus ?thesis using assms trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst[of _ "rm_vars (set X) \<delta>"] by auto
 next
   case False
   hence "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b)) \<delta>"
     using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst' bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegChecks
     by fastforce
   thus ?thesis using assms by fast
 qed
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst''':
   fixes t::"('a,'b) term" and \<delta> \<theta>::"('a,'b) subst"
   assumes "t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
   shows "\<exists>s \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p b. t = s \<cdot> rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b)) \<delta> \<circ>\<^sub>s \<theta>"
 proof -
   obtain s where s: "s \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)" "t = s \<cdot> \<theta>" using assms by moura
   show ?thesis using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst''[OF s(1)] s(2) by auto
 qed
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_subst:
   assumes "bvars\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<theta> = {}"
   shows "trms\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>) = trms\<^sub>s\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using assms
 proof (induction S)
   case (Cons a S)
   hence IH: "trms\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>) = trms\<^sub>s\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>" and *: "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) \<inter> subst_domain \<theta> = {}"
     by auto
   show ?case using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[OF *] IH by (auto simp add: subst_apply_stateful_strand_def)
 qed simp
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_subst_cons:
   "trms\<^sub>s\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<union> trms\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
 using subst_sst_cons[of a A \<delta>] trms\<^sub>s\<^sub>s\<^sub>t_cons[of a A] trms\<^sub>s\<^sub>s\<^sub>t_append by simp
 
 lemma (in intruder_model) wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>))"
   using assms
 proof (cases a)
   case (NegChecks X F G)
   hence *: "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) =
               (trms\<^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> (trms\<^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>))"
     by simp
 
   have "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> = (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<union> (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
     using NegChecks image_Un by simp
   hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)" using * assms by auto
   hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \<delta>)"
         "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \<delta>)"
     using wf_trms_subst_rm_vars[of \<delta> "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" "set X"]
           wf_trms_subst_rm_vars[of \<delta> "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" "set X"]
     by fast+
   thus ?thesis
     using * trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst[of _ "rm_vars (set X) \<delta>"]
     by auto
 qed auto
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_fv_vars\<^sub>s\<^sub>s\<^sub>t_subset: "t \<in> trms\<^sub>s\<^sub>s\<^sub>t A \<Longrightarrow> fv t \<subseteq> vars\<^sub>s\<^sub>s\<^sub>t A" 
 proof (induction A)
   case (Cons a A) thus ?case by (cases a) auto
 qed simp
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_fv_subst_subset:
   assumes "t \<in> trms\<^sub>s\<^sub>s\<^sub>t S" "subst_domain \<theta> \<inter> bvars\<^sub>s\<^sub>s\<^sub>t S = {}"
   shows "fv (t \<cdot> \<theta>) \<subseteq> vars\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 using assms
 proof (induction S)
   case (Cons s S) show ?case
   proof (cases "t \<in> trms\<^sub>s\<^sub>s\<^sub>t S")
     case True
     hence "fv (t \<cdot> \<theta>) \<subseteq> vars\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)" using Cons.IH Cons.prems by auto
     thus ?thesis using subst_sst_cons[of s S \<theta>] unfolding vars\<^sub>s\<^sub>s\<^sub>t_def by auto
   next
     case False
     hence *: "t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" "subst_domain \<theta> \<inter> set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s) = {}" using Cons.prems by auto
     hence "fv (t \<cdot> \<theta>) \<subseteq> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
     proof (cases s)
       case (NegChecks X F G)
       hence **: "t \<in> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<or> t \<in> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" using *(1) by auto
       have ***: "rm_vars (set X) \<theta> = \<theta>" using *(2) NegChecks rm_vars_apply' by auto
       have "fv (t \<cdot> \<theta>) \<subseteq> 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>) \<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) \<theta>)"
         using ** *** trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fv_subst_subset[of t _ \<theta>] by auto
       thus ?thesis using *(2) using NegChecks vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(7)[of X F G \<theta>] by blast
     qed auto
     thus ?thesis using subst_sst_cons[of s S \<theta>] unfolding vars\<^sub>s\<^sub>s\<^sub>t_def by auto
   qed
 qed simp
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_fv_subst_subset':
   assumes "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)" "fv t \<inter> bvars\<^sub>s\<^sub>s\<^sub>t S = {}" "fv (t \<cdot> \<theta>) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t S = {}"
   shows "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 using assms
 proof (induction S)
   case (Cons s S) show ?case
   proof (cases "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)")
     case True
     hence "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)" using Cons.IH Cons.prems by auto
     thus ?thesis using subst_sst_cons[of s S \<theta>] unfolding vars\<^sub>s\<^sub>s\<^sub>t_def by auto
   next
     case False
     hence 0: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p s)" "fv t \<inter> set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s) = {}"
              "fv (t \<cdot> \<theta>) \<inter> set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s) = {}"
       using Cons.prems by auto
 
     note 1 = UN_Un UN_insert fv\<^sub>s\<^sub>e\<^sub>t.simps subst_apply_fv_subset subst_apply_fv_unfold
              subst_apply_term_empty sup_bot.comm_neutral fv_subterms_set fv_subset[OF 0(1)]
 
     note 2 = subst_apply_fv_union
 
     have "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
     proof (cases s)
       case (Send ts)
       have "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (set ts)" using fv_subset[OF 0(1)] unfolding Send fv_subterms_set by simp
       hence "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
         by (metis subst_apply_fv_subset subst_apply_fv_unfold_set)
       thus ?thesis using Send by simp
     next
       case (Receive ts)
       have "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (set ts)" using fv_subset[OF 0(1)] unfolding Receive fv_subterms_set by simp
       hence "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
         by (metis subst_apply_fv_subset subst_apply_fv_unfold_set)
       thus ?thesis using Receive by simp
     next
       case (NegChecks X F G)
       hence 3: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \<or> t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G)" using 0(1) by auto
       have "t \<cdot> rm_vars (set X) \<theta> = t \<cdot> \<theta>" using 0(2) NegChecks rm_vars_ident[of t] by auto
       hence "fv (t \<cdot> \<theta>) \<subseteq> 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>) \<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) \<theta>)"
         using 3 trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fv_subst_subset'[of t _ "rm_vars (set X) \<theta>"] by fastforce
       thus ?thesis using 0(2,3) NegChecks fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(7)[of X F G \<theta>] by auto
     qed (metis (no_types, lifting) 1 2 trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(3) fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(3),
          metis (no_types, lifting) 1 2 trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(4) fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(4),
          metis (no_types, lifting) 1 2 trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(5) fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(5),
          metis (no_types, lifting) 1 2 trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(6) fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(6))
     thus ?thesis using subst_sst_cons[of s S \<theta>] unfolding fv\<^sub>s\<^sub>s\<^sub>t_def by auto
   qed
 qed simp
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_funs_term_cases:
   assumes "t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)" "f \<in> funs_term t"
   shows "(\<exists>u \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p s. f \<in> funs_term u) \<or> (\<exists>x \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s. f \<in> funs_term (\<theta> x))"
   using assms
 proof (cases s)
   case (NegChecks X F G)
   hence "t \<in> trms\<^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>) \<or> t \<in> trms\<^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) \<theta>)"
     using assms(1) by auto
   hence "(\<exists>u\<in>trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. f \<in> funs_term u) \<or> (\<exists>x\<in>fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. f \<in> funs_term (rm_vars (set X) \<theta> x)) \<or>
          (\<exists>u\<in>trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G. f \<in> funs_term u) \<or> (\<exists>x\<in>fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G. f \<in> funs_term (rm_vars (set X) \<theta> x))"
     using trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_funs_term_cases[OF _ assms(2), of _ "rm_vars (set X) \<theta>"] by meson
   hence "(\<exists>u \<in> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G. f \<in> funs_term u) \<or>
          (\<exists>x \<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. f \<in> funs_term (rm_vars (set X) \<theta> x))"
     by blast
   thus ?thesis
   proof
     assume "\<exists>x \<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. f \<in> funs_term (rm_vars (set X) \<theta> x)"
     then obtain x where x: "x \<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" "f \<in> funs_term (rm_vars (set X) \<theta> x)"
       by auto
     hence "x \<notin> set X" "rm_vars (set X) \<theta> x = \<theta> x" by auto
     thus ?thesis using x by (auto simp add: assms NegChecks)
   qed (auto simp add: assms NegChecks)
 qed (use assms funs_term_subst[of _ \<theta>] in auto)
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_funs_term_cases:
   assumes "t \<in> trms\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)" "f \<in> funs_term t"
   shows "(\<exists>u \<in> trms\<^sub>s\<^sub>s\<^sub>t S. f \<in> funs_term u) \<or> (\<exists>x \<in> fv\<^sub>s\<^sub>s\<^sub>t S. f \<in> funs_term (\<theta> x))"
 using assms(1)
 proof (induction S)
   case (Cons s S) thus ?case
   proof (cases "t \<in> trms\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)")
     case False
     hence "t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)" using Cons.prems(1) subst_sst_cons[of s S \<theta>] trms\<^sub>s\<^sub>s\<^sub>t_cons by auto
     thus ?thesis using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_funs_term_cases[OF _ assms(2)] by fastforce
   qed auto
 qed simp
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t_subst:
   assumes "x \<in> fv\<^sub>s\<^sub>s\<^sub>t T"
     and "bvars\<^sub>s\<^sub>s\<^sub>t T \<inter> subst_domain \<theta> = {}"
   shows "\<theta> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t (T \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>))"
 using trms\<^sub>s\<^sub>s\<^sub>t_subst[OF assms(2)] subterms_subst_subset'[of \<theta> "trms\<^sub>s\<^sub>s\<^sub>t T"]
       fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t[OF assms(1)]
-by (metis (no_types, lifting) image_iff subset_iff subst_apply_term.simps(1))
+by (metis (no_types, lifting) image_iff subset_iff eval_term.simps(1))
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_subst_fv_subset:
   assumes "x \<in> fv\<^sub>s\<^sub>s\<^sub>t S" "x \<notin> bvars\<^sub>s\<^sub>s\<^sub>t S" "fv (\<theta> x) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t S = {}"
   shows "fv (\<theta> x) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>)"
 using assms
 proof (induction S)
   case (Cons a S)
   note 1 = fv_subst_subset[of _ _ \<theta>]
   note 2 = subst_apply_fv_union subst_apply_fv_unfold[of _ \<theta>] fv_subset image_eqI
   note 3 = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases
   note 4 = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps
   from Cons show ?case
   proof (cases "x \<in> fv\<^sub>s\<^sub>s\<^sub>t S")
     case False
     hence 5: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" " fv (\<theta> x) \<inter> set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) = {}" "x \<notin> set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a)"
       using Cons.prems by auto
     hence "fv (\<theta> x) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
     proof (cases a)
       case (Send ts) thus ?thesis using 1 5(1) 3(1) 4(1) by auto
     next
       case (Receive ts) thus ?thesis using 1 5(1) 3(2) 4(2) by auto
     next
       case (NegChecks X F G)
       let ?\<delta> = "rm_vars (set X) \<theta>"
       have *: "x \<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" using NegChecks 5(1) by auto
       have **: "fv (\<theta> x) \<inter> set X = {}" using NegChecks 5(2) by simp
       have ***: "\<theta> x = ?\<delta> x" using NegChecks 5(3) by auto
       have "fv (\<theta> x) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<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>)"
         using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_fv_subset[of x _ ?\<delta>] * *** by auto
       thus ?thesis using NegChecks ** by auto
     qed (metis (full_types) 2 5(1) 3(3) 4(3), metis (full_types) 2 5(1) 3(4) 4(4),
          metis (full_types) 2 5(1) 3(5) 4(5), metis (full_types) 2 5(1) 3(6) 4(6))
     thus ?thesis by (auto simp add: subst_sst_cons[of a S \<theta>])
   qed (auto simp add: subst_sst_cons[of a S \<theta>])
 qed simp
 
 lemma (in intruder_model) wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_trms\<^sub>s\<^sub>s\<^sub>t_subst:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>))"
   using assms
 proof (induction A)
   case (Cons a A)
   hence IH: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>))" and *: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)" by auto
   have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>))" by (rule wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[OF *])
   thus ?case using IH trms\<^sub>s\<^sub>s\<^sub>t_subst_cons[of a A \<delta>] by blast
 qed simp
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var:
   assumes "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   shows "\<exists>y \<in> fv\<^sub>s\<^sub>s\<^sub>t S. x \<in> fv (\<delta> y)"
   using assms
 proof (induction S)
   case (Cons s S)
   hence "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>) \<Longrightarrow> \<exists>y \<in> fv\<^sub>s\<^sub>s\<^sub>t S. x \<in> fv (\<delta> y)"
     using bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset[of S s]
     by blast
   thus ?case
   proof (cases "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)")
     case False
     hence *: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)"
       using Cons.prems(1) subst_sst_cons[of s S \<delta>]
       by fastforce
 
     have "\<exists>y \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s. x \<in> fv (\<delta> y)"
     proof (cases s)
       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>) \<or> x \<in> 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>)"
           and **: "x \<notin> set X"
         using * by simp_all
       then obtain y where y: "y \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<or> y \<in> 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>"]
         by blast
       have "y \<notin> set X"
       proof
         assume y_in: "y \<in> set X"
         hence "(rm_vars (set X) \<delta>) y = Var y" by auto
         hence "x = y" using y(2) by simp
         thus False using ** y_in by metis
       qed
       thus ?thesis using NegChecks y by auto
     qed (use * fv_subst_obtain_var in force)+
     thus ?thesis by auto
   qed auto
 qed simp
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_subst_subset_range_vars_if_subset_domain:
   assumes "fv\<^sub>s\<^sub>s\<^sub>t S \<subseteq> subst_domain \<sigma>"
   shows "fv\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<subseteq> range_vars \<sigma>"
 using assms fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var[of _ S \<sigma>] subst_dom_vars_in_subst[of _ \<sigma>] subst_fv_imgI[of \<sigma>]
 by (metis (no_types) in_mono subsetI)
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_in_fv_trms\<^sub>s\<^sub>s\<^sub>t: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t S \<Longrightarrow> x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)"
 proof (induction S)
   case (Cons s S) thus ?case
   proof (cases "x \<in> fv\<^sub>s\<^sub>s\<^sub>t S")
     case False
     hence *: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" using Cons.prems by simp
     hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p s)"
     proof (cases s)
       case (NegChecks X F G)
       hence "x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<or> x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" using * by simp_all
       thus ?thesis using * fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_in_fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of x] NegChecks by auto
     qed auto
     thus ?thesis by simp
   qed simp
 qed simp
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_ground_subst_compose:
   assumes "subst_domain \<delta> = subst_domain \<sigma>"
     and "range_vars \<delta> = {}" "range_vars \<sigma> = {}"
   shows "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<circ>\<^sub>s \<theta>) = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma> \<circ>\<^sub>s \<theta>)"
 proof -
   note 0 = fv_ground_subst_compose
 
   have 1: "range_vars \<delta> \<inter> set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) = {}" "range_vars \<sigma> \<inter> set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) = {}"
     using assms(2,3) by (blast,blast)
 
   note 2 = 0[OF assms, of _ \<theta>]
 
   show ?thesis
   proof (cases a)
     case (NegChecks X F G)
     have 3: "range_vars \<delta> \<inter> set X = {}" "range_vars (rm_vars (set X) \<delta>) = {}"
             "range_vars \<sigma> \<inter> set X = {}" "range_vars (rm_vars (set X) \<sigma>) = {}"
       using assms(2,3) rm_vars_img_fv_subset[of "set X"] by auto
 
     have 4: "subst_domain (rm_vars (set X) \<delta>) = subst_domain (rm_vars (set X) \<sigma>)"
       using assms(1) rm_vars_dom[of "set X"] by blast
 
     have 5: "fv (t \<cdot> rm_vars (set X) (\<delta> \<circ>\<^sub>s \<theta>)) = fv (t \<cdot> rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<theta>))" for t
       using 2[of t] rm_vars_comp[OF 3(1), of t \<theta>] rm_vars_comp[OF 3(3), of t \<theta>]
             0[OF 4 3(2,4), of t "rm_vars (set X) \<theta>"]
       by argo
 
     have 6: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (H \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) (\<delta> \<circ>\<^sub>s \<theta>)) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (H \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<theta>))"
       for H
     proof -
       have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r (h \<cdot>\<^sub>p rm_vars (set X) (\<delta> \<circ>\<^sub>s \<theta>)) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r (h \<cdot>\<^sub>p rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<theta>))" for h
       proof -
         obtain s t where h: "h = (s,t)" by (metis surj_pair)
         show ?thesis using 5[of s] 5[of t] unfolding h by fast
       qed
       thus ?thesis unfolding subst_apply_pairs_def by auto
     qed
 
     show ?thesis using 5 6 unfolding NegChecks by simp
   qed (use 2 in auto)
 qed
 
 lemma fv\<^sub>s\<^sub>s\<^sub>t_ground_subst_compose:
   assumes "subst_domain \<delta> = subst_domain \<sigma>"
     and "range_vars \<delta> = {}" "range_vars \<sigma> = {}"
   shows "fv\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta> \<circ>\<^sub>s \<theta>) = fv\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<theta>)"
 by (induct S) (auto simp add: fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_ground_subst_compose[OF assms] fv\<^sub>s\<^sub>s\<^sub>t_Cons subst_sst_cons)
 
 lemma stateful_strand_step_subst_comp:
   assumes "range_vars \<delta> \<inter> set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x) = {}"
   shows "x \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<circ>\<^sub>s \<theta> = (x \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>"
 proof (cases x)
   case (NegChecks X F G)
   hence *: "range_vars \<delta> \<inter> set X = {}" using assms by simp
   have "H \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) (\<delta> \<circ>\<^sub>s \<theta>) = (H \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<delta>) \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>" for H
     using pairs_subst_comp rm_vars_comp[OF *] by (induct H) (auto simp add: subst_apply_pairs_def)
   thus ?thesis using NegChecks by simp
 qed simp_all
 
 lemma stateful_strand_subst_comp:
   assumes "range_vars \<delta> \<inter> bvars\<^sub>s\<^sub>s\<^sub>t S = {}"
   shows "S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta> \<circ>\<^sub>s \<theta> = (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>"
 using assms
 proof (induction S)
   case (Cons s S)
   hence IH: "S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta> \<circ>\<^sub>s \<theta> = (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>" using Cons by auto
 
   have "s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<circ>\<^sub>s \<theta> = (s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>"
     using Cons.prems stateful_strand_step_subst_comp[of \<delta> s \<theta>]
     unfolding range_vars_alt_def by auto
   thus ?case using IH by (simp add: subst_apply_stateful_strand_def)
 qed simp
 
 lemma subst_apply_bvars_disj_NegChecks:
   assumes "set X \<inter> subst_domain \<theta> = {}"
   shows "NegChecks X F G \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = NegChecks X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>) (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)"
 proof -
   have "rm_vars (set X) \<theta> = \<theta>" using assms rm_vars_apply'[of \<theta> "set X"] by auto
   thus ?thesis by simp
 qed
 
 lemma subst_apply_NegChecks_no_bvars[simp]:
   "\<forall>[]\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<forall>[]\<langle>\<or>\<noteq>: (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>) \<or>\<notin>: (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)\<rangle>"
   "\<forall>[]\<langle>\<or>\<noteq>: [] \<or>\<notin>: F'\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<forall>[]\<langle>\<or>\<noteq>: [] \<or>\<notin>: (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)\<rangle>"
   "\<forall>[]\<langle>\<or>\<noteq>: F \<or>\<notin>: []\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<forall>[]\<langle>\<or>\<noteq>: (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>) \<or>\<notin>: []\<rangle>"
   "\<forall>[]\<langle>\<or>\<noteq>: [] \<or>\<notin>: [(t,s)]\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<forall>[]\<langle>\<or>\<noteq>: [] \<or>\<notin>: ([(t \<cdot> \<theta>,s \<cdot> \<theta>)])\<rangle>"
   "\<forall>[]\<langle>\<or>\<noteq>: [(t,s)] \<or>\<notin>: []\<rangle> \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = \<forall>[]\<langle>\<or>\<noteq>: ([(t \<cdot> \<theta>,s \<cdot> \<theta>)]) \<or>\<notin>: []\<rangle>"
 by simp_all
 
 lemma setops\<^sub>s\<^sub>s\<^sub>t_mono:
   "set M \<subseteq> set N \<Longrightarrow> setops\<^sub>s\<^sub>s\<^sub>t M \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t N"
 by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma setops\<^sub>s\<^sub>s\<^sub>t_nil[simp]: "setops\<^sub>s\<^sub>s\<^sub>t [] = {}"
 by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma setops\<^sub>s\<^sub>s\<^sub>t_cons[simp]: "setops\<^sub>s\<^sub>s\<^sub>t (a#A) = setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<union> setops\<^sub>s\<^sub>s\<^sub>t A"
 by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma setops\<^sub>s\<^sub>s\<^sub>t_cons_subset[simp]: "setops\<^sub>s\<^sub>s\<^sub>t A \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (a#A)"
 using setops\<^sub>s\<^sub>s\<^sub>t_cons[of a A] by blast
 
 lemma setops\<^sub>s\<^sub>s\<^sub>t_append: "setops\<^sub>s\<^sub>s\<^sub>t (A@B) = setops\<^sub>s\<^sub>s\<^sub>t A \<union> setops\<^sub>s\<^sub>s\<^sub>t B"
 proof (induction A)
   case (Cons a A) thus ?case by (cases a) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_member_iff:
   "(t,s) \<in> setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \<longleftrightarrow>
     (x = Insert t s \<or> x = Delete t s \<or> (\<exists>ac. x = InSet ac t s) \<or>
      (\<exists>X F F'. x = NegChecks X F F' \<and> (t,s) \<in> set F'))"
 by (cases x) auto
 
 lemma setops\<^sub>s\<^sub>s\<^sub>t_member_iff:
   "(t,s) \<in> setops\<^sub>s\<^sub>s\<^sub>t A \<longleftrightarrow>
     (Insert t s \<in> set A \<or> Delete t s \<in> set A \<or> (\<exists>ac. InSet ac t s \<in> set A) \<or>
      (\<exists>X F F'. NegChecks X F F' \<in> set A \<and> (t,s) \<in> set F'))"
   (is "?P \<longleftrightarrow> ?Q")
 proof (induction A)
   case (Cons a A) thus ?case
   proof (cases "(t, s) \<in> setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p a")
     case True thus ?thesis using setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_member_iff[of t s a] by auto
   qed auto
 qed simp
 
 lemma setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst:
   assumes "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) \<inter> subst_domain \<theta> = {}"
   shows "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>"
 proof (cases a)
   case (NegChecks X F G)
   hence "rm_vars (set X) \<theta> = \<theta>" using assms rm_vars_apply'[of \<theta> "set X"] by auto
   hence "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = set (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)"
         "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta> = set G \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>"
     using NegChecks image_Un by simp_all
   thus ?thesis by (simp add: subst_apply_pairs_def) 
 qed simp_all
 
 lemma setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst':
   assumes "\<not>is_NegChecks a"
   shows "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using assms by (cases a) auto
 
 lemma setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst'':
   fixes t::"('a,'b) term \<times> ('a,'b) term" and \<delta>::"('a,'b) subst"
   assumes t: "t \<in> setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)"
   shows "\<exists>s \<in> setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p b. t = s \<cdot>\<^sub>p rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b)) \<delta>"
 proof (cases "is_NegChecks b")
   case True
   then obtain X F G where b: "b = NegChecks X F G" by (cases b) moura+
   hence "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p b = set G" "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = set (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b)) \<delta>)"
     by simp_all
   thus ?thesis using t subst_apply_pairs_pset_subst[of G] by blast
 next
   case False
   hence "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b)) \<delta>"
     using setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst' bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegChecks by fastforce
   thus ?thesis using t by blast
 qed
 
 lemma setops\<^sub>s\<^sub>s\<^sub>t_subst:
   assumes "bvars\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<theta> = {}"
   shows "setops\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>) = setops\<^sub>s\<^sub>s\<^sub>t S \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using assms
 proof (induction S)
   case (Cons a S)
   have "bvars\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<theta> = {}" and *: "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) \<inter> subst_domain \<theta> = {}"
     using Cons.prems by auto
   hence IH: "setops\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<theta>) = setops\<^sub>s\<^sub>s\<^sub>t S \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>"
     using Cons.IH by auto
   show ?case
     using setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[OF *] IH unfolding setops\<^sub>s\<^sub>s\<^sub>t_def
     by (auto simp add: subst_apply_stateful_strand_def)
 qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma setops\<^sub>s\<^sub>s\<^sub>t_subst':
   fixes p::"('a,'b) term \<times> ('a,'b) term" and \<delta>::"('a,'b) subst"
   assumes "p \<in> setops\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   shows "\<exists>s \<in> setops\<^sub>s\<^sub>s\<^sub>t S. \<exists>X. set X \<subseteq> bvars\<^sub>s\<^sub>s\<^sub>t S \<and> p = s \<cdot>\<^sub>p rm_vars (set X) \<delta>"
 using assms
 proof (induction S)
   case (Cons a S)
   note 0 = setops\<^sub>s\<^sub>s\<^sub>t_cons[of a S] bvars\<^sub>s\<^sub>s\<^sub>t_Cons[of a S]
   note 1 = setops\<^sub>s\<^sub>s\<^sub>t_cons[of "a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>" "S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>"] subst_sst_cons[of a S \<delta>]
   have "p \<in> setops\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>) \<or> p \<in> setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)" using Cons.prems 1 by auto
   thus ?case
   proof
     assume *: "p \<in> setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)"
     show ?thesis using setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst''[OF *] 0 by blast
   next
     assume *: "p \<in> setops\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
     show ?thesis using Cons.IH[OF *] 0 by blast
   qed
 qed simp
 
 
 subsection \<open>Stateful Constraint Semantics\<close>
 context intruder_model
 begin
 
 definition negchecks_model where
   "negchecks_model (\<I>::('a,'b) subst) (D::('a,'b) dbstate) X F G \<equiv>
       (\<forall>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>) \<longrightarrow> 
               (\<exists>(t,s) \<in> set F. t \<cdot> \<delta> \<circ>\<^sub>s \<I> \<noteq> s \<cdot> \<delta> \<circ>\<^sub>s \<I>) \<or>
               (\<exists>(t,s) \<in> set G. (t,s) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s \<I> \<notin> D))"
 
 fun strand_sem_stateful::
   "('fun,'var) terms \<Rightarrow> ('fun,'var) dbstate \<Rightarrow> ('fun,'var) stateful_strand \<Rightarrow> ('fun,'var) subst \<Rightarrow> bool"
   ("\<lbrakk>_; _; _\<rbrakk>\<^sub>s")
 where
   "\<lbrakk>M; D; []\<rbrakk>\<^sub>s = (\<lambda>\<I>. True)"
 | "\<lbrakk>M; D; Send ts#S\<rbrakk>\<^sub>s = (\<lambda>\<I>. (\<forall>t \<in> set ts. M \<turnstile> t \<cdot> \<I>) \<and> \<lbrakk>M; D; S\<rbrakk>\<^sub>s \<I>)"
 | "\<lbrakk>M; D; Receive ts#S\<rbrakk>\<^sub>s = (\<lambda>\<I>. \<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> M; D; S\<rbrakk>\<^sub>s \<I>)"
 | "\<lbrakk>M; D; Equality _ t t'#S\<rbrakk>\<^sub>s = (\<lambda>\<I>. t \<cdot> \<I> = t' \<cdot> \<I> \<and> \<lbrakk>M; D; S\<rbrakk>\<^sub>s \<I>)"
 | "\<lbrakk>M; D; Insert t s#S\<rbrakk>\<^sub>s = (\<lambda>\<I>. \<lbrakk>M; insert ((t,s) \<cdot>\<^sub>p \<I>) D; S\<rbrakk>\<^sub>s \<I>)"
 | "\<lbrakk>M; D; Delete t s#S\<rbrakk>\<^sub>s = (\<lambda>\<I>. \<lbrakk>M; D - {(t,s) \<cdot>\<^sub>p \<I>}; S\<rbrakk>\<^sub>s \<I>)"
 | "\<lbrakk>M; D; InSet _ t s#S\<rbrakk>\<^sub>s = (\<lambda>\<I>. (t,s) \<cdot>\<^sub>p \<I> \<in> D \<and> \<lbrakk>M; D; S\<rbrakk>\<^sub>s \<I>)"
 | "\<lbrakk>M; D; NegChecks X F F'#S\<rbrakk>\<^sub>s = (\<lambda>\<I>. negchecks_model \<I> D X F F' \<and> \<lbrakk>M; D; S\<rbrakk>\<^sub>s \<I>)"
 
 
 lemmas strand_sem_stateful_induct =
   strand_sem_stateful.induct[case_names Nil ConsSnd ConsRcv ConsEq
                                         ConsIns ConsDel ConsIn ConsNegChecks]
 
 abbreviation constr_sem_stateful (infix "\<Turnstile>\<^sub>s" 91) where "\<I> \<Turnstile>\<^sub>s A \<equiv> \<lbrakk>{}; {}; A\<rbrakk>\<^sub>s \<I>"
 
 lemma stateful_strand_sem_NegChecks_no_bvars:
   "\<lbrakk>M; D; [\<langle>t not in s\<rangle>]\<rbrakk>\<^sub>s \<I> \<longleftrightarrow> (t \<cdot> \<I>, s \<cdot> \<I>) \<notin> D"
   "\<lbrakk>M; D; [\<langle>t != s\<rangle>]\<rbrakk>\<^sub>s \<I> \<longleftrightarrow> t \<cdot> \<I> \<noteq> s \<cdot> \<I>"
 by (simp_all add: negchecks_model_def empty_dom_iff_empty_subst)
 
 lemma strand_sem_ik_mono_stateful:
   "\<lbrakk>M; D; A\<rbrakk>\<^sub>s \<I> \<Longrightarrow> \<lbrakk>M \<union> M'; D; A\<rbrakk>\<^sub>s \<I>"
 proof (induction A arbitrary: M M' D rule: strand_sem_stateful.induct)
   case (2 M D ts S)
   hence "\<forall>t \<in> set ts. M \<turnstile> t \<cdot> \<I>" "\<lbrakk>M \<union> M'; D; S\<rbrakk>\<^sub>s \<I>" by auto
   thus ?case
     using ideduct_mono[of M _ "M \<union> M'"] strand_sem_stateful.simps(2)[of "M \<union> M'" D ts S]
     by fastforce
 next
   case (3 M D ts S)
   hence "\<lbrakk>((set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> M) \<union> M'; D; S\<rbrakk>\<^sub>s \<I>" by simp
   hence "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (M \<union> M'); D; S\<rbrakk>\<^sub>s \<I>" by (metis Un_assoc)
   thus ?case by simp
 qed simp_all
 
 lemma strand_sem_append_stateful:
   "\<lbrakk>M; D; A@B\<rbrakk>\<^sub>s \<I> \<longleftrightarrow> \<lbrakk>M; D; A\<rbrakk>\<^sub>s \<I> \<and> \<lbrakk>M \<union> (ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>); dbupd\<^sub>s\<^sub>s\<^sub>t A \<I> D; B\<rbrakk>\<^sub>s \<I>"
   (is "?P \<longleftrightarrow> ?Q \<and> ?R")
 proof -
   have 1: "?P \<Longrightarrow> ?Q" by (induct A rule: strand_sem_stateful.induct) auto
 
   have 2: "?P \<Longrightarrow> ?R"
   proof (induction A arbitrary: M D B)
     case (Cons a A) thus ?case
     proof (cases a)
       case (Receive ts)
       have "(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (M \<union> (ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)) = M \<union> (ik\<^sub>s\<^sub>s\<^sub>t (a#A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)"
            "dbupd\<^sub>s\<^sub>s\<^sub>t A \<I> D = dbupd\<^sub>s\<^sub>s\<^sub>t (a#A) \<I> D"
         using Receive by (auto simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
       thus ?thesis
         using Cons Receive
         by (metis (no_types, lifting) Un_assoc append_Cons strand_sem_stateful.simps(3))
     qed (auto simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
   qed (simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
 
   have 3: "?Q \<Longrightarrow> ?R \<Longrightarrow> ?P"
   proof (induction A arbitrary: M D)
     case (Cons a A) thus ?case
     proof (cases a)
       case (Receive ts)
       have "(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (M \<union> (ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)) = M \<union> (ik\<^sub>s\<^sub>s\<^sub>t (a#A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)"
            "dbupd\<^sub>s\<^sub>s\<^sub>t A \<I> D = dbupd\<^sub>s\<^sub>s\<^sub>t (a#A) \<I> D"
         using Receive by (auto simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
       thus ?thesis
         using Cons Receive
         by (metis (no_types, lifting) Un_assoc append_Cons strand_sem_stateful.simps(3))
     qed (auto simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
   qed (simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
 
   show ?thesis by (metis 1 2 3)
 qed
 
 lemma negchecks_model_db_subset:
   fixes F F'::"(('a,'b) term \<times> ('a,'b) term) list"
   assumes "D' \<subseteq> D"
   and "negchecks_model \<I> D X F F'"
   shows "negchecks_model \<I> D' X F F'"
 proof -
   have "\<exists>(s,t) \<in> set F'. (s,t) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s \<I> \<notin> D'"
     when "\<exists>(s,t) \<in> set F'. (s,t) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s \<I> \<notin> D"
     for \<delta>::"('a,'b) subst"
     using that assms(1) by blast
   thus ?thesis using assms(2) unfolding negchecks_model_def by meson
 qed
 
 lemma negchecks_model_db_supset:
   fixes F F'::"(('a,'b) term \<times> ('a,'b) term) list"
   assumes "D' \<subseteq> D"
     and "\<forall>f \<in> set F'. \<forall>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>) \<longrightarrow> f \<cdot>\<^sub>p (\<delta> \<circ>\<^sub>s \<I>) \<notin> D - D'"
     and "negchecks_model \<I> D' X F F'"
   shows "negchecks_model \<I> D X F F'"
 proof -
   have "\<exists>(s,t) \<in> set F'. (s,t) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s \<I> \<notin> D"
     when "\<exists>(s,t) \<in> set F'. (s,t) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s \<I> \<notin> D'" "subst_domain \<delta> = set X \<and> ground (subst_range \<delta>)"
     for \<delta>::"('a,'b) subst"
     using that assms(1,2) by blast
   thus ?thesis using assms(3) unfolding negchecks_model_def by meson
 qed
 
 lemma negchecks_model_subst:
   fixes F F'::"(('a,'b) term \<times> ('a,'b) term) list"
   assumes "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> set X = {}"
   shows "negchecks_model (\<delta> \<circ>\<^sub>s \<theta>) D X F F' \<longleftrightarrow> negchecks_model \<theta> D X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
 proof -
   have 0: "\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) = \<delta> \<circ>\<^sub>s (\<sigma> \<circ>\<^sub>s \<theta>)"
     when \<sigma>: "subst_domain \<sigma> = set X" "ground (subst_range \<sigma>)" for \<sigma>
     by (metis (no_types, lifting) \<sigma> subst_compose_assoc assms(1) inf_sup_aci(1)
             subst_comp_eq_if_disjoint_vars sup_inf_absorb range_vars_alt_def)
 
   { fix \<sigma>::"('a,'b) subst" and t t'
     assume \<sigma>: "subst_domain \<sigma> = set X" "ground (subst_range \<sigma>)"
         and *: "\<exists>(s,t) \<in> set F. s \<cdot> (\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)) \<noteq> t \<cdot> (\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>))"
     obtain f where f: "f \<in> set F" "fst f \<cdot> \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) \<noteq> snd f \<cdot> \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)"
       using * unfolding case_prod_unfold by (induct F) auto
     hence "(fst f \<cdot> \<delta>) \<cdot> \<sigma> \<circ>\<^sub>s \<theta> \<noteq> (snd f \<cdot> \<delta>) \<cdot> \<sigma> \<circ>\<^sub>s \<theta>" using 0[OF \<sigma>] by simp
     moreover have "(fst f \<cdot> \<delta>, snd f \<cdot> \<delta>) \<in> set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
       using f(1) by (auto simp add: subst_apply_pairs_def)
     ultimately have "\<exists>(s,t) \<in> set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>). s \<cdot> (\<sigma> \<circ>\<^sub>s \<theta>) \<noteq> t \<cdot> (\<sigma> \<circ>\<^sub>s \<theta>)"
       using f(1) by fastforce
   } moreover {
     fix \<sigma>::"('a,'b) subst" and t t'
     assume \<sigma>: "subst_domain \<sigma> = set X" "ground (subst_range \<sigma>)"
         and *: "\<exists>(s,t) \<in> set F'. (s,t) \<cdot>\<^sub>p \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) \<notin> D"
     obtain f where f: "f \<in> set F'" "f \<cdot>\<^sub>p \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) \<notin> D"
       using * by (induct F') auto
     hence "f \<cdot>\<^sub>p \<delta> \<cdot>\<^sub>p \<sigma> \<circ>\<^sub>s \<theta> \<notin> D" using 0[OF \<sigma>] by (metis subst_pair_compose)
     moreover have "f \<cdot>\<^sub>p \<delta> \<in> set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
       using f(1) by (auto simp add: subst_apply_pairs_def)
     ultimately have "\<exists>(s,t) \<in> set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>). (s,t) \<cdot>\<^sub>p \<sigma> \<circ>\<^sub>s \<theta> \<notin> D"
       using f(1) by (metis (no_types, lifting) case_prodI2)
   } moreover {
     fix \<sigma>::"('a,'b) subst" and t t'
     assume \<sigma>: "subst_domain \<sigma> = set X" "ground (subst_range \<sigma>)"
         and *: "\<exists>(s,t) \<in> set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>). s \<cdot> (\<sigma> \<circ>\<^sub>s \<theta>) \<noteq> t \<cdot> (\<sigma> \<circ>\<^sub>s \<theta>)"
     obtain f where f: "f \<in> set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)" "fst f \<cdot> \<sigma> \<circ>\<^sub>s \<theta> \<noteq> snd f \<cdot> \<sigma> \<circ>\<^sub>s \<theta>"
       using * by (induct F) auto
     then obtain g where g: "g \<in> set F" "f = g \<cdot>\<^sub>p \<delta>" by (auto simp add: subst_apply_pairs_def)
     have "fst g \<cdot> \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) \<noteq> snd g \<cdot> \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)"
       using f(2) g 0[OF \<sigma>] by (simp add: prod.case_eq_if)
     hence "\<exists>(s,t) \<in> set F. s \<cdot> (\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)) \<noteq> t \<cdot> (\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>))"
       using g by fastforce
   } moreover {
     fix \<sigma>::"('a,'b) subst" and t t'
     assume \<sigma>: "subst_domain \<sigma> = set X" "ground (subst_range \<sigma>)"
         and *: "\<exists>(s,t) \<in> set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>). (s,t) \<cdot>\<^sub>p (\<sigma> \<circ>\<^sub>s \<theta>) \<notin> D"
     obtain f where f: "f \<in> set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)" "f \<cdot>\<^sub>p \<sigma> \<circ>\<^sub>s \<theta> \<notin> D"
       using * by (induct F') auto
     then obtain g where g: "g \<in> set F'" "f = g \<cdot>\<^sub>p \<delta>" by (auto simp add: subst_apply_pairs_def)
     have "g \<cdot>\<^sub>p \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) \<notin> D"
       using f(2) g 0[OF \<sigma>] by (simp add: prod.case_eq_if)
     hence "\<exists>(s,t) \<in> set F'. (s,t) \<cdot>\<^sub>p (\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)) \<notin> D"
       using g by (metis (no_types, lifting) case_prodI2)
   } ultimately show ?thesis
       using assms unfolding negchecks_model_def by meson
 qed
 
 lemma strand_sem_subst_stateful:
   fixes \<delta>::"('fun,'var) subst"
   assumes "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t S = {}"
   shows "\<lbrakk>M; D; S\<rbrakk>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) \<longleftrightarrow> \<lbrakk>M; D; S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>s \<theta>"
 proof
   note [simp] = subst_sst_cons[of _ _ \<delta>] subst_subst_compose[of _ \<delta> \<theta>]
 
   have "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> (subst_domain \<gamma> \<union> range_vars \<gamma>) = {}"
     when \<delta>: "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> set X = {}"
       and \<gamma>: "subst_domain \<gamma> = set X" "ground (subst_range \<gamma>)"
     for X and \<gamma>::"('fun,'var) subst"
     using \<delta> \<gamma> unfolding range_vars_alt_def by auto
   hence 0: "\<gamma> \<circ>\<^sub>s \<delta> = \<delta> \<circ>\<^sub>s \<gamma>"
     when \<delta>: "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> set X = {}"
       and \<gamma>: "subst_domain \<gamma> = set X" "ground (subst_range \<gamma>)"
     for \<gamma> X
     by (metis \<delta> \<gamma> subst_comp_eq_if_disjoint_vars)
 
   show "\<lbrakk>M; D; S\<rbrakk>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) \<Longrightarrow> \<lbrakk>M; D; S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>s \<theta>" using assms
   proof (induction S arbitrary: M D rule: strand_sem_stateful_induct)
     case (ConsSnd M D ts S)
     hence "\<forall>t \<in> set ts. M \<turnstile> t \<cdot> \<delta> \<cdot> \<theta>" and IH: "\<lbrakk>M; D; S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>s \<theta>" by auto
     hence "\<forall>t \<in> set (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>). M \<turnstile> t \<cdot> \<theta>" by simp
     thus ?case using IH by simp
   next
     case (ConsRcv M D ts S)
     hence "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<circ>\<^sub>s \<theta>) \<union> M; D; S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>s \<theta>" by simp
     hence "\<lbrakk>(set (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M; D; S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>s \<theta>" by (metis list.set_map subst_comp_all) 
     thus ?case by simp
   next
     case (ConsNegChecks M D X F F' S)
     hence *: "\<lbrakk>M; D; S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>s \<theta>" and **: "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> set X = {}"
       unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def negchecks_model_def by (force, auto)
     have "negchecks_model (\<delta> \<circ>\<^sub>s \<theta>) D X F F'" using ConsNegChecks by auto
     hence "negchecks_model \<theta> D X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
       using 0[OF **] negchecks_model_subst[OF **] by blast
     moreover have "rm_vars (set X) \<delta> = \<delta>" using ConsNegChecks.prems(2) by force
     ultimately show ?case using * by auto
   qed simp_all
 
   show "\<lbrakk>M; D; S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>s \<theta> \<Longrightarrow> \<lbrakk>M; D; S\<rbrakk>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)" using assms
   proof (induction S arbitrary: M D rule: strand_sem_stateful_induct)
     case (ConsSnd M D ts S)
     hence "\<forall>t \<in> set (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>). M \<turnstile> t \<cdot> \<theta>" and IH: "\<lbrakk>M; D; S\<rbrakk>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)" by auto
     hence "\<forall>t \<in> set ts. M \<turnstile> t \<cdot> \<delta> \<cdot> \<theta>" by simp
     thus ?case using IH by simp
   next
     case (ConsRcv M D ts S)
     hence "\<lbrakk>(set (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M; D; S\<rbrakk>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)" by simp
     hence "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<circ>\<^sub>s \<theta>) \<union> M; D; S\<rbrakk>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)" by (metis list.set_map subst_comp_all) 
     thus ?case by simp
   next
     case (ConsNegChecks M D X F F' S)
     have \<delta>: "rm_vars (set X) \<delta> = \<delta>" using ConsNegChecks.prems(2) by force
     hence *: "\<lbrakk>M; D; S\<rbrakk>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)" and **: "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> set X = {}"
       using ConsNegChecks unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def negchecks_model_def by auto
     have "negchecks_model \<theta> D X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
       using ConsNegChecks.prems(1) \<delta> by (auto simp add: subst_compose_assoc negchecks_model_def)
     hence "negchecks_model (\<delta> \<circ>\<^sub>s \<theta>) D X F F'"
       using 0[OF **] negchecks_model_subst[OF **] by blast
     thus ?case using * by auto
   qed simp_all
 qed
 
 lemma strand_sem_receive_prepend_stateful:
   assumes "\<lbrakk>M; D; S\<rbrakk>\<^sub>s \<theta>"
     and "list_all is_Receive S'"
   shows "\<lbrakk>M; D; S@S'\<rbrakk>\<^sub>s \<theta>"
 using assms(2)
 proof (induction S' rule: List.rev_induct)
   case (snoc x S')
   hence "\<exists>t. x = receive\<langle>t\<rangle>" "\<lbrakk>M; D; S@S'\<rbrakk>\<^sub>s \<theta>"
     unfolding list_all_iff is_Receive_def by auto
   thus ?case using strand_sem_append_stateful[of M D "S@S'" "[x]" \<theta>] by auto
 qed (simp add: assms(1))
 
 lemma negchecks_model_model_swap:
   fixes I J::"('a,'b) subst"
   assumes "\<forall>x \<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) - set X. I x = J x"
     and "negchecks_model I D X F G"
   shows "negchecks_model J D X F G"
 proof -
   have 0: "\<forall>x \<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). (\<delta> \<circ>\<^sub>s I) x = (\<delta> \<circ>\<^sub>s J) x"
     when "subst_domain \<delta> = set X" "ground (subst_range \<delta>)"
     for \<delta>::"('a,'b) subst"
     using that assms(1)
     by (metis DiffI ground_subst_range_empty_fv subst_comp_notin_dom_eq
               subst_ground_ident_compose(1))
 
   have 1: "s \<cdot> (\<delta> \<circ>\<^sub>s J) \<noteq> t \<cdot> (\<delta> \<circ>\<^sub>s J)"
     when "s \<cdot> (\<delta> \<circ>\<^sub>s I) \<noteq> t \<cdot> (\<delta> \<circ>\<^sub>s I)" "(s,t) \<in> set F"
          "subst_domain \<delta> = set X" "ground (subst_range \<delta>)"
     for \<delta>::"('a,'b) subst" and s t
     using that(1,2) 0[OF that(3,4)] term_subst_eq_conv[of _ "\<delta> \<circ>\<^sub>s I" "\<delta> \<circ>\<^sub>s J"]
           UnCI fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_inI(4,5)[OF that(2)]
     by metis
 
   have 2: "(s,t) \<cdot>\<^sub>p (\<delta> \<circ>\<^sub>s J) \<notin> D"
     when "(s,t) \<cdot>\<^sub>p (\<delta> \<circ>\<^sub>s I) \<notin> D" "(s,t) \<in> set G"
          "subst_domain \<delta> = set X" "ground (subst_range \<delta>)"
     for \<delta>::"('a,'b) subst" and s t
     using that(1,2) 0[OF that(3,4)] fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_inI(4,5)[of s t G]
           term_subst_eq_conv[of s "\<delta> \<circ>\<^sub>s I" "\<delta> \<circ>\<^sub>s J"]
           term_subst_eq_conv[of t "\<delta> \<circ>\<^sub>s I" "\<delta> \<circ>\<^sub>s J"]
     by simp
 
   have 3: "(\<exists>(s,t) \<in> set F. s \<cdot> \<delta> \<circ>\<^sub>s J \<noteq> t \<cdot> \<delta> \<circ>\<^sub>s J) \<or> (\<exists>(s,t) \<in> set G. (s, t) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s J \<notin> D)"
     when "subst_domain \<delta> = set X" "ground (subst_range \<delta>)"
          "(\<exists>(s,t) \<in> set F. s \<cdot> \<delta> \<circ>\<^sub>s I \<noteq> t \<cdot> \<delta> \<circ>\<^sub>s I) \<or> (\<exists>(s,t) \<in> set G. (s, t) \<cdot>\<^sub>p \<delta> \<circ>\<^sub>s I \<notin> D)"
     for \<delta>::"('a,'b) subst"
     using 1[OF _ _ that(1,2)] 2[OF _ _ that(1,2)] that(3) by blast
   thus ?thesis
     using assms(2) unfolding negchecks_model_def by simp
 qed
 
 lemma strand_sem_model_swap:
   assumes "\<forall>x \<in> fv\<^sub>s\<^sub>s\<^sub>t S. I x = J x"
     and "\<lbrakk>M; D; S\<rbrakk>\<^sub>s I"
   shows "\<lbrakk>M; D; S\<rbrakk>\<^sub>s J"
 using assms(2,1)
 proof (induction S arbitrary: M D rule: strand_sem_stateful_induct)
   case (ConsSnd M D ts S)
   hence *: "\<lbrakk>M; D; S\<rbrakk>\<^sub>s J" "\<forall>t \<in> set ts. M \<turnstile> t \<cdot> I" "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts). I x = J x"
     by (fastforce, fastforce, fastforce)
 
   have "\<forall>t \<in> set ts. M \<turnstile> t \<cdot> J"
     using *(2,3) term_subst_eq_conv[of _ I J]
     by (metis fv_subset subsetD)
   thus ?case using *(1) by auto
 next
   case (ConsRcv M D ts S)
   hence *: "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<union> M; D; S\<rbrakk>\<^sub>s J" "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts). I x = J x"
     by (fastforce, fastforce)
 
   have "set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t I = set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t J"
     using *(2) term_subst_eq_conv[of _ I J]
     by (meson fv_subset image_cong subsetD)
   thus ?case using *(1) by simp
 next
   case (ConsEq M D ac t t' S) thus ?case
     using term_subst_eq_conv[of t I J] term_subst_eq_conv[of t' I J] by force
 next
   case (ConsIns M D t s S) thus ?case
     using term_subst_eq_conv[of t I J] term_subst_eq_conv[of s I J] by force
 next
   case (ConsDel M D t s S) thus ?case
     using term_subst_eq_conv[of t I J] term_subst_eq_conv[of s I J] by force
 next
   case (ConsIn M D uv t s S) thus ?case
     using term_subst_eq_conv[of t I J] term_subst_eq_conv[of s I J] by force
 next
   case (ConsNegChecks M D X F F' S)
   hence "\<lbrakk>M; D; S\<rbrakk>\<^sub>s J" "negchecks_model I D X F F'" "\<forall>x\<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 F' - set X. I x = J x"
     by (fastforce, fastforce, fastforce)
   thus ?case using negchecks_model_model_swap[of F F' X I J D] by fastforce
 qed simp
 
 lemma strand_sem_receive_send_append:
   assumes A: "\<lbrakk>M; D; A\<rbrakk>\<^sub>s I"
   shows "\<lbrakk>M; D; A@[receive\<langle>[t]\<rangle>,send\<langle>[t]\<rangle>]\<rbrakk>\<^sub>s I"
 proof -
   have "M \<union> (ik\<^sub>s\<^sub>s\<^sub>t (A@[receive\<langle>[t]\<rangle>]) \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<turnstile> t \<cdot> I"
     using in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of t "A@[receive\<langle>[t]\<rangle>]"] by auto
   thus ?thesis
     using A strand_sem_append_stateful[of M D A "[receive\<langle>[t]\<rangle>]" I]
           strand_sem_append_stateful[of M D "A@[receive\<langle>[t]\<rangle>]" "[send\<langle>[t]\<rangle>]" I]
     by force
 qed
 
 lemma strand_sem_stateful_if_no_send_or_check:
   assumes A: "list_all (\<lambda>a. \<not>is_Send a \<and> \<not>is_Check_or_Assignment a) A"
   shows "\<lbrakk>M; D; A\<rbrakk>\<^sub>s I"
 using A
 proof (induction A rule: List.rev_induct)
   case (snoc a A)
   hence IH: "\<lbrakk>M; D; A\<rbrakk>\<^sub>s I" and a: "\<not>is_Send a" "\<not>is_Check_or_Assignment a" by auto
   from a have "\<lbrakk>M; D; [a]\<rbrakk>\<^sub>s I" for M D by (cases a) auto
   thus ?case using IH strand_sem_append_stateful[of M D A "[a]" I] by blast
 qed simp
 
 lemma strand_sem_stateful_if_sends_deduct:
   assumes "list_all is_Send A"
     and "\<forall>ts. send\<langle>ts\<rangle> \<in> set A \<longrightarrow> (\<forall>t \<in> set ts. M \<turnstile> t \<cdot> I)"
   shows "\<lbrakk>M; D; A\<rbrakk>\<^sub>s I"
 using assms
 proof (induction A rule: List.rev_induct)
   case (snoc a A)
   hence IH: "\<lbrakk>M; D; A\<rbrakk>\<^sub>s I" by auto
   obtain ts where a: "a = send\<langle>ts\<rangle>" "\<forall>t \<in> set ts. M \<turnstile> t \<cdot> I" using snoc.prems by (cases a) auto
 
   have "\<lbrakk>M \<union> (ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I); D; [a]\<rbrakk>\<^sub>s I" for D
     using ideduct_mono[of M _ "M \<union> (ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I)"] a by auto
   thus ?case using IH strand_sem_append_stateful[of M D A "[a]" I] by blast
 qed simp
 
 lemma strand_sem_stateful_if_checks:
   assumes "list_all is_Check_or_Assignment A"
     and "\<forall>ac t s. \<langle>ac: t \<doteq> s\<rangle> \<in> set A \<longrightarrow> t \<cdot> I = s \<cdot> I"
     and "\<forall>ac t s. \<langle>ac: t \<in> s\<rangle> \<in> set A \<longrightarrow> (t \<cdot> I, s \<cdot> I) \<in> D"
     and "\<forall>X F G. \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set A \<longrightarrow> negchecks_model I D X F G"
   shows "\<lbrakk>M; D; A\<rbrakk>\<^sub>s I"
 using assms
 proof (induction A rule: List.rev_induct)
   case (snoc a A)
   hence IH: "\<lbrakk>M; D; A\<rbrakk>\<^sub>s I" and a: "is_Check_or_Assignment a" by auto
 
   have 0: "dbupd\<^sub>s\<^sub>s\<^sub>t A I D = D"
     using snoc.prems(1) dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd[of A I D] unfolding list_all_iff by auto
 
   have "\<lbrakk>M; D; [a]\<rbrakk>\<^sub>s I" for M using a snoc.prems(2,3,4) by (cases a) auto
   thus ?case using IH strand_sem_append_stateful[of M D A "[a]" I] unfolding 0 by blast
 qed simp
 
 lemma strand_sem_stateful_sends_deduct:
   assumes A: "\<lbrakk>M; D; A\<rbrakk>\<^sub>s I"
     and ts: "send\<langle>ts\<rangle> \<in> set A"
     and t: "t \<in> set ts"
   shows "M \<union> (ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<turnstile> t \<cdot> I"
 using A ts
 proof (induction A arbitrary: M D rule: List.rev_induct)
   case (snoc a A)
   have 0: "\<lbrakk>M; D; A\<rbrakk>\<^sub>s I"
     using strand_sem_append_stateful snoc.prems(1) by fast
 
   have 1: "M \<union> (ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<subseteq> M \<union> (ik\<^sub>s\<^sub>s\<^sub>t (A@[a]) \<cdot>\<^sub>s\<^sub>e\<^sub>t I)"
     by auto
 
   have 2: "M \<union> (ik\<^sub>s\<^sub>s\<^sub>t (A@[send\<langle>ts\<rangle>]) \<cdot>\<^sub>s\<^sub>e\<^sub>t I) = M \<union> (ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I)"
     using in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of _ A] in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of _ "A@[send\<langle>ts\<rangle>]"] by fastforce
 
   show ?case
   proof (cases "send\<langle>ts\<rangle> \<in> set A")
     case True show ?thesis by (rule ideduct_mono[OF snoc.IH[OF 0 True] 1])
   next
     case False
     hence a: "a = send\<langle>ts\<rangle>" using snoc.prems(2) by force
     show ?thesis
       using strand_sem_append_stateful[of M D A "[a]" I] snoc.prems(1) t
       unfolding a 2 by auto
   qed
 qed simp
 
 end
 
 
 subsection \<open>Well-Formedness Lemmata\<close>
 lemma wfvarsocc\<^sub>s\<^sub>s\<^sub>t_subset_wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t[simp]:
   "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S \<subseteq> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S"
 by (induction S)
    (auto simp add: wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def
          split: stateful_strand_step.split poscheckvariant.split)
 
 lemma wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_append: "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (S@S') = wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S'"
 by (simp add: wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_union[simp]:
   "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t (S@T) = wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \<union> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t T"
 by (simp add: wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_singleton:
   "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t [s] = wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s"
 by (simp add: wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma ik\<^sub>s\<^sub>s\<^sub>t_fv_subset_wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t[simp]:
   "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t S) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S"
 using in_ik\<^sub>s\<^sub>s\<^sub>t_iff[of _ S] unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by force
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_prefix[dest]: "wf'\<^sub>s\<^sub>s\<^sub>t V (S@S') \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t V S"
 by (induct S rule: wf'\<^sub>s\<^sub>s\<^sub>t.induct) auto
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_vars_mono: "wf'\<^sub>s\<^sub>s\<^sub>t V S \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> W) S"
 proof (induction S arbitrary: V)
   case (Cons x S) thus ?case
   proof (cases x)
     case (Send ts)
     have "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> W \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)) S"
       using Cons.prems(1) Cons.IH Send by (metis sup_assoc sup_commute wf'\<^sub>s\<^sub>s\<^sub>t.simps(3))
     thus ?thesis by (simp add: Send)
   next
     case (Equality a t t')
     show ?thesis
     proof (cases a)
       case Assign
       hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv t \<union> W) S" "fv t' \<subseteq> V \<union> W" using Equality Cons.prems(1) Cons.IH by auto
       thus ?thesis using Equality Assign by (simp add: sup_commute sup_left_commute)
     next
       case Check thus ?thesis using Equality Cons by auto
     qed
   next
     case (InSet a t t')
     show ?thesis
     proof (cases a)
       case Assign
       hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv t \<union> fv t' \<union> W) S" using InSet Cons.prems(1) Cons.IH by auto
       thus ?thesis using InSet Assign by (simp add: sup_commute sup_left_commute)
     next
       case Check thus ?thesis using InSet Cons by auto
     qed
   qed auto
 qed simp
 
 lemma wf\<^sub>s\<^sub>s\<^sub>tI[intro]: "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \<subseteq> V \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t V S"
 proof (induction S)
   case (Cons x S) thus ?case
   proof (cases x)
     case (Send ts)
     hence "wf'\<^sub>s\<^sub>s\<^sub>t V S" "V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts) = V"
       using Cons
       unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def
       by auto
     thus ?thesis using Send by simp
   next
     case (Equality a t t')
     show ?thesis
     proof (cases a)
       case Assign
       hence "wf'\<^sub>s\<^sub>s\<^sub>t V S" "fv t' \<subseteq> V"
         using Equality Cons 
         unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def
         by auto
       thus ?thesis using wf\<^sub>s\<^sub>s\<^sub>t_vars_mono Equality Assign by simp
     next
       case Check
       thus ?thesis
         using Equality Cons
         unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def
         by auto
     qed
   next
     case (InSet a t t')
     show ?thesis
     proof (cases a)
       case Assign
       hence "wf'\<^sub>s\<^sub>s\<^sub>t V S" "fv t \<union> fv t' \<subseteq> V"
         using InSet Cons
         unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def
         by auto
       thus ?thesis using wf\<^sub>s\<^sub>s\<^sub>t_vars_mono InSet Assign by (simp add: Un_assoc) 
     next
       case Check
       thus ?thesis
         using InSet Cons
         unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def
         by auto
     qed
   qed (simp_all add: wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def)
 qed (simp add: wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma wf\<^sub>s\<^sub>s\<^sub>tI'[intro]:
   assumes "\<Union>((\<lambda>x. case x of
             Receive ts \<Rightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set ts)
           | Equality Assign _ t' \<Rightarrow> fv t'
           | Insert t t' \<Rightarrow> fv t \<union> fv t'
           | _ \<Rightarrow> {}) ` set S) \<subseteq> V"
   shows "wf'\<^sub>s\<^sub>s\<^sub>t V S"
 using assms
 proof (induction S)
   case (Cons x S) thus ?case
   proof (cases x)
     case (Equality a t t')
     thus ?thesis using Cons by (cases a) (auto simp add: wf\<^sub>s\<^sub>s\<^sub>t_vars_mono)
   next
     case (InSet a t t')
     thus ?thesis using Cons by (cases a) (auto simp add: wf\<^sub>s\<^sub>s\<^sub>t_vars_mono Un_assoc)
   qed (simp_all add: wf\<^sub>s\<^sub>s\<^sub>t_vars_mono)
 qed simp
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_append_exec: "wf'\<^sub>s\<^sub>s\<^sub>t V (S@S') \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) S'"
 proof (induction S arbitrary: V)
   case (Cons x S V) thus ?case
   proof (cases x)
     case (Send ts)
     hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) S'" using Cons.prems Cons.IH by simp
     thus ?thesis using Send unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def by (auto simp add: sup_assoc)
   next
     case (Equality a t t') show ?thesis
     proof (cases a)
       case Assign
       hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv t \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) S'" using Equality Cons.prems Cons.IH by auto
       thus ?thesis using Equality Assign unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def by (auto simp add: sup_assoc)
     next
       case Check
       hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) S'" using Equality Cons.prems Cons.IH by auto
       thus ?thesis using Equality Check unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def by (auto simp add: sup_assoc)
     qed
   next
     case (InSet a t t') show ?thesis
     proof (cases a)
       case Assign
       hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv t \<union> fv t' \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) S'" using InSet Cons.prems Cons.IH by auto
       thus ?thesis using InSet Assign unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def by (auto simp add: sup_assoc)
     next
       case Check
       hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) S'" using InSet Cons.prems Cons.IH by auto
       thus ?thesis using InSet Check unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def by (auto simp add: sup_assoc)
     qed
   qed (auto simp add: wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def)
 qed (simp add: wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_append:
   "wf'\<^sub>s\<^sub>s\<^sub>t X S \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t Y T \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t (X \<union> Y) (S@T)"
 proof (induction X S rule: wf'\<^sub>s\<^sub>s\<^sub>t.induct)
   case 1 thus ?case by (metis wf\<^sub>s\<^sub>s\<^sub>t_vars_mono Un_commute append_Nil)
 next
   case 3 thus ?case by (metis append_Cons Un_commute Un_assoc wf'\<^sub>s\<^sub>s\<^sub>t.simps(3))
 next
   case (4 V t t' S)
   hence *: "fv t' \<subseteq> V" and "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv t \<union> Y) (S @ T)" by simp_all
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> Y \<union> fv t) (S @ T)" by (metis Un_commute Un_assoc)
   thus ?case using * by auto
 next
   case (8 V t t' S)
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv t \<union> fv t' \<union> Y) (S @ T)" by simp_all
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> Y \<union> fv t \<union> fv t') (S @ T)" by (metis Un_commute Un_assoc)
   thus ?case by auto
 qed auto
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_append_suffix:
   "wf'\<^sub>s\<^sub>s\<^sub>t V S \<Longrightarrow> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \<union> V \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t V (S@S')"
 proof (induction V S rule: wf'\<^sub>s\<^sub>s\<^sub>t.induct)
   case (2 V ts S)
   hence *: "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> V" "wf'\<^sub>s\<^sub>s\<^sub>t V S" by simp_all
   hence "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \<union> V"
     using "2.prems"(2) unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by fastforce
   thus ?case using "2.IH" * by simp
 next
   case (3 V ts S)
   hence *: "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)) S" by simp_all
   hence "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \<union> (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts))"
     using "3.prems"(2) unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by auto
   thus ?case using "3.IH" * by simp
 next
   case (4 V t t' S)
   hence *: "fv t' \<subseteq> V" "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv t) S" by simp_all
   moreover have "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\<langle>t := t'\<rangle>) = fv t \<union> fv t'"
     by simp
   moreover have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t (\<langle>t := t'\<rangle>#S) = fv t \<union> fv t' \<union> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S"
     unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by auto
   ultimately have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \<union> (V \<union> fv t)"
     using "4.prems"(2) by blast
   thus ?case using "4.IH" * by simp
 next
   case (6 V t t' S)
   hence *: "fv t \<union> fv t' \<subseteq> V" "wf'\<^sub>s\<^sub>s\<^sub>t V S" by simp_all
   moreover have "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\<langle>t,t'\<rangle>) = fv t \<union> fv t'"
     by simp
   moreover have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t (insert\<langle>t,t'\<rangle>#S) = fv t \<union> fv t' \<union> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S"
     unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by auto
   ultimately have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \<union> V"
     using "6.prems"(2) by blast
   thus ?case using "6.IH" * by simp
 next
   case (8 V t t' S)
   hence *: "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv t \<union> fv t') S" by simp_all
   moreover have "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (select\<langle>t,t'\<rangle>) = fv t \<union> fv t'"
     by simp
   moreover have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t (select\<langle>t,t'\<rangle>#S) = fv t \<union> fv t' \<union> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S"
     unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by auto
   ultimately have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \<union> (V \<union> fv t \<union> fv t')"
     using "8.prems"(2) by blast
   thus ?case using "8.IH" * by simp
 qed (simp_all add: wf\<^sub>s\<^sub>s\<^sub>tI wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_append_suffix':
   assumes "wf'\<^sub>s\<^sub>s\<^sub>t V S"
     and "\<Union>((\<lambda>x. case x of
             Receive ts \<Rightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set ts)
           | Equality Assign _ t' \<Rightarrow> fv t'
           | Insert t t' \<Rightarrow> fv t \<union> fv t'
           | _ \<Rightarrow> {}) ` set S') \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S \<union> V"
   shows "wf'\<^sub>s\<^sub>s\<^sub>t V (S@S')"
 using assms
 by (induction V S rule: wf'\<^sub>s\<^sub>s\<^sub>t.induct)
    (auto simp add: wf\<^sub>s\<^sub>s\<^sub>tI' wf\<^sub>s\<^sub>s\<^sub>t_vars_mono wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_subst_apply:
   "wf'\<^sub>s\<^sub>s\<^sub>t V S \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)) (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
 proof (induction S arbitrary: V rule: wf'\<^sub>s\<^sub>s\<^sub>t.induct)
   case (2 V ts S)
   hence "wf'\<^sub>s\<^sub>s\<^sub>t V S" "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> V" by simp_all
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)) (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)" "fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
     using "2.IH" subst_apply_fv_subset by (simp, force)
   thus ?case by (simp add: subst_apply_stateful_strand_def)
 next
   case (3 V ts S)
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)) S" by simp
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)))) (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)" using "3.IH" by metis
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)) (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
     using  subst_apply_fv_unfold_set[of \<delta> ts] by fastforce
   thus ?case by (simp add: subst_apply_stateful_strand_def)
 next
   case (4 V t t' S)
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv t) S" "fv t' \<subseteq> V" by auto
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> fv t))) (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)" and *: "fv (t' \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
     using "4.IH" subst_apply_fv_subset by force+
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv (t \<cdot> \<delta>)) (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)" by (metis subst_apply_fv_union)
   thus ?case using * by (simp add: subst_apply_stateful_strand_def)
 next
   case (6 V t t' S)
   hence "wf'\<^sub>s\<^sub>s\<^sub>t V S" "fv t \<union> fv t' \<subseteq> V" by auto
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)) (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)" "fv (t \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)" "fv (t' \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
     using "6.IH" subst_apply_fv_subset by force+
   thus ?case by (simp add: sup_assoc subst_apply_stateful_strand_def)
 next
   case (8 V t t' S)
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> fv t \<union> fv t') S" by auto
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> fv t \<union> fv t'))) (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
     using "8.IH" subst_apply_fv_subset by force
   hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)) (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)" by (metis subst_apply_fv_union)
   thus ?case by (simp add: subst_apply_stateful_strand_def)
 qed (auto simp add: subst_apply_stateful_strand_def)
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_induct[consumes 1,
                   case_names Nil ConsSnd ConsRcv ConsEq ConsEq2 ConsIn ConsIns ConsDel
                              ConsNegChecks]:
   fixes S::"('a,'b) stateful_strand"
   assumes "wf'\<^sub>s\<^sub>s\<^sub>t V S"
           "P []"
           "\<And>ts S. \<lbrakk>wf'\<^sub>s\<^sub>s\<^sub>t V S; P S\<rbrakk> \<Longrightarrow> P (S@[Send ts])"
           "\<And>ts S. \<lbrakk>wf'\<^sub>s\<^sub>s\<^sub>t V S; P S; fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> V \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S\<rbrakk> \<Longrightarrow> P (S@[Receive ts])"
           "\<And>t t' S. \<lbrakk>wf'\<^sub>s\<^sub>s\<^sub>t V S; P S; fv t' \<subseteq> V \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S\<rbrakk> \<Longrightarrow> P (S@[Equality Assign t t'])"
           "\<And>t t' S. \<lbrakk>wf'\<^sub>s\<^sub>s\<^sub>t V S; P S\<rbrakk> \<Longrightarrow> P (S@[Equality Check t t'])"
           "\<And>ac t t' S. \<lbrakk>wf'\<^sub>s\<^sub>s\<^sub>t V S; P S\<rbrakk> \<Longrightarrow> P (S@[InSet ac t t'])"
           "\<And>t t' S. \<lbrakk>wf'\<^sub>s\<^sub>s\<^sub>t V S; P S; fv t \<union> fv t' \<subseteq> V \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S\<rbrakk> \<Longrightarrow> P (S@[Insert t t'])"
           "\<And>t t' S. \<lbrakk>wf'\<^sub>s\<^sub>s\<^sub>t V S; P S\<rbrakk> \<Longrightarrow> P (S@[Delete t t'])"
           "\<And>X F G S. \<lbrakk>wf'\<^sub>s\<^sub>s\<^sub>t V S; P S\<rbrakk> \<Longrightarrow> P (S@[NegChecks X F G])"
   shows "P S"
 using assms
 proof (induction S rule: List.rev_induct)
   case (snoc x S)
   hence *: "wf'\<^sub>s\<^sub>s\<^sub>t V S" "wf'\<^sub>s\<^sub>s\<^sub>t (V \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) [x]"
     by (metis wf\<^sub>s\<^sub>s\<^sub>t_prefix, metis wf\<^sub>s\<^sub>s\<^sub>t_append_exec)
   have IH: "P S" using snoc.IH[OF *(1)] snoc.prems by auto
   note ** = snoc.prems(3-)[OF *(1) IH] *(2)
   show ?case
   proof (cases x)
     case (Send ts) thus ?thesis using **(1) by blast
   next
     case (Receive ts) thus ?thesis using **(2,9) by simp
   next
     case (Equality ac t t') thus ?thesis using **(3,4,9) by (cases ac) auto
   next
     case (Insert t t') thus ?thesis using **(6,9) by force
   next
     case (Delete t t') thus ?thesis using **(7) by presburger
   next
     case (NegChecks X F G) thus ?thesis using **(8) by presburger
   next
     case (InSet ac t t') thus ?thesis using **(5) by (cases ac) auto
   qed
 qed simp
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_strand_first_Send_var_split:
   assumes "wf'\<^sub>s\<^sub>s\<^sub>t {} S" "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v"
   shows "\<exists>S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f. \<not>(\<exists>w \<in> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e. t \<cdot> \<I> \<sqsubseteq> \<I> w) \<and> (
                     (\<exists>ts. S = S\<^sub>p\<^sub>r\<^sub>e@send\<langle>ts\<rangle>#S\<^sub>s\<^sub>u\<^sub>f \<and> t \<cdot> \<I> \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<or>
                     (\<exists>s u. S = S\<^sub>p\<^sub>r\<^sub>e@\<langle>assign: s \<doteq> u\<rangle>#S\<^sub>s\<^sub>u\<^sub>f \<and> t \<cdot> \<I> \<sqsubseteq> s \<cdot> \<I> \<and> \<not>(t \<cdot> \<I> \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t \<I> ` fv u)) \<or>
                     (\<exists>s u. S = S\<^sub>p\<^sub>r\<^sub>e@\<langle>assign: s \<in> u\<rangle>#S\<^sub>s\<^sub>u\<^sub>f \<and> (t \<cdot> \<I> \<sqsubseteq> s \<cdot> \<I> \<or> t \<cdot> \<I> \<sqsubseteq> u \<cdot> \<I>)))"
     (is "\<exists>S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f. ?P S\<^sub>p\<^sub>r\<^sub>e \<and> ?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f")
 using assms
 proof (induction S rule: wf\<^sub>s\<^sub>s\<^sub>t_induct)
   case (ConsSnd ts' S) show ?case
   proof (cases "\<exists>w \<in> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> w")
     case True
     then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f"
       using ConsSnd.IH by moura
     thus ?thesis by fastforce
   next
     case False
     then obtain v where v: "v \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts')" "t \<cdot> \<I> \<sqsubseteq> \<I> v"
       using ConsSnd.prems unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by auto
     then obtain t' where t': "t' \<in> set ts'" "v \<in> fv t'" by auto
     have "t \<cdot> \<I> \<sqsubseteq> t' \<cdot> \<I>"
       using v(2) t'(2) subst_mono[of "Var v" t' \<I>] vars_iff_subtermeq[of v] term.order_trans
       by auto
     hence "t \<cdot> \<I> \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using v(1) t'(1) by blast
     thus ?thesis using False v by blast
   qed
 next
   case (ConsRcv t' S)
   have "fv\<^sub>s\<^sub>e\<^sub>t (set t') \<subseteq> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S"
     using ConsRcv.hyps wfvarsocc\<^sub>s\<^sub>s\<^sub>t_subset_wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t[of S] by blast
   hence "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v"
     using ConsRcv.prems unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by fastforce
   then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f"
     using ConsRcv.IH by moura
   thus ?case by fastforce
 next
   case (ConsEq s s' S)
   have *: "fv s' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S"
     using ConsEq.hyps wfvarsocc\<^sub>s\<^sub>s\<^sub>t_subset_wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t[of S] by blast
   show ?case
   proof (cases "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v")
     case True
     then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f"
       using ConsEq.IH by moura
     thus ?thesis by fastforce
   next
     case False
     then obtain v where "v \<in> fv s" "t \<cdot> \<I> \<sqsubseteq> \<I> v" and **: "fv s' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S"
       using ConsEq.prems * unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by auto
     hence "t \<cdot> \<I> \<sqsubseteq> s \<cdot> \<I>"
       using vars_iff_subtermeq[of v s] subst_mono[of "Var v" s \<I>] term.order_trans by auto
     thus ?thesis using False ** by fastforce
   qed
 next
   case (ConsEq2 s s' S)
   have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t (S@[Equality Check s s']) = wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S"
     unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by auto
   hence "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v" using ConsEq2.prems by metis
   then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f" using ConsEq2.IH by moura
   thus ?case by fastforce
 next
   case (ConsNegChecks X F G S)
   hence "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v" unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by simp
   then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f" using ConsNegChecks.IH by moura
   thus ?case by fastforce
 next
   case (ConsIn ac s s' S)
   show ?case
   proof (cases "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v")
     case True
     then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f"
       using ConsIn.IH by moura
     thus ?thesis by fastforce
   next
     case False
     hence ac: "ac = assign" using ConsIn.prems unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by (cases ac) auto
     obtain v where "v \<in> fv s \<union> fv s'" "t \<cdot> \<I> \<sqsubseteq> \<I> v"
         using ConsIn.prems False unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def ac by auto
     hence *: "t \<cdot> \<I> \<sqsubseteq> s \<cdot> \<I> \<or> t \<cdot> \<I> \<sqsubseteq> s' \<cdot> \<I>"
       using vars_iff_subtermeq[of v s] vars_iff_subtermeq[of v s']
             subst_mono[of "Var v" s \<I>] subst_mono[of "Var v" s' \<I>] term.order_trans
       by auto
     show ?thesis using * False unfolding ac by fast
   qed
 next
   case (ConsIns s s' S)
   have "fv s \<union> fv s' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S"
     using ConsIns.hyps wfvarsocc\<^sub>s\<^sub>s\<^sub>t_subset_wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t[of S] by blast
   hence "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v"
       using ConsIns.prems unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by fastforce
   then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f" using ConsIns.IH by moura
   thus ?case by fastforce
 next
   case (ConsDel s s' S)
   hence "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v" unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by simp
   then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f" using ConsDel.IH by moura
   thus ?case by fastforce
 qed (simp add: wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_vars_mono': "wf'\<^sub>s\<^sub>s\<^sub>t V S \<Longrightarrow> V \<subseteq> W \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t W S"
 by (metis Diff_partition wf\<^sub>s\<^sub>s\<^sub>t_vars_mono)
 
 lemma wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_receives_only_eq:
   assumes "list_all is_Receive S"
   shows "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S = fv\<^sub>s\<^sub>s\<^sub>t S"
 using assms
 proof (induction S)
   case (Cons a A)
   obtain ts where a: "a = receive\<langle>ts\<rangle>" using Cons.prems by (cases a) auto
   have IH: "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t A = fv\<^sub>s\<^sub>s\<^sub>t A" using Cons.prems Cons.IH by simp
   show ?case using IH unfolding a wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by simp
 qed (simp add: wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_receives_only_empty:
   assumes "list_all is_Receive S"
   shows "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S = {}"
 using assms
 proof (induction S)
   case (Cons a A)
   obtain ts where a: "a = receive\<langle>ts\<rangle>" using Cons.prems by (cases a) auto
   have IH: "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t A = {}" using Cons.prems Cons.IH by simp
   show ?case using IH unfolding a wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def by simp
 qed (simp add: wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def)
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_sends_only:
   assumes "list_all is_Send S"
   shows "wf'\<^sub>s\<^sub>s\<^sub>t V S"
 using assms
 proof (induction S arbitrary: V)
   case (Cons s S) thus ?case by (cases s) auto
 qed simp
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_sends_only_prepend:
   assumes "wf'\<^sub>s\<^sub>s\<^sub>t V S"
     and "list_all is_Send S'"
   shows "wf'\<^sub>s\<^sub>s\<^sub>t V (S'@S)"
 using wf\<^sub>s\<^sub>s\<^sub>t_append[OF wf\<^sub>s\<^sub>s\<^sub>t_sends_only[OF assms(2), of "{}"] assms(1)] by simp
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_receives_only_fv_subset:
   assumes "wf'\<^sub>s\<^sub>s\<^sub>t V S"
     and "list_all is_Receive S"
   shows "fv\<^sub>s\<^sub>s\<^sub>t S \<subseteq> V"
 using assms
 proof (induction rule: wf\<^sub>s\<^sub>s\<^sub>t_induct)
   case (ConsRcv ts S) thus ?case using wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_receives_only_empty[of S] by auto
 qed auto
 
 lemma wf\<^sub>s\<^sub>s\<^sub>t_append_suffix'':
   assumes "wf'\<^sub>s\<^sub>s\<^sub>t V S"
     and "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S \<union> V"
   shows "wf'\<^sub>s\<^sub>s\<^sub>t V (S@S')"
 using assms
 by (induction V S rule: wf'\<^sub>s\<^sub>s\<^sub>t.induct)
    (auto simp add: wf\<^sub>s\<^sub>s\<^sub>tI' wf\<^sub>s\<^sub>s\<^sub>t_vars_mono wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def)
 
 
 end
diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Strands_and_Constraints.thy b/thys/Stateful_Protocol_Composition_and_Typing/Strands_and_Constraints.thy
--- a/thys/Stateful_Protocol_Composition_and_Typing/Strands_and_Constraints.thy
+++ b/thys/Stateful_Protocol_Composition_and_Typing/Strands_and_Constraints.thy
@@ -1,2896 +1,2896 @@
 (*  Title:      Strands_and_Constraints.thy
     Author:     Andreas Viktor Hess, DTU
     SPDX-License-Identifier: BSD-3-Clause
 *)
 
 section \<open>Strands and Symbolic Intruder Constraints\<close>
 theory Strands_and_Constraints
 imports Messages More_Unification Intruder_Deduction
 begin
 
 subsection \<open>Constraints, Strands and Related Definitions\<close>
 datatype poscheckvariant = Assign ("assign") | Check ("check")
 
 text \<open>
   A strand (or constraint) step is either a message transmission (either a message being sent \<open>Send\<close>
   or being received \<open>Receive\<close>) or a check on messages (a positive check \<open>Equality\<close>---which can be
   either an "assignment" or just a check---or a negative check \<open>Inequality\<close>)
 \<close>
 datatype (funs\<^sub>s\<^sub>t\<^sub>p: 'a, vars\<^sub>s\<^sub>t\<^sub>p: 'b) strand_step =
   Send       "('a,'b) term list" ("send\<langle>_\<rangle>\<^sub>s\<^sub>t" 80)
 | Receive    "('a,'b) term list" ("receive\<langle>_\<rangle>\<^sub>s\<^sub>t" 80)
 | Equality   poscheckvariant "('a,'b) term" "('a,'b) term" ("\<langle>_: _ \<doteq> _\<rangle>\<^sub>s\<^sub>t" [80,80])
 | Inequality (bvars\<^sub>s\<^sub>t\<^sub>p: "'b list") "(('a,'b) term \<times> ('a,'b) term) list" ("\<forall>_\<langle>\<or>\<noteq>: _\<rangle>\<^sub>s\<^sub>t" [80,80])
 where
   "bvars\<^sub>s\<^sub>t\<^sub>p (Send _) = []"
 | "bvars\<^sub>s\<^sub>t\<^sub>p (Receive _) = []"
 | "bvars\<^sub>s\<^sub>t\<^sub>p (Equality _ _ _) = []"
 
 abbreviation "Send1 t \<equiv> Send [t]"
 abbreviation "Receive1 t \<equiv> Receive [t]"
 
 text \<open>
   A strand is a finite sequence of strand steps (constraints and strands share the same datatype)
 \<close>
 type_synonym ('a,'b) strand = "('a,'b) strand_step list"
 
 type_synonym ('a,'b) strands = "('a,'b) strand set"
 
 abbreviation "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<equiv> \<Union>(t,t') \<in> set F. {t,t'}"
 
 fun trms\<^sub>s\<^sub>t\<^sub>p::"('a,'b) strand_step \<Rightarrow> ('a,'b) terms" where
   "trms\<^sub>s\<^sub>t\<^sub>p (Send ts) = set ts"
 | "trms\<^sub>s\<^sub>t\<^sub>p (Receive ts) = set ts"
 | "trms\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = {t,t'}"
 | "trms\<^sub>s\<^sub>t\<^sub>p (Inequality _ F) = trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
 
 lemma vars\<^sub>s\<^sub>t\<^sub>p_unfold[simp]: "vars\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p x) \<union> set (bvars\<^sub>s\<^sub>t\<^sub>p x)"
 by (cases x) auto
 
 text \<open>The set of terms occurring in a strand\<close>
 definition trms\<^sub>s\<^sub>t where "trms\<^sub>s\<^sub>t S \<equiv> \<Union>(trms\<^sub>s\<^sub>t\<^sub>p ` set S)"
 
 fun trms_list\<^sub>s\<^sub>t\<^sub>p::"('a,'b) strand_step \<Rightarrow> ('a,'b) term list" where
   "trms_list\<^sub>s\<^sub>t\<^sub>p (Send ts) = ts"
 | "trms_list\<^sub>s\<^sub>t\<^sub>p (Receive ts) = ts"
 | "trms_list\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = [t,t']"
 | "trms_list\<^sub>s\<^sub>t\<^sub>p (Inequality _ F) = concat (map (\<lambda>(t,t'). [t,t']) F)"
 
 text \<open>The set of terms occurring in a strand (list variant)\<close>
 definition trms_list\<^sub>s\<^sub>t where "trms_list\<^sub>s\<^sub>t S \<equiv> remdups (concat (map trms_list\<^sub>s\<^sub>t\<^sub>p S))"
 
 text \<open>The set of variables occurring in a sent message\<close>
 definition fv\<^sub>s\<^sub>n\<^sub>d::"('a,'b) strand_step \<Rightarrow> 'b set" where
   "fv\<^sub>s\<^sub>n\<^sub>d x \<equiv> case x of Send t \<Rightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set t) | _ \<Rightarrow> {}"
 
 text \<open>The set of variables occurring in a received message\<close>
 definition fv\<^sub>r\<^sub>c\<^sub>v::"('a,'b) strand_step \<Rightarrow> 'b set" where
   "fv\<^sub>r\<^sub>c\<^sub>v x \<equiv> case x of Receive t \<Rightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set t) | _ \<Rightarrow> {}"
 
 text \<open>The set of variables occurring in an equality constraint\<close>
 definition fv\<^sub>e\<^sub>q::"poscheckvariant \<Rightarrow> ('a,'b) strand_step \<Rightarrow> 'b set" where
   "fv\<^sub>e\<^sub>q ac x \<equiv> case x of Equality ac' s t \<Rightarrow> if ac = ac' then fv s \<union> fv t else {} | _ \<Rightarrow> {}"
 
 text \<open>The set of variables occurring at the left-hand side of an equality constraint\<close>
 definition fv_l\<^sub>e\<^sub>q::"poscheckvariant \<Rightarrow> ('a,'b) strand_step \<Rightarrow> 'b set" where
   "fv_l\<^sub>e\<^sub>q ac x \<equiv> case x of Equality ac' s t \<Rightarrow> if ac = ac' then fv s else {} | _ \<Rightarrow> {}"
 
 text \<open>The set of variables occurring at the right-hand side of an equality constraint\<close>
 definition fv_r\<^sub>e\<^sub>q::"poscheckvariant \<Rightarrow> ('a,'b) strand_step \<Rightarrow> 'b set" where
   "fv_r\<^sub>e\<^sub>q ac x \<equiv> case x of Equality ac' s t \<Rightarrow> if ac = ac' then fv t else {} | _ \<Rightarrow> {}"
 
 text \<open>The free variables of inequality constraints\<close>
 definition fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q::"('a,'b) strand_step \<Rightarrow> 'b set" where
   "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x \<equiv> case x of Inequality X F \<Rightarrow> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X | _ \<Rightarrow> {}"
 
 fun fv\<^sub>s\<^sub>t\<^sub>p::"('a,'b) strand_step \<Rightarrow> 'b set" where
   "fv\<^sub>s\<^sub>t\<^sub>p (Send t) = fv\<^sub>s\<^sub>e\<^sub>t (set t)"
 | "fv\<^sub>s\<^sub>t\<^sub>p (Receive t) = fv\<^sub>s\<^sub>e\<^sub>t (set t)"
 | "fv\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = fv t \<union> fv t'"
 | "fv\<^sub>s\<^sub>t\<^sub>p (Inequality X F) = (\<Union>(t,t') \<in> set F. fv t \<union> fv t') - set X"
 
 text \<open>The set of free variables of a strand\<close>
 definition fv\<^sub>s\<^sub>t::"('a,'b) strand \<Rightarrow> 'b set" where
   "fv\<^sub>s\<^sub>t S \<equiv> \<Union>(set (map fv\<^sub>s\<^sub>t\<^sub>p S))"
 
 text \<open>The set of bound variables of a strand\<close>
 definition bvars\<^sub>s\<^sub>t::"('a,'b) strand \<Rightarrow> 'b set" where
   "bvars\<^sub>s\<^sub>t S \<equiv> \<Union>(set (map (set \<circ> bvars\<^sub>s\<^sub>t\<^sub>p) S))"
 
 text \<open>The set of all variables occurring in a strand\<close>
 definition vars\<^sub>s\<^sub>t::"('a,'b) strand \<Rightarrow> 'b set" where
   "vars\<^sub>s\<^sub>t S \<equiv> \<Union>(set (map vars\<^sub>s\<^sub>t\<^sub>p S))"
 
 abbreviation wfrestrictedvars\<^sub>s\<^sub>t\<^sub>p::"('a,'b) strand_step \<Rightarrow> 'b set" where
   "wfrestrictedvars\<^sub>s\<^sub>t\<^sub>p x \<equiv>
     case x of Inequality _ _ \<Rightarrow> {} | Equality Check _ _ \<Rightarrow> {} | _ \<Rightarrow> vars\<^sub>s\<^sub>t\<^sub>p x"
 
 text \<open>The variables of a strand whose occurrences might be restricted by well-formedness constraints\<close>
 definition wfrestrictedvars\<^sub>s\<^sub>t::"('a,'b) strand \<Rightarrow> 'b set" where
   "wfrestrictedvars\<^sub>s\<^sub>t S \<equiv> \<Union>(set (map wfrestrictedvars\<^sub>s\<^sub>t\<^sub>p S))"
 
 abbreviation wfvarsoccs\<^sub>s\<^sub>t\<^sub>p where
   "wfvarsoccs\<^sub>s\<^sub>t\<^sub>p x \<equiv> case x of Send t \<Rightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set t) | Equality Assign s t \<Rightarrow> fv s | _ \<Rightarrow> {}"
 
 text \<open>The variables of a strand that occur in sent messages or in assignments\<close>
 definition wfvarsoccs\<^sub>s\<^sub>t where
   "wfvarsoccs\<^sub>s\<^sub>t S \<equiv> \<Union>(set (map wfvarsoccs\<^sub>s\<^sub>t\<^sub>p S))"
 
 text \<open>The variables occurring at the right-hand side of assignment steps\<close>
 fun assignment_rhs\<^sub>s\<^sub>t where
   "assignment_rhs\<^sub>s\<^sub>t [] = {}"
 | "assignment_rhs\<^sub>s\<^sub>t (Equality Assign t t'#S) = insert t' (assignment_rhs\<^sub>s\<^sub>t S)"
 | "assignment_rhs\<^sub>s\<^sub>t (x#S) = assignment_rhs\<^sub>s\<^sub>t S"
 
 text \<open>The set of function symbols occurring in a strand\<close>
 definition funs\<^sub>s\<^sub>t::"('a,'b) strand \<Rightarrow> 'a set" where
   "funs\<^sub>s\<^sub>t S \<equiv> \<Union>(set (map funs\<^sub>s\<^sub>t\<^sub>p S))"
 
 fun subst_apply_strand_step::"('a,'b) strand_step \<Rightarrow> ('a,'b) subst \<Rightarrow> ('a,'b) strand_step"
   (infix "\<cdot>\<^sub>s\<^sub>t\<^sub>p" 51) where
   "Send t \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta> = Send (t \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)"
 | "Receive t \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta> = Receive (t \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)"
 | "Equality a t t' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta> = Equality a (t \<cdot> \<theta>) (t' \<cdot> \<theta>)"
 | "Inequality X F \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta> = Inequality X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>)"
 
 text \<open>Substitution application for strands\<close>
 definition subst_apply_strand::"('a,'b) strand \<Rightarrow> ('a,'b) subst \<Rightarrow> ('a,'b) strand"
   (infix "\<cdot>\<^sub>s\<^sub>t" 51) where
   "S \<cdot>\<^sub>s\<^sub>t \<theta> \<equiv> map (\<lambda>x. x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>) S"
 
 text \<open>The semantics of inequality constraints\<close>
 definition
   "ineq_model (\<I>::('a,'b) subst) X F \<equiv>
       (\<forall>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>) \<longrightarrow> 
               (\<exists>(t,t') \<in> set F. t \<cdot> \<delta> \<circ>\<^sub>s \<I> \<noteq> t' \<cdot> \<delta> \<circ>\<^sub>s \<I>))"
 
 fun simple\<^sub>s\<^sub>t\<^sub>p where
   "simple\<^sub>s\<^sub>t\<^sub>p (Receive t) = True"
 | "simple\<^sub>s\<^sub>t\<^sub>p (Send [Var v]) = True"
 | "simple\<^sub>s\<^sub>t\<^sub>p (Inequality X F) = (\<exists>\<I>. ineq_model \<I> X F)"
 | "simple\<^sub>s\<^sub>t\<^sub>p _ = False"
 
 text \<open>Simple constraints\<close>
 definition simple where "simple S \<equiv> list_all simple\<^sub>s\<^sub>t\<^sub>p S"
 
 text \<open>The intruder knowledge of a constraint\<close>
 fun ik\<^sub>s\<^sub>t::"('a,'b) strand \<Rightarrow> ('a,'b) terms" where
   "ik\<^sub>s\<^sub>t [] = {}"
 | "ik\<^sub>s\<^sub>t (Receive t#S) = set t \<union> (ik\<^sub>s\<^sub>t S)"
 | "ik\<^sub>s\<^sub>t (_#S) = ik\<^sub>s\<^sub>t S"
 
 text \<open>Strand well-formedness\<close>
 fun wf\<^sub>s\<^sub>t::"'b set \<Rightarrow> ('a,'b) strand \<Rightarrow> bool" where
   "wf\<^sub>s\<^sub>t V [] = True"
 | "wf\<^sub>s\<^sub>t V (Receive ts#S) = (fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> V \<and> wf\<^sub>s\<^sub>t V S)"
 | "wf\<^sub>s\<^sub>t V (Send ts#S) = wf\<^sub>s\<^sub>t (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)) S"
 | "wf\<^sub>s\<^sub>t V (Equality Assign s t#S) = (fv t \<subseteq> V \<and> wf\<^sub>s\<^sub>t (V \<union> fv s) S)"
 | "wf\<^sub>s\<^sub>t V (Equality Check s t#S) = wf\<^sub>s\<^sub>t V S"
 | "wf\<^sub>s\<^sub>t V (Inequality _ _#S) = wf\<^sub>s\<^sub>t V S"
 
 text \<open>Well-formedness of constraint states\<close>
 definition wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r::"('a,'b) strand \<Rightarrow> ('a,'b) subst \<Rightarrow> bool" where
   "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta> \<equiv> (wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> wf\<^sub>s\<^sub>t {} S \<and> subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t S = {} \<and>
                   range_vars \<theta> \<inter> bvars\<^sub>s\<^sub>t S = {} \<and> fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {})"
 
 declare trms\<^sub>s\<^sub>t_def[simp]
 declare fv\<^sub>s\<^sub>n\<^sub>d_def[simp]
 declare fv\<^sub>r\<^sub>c\<^sub>v_def[simp]
 declare fv\<^sub>e\<^sub>q_def[simp]
 declare fv_l\<^sub>e\<^sub>q_def[simp]
 declare fv_r\<^sub>e\<^sub>q_def[simp]
 declare fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q_def[simp]
 declare fv\<^sub>s\<^sub>t_def[simp]
 declare vars\<^sub>s\<^sub>t_def[simp]
 declare bvars\<^sub>s\<^sub>t_def[simp]
 declare wfrestrictedvars\<^sub>s\<^sub>t_def[simp]
 declare wfvarsoccs\<^sub>s\<^sub>t_def[simp]
 
 lemmas wf\<^sub>s\<^sub>t_induct = wf\<^sub>s\<^sub>t.induct[case_names Nil ConsRcv ConsSnd ConsEq ConsEq2 ConsIneq]
 lemmas ik\<^sub>s\<^sub>t_induct = ik\<^sub>s\<^sub>t.induct[case_names Nil ConsRcv ConsSnd ConsEq ConsIneq]
 lemmas assignment_rhs\<^sub>s\<^sub>t_induct = assignment_rhs\<^sub>s\<^sub>t.induct[case_names Nil ConsEq2 ConsSnd ConsRcv ConsEq ConsIneq]
   
 
 subsubsection \<open>Lexicographical measure on strands\<close>
 definition size\<^sub>s\<^sub>t::"('a,'b) strand \<Rightarrow> nat" where
   "size\<^sub>s\<^sub>t S \<equiv> size_list (\<lambda>x. Max (insert 0 (size ` trms\<^sub>s\<^sub>t\<^sub>p x))) S"
 
 definition measure\<^sub>s\<^sub>t::"((('a, 'b) strand \<times> ('a,'b) subst) \<times> ('a, 'b) strand \<times> ('a,'b) subst) set"
 where
   "measure\<^sub>s\<^sub>t \<equiv> measures [\<lambda>(S,\<theta>). card (fv\<^sub>s\<^sub>t S), \<lambda>(S,\<theta>). size\<^sub>s\<^sub>t S]"
 
 lemma measure\<^sub>s\<^sub>t_alt_def:
   "((s,x),(t,y)) \<in> measure\<^sub>s\<^sub>t =
       (card (fv\<^sub>s\<^sub>t s) < card (fv\<^sub>s\<^sub>t t) \<or> (card (fv\<^sub>s\<^sub>t s) = card (fv\<^sub>s\<^sub>t t) \<and> size\<^sub>s\<^sub>t s < size\<^sub>s\<^sub>t t))"
 by (simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)
 
 lemma measure\<^sub>s\<^sub>t_trans: "trans measure\<^sub>s\<^sub>t"
 by (simp add: trans_def measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)
 
 
 subsubsection \<open>Some lemmata\<close>
 lemma trms_list\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>t: "trms\<^sub>s\<^sub>t S = set (trms_list\<^sub>s\<^sub>t S)"
 unfolding trms\<^sub>s\<^sub>t_def trms_list\<^sub>s\<^sub>t_def
 proof (induction S)
   case (Cons x S) thus ?case by (cases x) auto
 qed simp
 
 lemma subst_apply_strand_step_def:
   "s \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta> = (case s of
     Send t \<Rightarrow> Send (t \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)
   | Receive t \<Rightarrow> Receive (t \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>)
   | Equality a t t' \<Rightarrow> Equality a (t \<cdot> \<theta>) (t' \<cdot> \<theta>)
   | Inequality X F \<Rightarrow> Inequality X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>))"
 by (cases s) simp_all
 
 lemma subst_apply_strand_nil[simp]: "[] \<cdot>\<^sub>s\<^sub>t \<delta> = []"
 unfolding subst_apply_strand_def by simp
 
 lemma finite_funs\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (funs\<^sub>s\<^sub>t\<^sub>p x)" by (cases x) auto
 lemma finite_funs\<^sub>s\<^sub>t[simp]: "finite (funs\<^sub>s\<^sub>t S)" unfolding funs\<^sub>s\<^sub>t_def by simp
 lemma finite_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[simp]: "finite (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s x)" by (induct x) auto
 lemma finite_trms\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (trms\<^sub>s\<^sub>t\<^sub>p x)" by (cases x) auto
 lemma finite_vars\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (vars\<^sub>s\<^sub>t\<^sub>p x)" by auto
 lemma finite_bvars\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (set (bvars\<^sub>s\<^sub>t\<^sub>p x))" by rule
 lemma finite_fv\<^sub>s\<^sub>n\<^sub>d[simp]: "finite (fv\<^sub>s\<^sub>n\<^sub>d x)" by (cases x) auto
 lemma finite_fv\<^sub>r\<^sub>c\<^sub>v[simp]: "finite (fv\<^sub>r\<^sub>c\<^sub>v x)" by (cases x) auto
 lemma finite_fv\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (fv\<^sub>s\<^sub>t\<^sub>p x)" by (cases x) auto
 lemma finite_vars\<^sub>s\<^sub>t[simp]: "finite (vars\<^sub>s\<^sub>t S)" by simp
 lemma finite_bvars\<^sub>s\<^sub>t[simp]: "finite (bvars\<^sub>s\<^sub>t S)" by simp
 lemma finite_fv\<^sub>s\<^sub>t[simp]: "finite (fv\<^sub>s\<^sub>t S)" by simp
 
 lemma finite_wfrestrictedvars\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (wfrestrictedvars\<^sub>s\<^sub>t\<^sub>p x)"
 by (cases x) (auto split: poscheckvariant.splits)
 
 lemma finite_wfrestrictedvars\<^sub>s\<^sub>t[simp]: "finite (wfrestrictedvars\<^sub>s\<^sub>t S)"
 using finite_wfrestrictedvars\<^sub>s\<^sub>t\<^sub>p by auto
 
 lemma finite_wfvarsoccs\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (wfvarsoccs\<^sub>s\<^sub>t\<^sub>p x)"
 by (cases x) (auto split: poscheckvariant.splits)
 
 lemma finite_wfvarsoccs\<^sub>s\<^sub>t[simp]: "finite (wfvarsoccs\<^sub>s\<^sub>t S)"
 using finite_wfvarsoccs\<^sub>s\<^sub>t\<^sub>p by auto
 
 lemma finite_ik\<^sub>s\<^sub>t[simp]: "finite (ik\<^sub>s\<^sub>t S)"
 by (induct S rule: ik\<^sub>s\<^sub>t.induct) simp_all
 
 lemma finite_assignment_rhs\<^sub>s\<^sub>t[simp]: "finite (assignment_rhs\<^sub>s\<^sub>t S)"
 by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) simp_all
 
 lemma ik\<^sub>s\<^sub>t_is_rcv_set: "ik\<^sub>s\<^sub>t A = {t | ts t. Receive ts \<in> set A \<and> t \<in> set ts}"
 by (induct A rule: ik\<^sub>s\<^sub>t.induct) auto
 
 lemma ik\<^sub>s\<^sub>t_snoc_no_receive_eq:
   assumes "\<nexists>ts. a = receive\<langle>ts\<rangle>\<^sub>s\<^sub>t"
   shows "ik\<^sub>s\<^sub>t (A@[a]) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = ik\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
 using assms unfolding ik\<^sub>s\<^sub>t_is_rcv_set
 by (metis (no_types, lifting) Un_iff append_Nil2 set_ConsD set_append)
 
 lemma ik\<^sub>s\<^sub>tD[dest]: "t \<in> ik\<^sub>s\<^sub>t S \<Longrightarrow> \<exists>ts. t \<in> set ts \<and> Receive ts \<in> set S"
 by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto
 
 lemma ik\<^sub>s\<^sub>tD'[dest]: "t \<in> ik\<^sub>s\<^sub>t S \<Longrightarrow> t \<in> trms\<^sub>s\<^sub>t S"
 by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto
 
 lemma ik\<^sub>s\<^sub>tD''[dest]: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t S) \<Longrightarrow> t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)"
 by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto
 
 lemma ik\<^sub>s\<^sub>t_subterm_exD:
   assumes "t \<in> ik\<^sub>s\<^sub>t S"
   shows "\<exists>x \<in> set S. t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p x)"
 using assms ik\<^sub>s\<^sub>tD by force
 
 lemma assignment_rhs\<^sub>s\<^sub>tD[dest]: "t \<in> assignment_rhs\<^sub>s\<^sub>t S \<Longrightarrow> \<exists>t'. Equality Assign t' t \<in> set S"
 by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) auto
 
 lemma assignment_rhs\<^sub>s\<^sub>tD'[dest]: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (assignment_rhs\<^sub>s\<^sub>t S) \<Longrightarrow> t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)"
 by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) auto
 
 lemma bvars\<^sub>s\<^sub>t_split: "bvars\<^sub>s\<^sub>t (S@S') = bvars\<^sub>s\<^sub>t S \<union> bvars\<^sub>s\<^sub>t S'"
 unfolding bvars\<^sub>s\<^sub>t_def by auto
 
 lemma bvars\<^sub>s\<^sub>t_singleton: "bvars\<^sub>s\<^sub>t [x] = set (bvars\<^sub>s\<^sub>t\<^sub>p x)"
 unfolding bvars\<^sub>s\<^sub>t_def by auto
 
 lemma strand_fv_bvars_disjointD:
   assumes "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {}" "Inequality X F \<in> set S"
   shows "set X \<subseteq> bvars\<^sub>s\<^sub>t S" "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<subseteq> fv\<^sub>s\<^sub>t S"
 using assms by (induct S) fastforce+
 
 lemma strand_fv_bvars_disjoint_unfold:
   assumes "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {}" "Inequality X F \<in> set S" "Inequality Y G \<in> set S"
   shows "set Y \<inter> (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X) = {}"
 proof -
   have "set X \<subseteq> bvars\<^sub>s\<^sub>t S" "set Y \<subseteq> bvars\<^sub>s\<^sub>t S"
        "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<subseteq> fv\<^sub>s\<^sub>t S" "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G - set Y \<subseteq> fv\<^sub>s\<^sub>t S"
     using strand_fv_bvars_disjointD[OF assms(1)] assms(2,3) by auto
   thus ?thesis using assms(1) by fastforce
 qed
 
 lemma strand_subst_hom[iff]:
   "(S@S') \<cdot>\<^sub>s\<^sub>t \<theta> = (S \<cdot>\<^sub>s\<^sub>t \<theta>)@(S' \<cdot>\<^sub>s\<^sub>t \<theta>)" "(x#S) \<cdot>\<^sub>s\<^sub>t \<theta> = (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>)#(S \<cdot>\<^sub>s\<^sub>t \<theta>)"
 unfolding subst_apply_strand_def by auto
 
 lemma strand_subst_comp: "range_vars \<delta> \<inter> bvars\<^sub>s\<^sub>t S = {} \<Longrightarrow> S \<cdot>\<^sub>s\<^sub>t \<delta> \<circ>\<^sub>s \<theta> = ((S \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta>)"
 proof (induction S)
   case (Cons x S)
   have *: "range_vars \<delta> \<inter> bvars\<^sub>s\<^sub>t S = {}" "range_vars \<delta> \<inter> (set (bvars\<^sub>s\<^sub>t\<^sub>p x)) = {}"
     using Cons bvars\<^sub>s\<^sub>t_split[of "[x]" S] append_Cons inf_sup_absorb
     by (metis (no_types, lifting) Int_iff Un_commute disjoint_iff_not_equal self_append_conv2,
         metis append_self_conv2 bvars\<^sub>s\<^sub>t_singleton inf_bot_right inf_left_commute) 
   hence IH: "S \<cdot>\<^sub>s\<^sub>t \<delta> \<circ>\<^sub>s \<theta> = (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta>" using Cons.IH by auto
   have "(x#S \<cdot>\<^sub>s\<^sub>t \<delta> \<circ>\<^sub>s \<theta>) = (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta> \<circ>\<^sub>s \<theta>)#(S \<cdot>\<^sub>s\<^sub>t \<delta> \<circ>\<^sub>s \<theta>)" by (metis strand_subst_hom(2))
   hence "... = (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta> \<circ>\<^sub>s \<theta>)#((S \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta>)" by (metis IH)
   hence "... = ((x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>)#((S \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta>)" using rm_vars_comp[OF *(2)]
   proof (induction x)
     case (Inequality X F) thus ?case
       by (induct F) (auto simp add: subst_apply_pairs_def subst_apply_strand_step_def)
   qed (simp_all add: subst_apply_strand_step_def)
   thus ?case using IH by auto
 qed (simp add: subst_apply_strand_def)
 
 lemma strand_substI[intro]:
   "subst_domain \<theta> \<inter> fv\<^sub>s\<^sub>t S = {} \<Longrightarrow> S \<cdot>\<^sub>s\<^sub>t \<theta> = S"
   "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t S = {} \<Longrightarrow> S \<cdot>\<^sub>s\<^sub>t \<theta> = S"
 proof -
   show "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t S = {} \<Longrightarrow> S \<cdot>\<^sub>s\<^sub>t \<theta> = S"
   proof (induction S)
     case (Cons x S)
     hence "S \<cdot>\<^sub>s\<^sub>t \<theta> = S" by auto
     moreover have "vars\<^sub>s\<^sub>t\<^sub>p x \<inter> subst_domain \<theta> = {}" using Cons.prems by auto
     hence "x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta> = x"
     proof (induction x)
       case (Send ts) thus ?case by (induct ts) auto
     next
       case (Receive ts) thus ?case by (induct ts) auto
     next
       case (Inequality X F) thus ?case
         by (induct F) (force simp add: subst_apply_pairs_def)+
     qed auto
     ultimately show ?case by simp
   qed (simp add: subst_apply_strand_def)
 
   show "subst_domain \<theta> \<inter> fv\<^sub>s\<^sub>t S = {} \<Longrightarrow> S \<cdot>\<^sub>s\<^sub>t \<theta> = S"
   proof (induction S)
     case (Cons x S)
     hence "S \<cdot>\<^sub>s\<^sub>t \<theta> = S" by auto
     moreover have "fv\<^sub>s\<^sub>t\<^sub>p x \<inter> subst_domain \<theta> = {}"
       using Cons.prems by auto
     hence "x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta> = x"
     proof (induction x)
       case (Send ts) thus ?case by (induct ts) auto
     next
       case (Receive ts) thus ?case by (induct ts) auto
     next
       case (Inequality X F) thus ?case
         by (induct F) (force simp add: subst_apply_pairs_def)+
     qed auto
     ultimately show ?case by simp
   qed (simp add: subst_apply_strand_def)
 qed
 
 lemma strand_substI':
   "fv\<^sub>s\<^sub>t S = {} \<Longrightarrow> S \<cdot>\<^sub>s\<^sub>t \<theta> = S"
   "vars\<^sub>s\<^sub>t S = {} \<Longrightarrow> S \<cdot>\<^sub>s\<^sub>t \<theta> = S"
 by (metis inf_bot_right strand_substI(1),
     metis inf_bot_right strand_substI(2))
 
 lemma strand_subst_set: "(set (S \<cdot>\<^sub>s\<^sub>t \<theta>)) = ((\<lambda>x. x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>) ` (set S))"
 by (auto simp add: subst_apply_strand_def)
 
 lemma strand_map_inv_set_snd_rcv_subst:
   assumes "finite (M::('a,'b) terms)"
   shows "set ((map Send1 (inv set M)) \<cdot>\<^sub>s\<^sub>t \<theta>) = Send1 ` (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)" (is ?A)
         "set ((map Receive1 (inv set M)) \<cdot>\<^sub>s\<^sub>t \<theta>) = Receive1 ` (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)" (is ?B)
 proof -
   { fix f::"('a,'b) term \<Rightarrow> ('a,'b) strand_step"
     assume f: "f = Send1 \<or> f = Receive1"
     from assms have "set ((map f (inv set M)) \<cdot>\<^sub>s\<^sub>t \<theta>) = f ` (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
     proof (induction rule: finite_induct)
       case empty thus ?case unfolding inv_def by auto
     next
       case (insert m M)
       have "set (map f (inv set (insert m M)) \<cdot>\<^sub>s\<^sub>t \<theta>) =
             insert (f m \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>) (set (map f (inv set M) \<cdot>\<^sub>s\<^sub>t \<theta>))"
         by (simp add: insert.hyps(1) inv_set_fset subst_apply_strand_def)
       thus ?case using f insert.IH by auto
     qed
   }
   thus "?A" "?B" by auto
 qed
 
 lemma strand_ground_subst_vars_subset:
   assumes "ground (subst_range \<theta>)" shows "vars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<theta>) \<subseteq> vars\<^sub>s\<^sub>t S"
 proof (induction S)
   case (Cons x S)
   have "vars\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>) \<subseteq> vars\<^sub>s\<^sub>t\<^sub>p x" using ground_subst_fv_subset[OF assms] 
   proof (cases x)
     case (Inequality X F)
     let ?\<theta> = "rm_vars (set X) \<theta>"
     have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<theta>) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
     proof (induction F)
       case (Cons f F)
       obtain t t' where f: "f = (t,t')" by (metis surj_pair)
       hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (f#F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<theta>) = fv (t \<cdot> ?\<theta>) \<union> fv (t' \<cdot> ?\<theta>) \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<theta>)"
             "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (f#F) = fv t \<union> fv t' \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
         by (auto simp add: subst_apply_pairs_def)
       thus ?case
         using ground_subst_fv_subset[OF ground_subset[OF rm_vars_img_subset assms, of "set X"]]
               Cons.IH
         by (metis (no_types, lifting) Un_mono)
     qed (simp add: subst_apply_pairs_def)
     moreover have
         "vars\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>) = 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>) \<union> set X"
         "vars\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> set X"
       using Inequality
       by (auto simp add: subst_apply_pairs_def)
     ultimately show ?thesis by auto
   qed auto
   thus ?case using Cons.IH by auto
 qed (simp add: subst_apply_strand_def)
 
 lemma ik_union_subset: "\<Union>(P ` ik\<^sub>s\<^sub>t S) \<subseteq> (\<Union>x \<in> (set S). \<Union>(P ` trms\<^sub>s\<^sub>t\<^sub>p x))"
 by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto
 
 lemma ik_snd_empty[simp]: "ik\<^sub>s\<^sub>t (map Send X) = {}"
 by (induct "map Send X" arbitrary: X rule: ik\<^sub>s\<^sub>t.induct) auto
 
 lemma ik_snd_empty'[simp]: "ik\<^sub>s\<^sub>t [Send t] = {}" by simp
 
 lemma ik_append[iff]: "ik\<^sub>s\<^sub>t (S@S') = ik\<^sub>s\<^sub>t S \<union> ik\<^sub>s\<^sub>t S'" by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto
 
 lemma ik_cons: "ik\<^sub>s\<^sub>t (x#S) = ik\<^sub>s\<^sub>t [x] \<union> ik\<^sub>s\<^sub>t S" using ik_append[of "[x]" S] by simp
 
 lemma assignment_rhs_append[iff]: "assignment_rhs\<^sub>s\<^sub>t (S@S') = assignment_rhs\<^sub>s\<^sub>t S \<union> assignment_rhs\<^sub>s\<^sub>t S'"
 by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) auto
 
 lemma eqs_rcv_map_empty: "assignment_rhs\<^sub>s\<^sub>t (map Receive M) = {}"
 by auto
 
 lemma ik_rcv_map: assumes "ts \<in> set L" shows "set ts \<subseteq> ik\<^sub>s\<^sub>t (map Receive L)"
 proof -
   { fix L L' 
     have "set ts \<subseteq> ik\<^sub>s\<^sub>t [Receive ts]" by auto
     hence "set ts \<subseteq> ik\<^sub>s\<^sub>t (map Receive L@Receive ts#map Receive L')" using ik_append by auto
     hence "set ts \<subseteq> ik\<^sub>s\<^sub>t (map Receive (L@ts#L'))" by auto
   }
   thus ?thesis using assms split_list_last by force 
 qed
 
 lemma ik_subst: "ik\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) = ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
 by (induct rule: ik\<^sub>s\<^sub>t_induct) auto
 
 lemma ik_rcv_map': assumes "t \<in> ik\<^sub>s\<^sub>t (map Receive L)" shows "\<exists>ts \<in> set L. t \<in> set ts"
 using assms by force
 
 lemma ik_append_subset[simp]: "ik\<^sub>s\<^sub>t S \<subseteq> ik\<^sub>s\<^sub>t (S@S')" "ik\<^sub>s\<^sub>t S' \<subseteq> ik\<^sub>s\<^sub>t (S@S')"
 by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto
 
 lemma assignment_rhs_append_subset[simp]:
   "assignment_rhs\<^sub>s\<^sub>t S \<subseteq> assignment_rhs\<^sub>s\<^sub>t (S@S')"
   "assignment_rhs\<^sub>s\<^sub>t S' \<subseteq> assignment_rhs\<^sub>s\<^sub>t (S@S')"
 by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) auto
 
 lemma trms\<^sub>s\<^sub>t_cons: "trms\<^sub>s\<^sub>t (x#S) = trms\<^sub>s\<^sub>t\<^sub>p x \<union> trms\<^sub>s\<^sub>t S" by simp
 
 lemma trm_strand_subst_cong:
   "t \<in> trms\<^sub>s\<^sub>t S \<Longrightarrow> t \<cdot> \<delta> \<in> trms\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)
     \<or> (\<exists>X F. Inequality X F \<in> set S \<and> t \<cdot> rm_vars (set X) \<delta> \<in> trms\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>))"
     (is "t \<in> trms\<^sub>s\<^sub>t S \<Longrightarrow> ?P t \<delta> S")
   "t \<in> trms\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<Longrightarrow> (\<exists>t'. t = t' \<cdot> \<delta> \<and> t' \<in> trms\<^sub>s\<^sub>t S)
     \<or> (\<exists>X F. Inequality X F \<in> set S \<and> (\<exists>t' \<in> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. t = t' \<cdot> rm_vars (set X) \<delta>))"
     (is "t \<in> trms\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<Longrightarrow> ?Q t \<delta> S")
 proof -
   show "t \<in> trms\<^sub>s\<^sub>t S \<Longrightarrow> ?P t \<delta> S"
   proof (induction S)
     case (Cons x S) show ?case
     proof (cases "t \<in> trms\<^sub>s\<^sub>t S")
       case True
       hence "?P t \<delta> S" using Cons by simp
       thus ?thesis
         by (cases x)
            (metis (no_types, lifting) Un_iff list.set_intros(2) strand_subst_hom(2) trms\<^sub>s\<^sub>t_cons)+
     next
       case False
       hence "t \<in> trms\<^sub>s\<^sub>t\<^sub>p x" using Cons.prems by auto
       thus ?thesis
       proof (induction x)
         case (Inequality X F)
         hence "t \<cdot> rm_vars (set X) \<delta> \<in> trms\<^sub>s\<^sub>t\<^sub>p (Inequality X F \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>)"
           by (induct F) (auto simp add: subst_apply_pairs_def subst_apply_strand_step_def)
         thus ?case by fastforce
       qed (auto simp add: subst_apply_strand_step_def)
     qed
   qed simp
 
   show "t \<in> trms\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<Longrightarrow> ?Q t \<delta> S"
   proof (induction S)
     case (Cons x S) show ?case
     proof (cases "t \<in> trms\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)")
       case True
       hence "?Q t \<delta> S" using Cons by simp
       thus ?thesis by (cases x) force+
     next
       case False
       hence "t \<in> trms\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>)" using Cons.prems by auto
       thus ?thesis
       proof (induction x)
         case (Inequality X F)
         hence "t \<in> trms\<^sub>s\<^sub>t\<^sub>p (Inequality X F) \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \<delta>"
           by (induct F) (force simp add: subst_apply_pairs_def)+
         thus ?case by fastforce
       qed (auto simp add: subst_apply_strand_step_def)
     qed
   qed simp
 qed
 
 
 subsection \<open>Lemmata: Free Variables of Strands\<close>
 lemma fv_trm_snd_rcv[simp]:
   "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p (Send ts)) = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p (Receive ts)) = fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
 by simp_all
 
 lemma in_strand_fv_subset: "x \<in> set S \<Longrightarrow> vars\<^sub>s\<^sub>t\<^sub>p x \<subseteq> vars\<^sub>s\<^sub>t S"
 by fastforce
 
 lemma in_strand_fv_subset_snd: "Send ts \<in> set S \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> \<Union>(set (map fv\<^sub>s\<^sub>n\<^sub>d S))"
 by fastforce
 
 lemma in_strand_fv_subset_rcv: "Receive ts \<in> set S \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> \<Union>(set (map fv\<^sub>r\<^sub>c\<^sub>v S))"
 by fastforce
 
 lemma fv\<^sub>s\<^sub>n\<^sub>dE:
   assumes "v \<in> \<Union>(set (map fv\<^sub>s\<^sub>n\<^sub>d S))"
   obtains ts where "send\<langle>ts\<rangle>\<^sub>s\<^sub>t \<in> set S" "v \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
 proof -
   have "\<exists>ts. send\<langle>ts\<rangle>\<^sub>s\<^sub>t \<in> set S \<and> v \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
     by (metis (no_types, lifting) assms UN_E empty_iff set_map strand_step.case_eq_if
               fv\<^sub>s\<^sub>n\<^sub>d_def strand_step.collapse(1))
   thus ?thesis by (metis that)
 qed
 
 lemma fv\<^sub>r\<^sub>c\<^sub>vE:
   assumes "v \<in> \<Union>(set (map fv\<^sub>r\<^sub>c\<^sub>v S))"
   obtains ts where "receive\<langle>ts\<rangle>\<^sub>s\<^sub>t \<in> set S" "v \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
 proof -
   have "\<exists>ts. receive\<langle>ts\<rangle>\<^sub>s\<^sub>t \<in> set S \<and> v \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
     by (metis (no_types, lifting) assms UN_E empty_iff set_map strand_step.case_eq_if
               fv\<^sub>r\<^sub>c\<^sub>v_def strand_step.collapse(2))
   thus ?thesis by (metis that)
 qed
 
 lemma vars\<^sub>s\<^sub>t\<^sub>pI[intro]: "x \<in> fv\<^sub>s\<^sub>t\<^sub>p s \<Longrightarrow> x \<in> vars\<^sub>s\<^sub>t\<^sub>p s"
 by (induct s rule: fv\<^sub>s\<^sub>t\<^sub>p.induct) auto
 
 lemma vars\<^sub>s\<^sub>tI[intro]: "x \<in> fv\<^sub>s\<^sub>t S \<Longrightarrow> x \<in> vars\<^sub>s\<^sub>t S" using vars\<^sub>s\<^sub>t\<^sub>pI by fastforce
 
 lemma fv\<^sub>s\<^sub>t_subset_vars\<^sub>s\<^sub>t[simp]: "fv\<^sub>s\<^sub>t S \<subseteq> vars\<^sub>s\<^sub>t S" using vars\<^sub>s\<^sub>tI by force
 
 lemma vars\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>t: "vars\<^sub>s\<^sub>t S = fv\<^sub>s\<^sub>t S \<union> bvars\<^sub>s\<^sub>t S"
 proof (induction S)
   case (Cons x S) thus ?case
   proof (induction x)
     case (Inequality X F) thus ?case by (induct F) auto
   qed auto
 qed simp
 
 lemma fv\<^sub>s\<^sub>t\<^sub>p_is_subterm_trms\<^sub>s\<^sub>t\<^sub>p: "x \<in> fv\<^sub>s\<^sub>t\<^sub>p a \<Longrightarrow> Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p a)" 
 using var_is_subterm by (cases a) force+
 
 lemma fv\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>t: "x \<in> fv\<^sub>s\<^sub>t A \<Longrightarrow> Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t A)"
 proof (induction A)
   case (Cons a A) thus ?case using fv\<^sub>s\<^sub>t\<^sub>p_is_subterm_trms\<^sub>s\<^sub>t\<^sub>p by (cases "x \<in> fv\<^sub>s\<^sub>t A") auto
 qed simp
 
 lemma vars_st_snd_map: "vars\<^sub>s\<^sub>t (map Send tss) = fv\<^sub>s\<^sub>e\<^sub>t (Fun f ` set tss)" by auto
 
 lemma vars_st_rcv_map: "vars\<^sub>s\<^sub>t (map Receive tss) = fv\<^sub>s\<^sub>e\<^sub>t (Fun f ` set tss)" by auto
 
 lemma vars_snd_rcv_union:
   "vars\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>n\<^sub>d x \<union> fv\<^sub>r\<^sub>c\<^sub>v x \<union> fv\<^sub>e\<^sub>q assign x \<union> fv\<^sub>e\<^sub>q check x \<union> fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x \<union> set (bvars\<^sub>s\<^sub>t\<^sub>p x)"
 proof (cases x)
   case (Equality ac t t') thus ?thesis by (cases ac) auto
 qed auto
 
 lemma fv_snd_rcv_union:
   "fv\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>n\<^sub>d x \<union> fv\<^sub>r\<^sub>c\<^sub>v x \<union> fv\<^sub>e\<^sub>q assign x \<union> fv\<^sub>e\<^sub>q check x \<union> fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x"
 proof (cases x)
   case (Equality ac t t') thus ?thesis by (cases ac) auto
 qed auto
 
 lemma fv_snd_rcv_empty[simp]: "fv\<^sub>s\<^sub>n\<^sub>d x = {} \<or> fv\<^sub>r\<^sub>c\<^sub>v x = {}" by (cases x) simp_all
 
 lemma vars_snd_rcv_strand[iff]:
   "vars\<^sub>s\<^sub>t (S::('a,'b) strand) =
     (\<Union>(set (map fv\<^sub>s\<^sub>n\<^sub>d S))) \<union> (\<Union>(set (map fv\<^sub>r\<^sub>c\<^sub>v S))) \<union> (\<Union>(set (map (fv\<^sub>e\<^sub>q assign) S)))
     \<union> (\<Union>(set (map (fv\<^sub>e\<^sub>q check) S))) \<union> (\<Union>(set (map fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q S))) \<union> bvars\<^sub>s\<^sub>t S"
 unfolding bvars\<^sub>s\<^sub>t_def
 proof (induction S)
   case (Cons x S)
   have "\<And>s V. vars\<^sub>s\<^sub>t\<^sub>p (s::('a,'b) strand_step) \<union> V = 
                 fv\<^sub>s\<^sub>n\<^sub>d s \<union> fv\<^sub>r\<^sub>c\<^sub>v s \<union> fv\<^sub>e\<^sub>q assign s \<union> fv\<^sub>e\<^sub>q check s \<union> fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q s \<union> set (bvars\<^sub>s\<^sub>t\<^sub>p s) \<union> V"
     by (metis vars_snd_rcv_union)
   thus ?case using Cons.IH by (auto simp add: sup_assoc sup_left_commute)
 qed simp
 
 lemma fv_snd_rcv_strand[iff]:
   "fv\<^sub>s\<^sub>t (S::('a,'b) strand) =
     (\<Union>(set (map fv\<^sub>s\<^sub>n\<^sub>d S))) \<union> (\<Union>(set (map fv\<^sub>r\<^sub>c\<^sub>v S))) \<union> (\<Union>(set (map (fv\<^sub>e\<^sub>q assign) S)))
     \<union> (\<Union>(set (map (fv\<^sub>e\<^sub>q check) S))) \<union> (\<Union>(set (map fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q S)))"
 unfolding bvars\<^sub>s\<^sub>t_def
 proof (induction S)
   case (Cons x S)
   have "\<And>s V. fv\<^sub>s\<^sub>t\<^sub>p (s::('a,'b) strand_step) \<union> V = 
                 fv\<^sub>s\<^sub>n\<^sub>d s \<union> fv\<^sub>r\<^sub>c\<^sub>v s \<union> fv\<^sub>e\<^sub>q assign s \<union> fv\<^sub>e\<^sub>q check s \<union> fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q s \<union> V"
     by (metis fv_snd_rcv_union)
   thus ?case using Cons.IH by (auto simp add: sup_assoc sup_left_commute)
 qed simp
 
 lemma vars_snd_rcv_strand2[iff]:
   "wfrestrictedvars\<^sub>s\<^sub>t (S::('a,'b) strand) =
     (\<Union>(set (map fv\<^sub>s\<^sub>n\<^sub>d S))) \<union> (\<Union>(set (map fv\<^sub>r\<^sub>c\<^sub>v S))) \<union> (\<Union>(set (map (fv\<^sub>e\<^sub>q assign) S)))"
 by (induct S) (auto simp add: split: strand_step.split poscheckvariant.split)
 
 lemma fv_snd_rcv_strand_subset[simp]:
   "\<Union>(set (map fv\<^sub>s\<^sub>n\<^sub>d S)) \<subseteq> fv\<^sub>s\<^sub>t S" "\<Union>(set (map fv\<^sub>r\<^sub>c\<^sub>v S)) \<subseteq> fv\<^sub>s\<^sub>t S"
   "\<Union>(set (map (fv\<^sub>e\<^sub>q ac) S)) \<subseteq> fv\<^sub>s\<^sub>t S" "\<Union>(set (map fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q S)) \<subseteq> fv\<^sub>s\<^sub>t S"
   "wfvarsoccs\<^sub>s\<^sub>t S \<subseteq> fv\<^sub>s\<^sub>t S"
 proof -
   show "\<Union>(set (map fv\<^sub>s\<^sub>n\<^sub>d S)) \<subseteq> fv\<^sub>s\<^sub>t S" "\<Union>(set (map fv\<^sub>r\<^sub>c\<^sub>v S)) \<subseteq> fv\<^sub>s\<^sub>t S" "\<Union>(set (map fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q S)) \<subseteq> fv\<^sub>s\<^sub>t S"
     using fv_snd_rcv_strand[of S] by auto
   
   show "\<Union>(set (map (fv\<^sub>e\<^sub>q ac) S)) \<subseteq> fv\<^sub>s\<^sub>t S"
     by (induct S) (auto split: strand_step.split poscheckvariant.split)
 
   show "wfvarsoccs\<^sub>s\<^sub>t S \<subseteq> fv\<^sub>s\<^sub>t S"
     by (induct S) (auto split: strand_step.split poscheckvariant.split)
 qed
 
 lemma vars_snd_rcv_strand_subset2[simp]:
   "\<Union>(set (map fv\<^sub>s\<^sub>n\<^sub>d S)) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S" "\<Union>(set (map fv\<^sub>r\<^sub>c\<^sub>v S)) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S"
   "\<Union>(set (map (fv\<^sub>e\<^sub>q assign) S)) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S" "wfvarsoccs\<^sub>s\<^sub>t S \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S"
 by (induction S) (auto split: strand_step.split poscheckvariant.split)
 
 lemma wfrestrictedvars\<^sub>s\<^sub>t_subset_vars\<^sub>s\<^sub>t: "wfrestrictedvars\<^sub>s\<^sub>t S \<subseteq> vars\<^sub>s\<^sub>t S"
 by (induction S) (auto split: strand_step.split poscheckvariant.split)
 
 lemma subst_sends_strand_step_fv_to_img: "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) \<subseteq> fv\<^sub>s\<^sub>t\<^sub>p x \<union> range_vars \<delta>" 
 using subst_sends_fv_to_img[of _ \<delta>]
 proof (cases x)
   case (Inequality X F)
   let ?\<theta> = "rm_vars (set X) \<delta>"
   have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<theta>) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> range_vars ?\<theta>"
   proof (induction F)
     case (Cons f F) thus ?case
       using subst_sends_fv_to_img[of _ ?\<theta>]
       by (auto simp add: subst_apply_pairs_def)
   qed (auto simp add: subst_apply_pairs_def)
   hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<theta>) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> range_vars \<delta>"
     using rm_vars_img_subset[of "set X" \<delta>] fv_set_mono
     unfolding range_vars_alt_def by blast+
   thus ?thesis using Inequality by (auto simp add: subst_apply_strand_step_def)
 qed (auto simp add: subst_apply_strand_step_def)
 
 lemma subst_sends_strand_fv_to_img: "fv\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t S \<union> range_vars \<delta>" 
 proof (induction S)
   case (Cons x S)
   have *: "fv\<^sub>s\<^sub>t (x#S \<cdot>\<^sub>s\<^sub>t \<delta>) = fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) \<union> fv\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
           "fv\<^sub>s\<^sub>t (x#S) \<union> range_vars \<delta> = fv\<^sub>s\<^sub>t\<^sub>p x \<union> fv\<^sub>s\<^sub>t S \<union> range_vars \<delta>"
     by auto
   thus ?case using Cons.IH subst_sends_strand_step_fv_to_img[of x \<delta>] by auto
 qed simp
 
 lemma ineq_apply_subst:
   assumes "subst_domain \<delta> \<inter> set X = {}"
   shows "(Inequality X F) \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta> = Inequality X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
 using rm_vars_apply'[OF assms] by (simp add: subst_apply_strand_step_def)
 
 lemma fv_strand_step_subst:
   assumes "P = fv\<^sub>s\<^sub>t\<^sub>p \<or> P = fv\<^sub>r\<^sub>c\<^sub>v \<or> P = fv\<^sub>s\<^sub>n\<^sub>d \<or> P = fv\<^sub>e\<^sub>q ac \<or> P = fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q"
   and "set (bvars\<^sub>s\<^sub>t\<^sub>p x) \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (P x)) = P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>)"
 proof (cases x)
   case (Send ts)
   hence "vars\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "fv\<^sub>s\<^sub>n\<^sub>d x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" by auto
   thus ?thesis using assms Send subst_apply_fv_unfold[of _ \<delta>] by fastforce
 next
   case (Receive ts)
   hence "vars\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "fv\<^sub>r\<^sub>c\<^sub>v x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" by auto
   thus ?thesis using assms Receive subst_apply_fv_unfold[of _ \<delta>] by fastforce
 next
   case (Equality ac' t t') show ?thesis
   proof (cases "ac = ac'")
     case True
     hence "vars\<^sub>s\<^sub>t\<^sub>p x = fv t \<union> fv t'" "fv\<^sub>e\<^sub>q ac x = fv t \<union> fv t'"
       using Equality
       by auto
     thus ?thesis
       using assms Equality subst_apply_fv_unfold[of _ \<delta>] True
       by auto
   next
     case False
     hence "vars\<^sub>s\<^sub>t\<^sub>p x = fv t \<union> fv t'" "fv\<^sub>e\<^sub>q ac x = {}"
       using Equality
       by auto
     thus ?thesis
       using assms Equality subst_apply_fv_unfold[of _ \<delta>] False
       by auto
   qed
 next
   case (Inequality X F)
   hence 1: "set X \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
            "x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta> = Inequality X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
            "rm_vars (set X) \<delta> = \<delta>"
     using assms ineq_apply_subst[of \<delta> X F] rm_vars_apply'[of \<delta> "set X"]
     unfolding range_vars_alt_def by force+
 
   have 2: "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" using Inequality by auto
   hence "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X"
     using fv\<^sub>s\<^sub>e\<^sub>t_subst_img_eq[OF 1(1), of "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"] by simp
   hence 3: "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) - set X" by (metis fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_step_subst)
   
   have 4: "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) - set X" using 1(2) by auto
 
   show ?thesis
     using assms(1) Inequality subst_apply_fv_unfold[of _ \<delta>] 1(2) 2 3 4
     unfolding fv\<^sub>e\<^sub>q_def fv\<^sub>r\<^sub>c\<^sub>v_def fv\<^sub>s\<^sub>n\<^sub>d_def
     by (metis (no_types) Sup_empty image_empty fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.simps fv\<^sub>s\<^sub>e\<^sub>t.simps
               fv\<^sub>s\<^sub>t\<^sub>p.simps(4) strand_step.simps(20))
 qed
 
 lemma fv_strand_subst:
   assumes "P = fv\<^sub>s\<^sub>t\<^sub>p \<or> P = fv\<^sub>r\<^sub>c\<^sub>v \<or> P = fv\<^sub>s\<^sub>n\<^sub>d \<or> P = fv\<^sub>e\<^sub>q ac \<or> P = fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q"
   and "bvars\<^sub>s\<^sub>t S \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (\<Union>(set (map P S)))) = \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>)))"
 using assms(2)
 proof (induction S)
   case (Cons x S)
   hence *: "bvars\<^sub>s\<^sub>t S \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
            "set (bvars\<^sub>s\<^sub>t\<^sub>p x) \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
     unfolding bvars\<^sub>s\<^sub>t_def by force+
   hence **: "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` P x) = P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>)" using fv_strand_step_subst[OF assms(1), of x \<delta>] by auto
   have "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (\<Union>(set (map P (x#S))))) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` P x) \<union> (\<Union>(set (map P ((S \<cdot>\<^sub>s\<^sub>t \<delta>)))))"
     using Cons unfolding range_vars_alt_def bvars\<^sub>s\<^sub>t_def by force
   hence "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (\<Union>(set (map P (x#S))))) = P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (\<Union>(set (map P S))))"
     using ** by simp
   thus ?case using Cons.IH[OF *(1)] unfolding bvars\<^sub>s\<^sub>t_def by simp
 qed simp
 
 lemma fv_strand_subst2:
   assumes "bvars\<^sub>s\<^sub>t S \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (wfrestrictedvars\<^sub>s\<^sub>t S)) = wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
 by (metis (no_types, lifting) assms fv\<^sub>s\<^sub>e\<^sub>t.simps vars_snd_rcv_strand2 fv_strand_subst UN_Un image_Un)
 
 lemma fv_strand_subst':
   assumes "bvars\<^sub>s\<^sub>t S \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (fv\<^sub>s\<^sub>t S)) = fv\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
 by (metis assms fv_strand_subst fv\<^sub>s\<^sub>t_def)
 
 lemma fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s:
   "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
 by auto
 
 lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_in_fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s: "x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<Longrightarrow> x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F)"
 using fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of F] by blast
 
 lemma trms\<^sub>s\<^sub>t_append: "trms\<^sub>s\<^sub>t (A@B) = trms\<^sub>s\<^sub>t A \<union> trms\<^sub>s\<^sub>t B"
 by auto
 
 lemma trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst: "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (a \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>) = trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s a \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 by (auto simp add: subst_apply_pairs_def)
 
 lemma trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fv_subst_subset:
   "t \<in> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<Longrightarrow> fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)"
 by (force simp add: subst_apply_pairs_def)
 
 lemma trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fv_subst_subset':
   fixes t::"('a,'b) term" and \<theta>::"('a,'b) subst"
   assumes "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F)"
   shows "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)"
 proof -
   { fix x assume "x \<in> fv t"
     hence "x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
       using fv_subset[OF assms] fv_subterms_set[of "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"] fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of F]
       by blast
     hence "fv (\<theta> x) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)" using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_fv_subset by fast
   } thus ?thesis by (meson fv_subst_obtain_var subset_iff) 
 qed
 
 lemma trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_funs_term_cases:
   assumes "t \<in> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)" "f \<in> funs_term t"
   shows "(\<exists>u \<in> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. f \<in> funs_term u) \<or> (\<exists>x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. f \<in> funs_term (\<theta> x))"
 using assms(1)
 proof (induction F)
   case (Cons g F)
   obtain s u where g: "g = (s,u)" by (metis surj_pair)
   show ?case
   proof (cases "t \<in> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)")
     case False
     thus ?thesis
       using assms(2) Cons.prems g funs_term_subst[of _ \<theta>]
       by (auto simp add: subst_apply_pairs_def)
   qed (use Cons.IH in fastforce)
 qed simp
 
 lemma trm\<^sub>s\<^sub>t\<^sub>p_subst: 
   assumes "subst_domain \<theta> \<inter> set (bvars\<^sub>s\<^sub>t\<^sub>p a) = {}"
   shows "trms\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>) = trms\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 proof -
   have "rm_vars (set (bvars\<^sub>s\<^sub>t\<^sub>p a)) \<theta> = \<theta>" using assms by force
   thus ?thesis
     using assms
     by (auto simp add: subst_apply_pairs_def subst_apply_strand_step_def
              split: strand_step.splits)
 qed
 
 lemma trms\<^sub>s\<^sub>t_subst:
   assumes "subst_domain \<theta> \<inter> bvars\<^sub>s\<^sub>t A = {}"
   shows "trms\<^sub>s\<^sub>t (A \<cdot>\<^sub>s\<^sub>t \<theta>) = trms\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using assms
 proof (induction A)
   case (Cons a A)
   have 1: "subst_domain \<theta> \<inter> bvars\<^sub>s\<^sub>t A = {}" "subst_domain \<theta> \<inter> set (bvars\<^sub>s\<^sub>t\<^sub>p a) = {}"
     using Cons.prems by auto
   hence IH: "trms\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = trms\<^sub>s\<^sub>t (A \<cdot>\<^sub>s\<^sub>t \<theta>)" using Cons.IH by simp
   
   have "trms\<^sub>s\<^sub>t (a#A) = trms\<^sub>s\<^sub>t\<^sub>p a \<union> trms\<^sub>s\<^sub>t A" by auto
   hence 2: "trms\<^sub>s\<^sub>t (a#A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = (trms\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> (trms\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)" by (metis image_Un)
 
   have "trms\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>s\<^sub>t \<theta>) = (trms\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>)) \<union> trms\<^sub>s\<^sub>t (A \<cdot>\<^sub>s\<^sub>t \<theta>)"
     by (auto simp add: subst_apply_strand_def)
   hence 3: "trms\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>s\<^sub>t \<theta>) = (trms\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> trms\<^sub>s\<^sub>t (A \<cdot>\<^sub>s\<^sub>t \<theta>)"
     using trm\<^sub>s\<^sub>t\<^sub>p_subst[OF 1(2)] by auto
   
   show ?case using IH 2 3 by metis
 qed (simp add: subst_apply_strand_def)
 
 lemma strand_map_set_subst:
   assumes \<delta>: "bvars\<^sub>s\<^sub>t S \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "\<Union>(set (map trms\<^sub>s\<^sub>t\<^sub>p (S \<cdot>\<^sub>s\<^sub>t \<delta>))) = (\<Union>(set (map trms\<^sub>s\<^sub>t\<^sub>p S))) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
 using assms
 proof (induction S)
   case (Cons x S)
   hence "bvars\<^sub>s\<^sub>t [x] \<inter> subst_domain \<delta> = {}" "bvars\<^sub>s\<^sub>t S \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
     unfolding bvars\<^sub>s\<^sub>t_def by force+
   hence *: "subst_domain \<delta> \<inter> set (bvars\<^sub>s\<^sub>t\<^sub>p x) = {}"
            "\<Union>(set (map trms\<^sub>s\<^sub>t\<^sub>p (S \<cdot>\<^sub>s\<^sub>t \<delta>))) = \<Union>(set (map trms\<^sub>s\<^sub>t\<^sub>p S)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
     using Cons.IH(1) bvars\<^sub>s\<^sub>t_singleton[of x] by auto
   hence "trms\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = (trms\<^sub>s\<^sub>t\<^sub>p x) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
   proof (cases x)
     case (Inequality X F)
     thus ?thesis
       using rm_vars_apply'[of \<delta> "set X"] * 
       by (metis (no_types, lifting) image_cong trm\<^sub>s\<^sub>t\<^sub>p_subst)
   qed simp_all
   thus ?case using * subst_all_insert by auto
 qed simp
 
 lemma subst_apply_fv_subset_strand_trm:
   assumes P: "P = fv\<^sub>s\<^sub>t\<^sub>p \<or> P = fv\<^sub>r\<^sub>c\<^sub>v \<or> P = fv\<^sub>s\<^sub>n\<^sub>d \<or> P = fv\<^sub>e\<^sub>q ac \<or> P = fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q"
   and fv_sub: "fv t \<subseteq> \<Union>(set (map P S)) \<union> V"
   and \<delta>: "bvars\<^sub>s\<^sub>t S \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "fv (t \<cdot> \<delta>) \<subseteq> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
 using fv_strand_subst[OF P \<delta>] subst_apply_fv_subset[OF fv_sub, of \<delta>] by force
 
 lemma subst_apply_fv_subset_strand_trm2:
   assumes fv_sub: "fv t \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V"
   and \<delta>: "bvars\<^sub>s\<^sub>t S \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "fv (t \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
 using fv_strand_subst2[OF \<delta>] subst_apply_fv_subset[OF fv_sub, of \<delta>] by force
 
 lemma subst_apply_fv_subset_strand:
   assumes P: "P = fv\<^sub>s\<^sub>t\<^sub>p \<or> P = fv\<^sub>r\<^sub>c\<^sub>v \<or> P = fv\<^sub>s\<^sub>n\<^sub>d \<or> P = fv\<^sub>e\<^sub>q ac \<or> P = fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q"
   and P_subset: "P x \<subseteq> \<Union>(set (map P S)) \<union> V"
   and \<delta>: "bvars\<^sub>s\<^sub>t S \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
          "set (bvars\<^sub>s\<^sub>t\<^sub>p x) \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) \<subseteq> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
 proof (cases x)
   case (Send ts)
   hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
            "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>s\<^sub>n\<^sub>d x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "fv\<^sub>s\<^sub>n\<^sub>d (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
            "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
     by auto
   hence **: "(P x = fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)) \<or>
              (P x = {} \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {})"
     by (metis P)
   moreover
   { assume "P x = {}" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" hence ?thesis by simp }
   moreover
   { assume "P x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
     hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> \<Union>(set (map P S)) \<union> V" using P_subset by auto
     hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<subseteq> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
       using subst_apply_fv_subset_strand_trm[OF P _ assms(3), of _ V] by fastforce
     hence ?thesis using \<open>P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)\<close> by force
   }
   ultimately show ?thesis by metis
 next
   case (Receive ts)
   hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
            "fv\<^sub>r\<^sub>c\<^sub>v x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "fv\<^sub>r\<^sub>c\<^sub>v (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
            "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
     by auto
   hence **: "(P x = fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)) \<or>
              (P x = {} \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {})"
     by (metis P)
   moreover
   { assume "P x = {}" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" hence ?thesis by simp }
   moreover
   { assume "P x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
     hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> \<Union>(set (map P S)) \<union> V" using P_subset by auto
     hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<subseteq> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
       using subst_apply_fv_subset_strand_trm[OF P _ assms(3), of _ V] by fastforce
     hence ?thesis using \<open>P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)\<close> by blast
   }
   ultimately show ?thesis by metis
 next
   case (Equality ac' t t') show ?thesis
   proof (cases "ac' = ac")
     case True
     hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv t \<union> fv t'" "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)"
              "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
              "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
              "fv\<^sub>e\<^sub>q ac x = fv t \<union> fv t'" "fv\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)"
              "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
       using Equality by auto
     hence **: "(P x = fv t \<union> fv t' \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>))
               \<or> (P x = {} \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {})"
       by (metis P)
     moreover
     { assume "P x = {}" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" hence ?thesis by simp }
     moreover
     { assume "P x = fv t \<union> fv t'" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)"
       hence "fv t \<subseteq> \<Union>(set (map P S)) \<union> V" "fv t' \<subseteq> \<Union>(set (map P S)) \<union> V" using P_subset by auto
       hence "fv (t \<cdot> \<delta>) \<subseteq> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
             "fv (t' \<cdot> \<delta>) \<subseteq> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
         using P subst_apply_fv_subset_strand_trm assms by metis+
       hence ?thesis using \<open>P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)\<close> by blast
     }
     ultimately show ?thesis by metis
   next
     case False
     hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv t \<union> fv t'" "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)"
              "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
              "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
              "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
              "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
       using Equality by auto
     hence **: "(P x = fv t \<union> fv t' \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>))
               \<or> (P x = {} \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {})"
       by (metis P)
     moreover
     { assume "P x = {}" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" hence ?thesis by simp }
     moreover
     { assume "P x = fv t \<union> fv t'" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)"
       hence "fv t \<subseteq> \<Union>(set (map P S)) \<union> V" "fv t' \<subseteq> \<Union>(set (map P S)) \<union> V" using P_subset by auto
       hence "fv (t \<cdot> \<delta>) \<subseteq> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
             "fv (t' \<cdot> \<delta>) \<subseteq> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
         using P subst_apply_fv_subset_strand_trm assms by metis+
       hence ?thesis using \<open>P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)\<close> by blast
     }
     ultimately show ?thesis by metis
   qed
 next
   case (Inequality X F)
   hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) - set X"
            "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X"
            "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) - set X"
     using \<delta>(2) ineq_apply_subst[of \<delta> X F] by force+
   hence **: "(P x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) - set X)
             \<or> (P x = {} \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {})"
     by (metis P)
   moreover
   { assume "P x = {}" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" hence ?thesis by simp }
   moreover
   { assume "P x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) - set X"
     hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<subseteq> \<Union>(set (map P S)) \<union> V"
       using P_subset by auto
     hence "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> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> set X))"
     proof (induction F)
       case (Cons f G)
       hence IH: "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> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> set X))"
         by (metis (no_types, lifting) Diff_subset_conv UN_insert le_sup_iff
                   list.simps(15) fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.simps)
       obtain t t' where f: "f = (t,t')" by (metis surj_pair)
       hence "fv t \<subseteq> \<Union>(set (map P S)) \<union> (V \<union> set X)" "fv t' \<subseteq> \<Union>(set (map P S)) \<union> (V \<union> set X)"
         using Cons.prems by auto
       hence "fv (t \<cdot> \<delta>) \<subseteq> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> set X))"
             "fv (t' \<cdot> \<delta>) \<subseteq> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> set X))"
         using subst_apply_fv_subset_strand_trm[OF P _ assms(3)]
         by blast+
       thus ?case using f IH by (auto simp add: subst_apply_pairs_def)
     qed (simp add: subst_apply_pairs_def)
     moreover have "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` set X) = set X" using assms(4) Inequality by force
     ultimately 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>) - set X \<subseteq> \<Union>(set (map P (S \<cdot>\<^sub>s\<^sub>t \<delta>))) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
       by auto
     hence ?thesis using \<open>P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) - set X\<close> by blast
   }
   ultimately show ?thesis by metis
 qed
 
 lemma subst_apply_fv_subset_strand2:
   assumes P: "P = fv\<^sub>s\<^sub>t\<^sub>p \<or> P = fv\<^sub>r\<^sub>c\<^sub>v \<or> P = fv\<^sub>s\<^sub>n\<^sub>d \<or> P = fv\<^sub>e\<^sub>q ac \<or> P = fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q \<or> P = fv_r\<^sub>e\<^sub>q ac"
   and P_subset: "P x \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V"
   and \<delta>: "bvars\<^sub>s\<^sub>t S \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
          "set (bvars\<^sub>s\<^sub>t\<^sub>p x) \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
 proof (cases x)
   case (Send ts)
   hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
            "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>s\<^sub>n\<^sub>d x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "fv\<^sub>s\<^sub>n\<^sub>d (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
            "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv_r\<^sub>e\<^sub>q ac x = {}" "fv_r\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
     by auto
   hence **: "(P x = fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)) \<or> (P x = {} \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {})" by (metis P)
   moreover
   { assume "P x = {}" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" hence ?thesis by simp }
   moreover
   { assume "P x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
     hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V" using P_subset by auto
     hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
       using subst_apply_fv_subset_strand_trm2[OF _ assms(3), of _ V] by fastforce
     hence ?thesis using \<open>P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)\<close> by blast
   }
   ultimately show ?thesis by metis
 next
   case (Receive ts)
   hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
            "fv\<^sub>r\<^sub>c\<^sub>v x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "fv\<^sub>r\<^sub>c\<^sub>v (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
            "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv_r\<^sub>e\<^sub>q ac x = {}" "fv_r\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
     by auto
   hence **: "(P x = fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)) \<or>
              (P x = {} \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {})"
     by (metis P)
   moreover
   { assume "P x = {}" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" hence ?thesis by simp }
   moreover
   { assume "P x = fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
     hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V" using P_subset by auto
     hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
       using subst_apply_fv_subset_strand_trm2[OF _ assms(3), of _ V] by fastforce
     hence ?thesis using \<open>P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)\<close> by blast
   }
   ultimately show ?thesis by metis
 next
   case (Equality ac' t t') show ?thesis
   proof (cases "ac' = ac")
     case True
     hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv t \<union> fv t'" "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)"
              "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
              "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
              "fv\<^sub>e\<^sub>q ac x = fv t \<union> fv t'" "fv\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)"
              "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
              "fv_r\<^sub>e\<^sub>q ac x = fv t'" "fv_r\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t' \<cdot> \<delta>)"
       using Equality by auto
     hence **: "(P x = fv t \<union> fv t' \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>))
               \<or> (P x = {} \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {})
               \<or> (P x = fv t' \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t' \<cdot> \<delta>))"
       by (metis P)
     moreover
     { assume "P x = {}" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" hence ?thesis by simp }
     moreover
     { assume "P x = fv t \<union> fv t'" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)"
       hence "fv t \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V" "fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V" using P_subset by auto
       hence "fv (t \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
             "fv (t' \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
         using P subst_apply_fv_subset_strand_trm2 assms by blast+
       hence ?thesis using \<open>P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)\<close> by blast
     }
     moreover
     { assume "P x = fv t'" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t' \<cdot> \<delta>)"
       hence "fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V" using P_subset by auto
       hence "fv (t' \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
         using P subst_apply_fv_subset_strand_trm2 assms by blast+
       hence ?thesis using \<open>P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t' \<cdot> \<delta>)\<close> by blast
     }
     ultimately show ?thesis by metis
   next
     case False
     hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv t \<union> fv t'" "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)"
              "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
              "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
              "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
              "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
              "fv_r\<^sub>e\<^sub>q ac x = {}" "fv_r\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
       using Equality by auto
     hence **: "(P x = fv t \<union> fv t' \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>))
               \<or> (P x = {} \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {})
               \<or> (P x = fv t' \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t' \<cdot> \<delta>))"
       by (metis P)
     moreover
     { assume "P x = {}" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" hence ?thesis by simp }
     moreover
     { assume "P x = fv t \<union> fv t'" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)"
       hence "fv t \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V" "fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V"
         using P_subset by auto
       hence "fv (t \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
             "fv (t' \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
         using P subst_apply_fv_subset_strand_trm2 assms by blast+
       hence ?thesis using \<open>P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>)\<close> by blast
     }
     moreover
     { assume "P x = fv t'" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t' \<cdot> \<delta>)"
       hence "fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V" using P_subset by auto
       hence "fv (t' \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
         using P subst_apply_fv_subset_strand_trm2 assms by blast+
       hence ?thesis using \<open>P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv (t' \<cdot> \<delta>)\<close> by blast
     }
     ultimately show ?thesis by metis
   qed
 next
   case (Inequality X F)
   hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) - set X"
            "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
            "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) - set X"
            "fv_r\<^sub>e\<^sub>q ac x = {}" "fv_r\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
     using \<delta>(2) ineq_apply_subst[of \<delta> X F] by force+
   hence **: "(P x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) - set X)
             \<or> (P x = {} \<and> P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {})"
     by (metis P)
   moreover
   { assume "P x = {}" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" hence ?thesis by simp }
   moreover
   { assume "P x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" "P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) - set X"
     hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V" using P_subset by auto
     hence "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> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> set X))"
     proof (induction F)
       case (Cons f G)
       hence IH: "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>wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> set X))"
         by (metis (no_types, lifting) Diff_subset_conv UN_insert le_sup_iff
                   list.simps(15) fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.simps)
       obtain t t' where f: "f = (t,t')" by (metis surj_pair)
       hence "fv t \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> (V \<union> set X)" "fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> (V \<union> set X)"
         using Cons.prems by auto
       hence "fv (t \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> set X))"
             "fv (t' \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> set X))"
         using subst_apply_fv_subset_strand_trm2[OF _ assms(3)] P
         by blast+
       thus ?case using f IH by (auto simp add: subst_apply_pairs_def)
     qed (simp add: subst_apply_pairs_def)
     moreover have "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` set X) = set X" using assms(4) Inequality by force
     ultimately 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>) - set X \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
       by fastforce
     hence ?thesis using \<open>P (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) - set X\<close> by blast
   }
   ultimately show ?thesis by metis
 qed
 
 lemma strand_subst_fv_bounded_if_img_bounded:
   assumes "range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t S"
   shows "fv\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t S"
 using subst_sends_strand_fv_to_img[of S \<delta>] assms by blast
 
 lemma strand_fv_subst_subset_if_subst_elim:
   assumes "subst_elim \<delta> v" and "v \<in> fv\<^sub>s\<^sub>t S \<or> bvars\<^sub>s\<^sub>t S \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "v \<notin> fv\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
 proof (cases "v \<in> fv\<^sub>s\<^sub>t S")
   case True thus ?thesis
   proof (induction S)
     case (Cons x S)
     have *: "v \<notin> fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>)"
     using assms(1)
     proof (cases x)
       case (Inequality X F)
       hence "subst_elim (rm_vars (set X) \<delta>) v \<or> v \<in> set X" using assms(1) by blast
       moreover have "fv\<^sub>s\<^sub>t\<^sub>p (Inequality X F \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = 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>) - set X"
         using Inequality by auto
       ultimately have "v \<notin> fv\<^sub>s\<^sub>t\<^sub>p (Inequality X F \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>)"
         by (induct F) (auto simp add: subst_elim_def subst_apply_pairs_def)
       thus ?thesis using Inequality by simp
     qed (simp_all add: subst_elim_def)
     moreover have "v \<notin> fv\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)" using Cons.IH
     proof (cases "v \<in> fv\<^sub>s\<^sub>t S")
       case False
       moreover have "v \<notin> range_vars \<delta>"
         by (simp add: subst_elimD''[OF assms(1)] range_vars_alt_def) 
       ultimately show ?thesis by (meson UnE subsetCE subst_sends_strand_fv_to_img)
     qed simp
     ultimately show ?case by auto
   qed simp
 next
   case False
   thus ?thesis
     using assms fv_strand_subst'
     unfolding subst_elim_def
-    by (metis (mono_tags, opaque_lifting) fv\<^sub>s\<^sub>e\<^sub>t.simps imageE mem_simps(8) subst_apply_term.simps(1))
+    by (metis (mono_tags, opaque_lifting) fv\<^sub>s\<^sub>e\<^sub>t.simps imageE mem_simps(8) eval_term.simps(1))
 qed
 
 lemma strand_fv_subst_subset_if_subst_elim':
   assumes "subst_elim \<delta> v" "v \<in> fv\<^sub>s\<^sub>t S" "range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t S"
   shows "fv\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<subset> fv\<^sub>s\<^sub>t S"
 using strand_fv_subst_subset_if_subst_elim[OF assms(1)] assms(2)
       strand_subst_fv_bounded_if_img_bounded[OF assms(3)]
 by blast
 
 lemma fv_ik_is_fv_rcv: "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t S) = \<Union>(set (map fv\<^sub>r\<^sub>c\<^sub>v S))"
 by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto
 
 lemma fv_ik_subset_fv_st[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t S) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S"
 by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto
 
 lemma fv_assignment_rhs_subset_fv_st[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (assignment_rhs\<^sub>s\<^sub>t S) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S"
 by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) force+
 
 lemma fv_ik_subset_fv_st'[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t S) \<subseteq> fv\<^sub>s\<^sub>t S"
 by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto
 
 lemma ik\<^sub>s\<^sub>t_var_is_fv: "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t A) \<Longrightarrow> x \<in> fv\<^sub>s\<^sub>t A"
 by (meson fv_ik_subset_fv_st'[of A] fv_subset_subterms subsetCE term.set_intros(3))
 
 lemma fv_assignment_rhs_subset_fv_st'[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (assignment_rhs\<^sub>s\<^sub>t S) \<subseteq> fv\<^sub>s\<^sub>t S"
 by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) auto
 
 lemma ik\<^sub>s\<^sub>t_assignment_rhs\<^sub>s\<^sub>t_wfrestrictedvars_subset:
   "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>s\<^sub>t A) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t A"
 using fv_ik_subset_fv_st[of A] fv_assignment_rhs_subset_fv_st[of A]
 by simp+
 
 lemma strand_step_id_subst[iff]: "x \<cdot>\<^sub>s\<^sub>t\<^sub>p Var = x" by (cases x) auto
 
 lemma strand_id_subst[iff]: "S \<cdot>\<^sub>s\<^sub>t Var = S" using strand_step_id_subst by (induct S) auto
 
 lemma strand_subst_vars_union_bound[simp]: "vars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> vars\<^sub>s\<^sub>t S \<union> range_vars \<delta>"
 proof (induction S)
   case (Cons x S)
   moreover have "vars\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) \<subseteq> vars\<^sub>s\<^sub>t\<^sub>p x \<union> range_vars \<delta>" using subst_sends_fv_to_img[of _ \<delta>]
   proof (cases x)
     case (Inequality X F)
     define \<delta>' where "\<delta>' \<equiv> rm_vars (set X) \<delta>"
     have 0: "range_vars \<delta>' \<subseteq> range_vars \<delta>"
       using rm_vars_img[of "set X" \<delta>]
       by (auto simp add: \<delta>'_def subst_domain_def range_vars_alt_def)
 
     have "vars\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>') \<union> set X" "vars\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> set X"
       using Inequality by (auto simp add: \<delta>'_def)
     moreover 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> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> range_vars \<delta>"
     proof (induction F)
       case (Cons f G)
       obtain t t' where f: "f = (t,t')" by moura
       hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (f#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 (f#G) = fv t \<union> fv t' \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G"
         by (auto simp add: subst_apply_pairs_def)
       thus ?case
         using 0 Cons.IH subst_sends_fv_to_img[of t \<delta>'] subst_sends_fv_to_img[of t' \<delta>']
         unfolding f by auto
     qed (simp add: subst_apply_pairs_def)
     ultimately show ?thesis by auto
   qed auto
   ultimately show ?case by auto
 qed simp
 
 lemma strand_vars_split:
   "vars\<^sub>s\<^sub>t (S@S') = vars\<^sub>s\<^sub>t S \<union> vars\<^sub>s\<^sub>t S'"
   "wfrestrictedvars\<^sub>s\<^sub>t (S@S') = wfrestrictedvars\<^sub>s\<^sub>t S \<union> wfrestrictedvars\<^sub>s\<^sub>t S'"
   "fv\<^sub>s\<^sub>t (S@S') = fv\<^sub>s\<^sub>t S \<union> fv\<^sub>s\<^sub>t S'"
 by auto
 
 lemma bvars_subst_ident: "bvars\<^sub>s\<^sub>t S = bvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
 unfolding bvars\<^sub>s\<^sub>t_def
 by (induct S) (simp_all add: subst_apply_strand_step_def split: strand_step.splits)
 
 lemma strand_subst_subst_idem:
   assumes "subst_idem \<delta>" "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t S" "subst_domain \<theta> \<inter> fv\<^sub>s\<^sub>t S = {}"
           "range_vars \<delta> \<inter> bvars\<^sub>s\<^sub>t S = {}" "range_vars \<theta> \<inter> bvars\<^sub>s\<^sub>t S = {}"
   shows "(S \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta> = (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
   and   "(S \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<delta>) = (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
 proof -
   from assms(2,3) have "fv\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<inter> subst_domain \<theta> = {}"
     using subst_sends_strand_fv_to_img[of S \<delta>] by blast
   thus "(S \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta> = (S \<cdot>\<^sub>s\<^sub>t \<delta>)" by blast
   thus "(S \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<delta>) = (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
     by (metis assms(1,4,5) bvars_subst_ident strand_subst_comp subst_idem_def)
 qed
 
 lemma strand_subst_img_bound:
   assumes "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t S"
     and "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t S = {}"
   shows "range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
 proof -
   have "subst_domain \<delta> \<subseteq> \<Union>(set (map fv\<^sub>s\<^sub>t\<^sub>p S))" by (metis (no_types) fv\<^sub>s\<^sub>t_def Un_subset_iff assms(1))
   thus ?thesis
     unfolding range_vars_alt_def fv\<^sub>s\<^sub>t_def
     by (metis subst_range.simps fv_set_mono fv_strand_subst Int_commute assms(2) image_Un
               le_iff_sup)
 qed
 
 lemma strand_subst_img_bound':
   assumes "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> vars\<^sub>s\<^sub>t S"
     and "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t S = {}"
   shows "range_vars \<delta> \<subseteq> vars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
 proof -
   have "(subst_domain \<delta> \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` subst_domain \<delta>)) \<inter> vars\<^sub>s\<^sub>t S =
         subst_domain \<delta> \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` subst_domain \<delta>)"
     using assms(1) by (metis inf.absorb_iff1 range_vars_alt_def subst_range.simps)
   hence "range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
     using vars_snd_rcv_strand fv_snd_rcv_strand assms(2) strand_subst_img_bound
     unfolding range_vars_alt_def
     by (metis (no_types) inf_le2 inf_sup_distrib1 subst_range.simps sup_bot.right_neutral)
   thus "range_vars \<delta> \<subseteq> vars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
     by (metis fv_snd_rcv_strand le_supI1 vars_snd_rcv_strand)
 qed
 
 lemma strand_subst_all_fv_subset:
   assumes "fv t \<subseteq> fv\<^sub>s\<^sub>t S" "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t S = {}"
   shows "fv (t \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
 using assms by (metis fv_strand_subst' Int_commute subst_apply_fv_subset)
 
 lemma strand_subst_not_dom_fixed:
   assumes "v \<in> fv\<^sub>s\<^sub>t S" and "v \<notin> subst_domain \<delta>"
   shows "v \<in> fv\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
 using assms
 proof (induction S)
   case (Cons x S')
   have 1: "\<And>X. v \<notin> subst_domain (rm_vars (set X) \<delta>)"
     using Cons.prems(2) rm_vars_dom_subset by force
   
   show ?case
   proof (cases "v \<in> fv\<^sub>s\<^sub>t S'")
     case True thus ?thesis using Cons.IH[OF _ Cons.prems(2)] by auto
   next
     case False
     hence 2: "v \<in> fv\<^sub>s\<^sub>t\<^sub>p x" using Cons.prems(1) by simp
     hence "v \<in> fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>)" using Cons.prems(2) subst_not_dom_fixed
     proof (cases x)
       case (Inequality X F)
       hence "v \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" using 2 by simp
       hence "v \<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>)"
         using subst_not_dom_fixed[OF _ 1]
         by (induct F) (auto simp add: subst_apply_pairs_def)
       thus ?thesis using Inequality 2 by auto
     qed (force simp add: subst_domain_def)+
     thus ?thesis by auto
   qed
 qed simp
 
 lemma strand_vars_unfold: "v \<in> vars\<^sub>s\<^sub>t S \<Longrightarrow> \<exists>S' x S''. S = S'@x#S'' \<and> v \<in> vars\<^sub>s\<^sub>t\<^sub>p x"
 proof (induction S)
   case (Cons x S) thus ?case
   proof (cases "v \<in> vars\<^sub>s\<^sub>t\<^sub>p x")
     case True thus ?thesis by blast
   next
     case False
     hence "v \<in> vars\<^sub>s\<^sub>t S" using Cons.prems by auto
     thus ?thesis using Cons.IH by (metis append_Cons)
   qed
 qed simp
 
 lemma strand_fv_unfold: "v \<in> fv\<^sub>s\<^sub>t S \<Longrightarrow> \<exists>S' x S''. S = S'@x#S'' \<and> v \<in> fv\<^sub>s\<^sub>t\<^sub>p x"
 proof (induction S)
   case (Cons x S) thus ?case
   proof (cases "v \<in> fv\<^sub>s\<^sub>t\<^sub>p x")
     case True thus ?thesis by blast
   next
     case False
     hence "v \<in> fv\<^sub>s\<^sub>t S" using Cons.prems by auto
     thus ?thesis using Cons.IH by (metis append_Cons)
   qed
 qed simp
 
 lemma subterm_if_in_strand_ik:
   "t \<in> ik\<^sub>s\<^sub>t S \<Longrightarrow> \<exists>ts. Receive ts \<in> set S \<and> t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts"
 by (induct S rule: ik\<^sub>s\<^sub>t_induct) auto
 
 lemma fv_subset_if_in_strand_ik:
   "t \<in> ik\<^sub>s\<^sub>t S \<Longrightarrow> fv t \<subseteq> \<Union>(set (map fv\<^sub>r\<^sub>c\<^sub>v S))"
 proof -
   assume "t \<in> ik\<^sub>s\<^sub>t S"
   then obtain ts where "Receive ts \<in> set S" "t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts" by (metis subterm_if_in_strand_ik)
   hence "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (set ts)" using subtermeq_vars_subset by auto
   thus ?thesis using in_strand_fv_subset_rcv[OF \<open>Receive ts \<in> set S\<close>] by auto
 qed
 
 lemma fv_subset_if_in_strand_ik':
   "t \<in> ik\<^sub>s\<^sub>t S \<Longrightarrow> fv t \<subseteq> fv\<^sub>s\<^sub>t S"
 using fv_subset_if_in_strand_ik[of t S] fv_snd_rcv_strand_subset(2)[of S] by blast
 
 lemma vars_subset_if_in_strand_ik2:
   "t \<in> ik\<^sub>s\<^sub>t S \<Longrightarrow> fv t \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S"
 using fv_subset_if_in_strand_ik[of t S] vars_snd_rcv_strand_subset2(2)[of S] by blast
 
 
 subsection \<open>Lemmata: Simple Strands\<close>
 lemma simple_Cons[dest]: "simple (s#S) \<Longrightarrow> simple S"
 unfolding simple_def by auto
 
 lemma simple_split[dest]:
   assumes "simple (S@S')"
   shows "simple S" "simple S'"
 using assms unfolding simple_def by auto
 
 lemma simple_append[intro]: "\<lbrakk>simple S; simple S'\<rbrakk> \<Longrightarrow> simple (S@S')"
 unfolding simple_def by auto
 
 lemma simple_append_sym[sym]: "simple (S@S') \<Longrightarrow> simple (S'@S)" by auto
 
 lemma not_simple_if_snd_fun: "Fun f T \<in> set ts \<Longrightarrow> S = S'@Send ts#S'' \<Longrightarrow> \<not>simple S"
 by (metis simple_def list.set_cases list_all_append list_all_simps(1) simple\<^sub>s\<^sub>t\<^sub>p.simps(5,6))
 
 lemma not_list_all_elim: "\<not>list_all P A \<Longrightarrow> \<exists>B x C. A = B@x#C \<and> \<not>P x \<and> list_all P B"
 proof (induction A rule: List.rev_induct)
   case (snoc a A)
   show ?case
   proof (cases "list_all P A")
     case True
     thus ?thesis using snoc.prems by auto
   next
     case False
     then obtain B x C where "A = B@x#C" "\<not>P x" "list_all P B" using snoc.IH[OF False] by auto
     thus ?thesis by auto
   qed
 qed simp
 
 lemma not_simple\<^sub>s\<^sub>t\<^sub>p_elim:
   assumes "\<not>simple\<^sub>s\<^sub>t\<^sub>p x"
   shows "(\<exists>ts. x = Send ts \<and> (\<nexists>y. ts = [Var y])) \<or>
          (\<exists>a t t'. x = Equality a t t') \<or>
          (\<exists>X F. x = Inequality X F \<and> (\<nexists>\<I>. ineq_model \<I> X F))"
 using assms by (cases x) (fastforce elim: simple\<^sub>s\<^sub>t\<^sub>p.elims)+
 
 lemma not_simple_elim:
   assumes "\<not>simple S"
   shows "(\<exists>A B ts. S = A@Send ts#B \<and> (\<nexists>x. ts = [Var x]) \<and> simple A) \<or> 
          (\<exists>A B a t t'. S = A@Equality a t t'#B \<and> simple A) \<or>
          (\<exists>A B X F. S = A@Inequality X F#B \<and> (\<nexists>\<I>. ineq_model \<I> X F) \<and> simple A)"
 by (metis assms not_list_all_elim not_simple\<^sub>s\<^sub>t\<^sub>p_elim simple_def)
 
 lemma simple_snd_is_var: "\<lbrakk>Send ts \<in> set S; simple S\<rbrakk> \<Longrightarrow> \<exists>v. ts = [Var v]"
 unfolding simple_def
 by (metis list_all_append list_all_simps(1) simple\<^sub>s\<^sub>t\<^sub>p.elims(2) split_list_first
           strand_step.distinct(1) strand_step.distinct(5) strand_step.inject(1)) 
 
 
 subsection \<open>Lemmata: Strand Measure\<close>
 lemma measure\<^sub>s\<^sub>t_wellfounded: "wf measure\<^sub>s\<^sub>t" unfolding measure\<^sub>s\<^sub>t_def by simp
 
 lemma strand_size_append[iff]: "size\<^sub>s\<^sub>t (S@S') = size\<^sub>s\<^sub>t S + size\<^sub>s\<^sub>t S'"
 by (induct S) (auto simp add: size\<^sub>s\<^sub>t_def)
 
 lemma strand_size_map_fun_lt[simp]:
   "size\<^sub>s\<^sub>t (map Send1 X) < size (Fun f X)"
   "size\<^sub>s\<^sub>t (map Send1 X) < size\<^sub>s\<^sub>t [Send [Fun f X]]"
   "size\<^sub>s\<^sub>t (map Receive1 X) < size\<^sub>s\<^sub>t [Receive [Fun f X]]"
   "size\<^sub>s\<^sub>t [Send X] < size\<^sub>s\<^sub>t [Send [Fun f X]]"
   "size\<^sub>s\<^sub>t [Receive X] < size\<^sub>s\<^sub>t [Receive [Fun f X]]"
 by (induct X) (auto simp add: size\<^sub>s\<^sub>t_def)
 
 lemma strand_size_rm_fun_lt[simp]:
   "size\<^sub>s\<^sub>t (S@S') < size\<^sub>s\<^sub>t (S@Send ts#S')"
   "size\<^sub>s\<^sub>t (S@S') < size\<^sub>s\<^sub>t (S@Receive ts#S')"
 by (induct S) (auto simp add: size\<^sub>s\<^sub>t_def)
 
 lemma strand_fv_card_map_fun_eq:
   "card (fv\<^sub>s\<^sub>t (S@Send [Fun f X]#S')) = card (fv\<^sub>s\<^sub>t (S@(map Send1 X)@S'))"
 proof -
   have "fv\<^sub>s\<^sub>t (S@Send [Fun f X]#S') = fv\<^sub>s\<^sub>t (S@(map Send1 X)@S')" by auto
   thus ?thesis by simp
 qed
 
 lemma strand_fv_card_rm_fun_le[simp]: "card (fv\<^sub>s\<^sub>t (S@S')) \<le> card (fv\<^sub>s\<^sub>t (S@Send [Fun f X]#S'))"
 by (force intro: card_mono)
 
 lemma strand_fv_card_rm_eq_le[simp]: "card (fv\<^sub>s\<^sub>t (S@S')) \<le> card (fv\<^sub>s\<^sub>t (S@Equality a t t'#S'))"
 by (force intro: card_mono)
 
 
 subsection \<open>Lemmata: Well-formed Strands\<close>
 lemma wf_prefix[dest]: "wf\<^sub>s\<^sub>t V (S@S') \<Longrightarrow> wf\<^sub>s\<^sub>t V S"
 by (induct S rule: wf\<^sub>s\<^sub>t.induct) auto
 
 lemma wf_vars_mono[simp]: "wf\<^sub>s\<^sub>t V S \<Longrightarrow> wf\<^sub>s\<^sub>t (V \<union> W) S"
 proof (induction S arbitrary: V)
   case (Cons x S) thus ?case
   proof (cases x)
     case (Send ts)
     hence "wf\<^sub>s\<^sub>t (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<union> W) S" using Cons.prems(1) Cons.IH by simp
     thus ?thesis by (metis Send sup_assoc sup_commute wf\<^sub>s\<^sub>t.simps(3))
   next
     case (Equality a t t')
     show ?thesis
     proof (cases a)
       case Assign
       hence "wf\<^sub>s\<^sub>t (V \<union> fv t \<union> W) S" "fv t' \<subseteq> V \<union> W" using Equality Cons.prems(1) Cons.IH by auto
       thus ?thesis using Equality Assign by (simp add: sup_commute sup_left_commute)
     next
       case Check thus ?thesis using Equality Cons by auto
     qed
   qed auto
 qed simp
 
 lemma wf\<^sub>s\<^sub>tI[intro]: "wfrestrictedvars\<^sub>s\<^sub>t S \<subseteq> V \<Longrightarrow> wf\<^sub>s\<^sub>t V S"
 proof (induction S)
   case (Cons x S) thus ?case
   proof (cases x)
     case (Send ts)
     hence "wf\<^sub>s\<^sub>t V S" "V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts) = V" using Cons by auto
     thus ?thesis using Send by simp
   next
     case (Equality a t t')
     show ?thesis
     proof (cases a)
       case Assign
       hence "wf\<^sub>s\<^sub>t V S" "fv t' \<subseteq> V" using Equality Cons by auto
       thus ?thesis using wf_vars_mono Equality Assign by simp
     next
       case Check thus ?thesis using Equality Cons by auto
     qed
   qed simp_all
 qed simp
 
 lemma wf\<^sub>s\<^sub>tI'[intro]: "\<Union>(fv\<^sub>r\<^sub>c\<^sub>v ` set S) \<union> \<Union>(fv_r\<^sub>e\<^sub>q assign ` set S) \<subseteq> V \<Longrightarrow> wf\<^sub>s\<^sub>t V S"
 proof (induction S)
   case (Cons x S) thus ?case
   proof (cases x)
     case (Equality a t t') thus ?thesis using Cons by (cases a) auto
   qed simp_all
 qed simp
 
 lemma wf_append_exec: "wf\<^sub>s\<^sub>t V (S@S') \<Longrightarrow> wf\<^sub>s\<^sub>t (V \<union> wfvarsoccs\<^sub>s\<^sub>t S) S'"
 proof (induction S arbitrary: V)
   case (Cons x S V) thus ?case
   proof (cases x)
     case (Send ts)
     hence "wf\<^sub>s\<^sub>t (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<union> wfvarsoccs\<^sub>s\<^sub>t S) S'" using Cons.prems Cons.IH by simp
     thus ?thesis using Send by (auto simp add: sup_assoc)
   next
     case (Equality a t t') show ?thesis
     proof (cases a)
       case Assign
       hence "wf\<^sub>s\<^sub>t (V \<union> fv t \<union> wfvarsoccs\<^sub>s\<^sub>t S) S'" using Equality Cons.prems Cons.IH by auto
       thus ?thesis using Equality Assign by (auto simp add: sup_assoc)
     next
       case Check
       hence "wf\<^sub>s\<^sub>t (V \<union> wfvarsoccs\<^sub>s\<^sub>t S) S'" using Equality Cons.prems Cons.IH by auto
       thus ?thesis using Equality Check by (auto simp add: sup_assoc)
     qed
   qed auto
 qed simp
 
 lemma wf_append_suffix:
   "wf\<^sub>s\<^sub>t V S \<Longrightarrow> wfrestrictedvars\<^sub>s\<^sub>t S' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@S')"
 proof (induction V S rule: wf\<^sub>s\<^sub>t_induct)
   case (ConsSnd V ts S)
   hence *: "wf\<^sub>s\<^sub>t (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)) S" by simp_all
   hence "wfrestrictedvars\<^sub>s\<^sub>t S' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts))"
     using ConsSnd.prems(2) by fastforce
   thus ?case using ConsSnd.IH * by simp
 next
   case (ConsRcv V ts S)
   hence *: "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> V" "wf\<^sub>s\<^sub>t V S" by simp_all
   hence "wfrestrictedvars\<^sub>s\<^sub>t S' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V"
     using ConsRcv.prems(2) by fastforce
   thus ?case using ConsRcv.IH * by simp
 next
   case (ConsEq V t t' S)
   hence *: "fv t' \<subseteq> V" "wf\<^sub>s\<^sub>t (V \<union> fv t) S" by simp_all
   moreover have "vars\<^sub>s\<^sub>t\<^sub>p (Equality Assign t t') = fv t \<union> fv t'"
     by simp
   moreover have "wfrestrictedvars\<^sub>s\<^sub>t (Equality Assign t t'#S) = fv t \<union> fv t' \<union> wfrestrictedvars\<^sub>s\<^sub>t S"
     by auto
   ultimately have "wfrestrictedvars\<^sub>s\<^sub>t S' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> (V \<union> fv t)"
     using ConsEq.prems(2) by blast
   thus ?case using ConsEq.IH * by simp
 qed (simp_all add: wf\<^sub>s\<^sub>tI)
 
 lemma wf_append_suffix':
   assumes "wf\<^sub>s\<^sub>t V S"
     and "\<Union>(fv\<^sub>r\<^sub>c\<^sub>v ` set S') \<union> \<Union>(fv_r\<^sub>e\<^sub>q assign ` set S') \<subseteq> wfvarsoccs\<^sub>s\<^sub>t S \<union> V"
   shows "wf\<^sub>s\<^sub>t V (S@S')"
 using assms
 proof (induction V S rule: wf\<^sub>s\<^sub>t_induct)
   case (ConsSnd V ts S)
   hence *: "wf\<^sub>s\<^sub>t (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)) S" by simp_all
   have "wfvarsoccs\<^sub>s\<^sub>t (send\<langle>ts\<rangle>\<^sub>s\<^sub>t#S) = fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<union> wfvarsoccs\<^sub>s\<^sub>t S"
     unfolding wfvarsoccs\<^sub>s\<^sub>t_def by simp
   hence "(\<Union>a\<in>set S'. fv\<^sub>r\<^sub>c\<^sub>v a) \<union> (\<Union>a\<in>set S'. fv_r\<^sub>e\<^sub>q assign a) \<subseteq> wfvarsoccs\<^sub>s\<^sub>t S \<union> (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts))"
     using ConsSnd.prems(2) unfolding wfvarsoccs\<^sub>s\<^sub>t_def by auto
   thus ?case using ConsSnd.IH[OF *] by auto
 next
   case (ConsEq V t t' S)
   hence *: "fv t' \<subseteq> V" "wf\<^sub>s\<^sub>t (V \<union> fv t) S" by simp_all
   have "wfvarsoccs\<^sub>s\<^sub>t (\<langle>assign: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S) = fv t \<union> wfvarsoccs\<^sub>s\<^sub>t S"
     unfolding wfvarsoccs\<^sub>s\<^sub>t_def by simp
   hence "(\<Union>a\<in>set S'. fv\<^sub>r\<^sub>c\<^sub>v a) \<union> (\<Union>a\<in>set S'. fv_r\<^sub>e\<^sub>q assign a) \<subseteq> wfvarsoccs\<^sub>s\<^sub>t S \<union> (V \<union> fv t)"
     using ConsEq.prems(2) unfolding wfvarsoccs\<^sub>s\<^sub>t_def by auto
   thus ?case using ConsEq.IH[OF *(2)] *(1) by auto
 qed (auto simp add: wf\<^sub>s\<^sub>tI')
 
 lemma wf_send_compose: "wf\<^sub>s\<^sub>t V (S@(map Send1 X)@S') = wf\<^sub>s\<^sub>t V (S@Send1 (Fun f X)#S')"
 proof (induction S arbitrary: V)
   case Nil thus ?case 
   proof (induction X arbitrary: V)
     case (Cons y Y) thus ?case by (simp add: sup_assoc)
   qed simp
 next
   case (Cons s S) thus ?case
   proof (cases s)
     case (Equality ac t t') thus ?thesis using Cons by (cases ac) auto
   qed auto
 qed
 
 lemma wf_snd_append[iff]: "wf\<^sub>s\<^sub>t V (S@[Send t]) = wf\<^sub>s\<^sub>t V S"
 by (induct S rule: wf\<^sub>s\<^sub>t.induct) simp_all
 
 lemma wf_snd_append': "wf\<^sub>s\<^sub>t V S \<Longrightarrow> wf\<^sub>s\<^sub>t V (Send t#S)"
 by simp
 
 lemma wf_rcv_append[dest]: "wf\<^sub>s\<^sub>t V (S@Receive t#S') \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@S')"
 by (induct S rule: wf\<^sub>s\<^sub>t.induct) simp_all
 
 lemma wf_rcv_append'[intro]:
   "\<lbrakk>wf\<^sub>s\<^sub>t V (S@S'); fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V\<rbrakk> \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@Receive ts#S')"
 proof (induction S rule: wf\<^sub>s\<^sub>t_induct)
   case (ConsRcv V t' S)
   hence "wf\<^sub>s\<^sub>t V (S@S')" "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V" by (simp, fastforce)
   thus ?case using ConsRcv by auto
 next
   case (ConsEq V t' t'' S)
   hence "fv t'' \<subseteq> V" by simp
   moreover have
       "wfrestrictedvars\<^sub>s\<^sub>t (Equality Assign t' t''#S) = fv t' \<union> fv t'' \<union> wfrestrictedvars\<^sub>s\<^sub>t S"
     by auto
   ultimately have "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> (V \<union> fv t')"
     using ConsEq.prems(2) by blast
   thus ?case using ConsEq by auto
 qed auto
 
 lemma wf_rcv_append''[intro]:
   "\<lbrakk>wf\<^sub>s\<^sub>t V S; fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> \<Union>(set (map fv\<^sub>s\<^sub>n\<^sub>d S))\<rbrakk> \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@[Receive ts])"
 by (induct S)
    (simp, metis vars_snd_rcv_strand_subset2(1) append_Nil2 le_supI1 order_trans wf_rcv_append')
 
 lemma wf_rcv_append'''[intro]:
   "\<lbrakk>wf\<^sub>s\<^sub>t V S; fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V\<rbrakk> \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@[Receive ts])"
 by (simp add: wf_rcv_append'[of _ _ "[]"])
 
 lemma wf_eq_append[dest]:
   "wf\<^sub>s\<^sub>t V (S@Equality a t t'#S') \<Longrightarrow> fv t \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@S')"
 proof (induction S rule: wf\<^sub>s\<^sub>t_induct)
   case (Nil V)
   hence "wf\<^sub>s\<^sub>t (V \<union> fv t) S'" by (cases a) auto
   moreover have "V \<union> fv t = V" using Nil by auto
   ultimately show ?case by simp
 next
   case (ConsRcv V us S)
   hence "wf\<^sub>s\<^sub>t V (S @ Equality a t t' # S')" "fv t \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V" "fv\<^sub>s\<^sub>e\<^sub>t (set us) \<subseteq> V"
     by fastforce+
   hence "wf\<^sub>s\<^sub>t V (S@S')" using ConsRcv.IH by auto
   thus ?case using \<open>fv\<^sub>s\<^sub>e\<^sub>t (set us) \<subseteq> V\<close> by simp
 next
   case (ConsEq V u u' S)
   hence "wf\<^sub>s\<^sub>t (V \<union> fv u) (S@Equality a t t'#S')" "fv t \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> (V \<union> fv u)" "fv u' \<subseteq> V"
     by auto
   hence "wf\<^sub>s\<^sub>t (V \<union> fv u) (S@S')" using ConsEq.IH by auto
   thus ?case using \<open>fv u' \<subseteq> V\<close> by simp
 qed auto
 
 lemma wf_eq_append'[intro]:
   "\<lbrakk>wf\<^sub>s\<^sub>t V (S@S'); fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V\<rbrakk> \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@Equality a t t'#S')"
 proof (induction S rule: wf\<^sub>s\<^sub>t_induct)
   case Nil thus ?case by (cases a) auto
 next
   case (ConsEq V u u' S)
   hence "wf\<^sub>s\<^sub>t (V \<union> fv u) (S@S')" "fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V \<union> fv u"
     by fastforce+
   thus ?case using ConsEq by auto
 next
   case (ConsEq2 V u u' S)
   hence "wf\<^sub>s\<^sub>t V (S@S')" by auto
   thus ?case using ConsEq2 by auto
 next
   case (ConsRcv V u S)
   hence "wf\<^sub>s\<^sub>t V (S@S')" "fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V"
     by fastforce+
   thus ?case using ConsRcv by auto
 next
   case (ConsSnd V us S)
   hence "wf\<^sub>s\<^sub>t (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set us)) (S@S')" "fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set us))"
     by fastforce+
   thus ?case using ConsSnd by auto
 qed auto
 
 lemma wf_eq_append''[intro]:
   "\<lbrakk>wf\<^sub>s\<^sub>t V (S@S'); fv t' \<subseteq> wfvarsoccs\<^sub>s\<^sub>t S \<union> V\<rbrakk> \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@[Equality a t t']@S')"
 proof (induction S rule: wf\<^sub>s\<^sub>t_induct)
   case Nil thus ?case by (cases a) auto
 next
   case (ConsEq V u u' S)
   hence "wf\<^sub>s\<^sub>t (V \<union> fv u) (S@S')" "fv t' \<subseteq> wfvarsoccs\<^sub>s\<^sub>t S \<union> V \<union> fv u" by fastforce+
   thus ?case using ConsEq by auto
 next
   case (ConsEq2 V u u' S)
   hence "wf\<^sub>s\<^sub>t (V \<union> fv u) (S@S')" "fv t' \<subseteq> wfvarsoccs\<^sub>s\<^sub>t S \<union> V \<union> fv u" by fastforce+
   thus ?case using ConsEq2 by auto
 next
   case (ConsRcv V u S)
   hence "wf\<^sub>s\<^sub>t V (S@S')" "fv t' \<subseteq> wfvarsoccs\<^sub>s\<^sub>t S \<union> V" by fastforce+
   thus ?case using ConsRcv by auto
 next
   case (ConsSnd V us S)
   hence "wf\<^sub>s\<^sub>t (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set us)) (S@S')" "fv t' \<subseteq> wfvarsoccs\<^sub>s\<^sub>t S \<union> (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set us))" by auto
   thus ?case using ConsSnd by auto
 qed auto
 
 lemma wf_eq_append'''[intro]:
   "\<lbrakk>wf\<^sub>s\<^sub>t V S; fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S \<union> V\<rbrakk> \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@[Equality a t t'])"
 by (simp add: wf_eq_append'[of _ _ "[]"])
 
 lemma wf_eq_check_append[dest]: "wf\<^sub>s\<^sub>t V (S@Equality Check t t'#S') \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@S')"
 by (induct S rule: wf\<^sub>s\<^sub>t.induct) simp_all
 
 lemma wf_eq_check_append'[intro]: "wf\<^sub>s\<^sub>t V (S@S') \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@Equality Check t t'#S')"
 by (induct S rule: wf\<^sub>s\<^sub>t.induct) auto
 
 lemma wf_eq_check_append''[intro]: "wf\<^sub>s\<^sub>t V S \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@[Equality Check t t'])"
 by (induct S rule: wf\<^sub>s\<^sub>t.induct) auto
 
 lemma wf_ineq_append[dest]: "wf\<^sub>s\<^sub>t V (S@Inequality X F#S') \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@S')"
 by (induct S rule: wf\<^sub>s\<^sub>t.induct) simp_all
 
 lemma wf_ineq_append'[intro]: "wf\<^sub>s\<^sub>t V (S@S') \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@Inequality X F#S')"
 by (induct S rule: wf\<^sub>s\<^sub>t.induct) auto
 
 lemma wf_ineq_append''[intro]: "wf\<^sub>s\<^sub>t V S \<Longrightarrow> wf\<^sub>s\<^sub>t V (S@[Inequality X F])"
 by (induct S rule: wf\<^sub>s\<^sub>t.induct) auto
 
 lemma wf_Receive1_prefix:
   assumes "wf\<^sub>s\<^sub>t X S"
     and "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> X"
   shows "wf\<^sub>s\<^sub>t X (map Receive1 ts@S)"
 using assms by (induct ts) simp_all
 
 lemma wf_Send1_prefix:
   assumes "wf\<^sub>s\<^sub>t (X \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)) S"
   shows "wf\<^sub>s\<^sub>t X (map Send1 ts@S)"
 using assms by (induct ts arbitrary: X) (simp, force simp add: Un_assoc)
 
 lemma wf_rcv_fv_single[elim]: "wf\<^sub>s\<^sub>t V (Receive ts#S') \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> V"
 by simp
 
 lemma wf_rcv_fv: "wf\<^sub>s\<^sub>t V (S@Receive ts#S') \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> wfvarsoccs\<^sub>s\<^sub>t S \<union> V"
 proof (induction S arbitrary: V)
   case (Cons a S) thus ?case by (cases a) (auto split!: poscheckvariant.split)
 qed simp
 
 lemma wf_eq_fv: "wf\<^sub>s\<^sub>t V (S@Equality Assign t t'#S') \<Longrightarrow> fv t' \<subseteq> wfvarsoccs\<^sub>s\<^sub>t S \<union> V"
 proof (induction S arbitrary: V)
   case (Cons a S) thus ?case by (cases a) (auto split!: poscheckvariant.split)
 qed simp
 
 lemma wf_simple_fv_occurrence:
   assumes "wf\<^sub>s\<^sub>t {} S" "simple S" "v \<in> wfrestrictedvars\<^sub>s\<^sub>t S"
   shows "\<exists>S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f. S = S\<^sub>p\<^sub>r\<^sub>e@Send [Var v]#S\<^sub>s\<^sub>u\<^sub>f \<and> v \<notin> wfrestrictedvars\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e"
 using assms
 proof (induction S rule: List.rev_induct)
   case (snoc x S)
   from \<open>wf\<^sub>s\<^sub>t {} (S@[x])\<close> have "wf\<^sub>s\<^sub>t {} S" "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>s\<^sub>t S) [x]"
     using wf_append_exec[THEN wf_vars_mono, of "{}" S "[x]" "wfrestrictedvars\<^sub>s\<^sub>t S - wfvarsoccs\<^sub>s\<^sub>t S"]
           vars_snd_rcv_strand_subset2(4)[of S]
           Diff_partition[of "wfvarsoccs\<^sub>s\<^sub>t S" "wfrestrictedvars\<^sub>s\<^sub>t S"]
     by auto
   from \<open>simple (S@[x])\<close> have "simple S" "simple\<^sub>s\<^sub>t\<^sub>p x" unfolding simple_def by auto
 
   show ?case
   proof (cases "v \<in> wfrestrictedvars\<^sub>s\<^sub>t S")
     case False
     show ?thesis
     proof (cases x)
       case (Receive ts)
       hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S" using \<open>wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>s\<^sub>t S) [x]\<close> by simp
       hence "v \<in> wfrestrictedvars\<^sub>s\<^sub>t S"
         using \<open>v \<in> wfrestrictedvars\<^sub>s\<^sub>t (S@[x])\<close> \<open>x = Receive ts\<close>
         by auto
       thus ?thesis using \<open>x = Receive ts\<close> snoc.IH[OF \<open>wf\<^sub>s\<^sub>t {} S\<close> \<open>simple S\<close>] by fastforce
     next
       case (Send ts)
       hence "v \<in> vars\<^sub>s\<^sub>t\<^sub>p x" using \<open>v \<in> wfrestrictedvars\<^sub>s\<^sub>t (S@[x])\<close> False by auto
       from Send obtain w where "ts = [Var w]" using \<open>simple\<^sub>s\<^sub>t\<^sub>p x\<close>
         by (cases ts) (simp, metis in_set_conv_decomp simple_snd_is_var snoc.prems(2))
       hence "v = w" using \<open>x = Send ts\<close> \<open>v \<in> vars\<^sub>s\<^sub>t\<^sub>p x\<close> by simp
       thus ?thesis using \<open>x = Send ts\<close> \<open>v \<notin> wfrestrictedvars\<^sub>s\<^sub>t S\<close> \<open>ts = [Var w]\<close> by auto
     next
       case (Equality ac t t') thus ?thesis using snoc.prems(2) unfolding simple_def by auto
     next
       case (Inequality t t') thus ?thesis using False snoc.prems(3) by auto
     qed
   qed (use snoc.IH[OF \<open>wf\<^sub>s\<^sub>t {} S\<close> \<open>simple S\<close>] in fastforce)
 qed simp
 
 lemma Unifier_strand_fv_subset:
   assumes g_in_ik: "t \<in> ik\<^sub>s\<^sub>t S"
   and \<delta>: "Unifier \<delta> (Fun f X) t"
   and disj: "bvars\<^sub>s\<^sub>t S \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "fv (Fun f X \<cdot> \<delta>) \<subseteq> \<Union>(set (map fv\<^sub>r\<^sub>c\<^sub>v (S \<cdot>\<^sub>s\<^sub>t \<delta>)))"
 by (metis (no_types) fv_subset_if_in_strand_ik[OF g_in_ik]
           disj \<delta> fv_strand_subst subst_apply_fv_subset)
 
 lemma wf\<^sub>s\<^sub>t_induct'[consumes 1, case_names Nil ConsSnd ConsRcv ConsEq ConsEq2 ConsIneq]:
   fixes S::"('a,'b) strand"
   assumes "wf\<^sub>s\<^sub>t V S"
           "P []"
           "\<And>ts S. \<lbrakk>wf\<^sub>s\<^sub>t V S; P S\<rbrakk> \<Longrightarrow> P (S@[Send ts])"
           "\<And>ts S. \<lbrakk>wf\<^sub>s\<^sub>t V S; P S; fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> V \<union> wfvarsoccs\<^sub>s\<^sub>t S\<rbrakk> \<Longrightarrow> P (S@[Receive ts])"
           "\<And>t t' S. \<lbrakk>wf\<^sub>s\<^sub>t V S; P S; fv t' \<subseteq> V \<union> wfvarsoccs\<^sub>s\<^sub>t S\<rbrakk> \<Longrightarrow> P (S@[Equality Assign t t'])"
           "\<And>t t' S. \<lbrakk>wf\<^sub>s\<^sub>t V S; P S\<rbrakk> \<Longrightarrow> P (S@[Equality Check t t'])"
           "\<And>X F S. \<lbrakk>wf\<^sub>s\<^sub>t V S; P S\<rbrakk> \<Longrightarrow> P (S@[Inequality X F])"
   shows "P S"
 using assms
 proof (induction S rule: List.rev_induct)
   case (snoc x S)
   hence *: "wf\<^sub>s\<^sub>t V S" "wf\<^sub>s\<^sub>t (V \<union> wfvarsoccs\<^sub>s\<^sub>t S) [x]" by (metis wf_prefix, metis wf_append_exec)
   have IH: "P S" using snoc.IH[OF *(1)] snoc.prems by auto
   note ** = snoc.prems(3,4,5,6,7)[OF *(1) IH] *(2)
   show ?case using **(1,2,4,5,6)
   proof (cases x)
     case (Equality ac t t')
     then show ?thesis using **(3,4,6) by (cases ac) auto
   qed auto
 qed simp
 
 lemma wf_subst_apply:
   "wf\<^sub>s\<^sub>t V S \<Longrightarrow> wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)) (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
 proof (induction S arbitrary: V rule: wf\<^sub>s\<^sub>t_induct)
   case (ConsRcv V ts S)
   hence "wf\<^sub>s\<^sub>t V S" "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> V" by simp_all
   hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)) (S \<cdot>\<^sub>s\<^sub>t \<delta>)" "fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
     using ConsRcv.IH subst_apply_fv_subset by (simp, force)
   thus ?case by simp
 next
   case (ConsSnd V ts S)
   hence "wf\<^sub>s\<^sub>t (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)) S" by simp
   hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)))) (S \<cdot>\<^sub>s\<^sub>t \<delta>)" using ConsSnd.IH by metis
   hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>s\<^sub>e\<^sub>t (set ts))) (S \<cdot>\<^sub>s\<^sub>t \<delta>)" by simp
   hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)) (S \<cdot>\<^sub>s\<^sub>t \<delta>)" by (metis subst_apply_fv_unfold_set)
   thus ?case by simp
 next
   case (ConsEq V t t' S)
   hence "wf\<^sub>s\<^sub>t (V \<union> fv t) S" "fv t' \<subseteq> V" by auto
   hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> fv t))) (S \<cdot>\<^sub>s\<^sub>t \<delta>)" and *: "fv (t' \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
     using ConsEq.IH subst_apply_fv_subset by force+
   hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv (t \<cdot> \<delta>)) (S \<cdot>\<^sub>s\<^sub>t \<delta>)" using subst_apply_fv_union by metis
   thus ?case using * by simp
 qed simp_all
 
 lemma wf_unify:
   assumes wf: "wf\<^sub>s\<^sub>t V (S@Send [Fun f X]#S')"
   and g_in_ik: "t \<in> ik\<^sub>s\<^sub>t S"
   and \<delta>: "Unifier \<delta> (Fun f X) t"
   and disj: "bvars\<^sub>s\<^sub>t (S@Send [Fun f X]#S') \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)) ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
 using assms
 proof (induction S' arbitrary: V rule: List.rev_induct)
   case (snoc x S' V)
   have fun_fv_bound: "fv (Fun f X \<cdot> \<delta>) \<subseteq> \<Union>(set (map fv\<^sub>r\<^sub>c\<^sub>v (S \<cdot>\<^sub>s\<^sub>t \<delta>)))"
     using snoc.prems(4) bvars\<^sub>s\<^sub>t_split Unifier_strand_fv_subset[OF g_in_ik \<delta>] by auto
   hence "fv (Fun f X \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>))" using fv_ik_is_fv_rcv by metis
   hence "fv (Fun f X \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)" using fv_ik_subset_fv_st[of "S \<cdot>\<^sub>s\<^sub>t \<delta>"] by blast
   hence *: "fv ((Fun f X) \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)" by fastforce
 
   from snoc.prems(1) have "wf\<^sub>s\<^sub>t V (S@Send [Fun f X]#S')"
     using wf_prefix[of V "S@Send [Fun f X]#S'" "[x]"] by simp
   hence **: "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)) ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
     using snoc.IH[OF _ snoc.prems(2,3)] snoc.prems(4) by auto
 
   from snoc.prems(1) have ***: "wf\<^sub>s\<^sub>t (V \<union> wfvarsoccs\<^sub>s\<^sub>t (S@Send [Fun f X]#S')) [x]"
     using wf_append_exec[of V "(S@Send [Fun f X]#S')" "[x]"] by simp
 
   from snoc.prems(4) have disj':
       "bvars\<^sub>s\<^sub>t (S@S') \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
       "set (bvars\<^sub>s\<^sub>t\<^sub>p x) \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
     by auto
 
   show ?case
   proof (cases x)
     case (Send t)
     thus ?thesis using wf_snd_append[of "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)" "(S@S') \<cdot>\<^sub>s\<^sub>t \<delta>"] ** by auto
   next
     case (Receive t)
     hence "fv\<^sub>s\<^sub>t\<^sub>p x \<subseteq> V \<union> wfvarsoccs\<^sub>s\<^sub>t (S@Send [Fun f X]#S')" using *** by auto
     hence "fv\<^sub>s\<^sub>t\<^sub>p x \<subseteq> V \<union> wfrestrictedvars\<^sub>s\<^sub>t (S@Send [Fun f X]#S')"
       using vars_snd_rcv_strand_subset2(4)[of "S@Send [Fun f X]#S'"] by blast
     hence "fv\<^sub>s\<^sub>t\<^sub>p x \<subseteq> V \<union> fv (Fun f X) \<union> wfrestrictedvars\<^sub>s\<^sub>t (S@S')" by auto
     hence "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv ((Fun f X) \<cdot> \<delta>) \<union> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
       by (metis (no_types) inf_sup_aci(5) subst_apply_fv_subset_strand2 subst_apply_fv_union disj')
     hence "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)" using * by blast
     hence "fv\<^sub>s\<^sub>e\<^sub>t (set t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) "
       using \<open>x = Receive t\<close> by auto
     hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)) (((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)@[Receive (t \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)])"
       using wf_rcv_append'''[OF **, of "t \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>"] by simp
     thus ?thesis using \<open>x = Receive t\<close> by auto
   next
     case (Equality ac s s') show ?thesis
     proof (cases ac)
       case Assign
       hence "fv s' \<subseteq> V \<union> wfvarsoccs\<^sub>s\<^sub>t (S@Send [Fun f X]#S')" using Equality *** by auto
       hence "fv s' \<subseteq> V \<union> wfrestrictedvars\<^sub>s\<^sub>t (S@Send [Fun f X]#S')"
         using vars_snd_rcv_strand_subset2(4)[of "S@Send [Fun f X]#S'"] by blast
       hence "fv s' \<subseteq> V \<union> fv (Fun f X) \<union> wfrestrictedvars\<^sub>s\<^sub>t (S@S')" by auto
       moreover have "fv s' = fv_r\<^sub>e\<^sub>q ac x" "fv (s' \<cdot> \<delta>) = fv_r\<^sub>e\<^sub>q ac (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>)"
         using Equality by simp_all
       ultimately have "fv (s' \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv (Fun f X \<cdot> \<delta>) \<union> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
         using subst_apply_fv_subset_strand2[of "fv\<^sub>e\<^sub>q ac" ac x]
         by (metis disj'(1) subst_apply_fv_subset_strand_trm2 subst_apply_fv_union sup_commute)
       hence "fv (s' \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)" using * by blast
       hence "fv (s' \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
         using \<open>x = Equality ac s s'\<close> by auto
       hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)) (((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)@[Equality ac (s \<cdot> \<delta>) (s' \<cdot> \<delta>)])"
         using wf_eq_append'''[OF **] by metis
       thus ?thesis using \<open>x = Equality ac s s'\<close> by auto
     next
       case Check thus ?thesis using wf_eq_check_append''[OF **] Equality by simp
     qed
   next
     case (Inequality t t') thus ?thesis using wf_ineq_append''[OF **] by simp
   qed
 qed (auto dest: wf_subst_apply)
 
 lemma wf_equality:
   assumes wf: "wf\<^sub>s\<^sub>t V (S@Equality ac t t'#S')"
   and \<delta>: "mgu t t' = Some \<delta>"
   and disj: "bvars\<^sub>s\<^sub>t (S@Equality ac t t'#S') \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)) ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
 using assms
 proof (induction S' arbitrary: V rule: List.rev_induct)
   case Nil thus ?case using wf_prefix[of V S "[Equality ac t t']"] wf_subst_apply[of V S \<delta>] by auto
 next
   case (snoc x S' V) show ?case
   proof (cases ac)
     case Assign
     hence "fv t' \<subseteq> V \<union> wfvarsoccs\<^sub>s\<^sub>t S"
       using wf_eq_fv[of V, of S t t' "S'@[x]"] snoc by auto
     hence "fv t' \<subseteq> V \<union> wfrestrictedvars\<^sub>s\<^sub>t S"
       using vars_snd_rcv_strand_subset2(4)[of S] by blast
     hence "fv t' \<subseteq> V \<union> wfrestrictedvars\<^sub>s\<^sub>t (S@S')" by force
     moreover have disj':
         "bvars\<^sub>s\<^sub>t (S@S') \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
         "set (bvars\<^sub>s\<^sub>t\<^sub>p x) \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
         "bvars\<^sub>s\<^sub>t (S@Equality ac t t'#S') \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
       using snoc.prems(3) by auto
     ultimately have
         "fv (t' \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
       by (metis inf_sup_aci(5) subst_apply_fv_subset_strand_trm2)
     moreover have "fv (t \<cdot> \<delta>) = fv (t' \<cdot> \<delta>)"
       by (metis MGU_is_Unifier[OF mgu_gives_MGU[OF \<delta>]])
     ultimately have *:
         "fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
       by simp
   
     from snoc.prems(1) have "wf\<^sub>s\<^sub>t V (S@Equality ac t t'#S')"
       using wf_prefix[of V "S@Equality ac t t'#S'"] by simp
     hence **: "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)) ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)" by (metis snoc.IH \<delta> disj'(3))
   
     from snoc.prems(1) have ***: "wf\<^sub>s\<^sub>t (V \<union> wfvarsoccs\<^sub>s\<^sub>t (S@Equality ac t t'#S')) [x]"
       using wf_append_exec[of V "(S@Equality ac t t'#S')" "[x]"] by simp
   
     show ?thesis
     proof (cases x)
       case (Send t)
       thus ?thesis using wf_snd_append[of "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)" "(S@S') \<cdot>\<^sub>s\<^sub>t \<delta>"] ** by auto
     next
       case (Receive s)
       hence "fv\<^sub>s\<^sub>t\<^sub>p x \<subseteq> V \<union> wfvarsoccs\<^sub>s\<^sub>t (S@Equality ac t t'#S')" using *** by auto
       hence "fv\<^sub>s\<^sub>t\<^sub>p x \<subseteq> V \<union> wfrestrictedvars\<^sub>s\<^sub>t (S@Equality ac t t'#S')"
         using vars_snd_rcv_strand_subset2(4)[of "S@Equality ac t t'#S'"] by blast
       hence "fv\<^sub>s\<^sub>t\<^sub>p x \<subseteq> V \<union> fv t \<union> fv t' \<union> wfrestrictedvars\<^sub>s\<^sub>t (S@S')"
         by (cases ac) auto
       hence "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>) \<union> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
         using subst_apply_fv_subset_strand2[of fv\<^sub>s\<^sub>t\<^sub>p]
         by (metis (no_types) inf_sup_aci(5) subst_apply_fv_union disj'(1,2))
       hence "fv\<^sub>s\<^sub>t\<^sub>p (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
         when "ac = Assign"
         using * that by blast
       hence "fv\<^sub>s\<^sub>e\<^sub>t (set s \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V))"
         when "ac = Assign"
         using \<open>x = Receive s\<close> that by auto
       hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)) (((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)@[Receive (s \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)])"
         when "ac = Assign"
         using wf_rcv_append'''[OF **, of "s \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>"] that by simp
       thus ?thesis using \<open>x = Receive s\<close> Assign by auto
     next
       case (Equality ac' s s') show ?thesis
       proof (cases ac')
         case Assign
         hence "fv s' \<subseteq> V \<union> wfvarsoccs\<^sub>s\<^sub>t (S@Equality ac t t'#S')" using *** Equality by auto
         hence "fv s' \<subseteq> V \<union> wfrestrictedvars\<^sub>s\<^sub>t (S@Equality ac t t'#S')"
           using vars_snd_rcv_strand_subset2(4)[of "S@Equality ac t t'#S'"] by blast
         hence "fv s' \<subseteq> V \<union> fv t \<union> fv t' \<union> wfrestrictedvars\<^sub>s\<^sub>t (S@S')"
           by (cases ac) auto
         moreover have "fv s' = fv_r\<^sub>e\<^sub>q ac' x" "fv (s' \<cdot> \<delta>) = fv_r\<^sub>e\<^sub>q ac' (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>)"
           using Equality by simp_all
         ultimately have
             "fv (s' \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>) \<union> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
           using subst_apply_fv_subset_strand2[of "fv_r\<^sub>e\<^sub>q ac'" ac' x]
           by (metis disj'(1) subst_apply_fv_subset_strand_trm2 subst_apply_fv_union sup_commute)
         hence "fv (s' \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
           using * \<open>ac = Assign\<close> by blast
         hence ****:
             "fv (s' \<cdot> \<delta>) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
           using \<open>x = Equality ac' s s'\<close> \<open>ac = Assign\<close> by auto
         thus ?thesis
           using \<open>x = Equality ac' s s'\<close> ** **** wf_eq_append' \<open>ac = Assign\<close>
           by (metis (no_types, lifting) append.assoc append_Nil2 strand_step.case(3)
                 strand_subst_hom subst_apply_strand_step_def)
       next
         case Check thus ?thesis using wf_eq_check_append''[OF **] Equality by simp
       qed
     next
       case (Inequality s s') thus ?thesis using wf_ineq_append''[OF **] by simp
     qed
   qed (metis snoc.prems(1) wf_eq_check_append wf_subst_apply)
 qed
 
 lemma wf_rcv_prefix_ground:
   "wf\<^sub>s\<^sub>t {} ((map Receive M)@S) \<Longrightarrow> vars\<^sub>s\<^sub>t (map Receive M) = {}"
 by (induct M) auto
 
 lemma simple_wfvarsoccs\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>n\<^sub>d:
   assumes "simple S"
   shows "wfvarsoccs\<^sub>s\<^sub>t S = \<Union>(set (map fv\<^sub>s\<^sub>n\<^sub>d S))"
 using assms unfolding simple_def
 proof (induction S)
   case (Cons x S) thus ?case by (cases x) auto
 qed simp
 
 lemma wf\<^sub>s\<^sub>t_simple_induct[consumes 2, case_names Nil ConsSnd ConsRcv ConsIneq]:
   fixes S::"('a,'b) strand"
   assumes "wf\<^sub>s\<^sub>t V S" "simple S"
           "P []"
           "\<And>v S. \<lbrakk>wf\<^sub>s\<^sub>t V S; simple S; P S\<rbrakk> \<Longrightarrow> P (S@[Send [Var v]])"
           "\<And>ts S. \<lbrakk>wf\<^sub>s\<^sub>t V S; simple S; P S; fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> V \<union> \<Union>(set (map fv\<^sub>s\<^sub>n\<^sub>d S))\<rbrakk> \<Longrightarrow> P (S@[Receive ts])"
           "\<And>X F S. \<lbrakk>wf\<^sub>s\<^sub>t V S; simple S; P S\<rbrakk> \<Longrightarrow> P (S@[Inequality X F])"
   shows "P S"
 using assms
 proof (induction S rule: wf\<^sub>s\<^sub>t_induct')
   case (ConsSnd t S)
   hence "P S" by auto
   obtain v where "t = [Var v]" using simple_snd_is_var[OF _ \<open>simple (S@[Send t])\<close>] by auto
   thus ?case using ConsSnd.prems(3)[OF \<open>wf\<^sub>s\<^sub>t V S\<close> _ \<open>P S\<close>] \<open>simple (S@[Send t])\<close> by auto
 next
   case (ConsRcv t S) thus ?case using simple_wfvarsoccs\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>n\<^sub>d[of "S@[Receive t]"] by auto
 qed (auto simp add: simple_def)
 
 lemma wf_trm_stp_dom_fv_disjoint:
   "\<lbrakk>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>; t \<in> trms\<^sub>s\<^sub>t S\<rbrakk> \<Longrightarrow> subst_domain \<theta> \<inter> fv t = {}"
 unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by force
 
 lemma wf_constr_bvars_disj: "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta> \<Longrightarrow> (subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t S = {}"
 unfolding range_vars_alt_def wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by fastforce
 
 lemma wf_constr_bvars_disj':
   assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t S"
   shows "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t S = {}" (is ?A)
   and "(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" (is ?B)
 proof -
   have "(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t S = {}" "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {}"
     using assms(1) unfolding range_vars_alt_def wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by fastforce+
   thus ?A and ?B using assms(2) bvars_subst_ident[of S \<delta>] by blast+
 qed
 
 lemma (in intruder_model) wf_simple_strand_first_Send_var_split:
   assumes "wf\<^sub>s\<^sub>t {} S" "simple S" "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>t S. t \<cdot> \<I> = \<I> v"
   shows "\<exists>v S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f. S = S\<^sub>p\<^sub>r\<^sub>e@Send [Var v]#S\<^sub>s\<^sub>u\<^sub>f \<and> t \<cdot> \<I> = \<I> v
                       \<and> \<not>(\<exists>w \<in> wfrestrictedvars\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e. t \<cdot> \<I> = \<I> w)"
     (is "?P S")
 using assms
 proof (induction S rule: wf\<^sub>s\<^sub>t_simple_induct)
   case (ConsSnd v S) show ?case
   proof (cases "\<exists>w \<in> wfrestrictedvars\<^sub>s\<^sub>t S. t \<cdot> \<I> = \<I> w")
     case True thus ?thesis using ConsSnd.IH by fastforce
   next
     case False thus ?thesis using ConsSnd.prems by auto
   qed
 next
   case (ConsRcv t' S)
   have "fv\<^sub>s\<^sub>e\<^sub>t (set t') \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S"
     using ConsRcv.hyps(3) vars_snd_rcv_strand_subset2(1) by force
   hence "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>t S. t \<cdot> \<I> = \<I> v"
     using ConsRcv.prems(1) by fastforce
   hence "?P S" by (metis ConsRcv.IH)
   thus ?case by fastforce 
 next
   case (ConsIneq X F S)
   moreover have "wfrestrictedvars\<^sub>s\<^sub>t (S @ [Inequality X F]) = wfrestrictedvars\<^sub>s\<^sub>t S" by auto
   ultimately have "?P S" by blast
   thus ?case by fastforce
 qed simp
 
 lemma (in intruder_model) wf_strand_first_Send_var_split:
   assumes "wf\<^sub>s\<^sub>t {} S" "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v"
   shows "\<exists>S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f. \<not>(\<exists>w \<in> wfrestrictedvars\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e. t \<cdot> \<I> \<sqsubseteq> \<I> w)
             \<and> ((\<exists>t'. S = S\<^sub>p\<^sub>r\<^sub>e@Send t'#S\<^sub>s\<^sub>u\<^sub>f \<and> t \<cdot> \<I> \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set t' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)
                \<or> (\<exists>t' t''. S = S\<^sub>p\<^sub>r\<^sub>e@Equality Assign t' t''#S\<^sub>s\<^sub>u\<^sub>f \<and> t \<cdot> \<I> \<sqsubseteq> t' \<cdot> \<I>))"
     (is "\<exists>S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f. ?P S\<^sub>p\<^sub>r\<^sub>e \<and> ?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f")
 using assms
 proof (induction S rule: wf\<^sub>s\<^sub>t_induct')
   case (ConsSnd ts' S) show ?case
   proof (cases "\<exists>w \<in> wfrestrictedvars\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> w")
     case True
     then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f"
       using ConsSnd.IH by moura
     thus ?thesis by fastforce
   next
     case False
     then obtain v where v: "v \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts')" "t \<cdot> \<I> \<sqsubseteq> \<I> v"
       using ConsSnd.prems by auto
     then obtain t' where t': "t' \<in> set ts'" "v \<in> fv t'" by auto
     have "t \<cdot> \<I> \<sqsubseteq> t' \<cdot> \<I>"
       using v(2) t'(2) subst_mono[of "Var v" t' \<I>] vars_iff_subtermeq[of v] term.order_trans
       by auto
     hence "t \<cdot> \<I> \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using v(1) t'(1) by blast
     thus ?thesis using False v by auto
   qed
 next
   case (ConsRcv t' S)
   have "fv\<^sub>s\<^sub>e\<^sub>t (set t') \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S"
     using ConsRcv.hyps vars_snd_rcv_strand_subset2(4)[of S] by blast
   hence "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v"
     using ConsRcv.prems by fastforce
   then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f"
     using ConsRcv.IH by moura
   thus ?case by fastforce
 next
   case (ConsEq s s' S)
   have *: "fv s' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t S"
     using ConsEq.hyps vars_snd_rcv_strand_subset2(4)[of S]
     by blast
   show ?case
   proof (cases "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v")
     case True
     then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f"
       using ConsEq.IH by moura
     thus ?thesis by fastforce
   next
     case False
     then obtain v where "v \<in> fv s" "t \<cdot> \<I> \<sqsubseteq> \<I> v" using ConsEq.prems * by auto
     hence "t \<cdot> \<I> \<sqsubseteq> s \<cdot> \<I>"
       using vars_iff_subtermeq[of v s] subst_mono[of "Var v" s \<I>] term.order_trans
       by auto
     thus ?thesis using False by fastforce
   qed
 next
   case (ConsEq2 s s' S)
   have "wfrestrictedvars\<^sub>s\<^sub>t (S@[Equality Check s s']) = wfrestrictedvars\<^sub>s\<^sub>t S" by auto
   hence "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v" using ConsEq2.prems by metis
   then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f"
     using ConsEq2.IH by moura
   thus ?case by fastforce
 next
   case (ConsIneq X F S)
   hence "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>t S. t \<cdot> \<I> \<sqsubseteq> \<I> v" by fastforce
   then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f"
     using ConsIneq.IH by moura
   thus ?case by fastforce
 qed simp
 
 
 subsection \<open>Constraint Semantics\<close>
 context intruder_model
 begin
 
 subsubsection \<open>Definitions\<close>
 text \<open>The constraint semantics in which the intruder is limited to composition only\<close>
 fun strand_sem_c::"('fun,'var) terms \<Rightarrow> ('fun,'var) strand \<Rightarrow> ('fun,'var) subst \<Rightarrow> bool" ("\<lbrakk>_; _\<rbrakk>\<^sub>c")
 where
   "\<lbrakk>M; []\<rbrakk>\<^sub>c = (\<lambda>\<I>. True)"
 | "\<lbrakk>M; Send ts#S\<rbrakk>\<^sub>c = (\<lambda>\<I>. (\<forall>t \<in> set ts. M \<turnstile>\<^sub>c t \<cdot> \<I>) \<and> \<lbrakk>M; S\<rbrakk>\<^sub>c \<I>)"
 | "\<lbrakk>M; Receive ts#S\<rbrakk>\<^sub>c = (\<lambda>\<I>. \<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> M; S\<rbrakk>\<^sub>c \<I>)"
 | "\<lbrakk>M; Equality _ t t'#S\<rbrakk>\<^sub>c = (\<lambda>\<I>. t \<cdot> \<I> = t' \<cdot> \<I> \<and> \<lbrakk>M; S\<rbrakk>\<^sub>c \<I>)"
 | "\<lbrakk>M; Inequality X F#S\<rbrakk>\<^sub>c = (\<lambda>\<I>. ineq_model \<I> X F \<and> \<lbrakk>M; S\<rbrakk>\<^sub>c \<I>)"
 
 definition constr_sem_c ("_ \<Turnstile>\<^sub>c \<langle>_,_\<rangle>") where "\<I> \<Turnstile>\<^sub>c \<langle>S,\<theta>\<rangle> \<equiv> (\<theta> supports \<I> \<and> \<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>)"
 abbreviation constr_sem_c' ("_ \<Turnstile>\<^sub>c \<langle>_\<rangle>" 90) where "\<I> \<Turnstile>\<^sub>c \<langle>S\<rangle> \<equiv> \<I> \<Turnstile>\<^sub>c \<langle>S,Var\<rangle>"
 
 text \<open>The full constraint semantics\<close>
 fun strand_sem_d::"('fun,'var) terms \<Rightarrow> ('fun,'var) strand \<Rightarrow> ('fun,'var) subst \<Rightarrow> bool" ("\<lbrakk>_; _\<rbrakk>\<^sub>d")
 where
   "\<lbrakk>M; []\<rbrakk>\<^sub>d = (\<lambda>\<I>. True)"
 | "\<lbrakk>M; Send ts#S\<rbrakk>\<^sub>d = (\<lambda>\<I>. (\<forall>t \<in> set ts. M \<turnstile> t \<cdot> \<I>) \<and> \<lbrakk>M; S\<rbrakk>\<^sub>d \<I>)"
 | "\<lbrakk>M; Receive ts#S\<rbrakk>\<^sub>d = (\<lambda>\<I>. \<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> M; S\<rbrakk>\<^sub>d \<I>)"
 | "\<lbrakk>M; Equality _ t t'#S\<rbrakk>\<^sub>d = (\<lambda>\<I>. t \<cdot> \<I> = t' \<cdot> \<I> \<and> \<lbrakk>M; S\<rbrakk>\<^sub>d \<I>)"
 | "\<lbrakk>M; Inequality X F#S\<rbrakk>\<^sub>d = (\<lambda>\<I>. ineq_model \<I> X F \<and> \<lbrakk>M; S\<rbrakk>\<^sub>d \<I>)"
 
 definition constr_sem_d ("_ \<Turnstile> \<langle>_,_\<rangle>") where "\<I> \<Turnstile> \<langle>S,\<theta>\<rangle> \<equiv> (\<theta> supports \<I> \<and> \<lbrakk>{}; S\<rbrakk>\<^sub>d \<I>)"
 abbreviation constr_sem_d' ("_ \<Turnstile> \<langle>_\<rangle>" 90) where "\<I> \<Turnstile> \<langle>S\<rangle> \<equiv> \<I> \<Turnstile> \<langle>S,Var\<rangle>"
 
 lemmas strand_sem_induct = strand_sem_c.induct[case_names Nil ConsSnd ConsRcv ConsEq ConsIneq]
 
 
 subsubsection \<open>Lemmata\<close>
 lemma strand_sem_d_if_c: "\<I> \<Turnstile>\<^sub>c \<langle>S,\<theta>\<rangle> \<Longrightarrow> \<I> \<Turnstile> \<langle>S,\<theta>\<rangle>"
 proof -
   assume *: "\<I> \<Turnstile>\<^sub>c \<langle>S,\<theta>\<rangle>"
   { fix M have "\<lbrakk>M; S\<rbrakk>\<^sub>c \<I> \<Longrightarrow> \<lbrakk>M; S\<rbrakk>\<^sub>d \<I>"
     proof (induction S rule: strand_sem_induct)
       case (ConsSnd M ts S)
       hence "\<forall>t \<in> set ts. M \<turnstile>\<^sub>c t \<cdot> \<I>" "\<lbrakk>M; S\<rbrakk>\<^sub>d \<I>" by auto
       thus ?case using strand_sem_d.simps(2)[of M _ S] by auto
     qed (auto simp add: ineq_model_def)
   }
   thus ?thesis using * by (simp add: constr_sem_c_def constr_sem_d_def)
 qed
 
 lemma strand_sem_mono_ik:
   "\<lbrakk>M \<subseteq> M'; \<lbrakk>M; S\<rbrakk>\<^sub>c \<theta>\<rbrakk> \<Longrightarrow> \<lbrakk>M'; S\<rbrakk>\<^sub>c \<theta>" (is "\<lbrakk>?A'; ?A''\<rbrakk> \<Longrightarrow> ?A")
   "\<lbrakk>M \<subseteq> M'; \<lbrakk>M; S\<rbrakk>\<^sub>d \<theta>\<rbrakk> \<Longrightarrow> \<lbrakk>M'; S\<rbrakk>\<^sub>d \<theta>" (is "\<lbrakk>?B'; ?B''\<rbrakk> \<Longrightarrow> ?B")
 proof -
   show "\<lbrakk>?A'; ?A''\<rbrakk> \<Longrightarrow> ?A"
   proof (induction M S arbitrary: M M' rule: strand_sem_induct)
     case (ConsRcv M ts S)
     thus ?case using ConsRcv.IH[of "(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M" "(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M'"] by auto
   next
     case (ConsSnd M ts S)
     hence "\<forall>t \<in> set ts. M \<turnstile>\<^sub>c t \<cdot> \<theta>" "\<lbrakk>M'; S\<rbrakk>\<^sub>c \<theta>" by auto
     hence "\<forall>t \<in> set ts. M' \<turnstile>\<^sub>c t \<cdot> \<theta>" using ideduct_synth_mono \<open>M \<subseteq> M'\<close> by metis
     thus ?case using \<open>\<lbrakk>M'; S\<rbrakk>\<^sub>c \<theta>\<close> by simp
   qed auto
 
   show "\<lbrakk>?B'; ?B''\<rbrakk> \<Longrightarrow> ?B"
   proof (induction M S arbitrary: M M' rule: strand_sem_induct)
     case (ConsRcv M ts S)
     thus ?case using ConsRcv.IH[of "(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M" "(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M'"] by auto
   next
     case (ConsSnd M ts S)
     hence "\<forall>t \<in> set ts. M \<turnstile> t \<cdot> \<theta>" "\<lbrakk>M'; S\<rbrakk>\<^sub>d \<theta>" by auto
     hence "\<forall>t \<in> set ts. M' \<turnstile> t \<cdot> \<theta>" using ideduct_mono \<open>M \<subseteq> M'\<close> by metis
     thus ?case using \<open>\<lbrakk>M'; S\<rbrakk>\<^sub>d \<theta>\<close> by simp
   qed auto
 qed
 
 context
 begin
 private lemma strand_sem_split_left:
   "\<lbrakk>M; S@S'\<rbrakk>\<^sub>c \<theta> \<Longrightarrow> \<lbrakk>M; S\<rbrakk>\<^sub>c \<theta>"
   "\<lbrakk>M; S@S'\<rbrakk>\<^sub>d \<theta> \<Longrightarrow> \<lbrakk>M; S\<rbrakk>\<^sub>d \<theta>"
 proof (induct S arbitrary: M)
   case (Cons x S)
   { case 1 thus ?case using Cons by (cases x) simp_all }
   { case 2 thus ?case using Cons by (cases x) simp_all }
 qed simp_all
 
 private lemma strand_sem_split_right:
   "\<lbrakk>M; S@S'\<rbrakk>\<^sub>c \<theta> \<Longrightarrow> \<lbrakk>M \<union> (ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>); S'\<rbrakk>\<^sub>c \<theta>"
   "\<lbrakk>M; S@S'\<rbrakk>\<^sub>d \<theta> \<Longrightarrow> \<lbrakk>M \<union> (ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>); S'\<rbrakk>\<^sub>d \<theta>"
 proof (induction S arbitrary: M rule: ik\<^sub>s\<^sub>t_induct)
   case (ConsRcv ts S)
   { case 1 thus ?case
       using ConsRcv.IH(1)[of "(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M"]
       by (simp add: Un_commute Un_left_commute image_Un)
   }
   { case 2 thus ?case
       using ConsRcv.IH(2)[of "(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M"]
       by (simp add: Un_commute Un_left_commute image_Un)
   }
 qed simp_all
 
 lemmas strand_sem_split[dest] =
   strand_sem_split_left(1) strand_sem_split_right(1)
   strand_sem_split_left(2) strand_sem_split_right(2)
 end
 
 lemma strand_sem_Send_split[dest]:
   "\<lbrakk>\<lbrakk>M; map Send T\<rbrakk>\<^sub>c \<theta>; ts \<in> set T\<rbrakk> \<Longrightarrow> \<lbrakk>M; [Send ts]\<rbrakk>\<^sub>c \<theta>" (is "\<lbrakk>?A'; ?A''\<rbrakk> \<Longrightarrow> ?A")
   "\<lbrakk>\<lbrakk>M; map Send T\<rbrakk>\<^sub>d \<theta>; ts \<in> set T\<rbrakk> \<Longrightarrow> \<lbrakk>M; [Send ts]\<rbrakk>\<^sub>d \<theta>" (is "\<lbrakk>?B'; ?B''\<rbrakk> \<Longrightarrow> ?B")
   "\<lbrakk>\<lbrakk>M; map Send T@S\<rbrakk>\<^sub>c \<theta>; ts \<in> set T\<rbrakk> \<Longrightarrow> \<lbrakk>M; Send ts#S\<rbrakk>\<^sub>c \<theta>" (is "\<lbrakk>?C'; ?C''\<rbrakk> \<Longrightarrow> ?C")
   "\<lbrakk>\<lbrakk>M; map Send T@S\<rbrakk>\<^sub>d \<theta>; ts \<in> set T\<rbrakk> \<Longrightarrow> \<lbrakk>M; Send ts#S\<rbrakk>\<^sub>d \<theta>" (is "\<lbrakk>?D'; ?D''\<rbrakk> \<Longrightarrow> ?D")
   "\<lbrakk>\<lbrakk>M; map Send1 T'\<rbrakk>\<^sub>c \<theta>; t \<in> set T'\<rbrakk> \<Longrightarrow> \<lbrakk>M; [Send1 t]\<rbrakk>\<^sub>c \<theta>" (is "\<lbrakk>?E'; ?E''\<rbrakk> \<Longrightarrow> ?E")
   "\<lbrakk>\<lbrakk>M; map Send1 T'\<rbrakk>\<^sub>d \<theta>; t \<in> set T'\<rbrakk> \<Longrightarrow> \<lbrakk>M; [Send1 t]\<rbrakk>\<^sub>d \<theta>" (is "\<lbrakk>?F'; ?F''\<rbrakk> \<Longrightarrow> ?F")
   "\<lbrakk>\<lbrakk>M; map Send1 T'@S\<rbrakk>\<^sub>c \<theta>; t \<in> set T'\<rbrakk> \<Longrightarrow> \<lbrakk>M; Send1 t#S\<rbrakk>\<^sub>c \<theta>" (is "\<lbrakk>?G'; ?G''\<rbrakk> \<Longrightarrow> ?G")
   "\<lbrakk>\<lbrakk>M; map Send1 T'@S\<rbrakk>\<^sub>d \<theta>; t \<in> set T'\<rbrakk> \<Longrightarrow> \<lbrakk>M; Send1 t#S\<rbrakk>\<^sub>d \<theta>" (is "\<lbrakk>?H'; ?H''\<rbrakk> \<Longrightarrow> ?H")
 proof -
   show A: "\<lbrakk>?A'; ?A''\<rbrakk> \<Longrightarrow> ?A" by (induct "map Send T" arbitrary: T rule: strand_sem_c.induct) auto
   show B: "\<lbrakk>?B'; ?B''\<rbrakk> \<Longrightarrow> ?B" by (induct "map Send T" arbitrary: T rule: strand_sem_d.induct) auto
   show "\<lbrakk>?C'; ?C''\<rbrakk> \<Longrightarrow> ?C" "\<lbrakk>?D'; ?D''\<rbrakk> \<Longrightarrow> ?D"
     using list.set_map list.simps(8) set_empty ik_snd_empty sup_bot.right_neutral
     by (metis (no_types, lifting) A strand_sem_split(1,2) strand_sem_c.simps(2),
         metis (no_types, lifting) B strand_sem_split(3,4) strand_sem_d.simps(2))
 
   show "\<lbrakk>?E'; ?E''\<rbrakk> \<Longrightarrow> ?E"
     by (induct "map Send1 T'" arbitrary: T' rule: strand_sem_c.induct) auto
 
   show "\<lbrakk>?F'; ?F''\<rbrakk> \<Longrightarrow> ?F"
     by (induct "map Send1 T'" arbitrary: T' rule: strand_sem_c.induct) auto
 
   show "\<lbrakk>?G'; ?G''\<rbrakk> \<Longrightarrow> ?G"
   proof (induction "map Send1 T'" arbitrary: T' rule: strand_sem_c.induct)
     case (2 M ts S')
     obtain t' T'' where ts: "ts = [t']" "T' = t'#T''" "S' = map Send1 T''"
       using "2.hyps"(2) by blast
     thus ?case using "2.prems" "2.hyps"(1)
     proof (cases "t = t'")
       case True
       have "ik\<^sub>s\<^sub>t (map Send1 T') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = {}" by force
       hence "\<lbrakk>M; [Send1 t]\<rbrakk>\<^sub>c \<theta>" "\<lbrakk>M; S\<rbrakk>\<^sub>c \<theta>" using "2.prems"(1) unfolding ts(2) True by auto
       thus ?thesis by simp
     qed auto
   qed auto
 
   show "\<lbrakk>?H'; ?H''\<rbrakk> \<Longrightarrow> ?H"
   proof (induction "map Send1 T'" arbitrary: T' rule: strand_sem_c.induct)
     case (2 M ts S')
     obtain t' T'' where ts: "ts = [t']" "T' = t'#T''" "S' = map Send1 T''"
       using "2.hyps"(2) by blast
     thus ?case using "2.prems" "2.hyps"(1)
     proof (cases "t = t'")
       case True
       have "ik\<^sub>s\<^sub>t (map Send1 T') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = {}" by force
       hence "\<lbrakk>M; [Send1 t]\<rbrakk>\<^sub>d \<theta>" "\<lbrakk>M; S\<rbrakk>\<^sub>d \<theta>" using "2.prems"(1) unfolding ts(2) True by auto
       thus ?thesis by simp
     qed auto
   qed auto
 qed
 
 lemma strand_sem_Send_map:
   "(\<And>ts. ts \<in> set T \<Longrightarrow> \<lbrakk>M; [Send ts]\<rbrakk>\<^sub>c \<I>) \<Longrightarrow> \<lbrakk>M; map Send T\<rbrakk>\<^sub>c \<I>"
   "(\<And>ts. ts \<in> set T \<Longrightarrow> \<lbrakk>M; [Send ts]\<rbrakk>\<^sub>d \<I>) \<Longrightarrow> \<lbrakk>M; map Send T\<rbrakk>\<^sub>d \<I>"
   "(\<And>t. t \<in> set T' \<Longrightarrow> \<lbrakk>M; [Send1 t]\<rbrakk>\<^sub>c \<I>) \<Longrightarrow> \<lbrakk>M; map Send1 T'\<rbrakk>\<^sub>c \<I>"
   "(\<And>t. t \<in> set T' \<Longrightarrow> \<lbrakk>M; [Send1 t]\<rbrakk>\<^sub>d \<I>) \<Longrightarrow> \<lbrakk>M; map Send1 T'\<rbrakk>\<^sub>d \<I>"
   "\<lbrakk>M; map Send1 T'\<rbrakk>\<^sub>c \<I> \<longleftrightarrow> \<lbrakk>M; [Send T']\<rbrakk>\<^sub>c \<I>"
   "\<lbrakk>M; map Send1 T'\<rbrakk>\<^sub>d \<I> \<longleftrightarrow> \<lbrakk>M; [Send T']\<rbrakk>\<^sub>d \<I>"
 proof -
   show "(\<And>ts. ts \<in> set T \<Longrightarrow> \<lbrakk>M; [Send ts]\<rbrakk>\<^sub>c \<I>) \<Longrightarrow> \<lbrakk>M; map Send T\<rbrakk>\<^sub>c \<I>"
        "(\<And>ts. ts \<in> set T \<Longrightarrow> \<lbrakk>M; [Send ts]\<rbrakk>\<^sub>d \<I>) \<Longrightarrow> \<lbrakk>M; map Send T\<rbrakk>\<^sub>d \<I>"
     by (induct T) auto
 
   show "(\<And>t. t \<in> set T' \<Longrightarrow> \<lbrakk>M; [Send1 t]\<rbrakk>\<^sub>c \<I>) \<Longrightarrow> \<lbrakk>M; map Send1 T'\<rbrakk>\<^sub>c \<I>"
        "(\<And>t. t \<in> set T' \<Longrightarrow> \<lbrakk>M; [Send1 t]\<rbrakk>\<^sub>d \<I>) \<Longrightarrow> \<lbrakk>M; map Send1 T'\<rbrakk>\<^sub>d \<I>"
     by (induct T') auto
 
   show "\<lbrakk>M; map Send1 T'\<rbrakk>\<^sub>c \<I> \<longleftrightarrow> \<lbrakk>M; [Send T']\<rbrakk>\<^sub>c \<I>"
        "\<lbrakk>M; map Send1 T'\<rbrakk>\<^sub>d \<I> \<longleftrightarrow> \<lbrakk>M; [Send T']\<rbrakk>\<^sub>d \<I>"
     by (induct T') auto
 qed
 
 lemma strand_sem_Receive_map:
   "\<lbrakk>M; map Receive T\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; map Receive T\<rbrakk>\<^sub>d \<I>"
   "\<lbrakk>M; map Receive1 T'\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; map Receive1 T'\<rbrakk>\<^sub>d \<I>"
   "\<lbrakk>M; [Receive T']\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; [Receive T']\<rbrakk>\<^sub>d \<I>"
 proof -
   show "\<lbrakk>M; map Receive T\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; map Receive T\<rbrakk>\<^sub>d \<I>" by (induct T arbitrary: M) auto
   show "\<lbrakk>M; map Receive1 T'\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; map Receive1 T'\<rbrakk>\<^sub>d \<I>" by (induct T' arbitrary: M) auto
   show "\<lbrakk>M; [Receive T']\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; [Receive T']\<rbrakk>\<^sub>d \<I>" by (induct T' arbitrary: M) auto
 qed
 
 lemma strand_sem_append[intro]:
   "\<lbrakk>\<lbrakk>M; S\<rbrakk>\<^sub>c \<theta>; \<lbrakk>M \<union> (ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>); S'\<rbrakk>\<^sub>c \<theta>\<rbrakk> \<Longrightarrow> \<lbrakk>M; S@S'\<rbrakk>\<^sub>c \<theta>"
   "\<lbrakk>\<lbrakk>M; S\<rbrakk>\<^sub>d \<theta>; \<lbrakk>M \<union> (ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>); S'\<rbrakk>\<^sub>d \<theta>\<rbrakk> \<Longrightarrow> \<lbrakk>M; S@S'\<rbrakk>\<^sub>d \<theta>"
 proof (induction S arbitrary: M)
   case (Cons x S) 
   { case 1 thus ?case using Cons
     proof (cases x)
       case (Receive ts) thus ?thesis
         using 1 Cons.IH(1)[of "(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M"]
               strand_sem_c.simps(3)[of M ts] image_Un[of "\<lambda>t. t \<cdot> \<theta>" "set ts" "ik\<^sub>s\<^sub>t S"]
         by (metis (no_types, lifting) ik\<^sub>s\<^sub>t.simps(2) Un_assoc Un_commute append_Cons)
     qed auto
   }
   { case 2 thus ?case using Cons
     proof (cases x)
       case (Receive ts) thus ?thesis
         using 2 Cons.IH(2)[of "(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M"]
               strand_sem_d.simps(3)[of M ts] image_Un[of "\<lambda>t. t \<cdot> \<theta>" "set ts" "ik\<^sub>s\<^sub>t S"]
         by (metis (no_types, lifting) ik\<^sub>s\<^sub>t.simps(2) Un_assoc Un_commute append_Cons)
     qed auto
   }
 qed simp_all
 
 lemma ineq_model_subst:
   fixes F::"(('a,'b) term \<times> ('a,'b) term) list"
   assumes "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> set X = {}"
     and "ineq_model (\<delta> \<circ>\<^sub>s \<theta>) X F"
   shows "ineq_model \<theta> X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
 proof -
   { fix \<sigma>::"('a,'b) subst" and t t'
     assume \<sigma>: "subst_domain \<sigma> = set X" "ground (subst_range \<sigma>)"
         and *: "\<exists>(s,t) \<in> set F. s \<cdot> (\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)) \<noteq> t \<cdot> (\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>))"
     obtain f where f: "f \<in> set F" "fst f \<cdot> \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) \<noteq> snd f \<cdot> \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)"
       using * by (induct F) force+
     have "\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) = \<delta> \<circ>\<^sub>s (\<sigma> \<circ>\<^sub>s \<theta>)"
       by (metis (no_types, lifting) \<sigma> subst_compose_assoc assms(1) inf_sup_aci(1)
               subst_comp_eq_if_disjoint_vars sup_inf_absorb range_vars_alt_def) 
     hence "(fst f \<cdot> \<delta>) \<cdot> \<sigma> \<circ>\<^sub>s \<theta> \<noteq> (snd f \<cdot> \<delta>) \<cdot> \<sigma> \<circ>\<^sub>s \<theta>" using f by auto
     moreover have "(fst f \<cdot> \<delta>, snd f \<cdot> \<delta>) \<in> set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
       using f(1) by (auto simp add: subst_apply_pairs_def)
     ultimately have "\<exists>(s,t) \<in> set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>). s \<cdot> (\<sigma> \<circ>\<^sub>s \<theta>) \<noteq> t \<cdot> (\<sigma> \<circ>\<^sub>s \<theta>)"
       using f(1) Bex_set by fastforce
   }
   thus ?thesis using assms unfolding ineq_model_def by simp
 qed
 
 lemma ineq_model_subst':
   fixes F::"(('a,'b) term \<times> ('a,'b) term) list"
   assumes "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> set X = {}"
     and "ineq_model \<theta> X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
   shows "ineq_model (\<delta> \<circ>\<^sub>s \<theta>) X F"
 proof -
   { fix \<sigma>::"('a,'b) subst" and t t'
     assume \<sigma>: "subst_domain \<sigma> = set X" "ground (subst_range \<sigma>)"
         and *: "\<exists>(s,t) \<in> set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>). s \<cdot> (\<sigma> \<circ>\<^sub>s \<theta>) \<noteq> t \<cdot> (\<sigma> \<circ>\<^sub>s \<theta>)"
     obtain f where f: "f \<in> set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)" "fst f \<cdot> \<sigma> \<circ>\<^sub>s \<theta> \<noteq> snd f \<cdot> \<sigma> \<circ>\<^sub>s \<theta>"
       using * by (induct F) auto
     then obtain g where g: "g \<in> set F" "f = g \<cdot>\<^sub>p \<delta>" by (auto simp add: subst_apply_pairs_def)
     have "\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) = \<delta> \<circ>\<^sub>s (\<sigma> \<circ>\<^sub>s \<theta>)"
       by (metis (no_types, lifting) \<sigma> subst_compose_assoc assms(1) inf_sup_aci(1)
               subst_comp_eq_if_disjoint_vars sup_inf_absorb range_vars_alt_def) 
     hence "fst g \<cdot> \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) \<noteq> snd g \<cdot> \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)"
       using f(2) g by (simp add: prod.case_eq_if)
     hence "\<exists>(s,t) \<in> set F. s \<cdot> (\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)) \<noteq> t \<cdot> (\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>))"
       using g Bex_set by fastforce
   }
   thus ?thesis using assms unfolding ineq_model_def by simp
 qed
 
 lemma ineq_model_ground_subst:
   fixes F::"(('a,'b) term \<times> ('a,'b) term) list"
   assumes "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<subseteq> subst_domain \<delta>"
     and "ground (subst_range \<delta>)"
     and "ineq_model \<delta> X F"
   shows "ineq_model (\<delta> \<circ>\<^sub>s \<theta>) X F"
 proof -
   { fix \<sigma>::"('a,'b) subst" and t t'
     assume \<sigma>: "subst_domain \<sigma> = set X" "ground (subst_range \<sigma>)"
         and *: "\<exists>(s,t) \<in> set F. s \<cdot> (\<sigma> \<circ>\<^sub>s \<delta>) \<noteq> t \<cdot> (\<sigma> \<circ>\<^sub>s \<delta> )"
     obtain f where f: "f \<in> set F" "fst f \<cdot> \<sigma> \<circ>\<^sub>s \<delta> \<noteq> snd f \<cdot> \<sigma> \<circ>\<^sub>s \<delta>"
       using * by (induct F) force+
     hence "fv (fst f) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" "fv (snd f) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" by auto
     hence "fv (fst f) - set X \<subseteq> subst_domain \<delta>" "fv (snd f) - set X \<subseteq> subst_domain \<delta>"
       using assms(1) by auto
     hence "fv (fst f \<cdot> \<sigma>) \<subseteq> subst_domain \<delta>" "fv (snd f \<cdot> \<sigma>) \<subseteq> subst_domain \<delta>"
       using \<sigma> by (simp_all add: range_vars_alt_def subst_fv_unfold_ground_img)
     hence "fv (fst f \<cdot> \<sigma> \<circ>\<^sub>s \<delta>) = {}" "fv (snd f \<cdot> \<sigma> \<circ>\<^sub>s \<delta>) = {}"
       using assms(2) by (simp_all add: subst_fv_dom_ground_if_ground_img)
     hence "fst f \<cdot> \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>) \<noteq> snd f \<cdot> \<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)" using f(2) subst_ground_ident by fastforce 
     hence "\<exists>(s,t) \<in> set F. s \<cdot> (\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>)) \<noteq> t \<cdot> (\<sigma> \<circ>\<^sub>s (\<delta> \<circ>\<^sub>s \<theta>))"
       using f(1) Bex_set by fastforce
   }
   thus ?thesis using assms unfolding ineq_model_def by simp
 qed
 
 context
 begin
 private lemma strand_sem_subst_c:
   assumes "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t S = {}"
   shows "\<lbrakk>M; S\<rbrakk>\<^sub>c (\<delta> \<circ>\<^sub>s \<theta>) \<Longrightarrow> \<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<theta>"
 using assms
 proof (induction S arbitrary: \<delta> M rule: strand_sem_induct)
   case (ConsSnd M ts S)
   hence "\<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<theta>" "\<forall>t \<in> set ts. M \<turnstile>\<^sub>c t \<cdot> (\<delta> \<circ>\<^sub>s \<theta>)" by auto
   hence "\<forall>t \<in> set ts. M \<turnstile>\<^sub>c (t \<cdot> \<delta>) \<cdot> \<theta>"
     using subst_comp_all[of \<delta> \<theta> M] subst_subst_compose[of _ \<delta> \<theta>] by simp
   hence "\<forall>t \<in> set (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>). M \<turnstile>\<^sub>c t \<cdot> \<theta>" by fastforce
   thus ?case
     using \<open>\<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<theta>\<close>
     unfolding subst_apply_strand_def 
     by simp
 next
   case (ConsRcv M ts S)
   have *: "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<circ>\<^sub>s \<theta>) \<union> M; S\<rbrakk>\<^sub>c (\<delta> \<circ>\<^sub>s \<theta>)" using ConsRcv.prems(1) by simp
   have "bvars\<^sub>s\<^sub>t (Receive ts#S) = bvars\<^sub>s\<^sub>t S" by auto
   hence **: "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t S = {}" using ConsRcv.prems(2) by blast
   have "\<lbrakk>M; Receive (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)#(S \<cdot>\<^sub>s\<^sub>t \<delta>)\<rbrakk>\<^sub>c \<theta>"
     using ConsRcv.IH[OF * **] by (metis (no_types) image_set strand_sem_c.simps(3) subst_comp_all)
   thus ?case by simp
 next
   case (ConsIneq M X F S)
   hence *: "\<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<theta>" and
         ***: "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> set X = {}" 
     unfolding bvars\<^sub>s\<^sub>t_def ineq_model_def by auto
   have **: "ineq_model (\<delta> \<circ>\<^sub>s \<theta>) X F"
     using ConsIneq by (auto simp add: subst_compose_assoc ineq_model_def)
   have "\<forall>\<gamma>. subst_domain \<gamma> = set X \<and> ground (subst_range \<gamma>)
           \<longrightarrow> (subst_domain \<delta> \<union> range_vars \<delta>) \<inter> (subst_domain \<gamma> \<union> range_vars \<gamma>) = {}"
     using * ** *** unfolding range_vars_alt_def by auto
   hence "\<forall>\<gamma>. subst_domain \<gamma> = set X \<and> ground (subst_range \<gamma>) \<longrightarrow> \<gamma> \<circ>\<^sub>s \<delta> = \<delta> \<circ>\<^sub>s \<gamma>"
     by (metis subst_comp_eq_if_disjoint_vars)
   hence "ineq_model \<theta> X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
     using ineq_model_subst[OF *** **]
     by blast
   moreover have "rm_vars (set X) \<delta> = \<delta>" using ConsIneq.prems(2) by force
   ultimately show ?case using * by auto
 qed simp_all
 
 private lemma strand_sem_subst_c':
   assumes "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t S = {}"
   shows "\<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<theta> \<Longrightarrow> \<lbrakk>M; S\<rbrakk>\<^sub>c (\<delta> \<circ>\<^sub>s \<theta>)"
 using assms
 proof (induction S arbitrary: \<delta> M rule: strand_sem_induct)
   case (ConsSnd M ts S)
   hence "\<lbrakk>M; [Send ts] \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<theta>" "\<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<theta>" by auto
   hence "\<lbrakk>M; S\<rbrakk>\<^sub>c (\<delta> \<circ>\<^sub>s \<theta>)" using ConsSnd.IH[OF _] ConsSnd.prems(2) by auto
   moreover have "\<lbrakk>M; [Send ts]\<rbrakk>\<^sub>c (\<delta> \<circ>\<^sub>s \<theta>)"
   proof -
     have "\<lbrakk>M; [send\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>c \<theta>" using \<open>\<lbrakk>M; [Send ts] \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<theta>\<close> by simp
     hence "\<forall>t \<in> set (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>). M \<turnstile>\<^sub>c t \<cdot> \<theta>" by simp
     hence "\<forall>t \<in> set ts. M \<turnstile>\<^sub>c t \<cdot> \<delta> \<cdot> \<theta>" by auto
     hence "\<forall>t \<in> set ts. M \<turnstile>\<^sub>c t \<cdot> (\<delta> \<circ>\<^sub>s \<theta>)" using subst_subst_compose by metis
     thus "\<lbrakk>M; [Send ts]\<rbrakk>\<^sub>c (\<delta> \<circ>\<^sub>s \<theta>)" by auto
   qed
   ultimately show ?case by auto
 next
   case (ConsRcv M ts S)
   hence "\<lbrakk>((set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M); S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<theta>" by (simp add: subst_all_insert)
   hence "\<lbrakk>((set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<circ>\<^sub>s \<theta>) \<union> M); S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<theta>" by (metis subst_comp_all)
   thus ?case using ConsRcv.IH ConsRcv.prems(2)  by auto
 next
   case (ConsIneq M X F S)
   have \<delta>: "rm_vars (set X) \<delta> = \<delta>" using ConsIneq.prems(2) by force
   hence *: "\<lbrakk>M; S\<rbrakk>\<^sub>c (\<delta> \<circ>\<^sub>s \<theta>)"
     and ***: "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> set X = {}"
     using ConsIneq unfolding bvars\<^sub>s\<^sub>t_def ineq_model_def by auto
   have **: "ineq_model \<theta> X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
     using ConsIneq.prems(1) \<delta> by (auto simp add: subst_compose_assoc ineq_model_def)
   have "\<forall>\<gamma>. subst_domain \<gamma> = set X \<and> ground (subst_range \<gamma>)
           \<longrightarrow> (subst_domain \<delta> \<union> range_vars \<delta>) \<inter> (subst_domain \<gamma> \<union> range_vars \<gamma>) = {}"
     using * ** *** unfolding range_vars_alt_def by auto
   hence "\<forall>\<gamma>. subst_domain \<gamma> = set X \<and> ground (subst_range \<gamma>) \<longrightarrow> \<gamma> \<circ>\<^sub>s \<delta> = \<delta> \<circ>\<^sub>s \<gamma>"
     by (metis subst_comp_eq_if_disjoint_vars)
   hence "ineq_model (\<delta> \<circ>\<^sub>s \<theta>) X F"
     using ineq_model_subst'[OF *** **]
     by blast
   thus ?case using * by auto
 next
   case ConsEq thus ?case unfolding bvars\<^sub>s\<^sub>t_def by auto
 qed simp_all
 
 private lemma strand_sem_subst_d:
   assumes "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t S = {}"
   shows "\<lbrakk>M; S\<rbrakk>\<^sub>d (\<delta> \<circ>\<^sub>s \<theta>) \<Longrightarrow> \<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>d \<theta>"
 using assms
 proof (induction S arbitrary: \<delta> M rule: strand_sem_induct)
   case (ConsSnd M ts S)
   hence "\<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>d \<theta>" "\<forall>t \<in> set ts. M \<turnstile> t \<cdot> (\<delta> \<circ>\<^sub>s \<theta>)" by auto
   hence "\<forall>t \<in> set ts. M \<turnstile> (t \<cdot> \<delta>) \<cdot> \<theta>"
     using subst_comp_all[of \<delta> \<theta> M] subst_subst_compose[of _ \<delta> \<theta>] by simp
   hence "\<forall>t \<in> set (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>). M \<turnstile> t \<cdot> \<theta>" by simp
   thus ?case using \<open>\<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>d \<theta>\<close> by simp
 next
   case (ConsRcv M ts S) 
   have "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<circ>\<^sub>s \<theta>) \<union> M; S\<rbrakk>\<^sub>d (\<delta> \<circ>\<^sub>s \<theta>)" using ConsRcv.prems(1) by simp
   hence *: "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M; S\<rbrakk>\<^sub>d (\<delta> \<circ>\<^sub>s \<theta>)" by (metis subst_comp_all)
   have "bvars\<^sub>s\<^sub>t (Receive ts#S) = bvars\<^sub>s\<^sub>t S" by auto
   hence **: "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t S = {}" using ConsRcv.prems(2) by blast
   have "\<lbrakk>M; Receive (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)#(S \<cdot>\<^sub>s\<^sub>t \<delta>)\<rbrakk>\<^sub>d \<theta>" using ConsRcv.IH[OF * **] by simp
   thus ?case by simp
 next
   case (ConsIneq M X F S)
   hence *: "\<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>d \<theta>" and
         ***: "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> set X = {}" 
     unfolding bvars\<^sub>s\<^sub>t_def ineq_model_def by auto
   have **: "ineq_model (\<delta> \<circ>\<^sub>s \<theta>) X F"
     using ConsIneq by (auto simp add: subst_compose_assoc ineq_model_def)
   have "\<forall>\<gamma>. subst_domain \<gamma> = set X \<and> ground (subst_range \<gamma>)
           \<longrightarrow> (subst_domain \<delta> \<union> range_vars \<delta>) \<inter> (subst_domain \<gamma> \<union> range_vars \<gamma>) = {}"
     using * ** *** unfolding range_vars_alt_def by auto
   hence "\<forall>\<gamma>. subst_domain \<gamma> = set X \<and> ground (subst_range \<gamma>) \<longrightarrow> \<gamma> \<circ>\<^sub>s \<delta> = \<delta> \<circ>\<^sub>s \<gamma>"
     by (metis subst_comp_eq_if_disjoint_vars)
   hence "ineq_model \<theta> X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
     using ineq_model_subst[OF *** **]
     by blast
   moreover have "rm_vars (set X) \<delta> = \<delta>" using ConsIneq.prems(2) by force
   ultimately show ?case using * by auto
 next
   case ConsEq thus ?case unfolding bvars\<^sub>s\<^sub>t_def by auto
 qed simp_all
 
 private lemma strand_sem_subst_d':
   assumes "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t S = {}"
   shows "\<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>d \<theta> \<Longrightarrow> \<lbrakk>M; S\<rbrakk>\<^sub>d (\<delta> \<circ>\<^sub>s \<theta>)"
 using assms
 proof (induction S arbitrary: \<delta> M rule: strand_sem_induct)
   case (ConsSnd M ts S)
   hence "\<lbrakk>M; [Send ts] \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>d \<theta>" "\<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>d \<theta>" by auto
   hence "\<lbrakk>M; S\<rbrakk>\<^sub>d (\<delta> \<circ>\<^sub>s \<theta>)" using ConsSnd.IH[OF _] ConsSnd.prems(2) by auto
   moreover have "\<lbrakk>M; [Send ts]\<rbrakk>\<^sub>d (\<delta> \<circ>\<^sub>s \<theta>)"
   proof -
     have "\<lbrakk>M; [send\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>d \<theta>" using \<open>\<lbrakk>M; [Send ts] \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>d \<theta>\<close> by simp
     hence "\<forall>t \<in> set (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>). M \<turnstile> t \<cdot> \<theta>" by simp
     hence "\<forall>t \<in> set ts. M \<turnstile> t \<cdot> \<delta> \<cdot> \<theta>" by auto
     hence "\<forall>t \<in> set ts. M \<turnstile> t \<cdot> (\<delta> \<circ>\<^sub>s \<theta>)" using subst_subst_compose by metis
     thus "\<lbrakk>M; [Send ts]\<rbrakk>\<^sub>d (\<delta> \<circ>\<^sub>s \<theta>)" by auto
   qed
   ultimately show ?case by auto
 next
   case (ConsRcv M ts S)
   hence "\<lbrakk>((set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> M); S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>d \<theta>" by (simp add: subst_all_insert)
   hence "\<lbrakk>((set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<circ>\<^sub>s \<theta>) \<union> M); S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>d \<theta>" by (metis subst_comp_all)
   thus ?case using ConsRcv.IH ConsRcv.prems(2) by auto
 next
   case (ConsIneq M X F S)
   have \<delta>: "rm_vars (set X) \<delta> = \<delta>" using ConsIneq.prems(2) by force
   hence *: "\<lbrakk>M; S\<rbrakk>\<^sub>d (\<delta> \<circ>\<^sub>s \<theta>)"
     and ***: "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> set X = {}"
     using ConsIneq unfolding bvars\<^sub>s\<^sub>t_def ineq_model_def by auto
   have **: "ineq_model \<theta> X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
     using ConsIneq.prems(1) \<delta> by (auto simp add: subst_compose_assoc ineq_model_def)
   have "\<forall>\<gamma>. subst_domain \<gamma> = set X \<and> ground (subst_range \<gamma>)
           \<longrightarrow> (subst_domain \<delta> \<union> range_vars \<delta>) \<inter> (subst_domain \<gamma> \<union> range_vars \<gamma>) = {}"
     using * ** *** unfolding range_vars_alt_def by auto
   hence "\<forall>\<gamma>. subst_domain \<gamma> = set X \<and> ground (subst_range \<gamma>) \<longrightarrow> \<gamma> \<circ>\<^sub>s \<delta> = \<delta> \<circ>\<^sub>s \<gamma>"
     by (metis subst_comp_eq_if_disjoint_vars)
   hence "ineq_model (\<delta> \<circ>\<^sub>s \<theta>) X F"
     using ineq_model_subst'[OF *** **]
     by blast
   thus ?case using * by auto
 next
   case ConsEq thus ?case unfolding bvars\<^sub>s\<^sub>t_def by auto
 qed simp_all
 
 lemmas strand_sem_subst =
   strand_sem_subst_c strand_sem_subst_c' strand_sem_subst_d strand_sem_subst_d'
 end
 
 lemma strand_sem_subst_subst_idem:
   assumes \<delta>: "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t S = {}"
   shows "\<lbrakk>\<lbrakk>M; S \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c (\<delta> \<circ>\<^sub>s \<theta>); subst_idem \<delta>\<rbrakk> \<Longrightarrow> \<lbrakk>M; S\<rbrakk>\<^sub>c (\<delta> \<circ>\<^sub>s \<theta>)"
 using strand_sem_subst(2)[OF assms, of M "\<delta> \<circ>\<^sub>s \<theta>"] subst_compose_assoc[of \<delta> \<delta> \<theta>]
 unfolding subst_idem_def by argo
 
 lemma strand_sem_subst_comp:
   assumes "(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t S = {}"
     and "\<lbrakk>M; S\<rbrakk>\<^sub>c \<delta>" "subst_domain \<theta> \<inter> (vars\<^sub>s\<^sub>t S \<union> fv\<^sub>s\<^sub>e\<^sub>t M) = {}"
   shows "\<lbrakk>M; S\<rbrakk>\<^sub>c (\<theta> \<circ>\<^sub>s \<delta>)"
 proof -
   from assms(3) have "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t S = {}" "subst_domain \<theta> \<inter> fv\<^sub>s\<^sub>e\<^sub>t M = {}" by auto
   hence "S \<cdot>\<^sub>s\<^sub>t \<theta> = S" "M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = M" using strand_substI set_subst_ident[of M \<theta>] by (blast, blast)
   thus ?thesis using assms(2) by (auto simp add: strand_sem_subst(2)[OF assms(1)])
 qed
 
 lemma strand_sem_c_imp_ineqs_neq:
   assumes "\<lbrakk>M; S\<rbrakk>\<^sub>c \<I>" "Inequality X [(t,t')] \<in> set S"
   shows "t \<noteq> t' \<and> (\<forall>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>)
                         \<longrightarrow> t \<cdot> \<delta> \<noteq> t' \<cdot> \<delta> \<and> t \<cdot> \<delta> \<cdot> \<I> \<noteq> t' \<cdot> \<delta> \<cdot> \<I>)"
 using assms
 proof (induction rule: strand_sem_induct)
   case (ConsIneq M Y F S) thus ?case
   proof (cases "Inequality X [(t,t')] \<in> set S")
     case False
     hence "X = Y" "F = [(t,t')]" using ConsIneq by auto
     hence *: "\<forall>\<theta>. subst_domain \<theta> = set X \<and> ground (subst_range \<theta>) \<longrightarrow> t \<cdot> \<theta> \<cdot> \<I> \<noteq> t' \<cdot> \<theta> \<cdot> \<I>"
       using ConsIneq by (auto simp add: ineq_model_def)
     then obtain \<theta> where \<theta>: "subst_domain \<theta> = set X" "ground (subst_range \<theta>)" "t \<cdot> \<theta> \<cdot> \<I> \<noteq> t' \<cdot> \<theta> \<cdot> \<I>"
       using interpretation_subst_exists'[of "set X"] by moura
     hence "t \<noteq> t'" by auto
     moreover have "\<And>\<I> \<theta>. t \<cdot> \<theta> \<cdot> \<I> \<noteq> t' \<cdot> \<theta> \<cdot> \<I> \<Longrightarrow> t \<cdot> \<theta> \<noteq> t' \<cdot> \<theta>" by auto
     ultimately show ?thesis using * by auto
   qed simp
 qed simp_all
 
 lemma strand_sem_c_imp_ineq_model:
   assumes "\<lbrakk>M; S\<rbrakk>\<^sub>c \<I>" "Inequality X F \<in> set S"
   shows "ineq_model \<I> X F"
 using assms by (induct S rule: strand_sem_induct) force+
 
 lemma strand_sem_wf_simple_fv_sat:
   assumes "wf\<^sub>s\<^sub>t {} S" "simple S" "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>"
   shows "\<And>v. v \<in> wfrestrictedvars\<^sub>s\<^sub>t S \<Longrightarrow> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c \<I> v"
 using assms
 proof (induction S rule: wf\<^sub>s\<^sub>t_simple_induct)
   case (ConsRcv t S)
   have "v \<in> wfrestrictedvars\<^sub>s\<^sub>t S"
     using ConsRcv.hyps(3) ConsRcv.prems(1) vars_snd_rcv_strand2
     by fastforce
   moreover have "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" using \<open>\<lbrakk>{}; S@[Receive t]\<rbrakk>\<^sub>c \<I>\<close> by blast
   moreover have "ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> ik\<^sub>s\<^sub>t (S@[Receive t]) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by auto
   ultimately show ?case using ConsRcv.IH ideduct_synth_mono by meson
 next
   case (ConsIneq X F S)
   hence "v \<in> wfrestrictedvars\<^sub>s\<^sub>t S" by fastforce
   moreover have "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" using \<open>\<lbrakk>{}; S@[Inequality X F]\<rbrakk>\<^sub>c \<I>\<close> by blast
   moreover have "ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> ik\<^sub>s\<^sub>t (S@[Inequality X F]) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by auto
   ultimately show ?case using ConsIneq.IH ideduct_synth_mono by meson
 next
   case (ConsSnd w S)
   hence *: "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c \<I> w" by auto
   have **: "ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> ik\<^sub>s\<^sub>t (S@[Send [Var w]]) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by simp
   show ?case
   proof (cases "v = w")
     case True thus ?thesis using *(2) ideduct_synth_mono[OF _ **] by meson
   next
     case False
     hence "v \<in> wfrestrictedvars\<^sub>s\<^sub>t S" using ConsSnd.prems(1) by auto
     thus ?thesis using ConsSnd.IH[OF _ *(1)] ideduct_synth_mono[OF _ **] by metis
   qed
 qed simp
 
 lemma strand_sem_wf_ik_or_assignment_rhs_fun_subterm:
   assumes "wf\<^sub>s\<^sub>t {} A" "\<lbrakk>{}; A\<rbrakk>\<^sub>c \<I>" "Var x \<in> ik\<^sub>s\<^sub>t A" "\<I> x = Fun f T"
           "t\<^sub>i \<in> set T" "\<not>ik\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t\<^sub>i" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
   obtains S where
     "Fun f S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t A) \<or> Fun f S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (assignment_rhs\<^sub>s\<^sub>t A)"
     "Fun f T = Fun f S \<cdot> \<I>"
 proof -
   have "x \<in> wfrestrictedvars\<^sub>s\<^sub>t A"
     by (metis (no_types) assms(3) set_rev_mp term.set_intros(3) vars_subset_if_in_strand_ik2)
   moreover have "Fun f T \<cdot> \<I> = Fun f T"
     by (metis subst_ground_ident interpretation_grounds_all assms(4,7))
   ultimately obtain A\<^sub>p\<^sub>r\<^sub>e A\<^sub>s\<^sub>u\<^sub>f where *:
       "\<not>(\<exists>w \<in> wfrestrictedvars\<^sub>s\<^sub>t A\<^sub>p\<^sub>r\<^sub>e. Fun f T \<sqsubseteq> \<I> w)"
       "(\<exists>t. A = A\<^sub>p\<^sub>r\<^sub>e@Send t#A\<^sub>s\<^sub>u\<^sub>f \<and> Fun f T \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<or>
        (\<exists>t t'. A = A\<^sub>p\<^sub>r\<^sub>e@Equality Assign t t'#A\<^sub>s\<^sub>u\<^sub>f \<and> Fun f T \<sqsubseteq> t \<cdot> \<I>)"
     using wf_strand_first_Send_var_split[OF assms(1)] assms(4) subtermeqI' by metis
   moreover
   { fix ts assume **: "A = A\<^sub>p\<^sub>r\<^sub>e@Send ts#A\<^sub>s\<^sub>u\<^sub>f" "Fun f T \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     hence ***: "\<forall>t \<in> set ts. ik\<^sub>s\<^sub>t A\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>" "\<not>ik\<^sub>s\<^sub>t A\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t\<^sub>i"
       using assms(2,6) by (auto intro: ideduct_synth_mono)
     then obtain t where t: "t \<in> set ts" "Fun f T \<sqsubseteq> t \<cdot> \<I>" "ik\<^sub>s\<^sub>t A\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
       using **(2) by blast
     obtain s where s: "s \<in> ik\<^sub>s\<^sub>t A\<^sub>p\<^sub>r\<^sub>e" "Fun f T \<sqsubseteq> s \<cdot> \<I>"
       using t(3,2) ***(2) assms(5) by (induct rule: intruder_synth_induct) auto
     then obtain g S where gS: "Fun g S \<sqsubseteq> s" "Fun f T = Fun g S \<cdot> \<I>"
       using subterm_subst_not_img_subterm[OF s(2)] *(1) by force
     hence ?thesis using that **(1) s(1) by force
   }
   moreover
   { fix t t' assume **: "A = A\<^sub>p\<^sub>r\<^sub>e@Equality Assign t t'#A\<^sub>s\<^sub>u\<^sub>f" "Fun f T \<sqsubseteq> t \<cdot> \<I>"
     with assms(2) have "t \<cdot> \<I> = t' \<cdot> \<I>" by auto
     hence "Fun f T \<sqsubseteq> t' \<cdot> \<I>" using **(2) by auto
     from assms(1) **(1) have "fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t A\<^sub>p\<^sub>r\<^sub>e"
       using wf_eq_fv[of "{}" A\<^sub>p\<^sub>r\<^sub>e t t' A\<^sub>s\<^sub>u\<^sub>f] vars_snd_rcv_strand_subset2(4)[of A\<^sub>p\<^sub>r\<^sub>e]
       by blast
     then obtain g S where gS: "Fun g S \<sqsubseteq> t'" "Fun f T = Fun g S \<cdot> \<I>"
       using subterm_subst_not_img_subterm[OF \<open>Fun f T \<sqsubseteq> t' \<cdot> \<I>\<close>] *(1) by fastforce
     hence ?thesis using that **(1) by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma ineq_model_not_unif_is_sat_ineq:
   assumes "\<nexists>\<theta>. Unifier \<theta> t t'"
   shows "ineq_model \<I> X [(t, t')]"
 using assms list.set_intros(1)[of "(t,t')" "[]"]
 unfolding ineq_model_def by blast
 
 lemma strand_sem_not_unif_is_sat_ineq:
   assumes "\<nexists>\<theta>. Unifier \<theta> t t'"
   shows "\<lbrakk>M; [Inequality X [(t,t')]]\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; [Inequality X [(t,t')]]\<rbrakk>\<^sub>d \<I>"
 using ineq_model_not_unif_is_sat_ineq[OF assms]
       strand_sem_c.simps(1,5)[of M] strand_sem_d.simps(1,5)[of M]
 by presburger+
 
 lemma ineq_model_singleI[intro]:
   assumes "\<forall>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>) \<longrightarrow> t \<cdot> \<delta> \<cdot> \<I> \<noteq> t' \<cdot> \<delta> \<cdot> \<I>"
   shows "ineq_model \<I> X [(t,t')]"
 using assms unfolding ineq_model_def by auto
 
 lemma ineq_model_singleE:
   assumes "ineq_model \<I> X [(t,t')]"
   shows "\<forall>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>) \<longrightarrow> t \<cdot> \<delta> \<cdot> \<I> \<noteq> t' \<cdot> \<delta> \<cdot> \<I>"
 using assms unfolding ineq_model_def by auto
 
 lemma ineq_model_single_iff:
   fixes F::"(('a,'b) term \<times> ('a,'b) term) list"
   shows "ineq_model \<I> X F \<longleftrightarrow>
          ineq_model \<I> X [(Fun f (Fun c []#map fst F),Fun f (Fun c []#map snd F))]"
     (is "?A \<longleftrightarrow> ?B")
 proof -
   let ?P = "\<lambda>\<delta> f. fst f \<cdot> (\<delta> \<circ>\<^sub>s \<I>) \<noteq> snd f \<cdot> (\<delta> \<circ>\<^sub>s \<I>)"
   let ?Q = "\<lambda>\<delta> t t'. t \<cdot> (\<delta> \<circ>\<^sub>s \<I>) \<noteq> t' \<cdot> (\<delta> \<circ>\<^sub>s \<I>)"
   let ?T = "\<lambda>g. Fun c []#map g F"
   let ?S = "\<lambda>\<delta> g. map (\<lambda>x. x \<cdot> (\<delta> \<circ>\<^sub>s \<I>)) (Fun c []#map g F)"
   let ?t = "Fun f (?T fst)"
   let ?t' = "Fun f (?T snd)"
 
   have len: "\<And>g h. length (?T g) = length (?T h)"
             "\<And>g h \<delta>. length (?S \<delta> g) = length (?T h)"
             "\<And>g h \<delta>. length (?S \<delta> g) = length (?T h)"
             "\<And>g h \<delta> \<sigma>. length (?S \<delta> g) = length (?S \<sigma> h)"
     by simp_all
 
   { fix \<delta>::"('a,'b) subst"
     assume \<delta>: "subst_domain \<delta> = set X" "ground (subst_range \<delta>)"
     have "list_ex (?P \<delta>) F \<longleftrightarrow> ?Q \<delta> ?t ?t'"
     proof
       assume "list_ex (?P \<delta>) F"
       then obtain a where a: "a \<in> set F" "?P \<delta> a" by (metis (mono_tags, lifting) Bex_set)
       thus "?Q \<delta> ?t ?t'" by auto
     qed (fastforce simp add: Bex_set)
   } thus ?thesis unfolding ineq_model_def case_prod_unfold by auto
 qed
 
 
 subsection \<open>Constraint Semantics (Alternative, Equivalent Version)\<close>
 text \<open>These are the constraint semantics used in the CSF 2017 paper\<close>
 fun strand_sem_c'::"('fun,'var) terms \<Rightarrow> ('fun,'var) strand \<Rightarrow> ('fun,'var) subst \<Rightarrow> bool"  ("\<lbrakk>_; _\<rbrakk>\<^sub>c''") 
   where
   "\<lbrakk>M; []\<rbrakk>\<^sub>c' = (\<lambda>\<I>. True)"
 | "\<lbrakk>M; Send ts#S\<rbrakk>\<^sub>c' = (\<lambda>\<I>. (\<forall>t \<in> set ts. M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>) \<and> \<lbrakk>M; S\<rbrakk>\<^sub>c' \<I>)"
 | "\<lbrakk>M; Receive ts#S\<rbrakk>\<^sub>c' = \<lbrakk>set ts \<union> M; S\<rbrakk>\<^sub>c'"
 | "\<lbrakk>M; Equality _ t t'#S\<rbrakk>\<^sub>c' = (\<lambda>\<I>. t \<cdot> \<I> = t' \<cdot> \<I> \<and> \<lbrakk>M; S\<rbrakk>\<^sub>c' \<I>)"
 | "\<lbrakk>M; Inequality X F#S\<rbrakk>\<^sub>c' = (\<lambda>\<I>. ineq_model \<I> X F \<and> \<lbrakk>M; S\<rbrakk>\<^sub>c' \<I>)"
 
 fun strand_sem_d'::"('fun,'var) terms \<Rightarrow> ('fun,'var) strand \<Rightarrow> ('fun,'var) subst \<Rightarrow> bool" ("\<lbrakk>_; _\<rbrakk>\<^sub>d''")
 where
   "\<lbrakk>M; []\<rbrakk>\<^sub>d' = (\<lambda>\<I>. True)"
 | "\<lbrakk>M; Send ts#S\<rbrakk>\<^sub>d' = (\<lambda>\<I>. (\<forall>t \<in> set ts. M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>) \<and> \<lbrakk>M; S\<rbrakk>\<^sub>d' \<I>)"
 | "\<lbrakk>M; Receive ts#S\<rbrakk>\<^sub>d' = \<lbrakk>set ts \<union> M; S\<rbrakk>\<^sub>d'"
 | "\<lbrakk>M; Equality _ t t'#S\<rbrakk>\<^sub>d' = (\<lambda>\<I>. t \<cdot> \<I> = t' \<cdot> \<I> \<and> \<lbrakk>M; S\<rbrakk>\<^sub>d' \<I>)"
 | "\<lbrakk>M; Inequality X F#S\<rbrakk>\<^sub>d' = (\<lambda>\<I>. ineq_model \<I> X F \<and> \<lbrakk>M; S\<rbrakk>\<^sub>d' \<I>)"
 
 lemma strand_sem_eq_defs:
   "\<lbrakk>M; \<A>\<rbrakk>\<^sub>c' \<I> = \<lbrakk>M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; \<A>\<rbrakk>\<^sub>c \<I>"
   "\<lbrakk>M; \<A>\<rbrakk>\<^sub>d' \<I> = \<lbrakk>M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; \<A>\<rbrakk>\<^sub>d \<I>"
 proof -
   have 1: "\<lbrakk>M; \<A>\<rbrakk>\<^sub>c' \<I> \<Longrightarrow> \<lbrakk>M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; \<A>\<rbrakk>\<^sub>c \<I>"
   proof (induction \<A> arbitrary: M rule: strand_sem_induct)
     case (ConsRcv M ts S) thus ?case by (fastforce simp add: image_Un[of "\<lambda>t. t \<cdot> \<I>"])
   qed simp_all
 
   have 2: "\<lbrakk>M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; \<A>\<rbrakk>\<^sub>c \<I> \<Longrightarrow> \<lbrakk>M; \<A>\<rbrakk>\<^sub>c' \<I>"
   proof (induction \<A> arbitrary: M rule: strand_sem_c'.induct)
     case (3 M ts S) thus ?case by (fastforce simp add: image_Un[of "\<lambda>t. t \<cdot> \<I>"])
   qed simp_all
 
   have 3: "\<lbrakk>M; \<A>\<rbrakk>\<^sub>d' \<I> \<Longrightarrow> \<lbrakk>M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; \<A>\<rbrakk>\<^sub>d \<I>"
   proof (induction \<A> arbitrary: M rule: strand_sem_induct)
     case (ConsRcv M ts S) thus ?case by (fastforce simp add: image_Un[of "\<lambda>t. t \<cdot> \<I>"])
   qed simp_all
 
   have 4: "\<lbrakk>M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; \<A>\<rbrakk>\<^sub>d \<I> \<Longrightarrow> \<lbrakk>M; \<A>\<rbrakk>\<^sub>d' \<I>"
   proof (induction \<A> arbitrary: M rule: strand_sem_d'.induct)
     case (3 M ts S) thus ?case by (fastforce simp add: image_Un[of "\<lambda>t. t \<cdot> \<I>"])
   qed simp_all
 
   show "\<lbrakk>M; \<A>\<rbrakk>\<^sub>c' \<I> = \<lbrakk>M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; \<A>\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; \<A>\<rbrakk>\<^sub>d' \<I> = \<lbrakk>M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; \<A>\<rbrakk>\<^sub>d \<I>"
     by (metis 1 2, metis 3 4)
 qed
 
 lemma strand_sem_split'[dest]:
   "\<lbrakk>M; S@S'\<rbrakk>\<^sub>c' \<theta> \<Longrightarrow> \<lbrakk>M; S\<rbrakk>\<^sub>c' \<theta>" 
   "\<lbrakk>M; S@S'\<rbrakk>\<^sub>c' \<theta> \<Longrightarrow> \<lbrakk>M \<union> ik\<^sub>s\<^sub>t S; S'\<rbrakk>\<^sub>c' \<theta>"
   "\<lbrakk>M; S@S'\<rbrakk>\<^sub>d' \<theta> \<Longrightarrow> \<lbrakk>M; S\<rbrakk>\<^sub>d' \<theta>"
   "\<lbrakk>M; S@S'\<rbrakk>\<^sub>d' \<theta> \<Longrightarrow> \<lbrakk>M \<union> ik\<^sub>s\<^sub>t S; S'\<rbrakk>\<^sub>d' \<theta>"
 using strand_sem_eq_defs[of M "S@S'" \<theta>]
       strand_sem_eq_defs[of M S \<theta>]
       strand_sem_eq_defs[of "M \<union> ik\<^sub>s\<^sub>t S" S' \<theta>]
       strand_sem_split(2,4)
 by (auto simp add: image_Un)
 
 lemma strand_sem_append'[intro]:
   "\<lbrakk>M; S\<rbrakk>\<^sub>c' \<theta> \<Longrightarrow> \<lbrakk>M \<union> ik\<^sub>s\<^sub>t S; S'\<rbrakk>\<^sub>c' \<theta> \<Longrightarrow> \<lbrakk>M; S@S'\<rbrakk>\<^sub>c' \<theta>"
   "\<lbrakk>M; S\<rbrakk>\<^sub>d' \<theta> \<Longrightarrow> \<lbrakk>M \<union> ik\<^sub>s\<^sub>t S; S'\<rbrakk>\<^sub>d' \<theta> \<Longrightarrow> \<lbrakk>M; S@S'\<rbrakk>\<^sub>d' \<theta>"
 using strand_sem_eq_defs[of M "S@S'" \<theta>]
       strand_sem_eq_defs[of M S \<theta>]
       strand_sem_eq_defs[of "M \<union> ik\<^sub>s\<^sub>t S" S' \<theta>]
 by (auto simp add: image_Un)
 
 end
 
 subsection \<open>Dual Strands\<close>
 fun dual\<^sub>s\<^sub>t::"('a,'b) strand \<Rightarrow> ('a,'b) strand" where
   "dual\<^sub>s\<^sub>t [] = []"
 | "dual\<^sub>s\<^sub>t (Receive t#S) = Send t#(dual\<^sub>s\<^sub>t S)"
 | "dual\<^sub>s\<^sub>t (Send t#S) = Receive t#(dual\<^sub>s\<^sub>t S)"
 | "dual\<^sub>s\<^sub>t (x#S) = x#(dual\<^sub>s\<^sub>t S)"
 
 lemma dual\<^sub>s\<^sub>t_append: "dual\<^sub>s\<^sub>t (A@B) = (dual\<^sub>s\<^sub>t A)@(dual\<^sub>s\<^sub>t B)"
 by (induct A rule: dual\<^sub>s\<^sub>t.induct) auto
 
 lemma dual\<^sub>s\<^sub>t_self_inverse: "dual\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t S) = S"
 proof (induction S)
   case (Cons x S) thus ?case by (cases x) auto
 qed simp
 
 lemma dual\<^sub>s\<^sub>t_trms_eq: "trms\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t S) = trms\<^sub>s\<^sub>t S"
 proof (induction S)
   case (Cons x S) thus ?case by (cases x) auto
 qed simp
 
 lemma dual\<^sub>s\<^sub>t_fv: "fv\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t A) = fv\<^sub>s\<^sub>t A"
 by (induct A rule: dual\<^sub>s\<^sub>t.induct) auto
 
 lemma dual\<^sub>s\<^sub>t_bvars: "bvars\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t A) = bvars\<^sub>s\<^sub>t A"
 by (induct A rule: dual\<^sub>s\<^sub>t.induct) fastforce+
 
 
 end
diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Typed_Model.thy b/thys/Stateful_Protocol_Composition_and_Typing/Typed_Model.thy
--- a/thys/Stateful_Protocol_Composition_and_Typing/Typed_Model.thy
+++ b/thys/Stateful_Protocol_Composition_and_Typing/Typed_Model.thy
@@ -1,2208 +1,2208 @@
 (*  Title:      Typed_Model.thy
     Author:     Andreas Viktor Hess, DTU
     SPDX-License-Identifier: BSD-3-Clause
 *)
 
 section \<open>The Typed Model\<close>
 theory Typed_Model
 imports Lazy_Intruder
 begin
 
 text \<open>Term types\<close>
 type_synonym ('f,'v) term_type = "('f,'v) term"
 
 text \<open>Constructors for term types\<close>
 abbreviation (input) TAtom::"'v \<Rightarrow> ('f,'v) term_type" where
   "TAtom a \<equiv> Var a"
 
 abbreviation (input) TComp::"['f, ('f,'v) term_type list] \<Rightarrow> ('f,'v) term_type" where
   "TComp f ts \<equiv> Fun f ts"
 
 
 text \<open>
   The typed model extends the intruder model with a typing function \<open>\<Gamma>\<close> that assigns types to terms.
 \<close>
 locale typed_model = intruder_model arity public Ana
   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)"
   +
   fixes \<Gamma>::"('fun,'var) term \<Rightarrow> ('fun,'atom::finite) term_type"
   assumes const_type: "\<And>c. arity c = 0 \<Longrightarrow> \<exists>a. \<forall>ts. \<Gamma> (Fun c ts) = TAtom a"
     and fun_type: "\<And>f ts. arity f > 0 \<Longrightarrow> \<Gamma> (Fun f ts) = TComp f (map \<Gamma> ts)"
     and \<Gamma>_wf: "\<And>x f ts. TComp f ts \<sqsubseteq> \<Gamma> (Var x) \<Longrightarrow> arity f > 0"
               "\<And>x. wf\<^sub>t\<^sub>r\<^sub>m (\<Gamma> (Var x))"
 begin
 
 
 subsection \<open>Definitions\<close>
 text \<open>The set of atomic types\<close>
 abbreviation "\<TT>\<^sub>a \<equiv> UNIV::('atom set)"
 
 text \<open>Well-typed substitutions\<close>
 definition wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t where
   "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma> \<equiv> (\<forall>v. \<Gamma> (Var v) = \<Gamma> (\<sigma> v))"
 
 text \<open>The set of sub-message patterns (SMP)\<close>
 inductive_set SMP::"('fun,'var) terms \<Rightarrow> ('fun,'var) terms" for M where
   MP[intro]: "t \<in> M \<Longrightarrow> t \<in> SMP M"
 | Subterm[intro]: "\<lbrakk>t \<in> SMP M; t' \<sqsubseteq> t\<rbrakk> \<Longrightarrow> t' \<in> SMP M"
 | Substitution[intro]: "\<lbrakk>t \<in> SMP M; wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>; wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)\<rbrakk> \<Longrightarrow> (t \<cdot> \<delta>) \<in> SMP M"
 | Ana[intro]: "\<lbrakk>t \<in> SMP M; Ana t = (K,T); k \<in> set K\<rbrakk> \<Longrightarrow> k \<in> SMP M"
 
 text \<open>
   Type-flaw resistance for sets:
   Unifiable sub-message patterns must have the same type (unless they are variables)
 \<close>
 definition tfr\<^sub>s\<^sub>e\<^sub>t where
   "tfr\<^sub>s\<^sub>e\<^sub>t M \<equiv> (\<forall>s \<in> SMP M - (Var`\<V>). \<forall>t \<in> SMP M - (Var`\<V>). (\<exists>\<delta>. Unifier \<delta> s t) \<longrightarrow> \<Gamma> s = \<Gamma> t)"
 
 text \<open>
   Type-flaw resistance for strand steps:
   - The terms in a satisfiable equality step must have the same types
   - Inequality steps must satisfy the conditions of the "inequality lemma"\<close>
 fun tfr\<^sub>s\<^sub>t\<^sub>p where
   "tfr\<^sub>s\<^sub>t\<^sub>p (Equality a t t') = ((\<exists>\<delta>. Unifier \<delta> t t') \<longrightarrow> \<Gamma> t = \<Gamma> t')"
 | "tfr\<^sub>s\<^sub>t\<^sub>p (Inequality X F) = (
       (\<forall>x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \<exists>a. \<Gamma> (Var x) = TAtom a) \<or>
       (\<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)))"
 | "tfr\<^sub>s\<^sub>t\<^sub>p _ = True"
 
 text \<open>
   Type-flaw resistance for strands:
   - The set of terms in strands must be type-flaw resistant
   - The steps of strands must be type-flaw resistant
 \<close>
 definition tfr\<^sub>s\<^sub>t where
   "tfr\<^sub>s\<^sub>t S \<equiv> tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S) \<and> list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
 
 
 subsection \<open>Small Lemmata\<close>
 lemma tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def:
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p S \<longleftrightarrow>
     ((\<forall>a t t'. Equality a t t' \<in> set S \<and> (\<exists>\<delta>. Unifier \<delta> t t') \<longrightarrow> \<Gamma> t = \<Gamma> t') \<and>
     (\<forall>X F. Inequality X F \<in> set S \<longrightarrow> 
       (\<forall>x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \<exists>a. \<Gamma> (Var x) = TAtom a)
     \<or> (\<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))))"
   (is "?P S \<longleftrightarrow> ?Q S")
 proof
   show "?P S \<Longrightarrow> ?Q S"
   proof (induction S)
     case (Cons x S) thus ?case by (cases x) auto
   qed simp
 
   show "?Q S \<Longrightarrow> ?P S"
   proof (induction S)
     case (Cons x S) thus ?case by (cases x) auto
   qed simp
 qed
 
 lemma \<Gamma>_wf'': "TComp f T \<sqsubseteq> \<Gamma> t \<Longrightarrow> arity f > 0"
 proof (induction t)
   case (Var x) thus ?case using \<Gamma>_wf(1)[of f T x] by blast
 next
   case (Fun g S) thus ?case
     using fun_type[of g S] const_type[of g] by (cases "arity g") auto
 qed
 
 lemma \<Gamma>_wf': "wf\<^sub>t\<^sub>r\<^sub>m t \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m (\<Gamma> t)"
 proof (induction t)
   case (Fun f T)
   hence *: "arity f = length T" "\<And>t. t \<in> set T \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m (\<Gamma> t)" unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
   { assume "arity f = 0" hence ?case using const_type[of f] by auto }
   moreover
   { assume "arity f > 0" hence ?case using fun_type[of f] * by force }
   ultimately show ?case by auto 
 qed (metis \<Gamma>_wf(2))
 
 lemma fun_type_inv: assumes "\<Gamma> t = TComp f T" shows "arity f > 0"
 using \<Gamma>_wf''(1)[of f T t] assms by simp_all
 
 lemma fun_type_inv_wf: assumes "\<Gamma> t = TComp f T" "wf\<^sub>t\<^sub>r\<^sub>m t" shows "arity f = length T"
 using \<Gamma>_wf'[OF assms(2)] assms(1) unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
 
 lemma const_type_inv: "\<Gamma> (Fun c X) = TAtom a \<Longrightarrow> arity c = 0"
 by (rule ccontr, simp add: fun_type)
 
 lemma const_type_inv_wf: assumes "\<Gamma> (Fun c X) = TAtom a" and "wf\<^sub>t\<^sub>r\<^sub>m (Fun c X)" shows "X = []"
 by (metis assms const_type_inv length_0_conv subtermeqI' wf\<^sub>t\<^sub>r\<^sub>m_def)
 
 lemma const_type': "\<forall>c \<in> \<C>. \<exists>a \<in> \<TT>\<^sub>a. \<forall>X. \<Gamma> (Fun c X) = TAtom a" using const_type by simp
 lemma fun_type': "\<forall>f \<in> \<Sigma>\<^sub>f. \<forall>X. \<Gamma> (Fun f X) = TComp f (map \<Gamma> X)" using fun_type by simp
 
 lemma fun_type_id_eq: "\<Gamma> (Fun f X) = TComp g Y \<Longrightarrow> f = g"
 by (metis const_type fun_type neq0_conv "term.inject"(2) "term.simps"(4))
 
 lemma fun_type_length_eq: "\<Gamma> (Fun f X) = TComp g Y \<Longrightarrow> length X = length Y"
 by (metis fun_type fun_type_id_eq fun_type_inv(1) length_map term.inject(2))
 
 lemma pgwt_type_map: 
   assumes "public_ground_wf_term t"
   shows "\<Gamma> t = TAtom a \<Longrightarrow> \<exists>f. t = Fun f []" "\<Gamma> t = TComp g Y \<Longrightarrow> \<exists>X. t = Fun g X \<and> map \<Gamma> X = Y"
 proof -
   let ?A = "\<Gamma> t = TAtom a \<longrightarrow> (\<exists>f. t = Fun f [])"
   let ?B = "\<Gamma> t = TComp g Y \<longrightarrow> (\<exists>X. t = Fun g X \<and> map \<Gamma> X = Y)"
   have "?A \<and> ?B"
   proof (cases "\<Gamma> t")
     case (Var a)
     obtain f X where "t = Fun f X" "arity f = length X"
       using pgwt_fun[OF assms(1)] pgwt_arity[OF assms(1)] by fastforce+
     thus ?thesis using const_type_inv \<open>\<Gamma> t = TAtom a\<close> by auto
   next
     case (Fun g Y)
     obtain f X where *: "t = Fun f X" using pgwt_fun[OF assms(1)] by force
     hence "f = g" "map \<Gamma> X = Y"
       using fun_type_id_eq \<open>\<Gamma> t = TComp g Y\<close> fun_type[OF fun_type_inv(1)[OF \<open>\<Gamma> t = TComp g Y\<close>]]
       by fastforce+
     thus ?thesis using *(1) \<open>\<Gamma> t = TComp g Y\<close> by auto 
   qed
   thus "\<Gamma> t = TAtom a \<Longrightarrow> \<exists>f. t = Fun f []" "\<Gamma> t = TComp g Y \<Longrightarrow> \<exists>X. t = Fun g X \<and> map \<Gamma> X = Y"
     by auto
 qed 
 
 lemma wt_subst_Var[simp]: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" by (metis wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
 
 lemma wt_subst_trm: "(\<And>v. v \<in> fv t \<Longrightarrow> \<Gamma> (Var v) = \<Gamma> (\<theta> v)) \<Longrightarrow> \<Gamma> t = \<Gamma> (t \<cdot> \<theta>)"
 proof (induction t)
   case (Fun f X)
   hence *: "\<And>x. x \<in> set X \<Longrightarrow> \<Gamma> x = \<Gamma> (x \<cdot> \<theta>)" by auto
   show ?case
   proof (cases "f \<in> \<Sigma>\<^sub>f")
     case True
     hence "\<forall>X. \<Gamma> (Fun f X) = TComp f (map \<Gamma> X)" using fun_type' by auto
     thus ?thesis using * by auto
   next
     case False
     hence "\<exists>a \<in> \<TT>\<^sub>a. \<forall>X. \<Gamma> (Fun f X) = TAtom a" using const_type' by auto
     thus ?thesis by auto
   qed
 qed auto
 
 lemma wt_subst_trm': "\<lbrakk>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>; \<Gamma> s = \<Gamma> t\<rbrakk> \<Longrightarrow> \<Gamma> (s \<cdot> \<sigma>) = \<Gamma> (t \<cdot> \<sigma>)"
 by (metis wt_subst_trm wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
 
 lemma wt_subst_trm'': "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma> \<Longrightarrow> \<Gamma> t = \<Gamma> (t \<cdot> \<sigma>)"
 by (metis wt_subst_trm wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
 
 lemma wt_subst_compose:
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<delta>)"
 proof -
   have "\<And>v. \<Gamma> (\<theta> v) = \<Gamma> (\<theta> v \<cdot> \<delta>)" using wt_subst_trm \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>\<close> unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by metis
   moreover have "\<And>v. \<Gamma> (Var v) = \<Gamma> (\<theta> v)" using \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by metis
   ultimately have "\<And>v. \<Gamma> (Var v) = \<Gamma> (\<theta> v \<cdot> \<delta>)" by metis
   thus ?thesis unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_compose_def by metis
 qed
 
 lemma wt_subst_TAtom_Var_cases:
   assumes \<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 x: "\<Gamma> (Var x) = TAtom a"
   shows "(\<exists>y. \<theta> x = Var y) \<or> (\<exists>c. \<theta> x = Fun c [])"
 proof (cases "(\<exists>y. \<theta> x = Var y)")
   case False
   then obtain c T where c: "\<theta> x = Fun c T"
     by (cases "\<theta> x") simp_all
   hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun c T)"
     using \<theta>(2) by fastforce
   hence "T = []"
     using const_type_inv_wf[of c T a] x c wt_subst_trm''[OF \<theta>(1), of "Var x"]
     by fastforce
   thus ?thesis
     using c by blast
 qed simp
 
 lemma wt_subst_TAtom_fv:
   assumes \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "\<forall>x. wf\<^sub>t\<^sub>r\<^sub>m (\<theta> x)"
   and "\<forall>x \<in> fv t - X. \<exists>a. \<Gamma> (Var x) = TAtom a"
   shows "\<forall>x \<in> fv (t \<cdot> \<theta>) - fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` X). \<exists>a. \<Gamma> (Var x) = TAtom a"
 using assms(3)
 proof (induction t)
   case (Var x) thus ?case
   proof (cases "x \<in> X")
     case False
     with Var obtain a where "\<Gamma> (Var x) = TAtom a" by moura
     hence *: "\<Gamma> (\<theta> x) = TAtom a" "wf\<^sub>t\<^sub>r\<^sub>m (\<theta> x)" using \<theta> unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by auto
     show ?thesis
     proof (cases "\<theta> x")
       case (Var y) thus ?thesis using * by auto
     next
       case (Fun f T)
       hence "T = []" using * const_type_inv[of f T a] unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
       thus ?thesis using Fun by auto
     qed
   qed auto
 qed fastforce
 
 lemma wt_subst_TAtom_subterms_subst:
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "\<forall>x \<in> fv t. \<exists>a. \<Gamma> (Var x) = TAtom a" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<theta> ` fv t)"
   shows "subterms (t \<cdot> \<theta>) = subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using assms(2,3)
 proof (induction t)
   case (Var x)
   obtain a where a: "\<Gamma> (Var x) = TAtom a" using Var.prems(1) by moura
   hence "\<Gamma> (\<theta> x) = TAtom a" using wt_subst_trm''[OF assms(1), of "Var x"] by simp
   hence "(\<exists>y. \<theta> x = Var y) \<or> (\<exists>c. \<theta> x = Fun c [])"
     using const_type_inv_wf Var.prems(2) by (cases "\<theta> x") auto
   thus ?case by auto
 next
   case (Fun f T)
   have "subterms (t \<cdot> \<theta>) = subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>" when "t \<in> set T" for t
     using that Fun.prems(1,2) Fun.IH[OF that]
     by auto
   thus ?case by auto
 qed
 
 lemma wt_subst_TAtom_subterms_set_subst: 
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<exists>a. \<Gamma> (Var x) = TAtom a" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<theta> ` fv\<^sub>s\<^sub>e\<^sub>t M)"
   shows "subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) = subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 proof
   show "subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
   proof
     fix t assume "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
     then obtain s where s: "s \<in> M" "t \<in> subterms (s \<cdot> \<theta>)" by auto
     thus "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
       using assms(2,3) wt_subst_TAtom_subterms_subst[OF assms(1), of s]
       by auto
   qed
 
   show "subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   proof
     fix t assume "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
     then obtain s where s: "s \<in> M" "t \<in> subterms s \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>" by auto
     thus "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
       using assms(2,3) wt_subst_TAtom_subterms_subst[OF assms(1), of s]
       by auto
   qed
 qed
 
 lemma wt_subst_subst_upd:
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
     and "\<Gamma> (Var x) = \<Gamma> t"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta>(x := t))"
 using assms unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
 by (metis fun_upd_other fun_upd_same)
 
 lemma wt_subst_const_fv_type_eq:
   assumes "\<forall>x \<in> fv t. \<exists>a. \<Gamma> (Var x) = TAtom a"
     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>)"
   shows "\<forall>x \<in> fv (t \<cdot> \<delta>). \<exists>y \<in> fv t. \<Gamma> (Var x) = \<Gamma> (Var y)"
 using assms(1)
 proof (induction t)
   case (Var x)
   then obtain a where a: "\<Gamma> (Var x) = TAtom a" by moura
   show ?case
   proof (cases "\<delta> x")
     case (Fun f T)
     hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" "\<Gamma> (Fun f T) = TAtom a"
       using a wt_subst_trm''[OF \<delta>(1), of "Var x"] \<delta>(2) by fastforce+
     thus ?thesis using const_type_inv_wf Fun by fastforce
   qed (use a wt_subst_trm''[OF \<delta>(1), of "Var x"] in simp)
 qed fastforce
 
 lemma TComp_term_cases:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "\<Gamma> t = TComp f T"
   shows "(\<exists>v. t = Var v) \<or> (\<exists>T'. t = Fun f T' \<and> T = map \<Gamma> T' \<and> T' \<noteq> [])"
 proof (cases "\<exists>v. t = Var v")
   case False
   then obtain T' where T': "t = Fun f T'" "T = map \<Gamma> T'"
     using assms fun_type[OF fun_type_inv(1)[OF assms(2)]] fun_type_id_eq
     by (cases t) force+
   thus ?thesis using assms fun_type_inv(1) fun_type_inv_wf by fastforce
 qed metis
 
 lemma TAtom_term_cases:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "\<Gamma> t = TAtom \<tau>"
   shows "(\<exists>v. t = Var v) \<or> (\<exists>f. t = Fun f [])"
 using assms const_type_inv unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (cases t) auto
 
 lemma subtermeq_imp_subtermtypeeq:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "s \<sqsubseteq> t"
   shows "\<Gamma> s \<sqsubseteq> \<Gamma> t"
 using assms(2,1)
 proof (induction t)
   case (Fun f T) thus ?case
   proof (cases "s = Fun f T")
     case False
     then obtain x where x: "x \<in> set T" "s \<sqsubseteq> x" using Fun.prems(1) by auto
     hence "wf\<^sub>t\<^sub>r\<^sub>m x" using wf_trm_subtermeq[OF Fun.prems(2)] Fun_param_is_subterm[of _ T f] by auto
     hence "\<Gamma> s \<sqsubseteq> \<Gamma> x" using Fun.IH[OF x] by simp
     moreover have "arity f > 0" using x fun_type_inv_wf Fun.prems
       by (metis length_pos_if_in_set term.order_refl wf\<^sub>t\<^sub>r\<^sub>m_def)
     ultimately show ?thesis using x Fun.prems fun_type[of f T] by auto
   qed simp
 qed simp
 
 lemma subterm_funs_term_in_type:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "Fun f T \<sqsubseteq> t" "\<Gamma> (Fun f T) = TComp f (map \<Gamma> T)"
   shows "f \<in> funs_term (\<Gamma> t)"
 using assms(2,1,3)
 proof (induction t)
   case (Fun f' T')
   hence [simp]: "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" by (metis wf_trm_subtermeq)
   { fix a assume \<tau>: "\<Gamma> (Fun f' T') = TAtom a"
     hence "Fun f T = Fun f' T'" using Fun TAtom_term_cases subtermeq_Var_const by metis
     hence False using Fun.prems(3) \<tau> by simp
   }
   moreover
   { fix g S assume \<tau>: "\<Gamma> (Fun f' T') = TComp g S"
     hence "g = f'" "S = map \<Gamma> T'"
       using Fun.prems(2) fun_type_id_eq[OF \<tau>] fun_type[OF fun_type_inv(1)[OF \<tau>]]
       by auto
     hence \<tau>': "\<Gamma> (Fun f' T') = TComp f' (map \<Gamma> T')" using \<tau> by auto
     hence "g \<in> funs_term (\<Gamma> (Fun f' T'))" using \<tau> by auto
     moreover {
       assume "Fun f T \<noteq> Fun f' T'"
       then obtain x where "x \<in> set T'" "Fun f T \<sqsubseteq> x" using Fun.prems(1) by auto
       hence "f \<in> funs_term (\<Gamma> x)"
         using Fun.IH[OF _ _ _ Fun.prems(3), of x] wf_trm_subtermeq[OF \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f' T')\<close>, of x]
         by force
       moreover have "\<Gamma> x \<in> set (map \<Gamma> T')" using \<tau>' \<open>x \<in> set T'\<close> by auto
       ultimately have "f \<in> funs_term (\<Gamma> (Fun f' T'))" using \<tau>' by auto
     }
     ultimately have ?case by (cases "Fun f T = Fun f' T'") (auto simp add: \<open>g = f'\<close>)
   }
   ultimately show ?case by (cases "\<Gamma> (Fun f' T')") auto
 qed simp
 
 lemma wt_subst_fv_termtype_subterm:
   assumes "x \<in> fv (\<theta> y)"
     and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
     and "wf\<^sub>t\<^sub>r\<^sub>m (\<theta> y)"
   shows "\<Gamma> (Var x) \<sqsubseteq> \<Gamma> (Var y)"
 using subtermeq_imp_subtermtypeeq[OF assms(3) var_is_subterm[OF assms(1)]]
       wt_subst_trm''[OF assms(2), of "Var y"]
 by auto
 
 lemma wt_subst_fv\<^sub>s\<^sub>e\<^sub>t_termtype_subterm:
   assumes "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` Y)"
     and "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>)"
   shows "\<exists>y \<in> Y. \<Gamma> (Var x) \<sqsubseteq> \<Gamma> (Var y)"
 using wt_subst_fv_termtype_subterm[OF _ assms(2), of x] assms(1,3)
 by fastforce
 
 lemma funs_term_type_iff:
   assumes t: "wf\<^sub>t\<^sub>r\<^sub>m t"
     and f: "arity f > 0"
   shows "f \<in> funs_term (\<Gamma> t) \<longleftrightarrow> (f \<in> funs_term t \<or> (\<exists>x \<in> fv t. f \<in> funs_term (\<Gamma> (Var x))))"
     (is "?P t \<longleftrightarrow> ?Q t")
 using t
 proof (induction t)
   case (Fun g T)
   hence IH: "?P s \<longleftrightarrow> ?Q s" when "s \<in> set T" for s
     using that wf_trm_subterm[OF _ Fun_param_is_subterm]
     by blast
   have 0: "arity g = length T" using Fun.prems unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
   show ?case
   proof (cases "f = g")
     case True thus ?thesis using fun_type[OF f] by simp
   next
     case False
     have "?P (Fun g T) \<longleftrightarrow> (\<exists>s \<in> set T. ?P s)"
     proof
       assume *: "?P (Fun g T)"
       hence "\<Gamma> (Fun g T) = TComp g (map \<Gamma> T)"
         using const_type[of g] fun_type[of g] by force
       thus "\<exists>s \<in> set T. ?P s" using False * by force
     next
       assume *: "\<exists>s \<in> set T. ?P s"
       hence "\<Gamma> (Fun g T) = TComp g (map \<Gamma> T)"
         using 0 const_type[of g] fun_type[of g] by force
       thus "?P (Fun g T)" using False * by force
     qed
     thus ?thesis using False f IH by auto
   qed
 qed simp
 
 lemma funs_term_type_iff':
   assumes M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and f: "arity f > 0"
   shows "f \<in> \<Union>(funs_term ` \<Gamma> ` M) \<longleftrightarrow>
         (f \<in> \<Union>(funs_term ` M) \<or> (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. f \<in> funs_term (\<Gamma> (Var x))))" (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   then obtain t where "t \<in> M" "wf\<^sub>t\<^sub>r\<^sub>m t" "f \<in> funs_term (\<Gamma> t)" using M by moura
   thus ?B using funs_term_type_iff[OF _ f, of t] by auto
 next
   assume ?B
   then obtain t where "t \<in> M" "wf\<^sub>t\<^sub>r\<^sub>m t" "f \<in> funs_term t \<or> (\<exists>x \<in> fv t. f \<in> funs_term (\<Gamma> (Var x)))"
     using M by auto
   thus ?A using funs_term_type_iff[OF _ f, of t] by blast
 qed
 
 lemma Ana_subterm_type:
   assumes "Ana t = (K,M)"
     and "wf\<^sub>t\<^sub>r\<^sub>m t"
     and "m \<in> set M"
   shows "\<Gamma> m \<sqsubseteq> \<Gamma> t"
 proof -
   have "m \<sqsubseteq> t" using Ana_subterm[OF assms(1)] assms(3) by auto
   thus ?thesis using subtermeq_imp_subtermtypeeq[OF assms(2)] by simp
 qed
 
 lemma wf_trm_TAtom_subterms:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "\<Gamma> t = TAtom \<tau>"
   shows "subterms t = {t}"
 using assms const_type_inv unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (cases t) force+
 
 lemma wf_trm_TComp_subterm:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m s" "t \<sqsubset> s"
   obtains f T where "\<Gamma> s = TComp f T"
 proof (cases s)
   case (Var x) thus ?thesis using \<open>t \<sqsubset> s\<close> by simp
 next
   case (Fun g S)
   hence "length S > 0" using assms Fun_subterm_inside_params[of t g S] by auto
   hence "arity g > 0" by (metis \<open>wf\<^sub>t\<^sub>r\<^sub>m s\<close> \<open>s = Fun g S\<close> term.order_refl wf\<^sub>t\<^sub>r\<^sub>m_def) 
   thus ?thesis using fun_type \<open>s = Fun g S\<close> that by auto
 qed
 
 lemma SMP_empty[simp]: "SMP {} = {}"
 proof (rule ccontr)
   assume "SMP {} \<noteq> {}"
   then obtain t where "t \<in> SMP {}" by auto
   thus False by (induct t rule: SMP.induct) auto
 qed
 
 lemma SMP_I:
   assumes "s \<in> M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "t \<sqsubseteq> s \<cdot> \<delta>" "\<And>v. wf\<^sub>t\<^sub>r\<^sub>m (\<delta> v)"
   shows "t \<in> SMP M"
 using SMP.Substitution[OF SMP.MP[OF assms(1)] assms(2)] SMP.Subterm[of "s \<cdot> \<delta>" M t] assms(3,4)
 by (cases "t = s \<cdot> \<delta>") simp_all
 
 lemma SMP_wf_trm:
   assumes "t \<in> SMP M" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
   shows "wf\<^sub>t\<^sub>r\<^sub>m t"
 using assms(1)
 by (induct t rule: SMP.induct)
    (use assms(2) in blast,
     use wf_trm_subtermeq in blast,
     use wf_trm_subst in blast,
     use Ana_keys_wf' in blast)
 
 lemma SMP_ikI[intro]: "t \<in> ik\<^sub>s\<^sub>t S \<Longrightarrow> t \<in> SMP (trms\<^sub>s\<^sub>t S)" by force
 
 lemma MP_setI[intro]: "x \<in> set S \<Longrightarrow> trms\<^sub>s\<^sub>t\<^sub>p x \<subseteq> trms\<^sub>s\<^sub>t S" by force
 
 lemma SMP_setI[intro]: "x \<in> set S \<Longrightarrow> trms\<^sub>s\<^sub>t\<^sub>p x \<subseteq> SMP (trms\<^sub>s\<^sub>t S)" by force
 
 lemma SMP_subset_I:
   assumes M: "\<forall>t \<in> M. \<exists>s \<delta>. s \<in> N \<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> t = s \<cdot> \<delta>"
   shows "SMP M \<subseteq> SMP N"
 proof
   fix t show "t \<in> SMP M \<Longrightarrow> t \<in> SMP N"
   proof (induction t rule: SMP.induct)
     case (MP t)
     then obtain s \<delta> where s: "s \<in> N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "t = s \<cdot> \<delta>"
       using M by moura
     show ?case using SMP_I[OF s(1,2), of "s \<cdot> \<delta>"] s(3,4) wf_trm_subst_range_iff by fast
   qed (auto intro!: SMP.Substitution[of _ N])
 qed
 
 lemma SMP_union: "SMP (A \<union> B) = SMP A \<union> SMP B"
 proof
   show "SMP (A \<union> B) \<subseteq> SMP A \<union> SMP B"
   proof
     fix t assume "t \<in> SMP (A \<union> B)"
     thus "t \<in> SMP A \<union> SMP B" by (induct rule: SMP.induct) blast+
   qed
 
   { fix t assume "t \<in> SMP A" hence "t \<in> SMP (A \<union> B)" by (induct rule: SMP.induct) blast+ }
   moreover { fix t assume "t \<in> SMP B" hence "t \<in> SMP (A \<union> B)" by (induct rule: SMP.induct) blast+ }
   ultimately show "SMP A \<union> SMP B \<subseteq> SMP (A \<union> B)" by blast
 qed
 
 lemma SMP_append[simp]: "SMP (trms\<^sub>s\<^sub>t (S@S')) = SMP (trms\<^sub>s\<^sub>t S) \<union> SMP (trms\<^sub>s\<^sub>t S')" (is "?A = ?B")
 using SMP_union by simp
 
 lemma SMP_mono: "A \<subseteq> B \<Longrightarrow> SMP A \<subseteq> SMP B"
 proof -
   assume "A \<subseteq> B"
   then obtain C where "B = A \<union> C" by moura
   thus "SMP A \<subseteq> SMP B" by (simp add: SMP_union)
 qed
 
 lemma SMP_Union: "SMP (\<Union>m \<in> M. f m) = (\<Union>m \<in> M. SMP (f m))"
 proof
   show "SMP (\<Union>m\<in>M. f m) \<subseteq> (\<Union>m\<in>M. SMP (f m))"
   proof
     fix t assume "t \<in> SMP (\<Union>m\<in>M. f m)"
     thus "t \<in> (\<Union>m\<in>M. SMP (f m))" by (induct t rule: SMP.induct) force+
   qed
   show "(\<Union>m\<in>M. SMP (f m)) \<subseteq> SMP (\<Union>m\<in>M. f m)"
   proof
     fix t assume "t \<in> (\<Union>m\<in>M. SMP (f m))"
     then obtain m where "m \<in> M" "t \<in> SMP (f m)" by moura
     thus "t \<in> SMP (\<Union>m\<in>M. f m)" using SMP_mono[of "f m" "\<Union>m\<in>M. f m"] by auto
   qed
 qed
 
 lemma SMP_singleton_ex:
   "t \<in> SMP M \<Longrightarrow> (\<exists>m \<in> M. t \<in> SMP {m})"
   "m \<in> M \<Longrightarrow> t \<in> SMP {m} \<Longrightarrow> t \<in> SMP M"
 using SMP_Union[of "\<lambda>t. {t}" M] by auto
 
 lemma SMP_Cons: "SMP (trms\<^sub>s\<^sub>t (x#S)) = SMP (trms\<^sub>s\<^sub>t [x]) \<union> SMP (trms\<^sub>s\<^sub>t S)"
 using SMP_append[of "[x]" S] by auto
 
 lemma SMP_Nil[simp]: "SMP (trms\<^sub>s\<^sub>t []) = {}" 
 proof -
   { fix t assume "t \<in> SMP (trms\<^sub>s\<^sub>t [])" hence False by induct auto }
   thus ?thesis by blast
 qed
 
 lemma SMP_subset_union_eq: assumes "M \<subseteq> SMP N" shows "SMP N = SMP (M \<union> N)"
 proof -
   { fix t assume "t \<in> SMP (M \<union> N)" hence "t \<in> SMP N"
       using assms by (induction rule: SMP.induct) blast+
   }
   thus ?thesis using SMP_union by auto
 qed
 
 lemma SMP_subterms_subset: "subterms\<^sub>s\<^sub>e\<^sub>t M \<subseteq> SMP M"
 proof
   fix t assume "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M"
   then obtain m where "m \<in> M" "t \<sqsubseteq> m" by auto
   thus "t \<in> SMP M" using SMP_I[of _ _ Var] by auto
 qed
 
 lemma SMP_SMP_subset: "N \<subseteq> SMP M \<Longrightarrow> SMP N \<subseteq> SMP M"
 by (metis SMP_mono SMP_subset_union_eq Un_commute Un_upper2)
 
 lemma wt_subst_rm_vars: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<Longrightarrow> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (rm_vars X \<delta>)"
 using rm_vars_dom unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by auto
 
 lemma wt_subst_SMP_subset:
   assumes "trms\<^sub>s\<^sub>t S \<subseteq> SMP S'" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
   shows "trms\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> SMP S'"
 proof
   fix t assume *: "t \<in> trms\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
   show "t \<in> SMP S'" using trm_strand_subst_cong(2)[OF *]
   proof
     assume "\<exists>t'. t = t' \<cdot> \<delta> \<and> t' \<in> trms\<^sub>s\<^sub>t S"
     thus "t \<in> SMP S'" using assms SMP.Substitution by auto
   next
     assume "\<exists>X F. Inequality X F \<in> set S \<and> (\<exists>t'\<in>trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. t = t' \<cdot> rm_vars (set X) \<delta>)"
     then obtain X F t' where **:
         "Inequality X F \<in> set S" "t'\<in>trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" "t = t' \<cdot> rm_vars (set X) \<delta>"
       by force
     then obtain s where s: "s \<in> trms\<^sub>s\<^sub>t\<^sub>p (Inequality X F)" "t = s \<cdot> rm_vars (set X) \<delta>" by moura
     hence "s \<in> SMP (trms\<^sub>s\<^sub>t S)" using **(1) by force
     hence "t \<in> SMP (trms\<^sub>s\<^sub>t S)"
       using SMP.Substitution[OF _ wt_subst_rm_vars[OF assms(2)] wf_trms_subst_rm_vars'[OF assms(3)]]
       unfolding s(2) by blast
     thus "t \<in> SMP S'" by (metis SMP_union SMP_subset_union_eq UnCI assms(1))
   qed
 qed
 
 lemma MP_subset_SMP: "\<Union>(trms\<^sub>s\<^sub>t\<^sub>p ` set S) \<subseteq> SMP (trms\<^sub>s\<^sub>t S)" "trms\<^sub>s\<^sub>t S \<subseteq> SMP (trms\<^sub>s\<^sub>t S)" "M \<subseteq> SMP M"
 by auto
 
 lemma SMP_fun_map_snd_subset: "SMP (trms\<^sub>s\<^sub>t (map Send1 X)) \<subseteq> SMP (trms\<^sub>s\<^sub>t [Send1 (Fun f X)])"
 proof
   fix t assume "t \<in> SMP (trms\<^sub>s\<^sub>t (map Send1 X))" thus "t \<in> SMP (trms\<^sub>s\<^sub>t [Send1 (Fun f X)])"
   proof (induction t rule: SMP.induct)
     case (MP t)
     hence "t \<in> set X" by auto
     hence "t \<sqsubset> Fun f X" by (metis subtermI')
     thus ?case using SMP.Subterm[of "Fun f X" "trms\<^sub>s\<^sub>t [Send1 (Fun f X)]" t] using SMP.MP by auto
   qed blast+
 qed
 
 lemma SMP_wt_subst_subset:
   assumes "t \<in> SMP (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
   shows "t \<in> SMP M"
 using assms wf_trm_subst_range_iff[of \<I>] by (induct t rule: SMP.induct) blast+
 
 lemma SMP_wt_instances_subset:
   assumes "\<forall>t \<in> M. \<exists>s \<in> N. \<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>)"
     and "t \<in> SMP M"
   shows "t \<in> SMP N"
 proof -
   obtain m where m: "m \<in> M" "t \<in> SMP {m}" using SMP_singleton_ex(1)[OF assms(2)] by blast
   then obtain n \<delta> where n: "n \<in> N" "m = n \<cdot> \<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 assms(1) by fast
 
   have "t \<in> SMP (N \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)" using n(1,2) SMP_singleton_ex(2)[of m "N \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>", OF _ m(2)] by fast
   thus ?thesis using SMP_wt_subst_subset[OF _ n(3,4)] by blast
 qed
 
 lemma SMP_consts:
   assumes "\<forall>t \<in> M. \<exists>c. t = Fun c []"
     and "\<forall>t \<in> M. Ana t = ([], [])"
   shows "SMP M = M"
 proof
   show "SMP M \<subseteq> M"
   proof
     fix t show "t \<in> SMP M \<Longrightarrow> t \<in> M"
       apply (induction t rule: SMP.induct)
       by (use assms in auto)
   qed
 qed auto
 
 lemma SMP_subterms_eq:
   "SMP (subterms\<^sub>s\<^sub>e\<^sub>t M) = SMP M"
 proof
   show "SMP M \<subseteq> SMP (subterms\<^sub>s\<^sub>e\<^sub>t M)" using SMP_mono[of M "subterms\<^sub>s\<^sub>e\<^sub>t M"] by blast
   show "SMP (subterms\<^sub>s\<^sub>e\<^sub>t M) \<subseteq> SMP M"
   proof
     fix t show "t \<in> SMP (subterms\<^sub>s\<^sub>e\<^sub>t M) \<Longrightarrow> t \<in> SMP M" by (induction t rule: SMP.induct) blast+
   qed
 qed
 
 lemma SMP_funs_term:
   assumes t: "t \<in> SMP M" "f \<in> funs_term t \<or> (\<exists>x \<in> fv t. f \<in> funs_term (\<Gamma> (Var x)))"
     and f: "arity f > 0"
     and M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and Ana_f: "\<And>s K T. Ana s = (K,T) \<Longrightarrow> f \<in> \<Union>(funs_term ` set K) \<Longrightarrow> f \<in> funs_term s"
   shows "f \<in> \<Union>(funs_term ` M) \<or> (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. f \<in> funs_term (\<Gamma> (Var x)))"
 using t
 proof (induction t rule: SMP.induct)
   case (Subterm t t')
   thus ?case by (metis UN_I vars_iff_subtermeq funs_term_subterms_eq(1) term.order_trans)
 next
   case (Substitution t \<delta>)
   show ?case
     using M SMP_wf_trm[OF Substitution.hyps(1)] wf_trm_subst[of \<delta> t, OF Substitution.hyps(3)]
           funs_term_type_iff[OF _ f] wt_subst_trm''[OF Substitution.hyps(2), of t]
           Substitution.prems Substitution.IH
     by metis
 next
   case (Ana t K T t')
   thus ?case
     using Ana_f[OF Ana.hyps(2)] Ana_keys_fv[OF Ana.hyps(2)]
     by fastforce
 qed auto
 
 lemma id_type_eq:
   assumes "\<Gamma> (Fun f X) = \<Gamma> (Fun g Y)"
   shows "f \<in> \<C> \<Longrightarrow> g \<in> \<C>" "f \<in> \<Sigma>\<^sub>f \<Longrightarrow> g \<in> \<Sigma>\<^sub>f"
 using assms const_type' fun_type' id_union_univ(1)
 by (metis UNIV_I UnE "term.distinct"(1))+
 
 lemma fun_type_arg_cong:
   assumes "f \<in> \<Sigma>\<^sub>f" "g \<in> \<Sigma>\<^sub>f" "\<Gamma> (Fun f (x#X)) = \<Gamma> (Fun g (y#Y))"
   shows "\<Gamma> x = \<Gamma> y" "\<Gamma> (Fun f X) = \<Gamma> (Fun g Y)"
 using assms fun_type' by auto
 
 lemma fun_type_arg_cong':
   assumes "f \<in> \<Sigma>\<^sub>f" "g \<in> \<Sigma>\<^sub>f" "\<Gamma> (Fun f (X@x#X')) = \<Gamma> (Fun g (Y@y#Y'))" "length X = length Y"
   shows "\<Gamma> x = \<Gamma> y"
 using assms
 proof (induction X arbitrary: Y)
   case Nil thus ?case using fun_type_arg_cong(1)[of f g x X' y Y'] by auto
 next
   case (Cons x' X Y'')
   then obtain y' Y where "Y'' = y'#Y" by (metis length_Suc_conv)
   hence "\<Gamma> (Fun f (X@x#X')) = \<Gamma> (Fun g (Y@y#Y'))" "length X = length Y"
     using Cons.prems(3,4) fun_type_arg_cong(2)[OF Cons.prems(1,2), of x' "X@x#X'"] by auto
   thus ?thesis using Cons.IH[OF Cons.prems(1,2)] by auto
 qed
 
 lemma fun_type_param_idx: "\<Gamma> (Fun f T) = Fun g S \<Longrightarrow> i < length T \<Longrightarrow> \<Gamma> (T ! i) = S ! i"
 by (metis fun_type fun_type_id_eq fun_type_inv(1) nth_map term.inject(2))
 
 lemma fun_type_param_ex:
   assumes "\<Gamma> (Fun f T) = Fun g (map \<Gamma> S)" "t \<in> set S"
   shows "\<exists>s \<in> set T. \<Gamma> s = \<Gamma> t"
 using fun_type_length_eq[OF assms(1)] length_map[of \<Gamma> S] assms(2)
       fun_type_param_idx[OF assms(1)] nth_map in_set_conv_nth
 by metis
 
 lemma tfr_stp_all_split:
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (x#S) \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p [x]"
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (x#S) \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S') \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S') \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p S'"
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@x#S') \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')"
 by fastforce+
 
 lemma tfr_stp_all_append:
   assumes "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'"
   shows "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')"
 using assms by fastforce
 
 lemma tfr_stp_all_wt_subst_apply:
   assumes "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
     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>)"
            "bvars\<^sub>s\<^sub>t S \<inter> range_vars \<theta> = {}"
   shows "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S \<cdot>\<^sub>s\<^sub>t \<theta>)"
 using assms(1,4)
 proof (induction S)
   case (Cons x S)
   hence IH: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S \<cdot>\<^sub>s\<^sub>t \<theta>)"
     using tfr_stp_all_split(2)[of x S]
     unfolding range_vars_alt_def by fastforce
   thus ?case
   proof (cases x)
     case (Equality a t t')
     hence "(\<exists>\<delta>. Unifier \<delta> t t') \<longrightarrow> \<Gamma> t = \<Gamma> t'" using Cons.prems by auto
     hence "(\<exists>\<delta>. Unifier \<delta> (t \<cdot> \<theta>) (t' \<cdot> \<theta>)) \<longrightarrow> \<Gamma> (t \<cdot> \<theta>) = \<Gamma> (t' \<cdot> \<theta>)"
       by (metis Unifier_comp' wt_subst_trm'[OF assms(2)])
     moreover have "(x#S) \<cdot>\<^sub>s\<^sub>t \<theta> = Equality a (t \<cdot> \<theta>) (t' \<cdot> \<theta>)#(S \<cdot>\<^sub>s\<^sub>t \<theta>)"
       using \<open>x = Equality a t t'\<close> by auto
     ultimately show ?thesis using IH by auto
   next
     case (Inequality X F)
     let ?\<sigma> = "rm_vars (set X) \<theta>"
     let ?G = "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<sigma>"
 
     let ?P = "\<lambda>F 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"
     let ?Q = "\<lambda>F 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 0: "set X \<inter> range_vars ?\<sigma> = {}"
       using Cons.prems(2) Inequality rm_vars_img_subset[of "set X"]
       by (auto simp add: subst_domain_def range_vars_alt_def)
 
     have 1: "?P F X \<or> ?Q F X" using Inequality Cons.prems by simp
 
     have 2: "fv\<^sub>s\<^sub>e\<^sub>t (?\<sigma> ` set X) = set X" by auto
 
     have "?P ?G X" when "?P F X" using that
     proof (induction F)
       case (Cons g G)
       obtain t t' where g: "g = (t,t')" by (metis surj_pair)
       
       have "\<forall>x \<in> (fv (t \<cdot> ?\<sigma>) \<union> fv (t' \<cdot> ?\<sigma>)) - set X. \<exists>a. \<Gamma> (Var x) = Var a"
       proof -
         have *: "\<forall>x \<in> fv t - set X. \<exists>a. \<Gamma> (Var x) = Var a"
                "\<forall>x \<in> fv t' - set X. \<exists>a. \<Gamma> (Var x) = Var a"
           using g Cons.prems by simp_all
 
         have **: "\<forall>x. wf\<^sub>t\<^sub>r\<^sub>m (?\<sigma> x)"
           using \<theta>(2) wf_trm_subst_range_iff[of \<theta>] wf_trm_subst_rm_vars'[of \<theta> _ "set X"] by simp
 
         show ?thesis
           using wt_subst_TAtom_fv[OF wt_subst_rm_vars[OF \<theta>(1)] ** *(1)]
                 wt_subst_TAtom_fv[OF wt_subst_rm_vars[OF \<theta>(1)] ** *(2)]
                 wt_subst_trm'[OF wt_subst_rm_vars[OF \<theta>(1), of "set X"]] 2
           by blast
       qed
       moreover have "\<forall>x\<in>fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<sigma>) - set X. \<exists>a. \<Gamma> (Var x) = Var a"
         using Cons by auto
       ultimately show ?case using g by (auto simp add: subst_apply_pairs_def)
     qed (simp add: subst_apply_pairs_def)
     hence "?P ?G X \<or> ?Q ?G X"
       using 1 ineq_subterm_inj_cond_subst[OF 0, of "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"] trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst[of F ?\<sigma>]
       by presburger
     moreover have "(x#S) \<cdot>\<^sub>s\<^sub>t \<theta> = Inequality X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<sigma>)#(S \<cdot>\<^sub>s\<^sub>t \<theta>)"
       using \<open>x = Inequality X F\<close> by auto
     ultimately show ?thesis using IH by simp
   qed auto
 qed simp
 
 lemma tfr_stp_all_same_type:
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@Equality a t t'#S') \<Longrightarrow> Unifier \<delta> t t' \<Longrightarrow> \<Gamma> t = \<Gamma> t'"
 by force+
 
 lemma tfr_subset:
   "\<And>A B. tfr\<^sub>s\<^sub>e\<^sub>t (A \<union> B) \<Longrightarrow> tfr\<^sub>s\<^sub>e\<^sub>t A"
   "\<And>A B. tfr\<^sub>s\<^sub>e\<^sub>t B \<Longrightarrow> A \<subseteq> B \<Longrightarrow> tfr\<^sub>s\<^sub>e\<^sub>t A"
   "\<And>A B. tfr\<^sub>s\<^sub>e\<^sub>t B \<Longrightarrow> SMP A \<subseteq> SMP B \<Longrightarrow> tfr\<^sub>s\<^sub>e\<^sub>t A"
 proof -
   show 1: "tfr\<^sub>s\<^sub>e\<^sub>t (A \<union> B) \<Longrightarrow> tfr\<^sub>s\<^sub>e\<^sub>t A" for A B
     using SMP_union[of A B] unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by simp
 
   fix A B assume B: "tfr\<^sub>s\<^sub>e\<^sub>t B"
 
   show "A \<subseteq> B \<Longrightarrow> tfr\<^sub>s\<^sub>e\<^sub>t A"
   proof -
     assume "A \<subseteq> B"
     then obtain C where "B = A \<union> C" by moura
     thus ?thesis using B 1 by blast
   qed
 
   show "SMP A \<subseteq> SMP B \<Longrightarrow> tfr\<^sub>s\<^sub>e\<^sub>t A"
   proof -
     assume "SMP A \<subseteq> SMP B"
     then obtain C where "SMP B = SMP A \<union> C" by moura
     thus ?thesis using B unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
   qed
 qed
 
 lemma tfr_empty[simp]: "tfr\<^sub>s\<^sub>e\<^sub>t {}"
 unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by simp
 
 lemma tfr_consts_mono:
   assumes "\<forall>t \<in> M. \<exists>c. t = Fun c []"
     and "\<forall>t \<in> M. Ana t = ([], [])"
     and "tfr\<^sub>s\<^sub>e\<^sub>t N"
   shows "tfr\<^sub>s\<^sub>e\<^sub>t (N \<union> M)"
 proof -
   { fix s t
     assume *: "s \<in> SMP (N \<union> M) - range Var" "t \<in> SMP (N \<union> M) - range Var" "\<exists>\<delta>. Unifier \<delta> s t"
     hence **: "is_Fun s" "is_Fun t" "s \<in> SMP N \<or> s \<in> M" "t \<in> SMP N \<or> t \<in> M"
       using assms(3) SMP_consts[OF assms(1,2)] SMP_union[of N M] by auto
     moreover have "\<Gamma> s = \<Gamma> t" when "s \<in> SMP N" "t \<in> SMP N"
       using that assms(3) *(3) **(1,2) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
     moreover have "\<Gamma> s = \<Gamma> t" when st: "s \<in> M" "t \<in> M"
     proof -
       obtain c d where "s = Fun c []" "t = Fun d []" using st assms(1) by moura
       hence "s = t" using *(3) by fast
       thus ?thesis by metis
     qed
     moreover have "\<Gamma> s = \<Gamma> t" when st: "s \<in> SMP N" "t \<in> M"
     proof -
       obtain c where "t = Fun c []" using st assms(1) by moura
       hence "s = t" using *(3) **(1,2) by auto
       thus ?thesis by metis
     qed
     moreover have "\<Gamma> s = \<Gamma> t" when st: "s \<in> M" "t \<in> SMP N"
     proof -
       obtain c where "s = Fun c []" using st assms(1) by moura
       hence "s = t" using *(3) **(1,2) by auto
       thus ?thesis by metis
     qed
     ultimately have "\<Gamma> s = \<Gamma> t" by metis
   } thus ?thesis by (metis tfr\<^sub>s\<^sub>e\<^sub>t_def)
 qed
 
 lemma dual\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>t\<^sub>p: "list_all tfr\<^sub>s\<^sub>t\<^sub>p S \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p (dual\<^sub>s\<^sub>t S)"
 proof (induction S)
   case (Cons x S)
   have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Cons.prems by simp
   hence IH: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (dual\<^sub>s\<^sub>t S)" using Cons.IH by metis
   from Cons show ?case
   proof (cases x)
     case (Equality a t t')
     hence "(\<exists>\<delta>. Unifier \<delta> t t') \<Longrightarrow> \<Gamma> t = \<Gamma> t'" using Cons by auto
     thus ?thesis using Equality IH by fastforce
   next
     case (Inequality X F)
     have "set (dual\<^sub>s\<^sub>t (x#S)) = insert x (set (dual\<^sub>s\<^sub>t S))" using Inequality by auto
     moreover have "(\<forall>x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \<exists>a. \<Gamma> (Var x) = Var a) \<or>
             (\<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))" 
       using Cons.prems Inequality by auto
     ultimately show ?thesis using Inequality IH by auto
   qed auto
 qed simp
 
 lemma subst_var_inv_wt:
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst_var_inv \<delta> X)"
 using assms f_inv_into_f[of _ \<delta> X]
 unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_var_inv_def
 by presburger
 
 lemma subst_var_inv_wf_trms:
   "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (subst_var_inv \<delta> X))"
 using f_inv_into_f[of _ \<delta> X]
 unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_var_inv_def
 by auto
 
 lemma unify_list_wt_if_same_type:
   assumes "Unification.unify E B = Some U" "\<forall>(s,t) \<in> set E. wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t \<and> \<Gamma> s = \<Gamma> t"
   and "\<forall>(v,t) \<in> set B. \<Gamma> (Var v) = \<Gamma> t"
   shows "\<forall>(v,t) \<in> set U. \<Gamma> (Var v) = \<Gamma> t"
 using assms
 proof (induction E B arbitrary: U rule: Unification.unify.induct)
   case (2 f X g Y E B U)
   hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun g Y)" "\<Gamma> (Fun f X) = \<Gamma> (Fun g Y)" by auto
 
   from "2.prems"(1) obtain E' where *: "decompose (Fun f X) (Fun g Y) = Some E'"
     and [simp]: "f = g" "length X = length Y" "E' = zip X Y"
     and **: "Unification.unify (E'@E) B = Some U"
     by (auto split: option.splits)
   
   have "\<forall>(s,t) \<in> set E'. wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t \<and> \<Gamma> s = \<Gamma> t"
   proof -
     { fix s t assume "(s,t) \<in> set E'"
       then obtain X' X'' Y' Y'' where "X = X'@s#X''" "Y = Y'@t#Y''" "length X' = length Y'"
         using zip_arg_subterm_split[of s t X Y] \<open>E' = zip X Y\<close> by metis
       hence "\<Gamma> (Fun f (X'@s#X'')) = \<Gamma> (Fun g (Y'@t#Y''))" by (metis \<open>\<Gamma> (Fun f X) = \<Gamma> (Fun g Y)\<close>)
       
       from \<open>E' = zip X Y\<close> have "\<forall>(s,t) \<in> set E'. s \<sqsubset> Fun f X \<and> t \<sqsubset> Fun g Y"
         using zip_arg_subterm[of _ _ X Y] by blast
       with \<open>(s,t) \<in> set E'\<close> have "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t"
         using wf_trm_subterm \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun g Y)\<close> by (blast,blast)
       moreover have "f \<in> \<Sigma>\<^sub>f"
       proof (rule ccontr)
         assume "f \<notin> \<Sigma>\<^sub>f"
         hence "f \<in> \<C>" "arity f = 0" using const_arity_eq_zero[of f] by simp_all
         thus False using \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close> * \<open>(s,t) \<in> set E'\<close> unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
       qed
       hence "\<Gamma> s = \<Gamma> t"
         using fun_type_arg_cong' \<open>f \<in> \<Sigma>\<^sub>f\<close> \<open>\<Gamma> (Fun f (X'@s#X'')) = \<Gamma> (Fun g (Y'@t#Y''))\<close>
               \<open>length X' = length Y'\<close> \<open>f = g\<close>
         by metis
       ultimately have "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t" "\<Gamma> s = \<Gamma> t" by metis+
     }
     thus ?thesis by blast
   qed
   moreover have "\<forall>(s,t) \<in> set E. wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t \<and> \<Gamma> s = \<Gamma> t" using "2.prems"(2) by auto
   ultimately show ?case using "2.IH"[OF * ** _ "2.prems"(3)] by fastforce
 next
   case (3 v t E B U)
   hence "\<Gamma> (Var v) = \<Gamma> t" "wf\<^sub>t\<^sub>r\<^sub>m t" by auto
   hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst v t)"
       and *: "\<forall>(v, t) \<in> set ((v,t)#B). \<Gamma> (Var v) = \<Gamma> t"
              "\<And>t t'. (t,t') \<in> set E \<Longrightarrow> \<Gamma> t = \<Gamma> t'"
     using "3.prems"(2,3) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_def by auto
 
   show ?case
   proof (cases "t = Var v")
     assume "t = Var v" thus ?case using 3 by auto
   next
     assume "t \<noteq> Var v"
     hence "v \<notin> fv t" using "3.prems"(1) by auto
     hence **: "Unification.unify (subst_list (subst v t) E) ((v, t)#B) = Some U"
       using Unification.unify.simps(3)[of v t E B] "3.prems"(1) \<open>t \<noteq> Var v\<close> by auto
     
     have "\<forall>(s, t) \<in> set (subst_list (subst v t) E). wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t"
       using wf_trm_subst_singleton[OF _ \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close>] "3.prems"(2)
       unfolding subst_list_def subst_def by auto
     moreover have "\<forall>(s, t) \<in> set (subst_list (subst v t) E). \<Gamma> s = \<Gamma> t"
       using *(2)[THEN wt_subst_trm'[OF \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst v t)\<close>]] by (simp add: subst_list_def)
     ultimately show ?thesis using "3.IH"(2)[OF \<open>t \<noteq> Var v\<close> \<open>v \<notin> fv t\<close> ** _ *(1)] by auto
   qed
 next
   case (4 f X v E B U)
   hence "\<Gamma> (Var v) = \<Gamma> (Fun f X)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" by auto
   hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst v (Fun f X))"
       and *: "\<forall>(v, t) \<in> set ((v,(Fun f X))#B). \<Gamma> (Var v) = \<Gamma> t"
              "\<And>t t'. (t,t') \<in> set E \<Longrightarrow> \<Gamma> t = \<Gamma> t'"
     using "4.prems"(2,3) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_def by auto
 
   have "v \<notin> fv (Fun f X)" using "4.prems"(1) by force
   hence **: "Unification.unify (subst_list (subst v (Fun f X)) E) ((v, (Fun f X))#B) = Some U"
     using Unification.unify.simps(3)[of v "Fun f X" E B] "4.prems"(1) by auto
   
   have "\<forall>(s, t) \<in> set (subst_list (subst v (Fun f X)) E). wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t"
     using wf_trm_subst_singleton[OF _ \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close>] "4.prems"(2)
     unfolding subst_list_def subst_def by auto
   moreover have "\<forall>(s, t) \<in> set (subst_list (subst v (Fun f X)) E). \<Gamma> s = \<Gamma> t"
     using *(2)[THEN wt_subst_trm'[OF \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst v (Fun f X))\<close>]] by (simp add: subst_list_def)
   ultimately show ?case using "4.IH"[OF \<open>v \<notin> fv (Fun f X)\<close> ** _ *(1)] by auto
 qed auto
 
 lemma mgu_wt_if_same_type:
   assumes "mgu s t = Some \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t" "\<Gamma> s = \<Gamma> t"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>"
 proof -
   let ?fv_disj = "\<lambda>v t S. \<not>(\<exists>(v',t') \<in> S - {(v,t)}. (insert v (fv t)) \<inter> (insert v' (fv t')) \<noteq> {})"
 
   from assms(1) obtain \<sigma>' where "Unification.unify [(s,t)] [] = Some \<sigma>'" "subst_of \<sigma>' = \<sigma>"
     by (auto simp: mgu_def split: option.splits)
   hence "\<forall>(v,t) \<in> set \<sigma>'. \<Gamma> (Var v) = \<Gamma> t" "distinct (map fst \<sigma>')"
     using assms(2,3,4) unify_list_wt_if_same_type unify_list_distinct[of "[(s,t)]"] by auto
   thus "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>" using \<open>subst_of \<sigma>' = \<sigma>\<close> unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
   proof (induction \<sigma>' arbitrary: \<sigma> rule: List.rev_induct)
     case (snoc tt \<sigma>' \<sigma>)
     then obtain v t where tt: "tt = (v,t)" by (metis surj_pair)
     hence \<sigma>: "\<sigma> = subst v t \<circ>\<^sub>s subst_of \<sigma>'" using snoc.prems(3) by simp
     
     have "\<forall>(v,t) \<in> set \<sigma>'. \<Gamma> (Var v) = \<Gamma> t" "distinct (map fst \<sigma>')" using snoc.prems(1,2) by auto
     then obtain \<sigma>'' where \<sigma>'': "subst_of \<sigma>' = \<sigma>''" "\<forall>v. \<Gamma> (Var v) = \<Gamma> (\<sigma>'' v)" by (metis snoc.IH)
     hence "\<Gamma> t = \<Gamma> (t \<cdot> \<sigma>'')" for t using wt_subst_trm by blast
     hence "\<Gamma> (Var v) = \<Gamma> (\<sigma>'' v)" "\<Gamma> t = \<Gamma> (t \<cdot> \<sigma>'')" using \<sigma>''(2) by auto
     moreover have "\<Gamma> (Var v) = \<Gamma> t" using snoc.prems(1) tt by simp
     moreover have \<sigma>2: "\<sigma> = Var(v := t) \<circ>\<^sub>s \<sigma>'' " using \<sigma> \<sigma>''(1) unfolding subst_def by simp
     ultimately have "\<Gamma> (Var v) = \<Gamma> (\<sigma> v)" unfolding subst_compose_def by simp
 
     have "subst_domain (subst v t) \<subseteq> {v}" unfolding subst_def by (auto simp add: subst_domain_def)
     hence *: "subst_domain \<sigma> \<subseteq> insert v (subst_domain \<sigma>'')"
       using tt \<sigma> \<sigma>''(1) snoc.prems(2) subst_domain_compose[of _ \<sigma>'']
       by (auto simp add: subst_domain_def)
     
     have "v \<notin> set (map fst \<sigma>')" using tt snoc.prems(2) by auto
     hence "v \<notin> subst_domain \<sigma>''" using \<sigma>''(1) subst_of_dom_subset[of \<sigma>'] by auto
 
     { fix w assume "w \<in> subst_domain \<sigma>''"
       hence "\<sigma> w = \<sigma>'' w" using \<sigma>2 \<sigma>''(1) \<open>v \<notin> subst_domain \<sigma>''\<close> unfolding subst_compose_def by auto
       hence "\<Gamma> (Var w) = \<Gamma> (\<sigma> w)" using \<sigma>''(2) by simp
     }
     thus ?case using \<open>\<Gamma> (Var v) = \<Gamma> (\<sigma> v)\<close> * by force
   qed simp
 qed
 
 lemma wt_Unifier_if_Unifier:
   assumes s_t: "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t" "\<Gamma> s = \<Gamma> t"
     and \<delta>: "Unifier \<delta> s t"
   shows "\<exists>\<theta>. Unifier \<theta> s t \<and> 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 mgu_always_unifies[OF \<delta>] mgu_gives_MGU[THEN MGU_is_Unifier[of s _ t]]
       mgu_wt_if_same_type[OF _ s_t] mgu_wf_trm[OF _ s_t(1,2)] wf_trm_subst_range_iff
 by fast
 
 end
 
 
 subsection \<open>Automatically Proving Type-Flaw Resistance\<close>
 subsubsection \<open>Definitions: Variable Renaming\<close>
 abbreviation "max_var t \<equiv> Max (insert 0 (snd ` fv t))"
 abbreviation "max_var_set X \<equiv> Max (insert 0 (snd ` X))"
 
 definition "var_rename n v \<equiv> Var (fst v, snd v + Suc n)"
 definition "var_rename_inv n v \<equiv> Var (fst v, snd v - Suc n)"
 
 
 subsubsection \<open>Definitions: Computing a Finite Representation of the Sub-Message Patterns\<close>
 text \<open>A sufficient requirement for a term to be a well-typed instance of another term\<close>
 definition is_wt_instance_of_cond where
   "is_wt_instance_of_cond \<Gamma> t s \<equiv> (
     \<Gamma> t = \<Gamma> s \<and> (case mgu t s of
       None \<Rightarrow> False
     | Some \<delta> \<Rightarrow> inj_on \<delta> (fv t) \<and> (\<forall>x \<in> fv t. is_Var (\<delta> x))))"
 
 definition has_all_wt_instances_of where
   "has_all_wt_instances_of \<Gamma> N M \<equiv> \<forall>t \<in> N. \<exists>s \<in> M. is_wt_instance_of_cond \<Gamma> t s"
 
 text \<open>This function computes a finite representation of the set of sub-message patterns\<close>
 definition SMP0 where
   "SMP0 Ana \<Gamma> M \<equiv> let
       f = \<lambda>t. Fun (the_Fun (\<Gamma> t)) (map Var (zip (args (\<Gamma> t)) [0..<length (args (\<Gamma> t))]));
       g = \<lambda>M'. map f (filter (\<lambda>t. is_Var t \<and> is_Fun (\<Gamma> t)) M')@
                concat (map (fst \<circ> Ana) M')@concat (map subterms_list M');
       h = remdups \<circ> g
     in while (\<lambda>A. set (h A) \<noteq> set A) h M"
 
 text \<open>These definitions are useful to refine an SMP representation set\<close>
 fun generalize_term where
   "generalize_term _ _ n (Var x) = (Var x, n)"
 | "generalize_term \<Gamma> p n (Fun f T) = (let \<tau> = \<Gamma> (Fun f T)
     in if p \<tau> then (Var (\<tau>, n), Suc n)
        else let (T',n') = foldr (\<lambda>t (S,m). let (t',m') = generalize_term \<Gamma> p m t in (t'#S,m'))
                                 T ([],n)
             in (Fun f T', n'))"
 
 definition generalize_terms where
   "generalize_terms \<Gamma> p \<equiv> map (fst \<circ> generalize_term \<Gamma> p 0)"
 
 definition remove_superfluous_terms where
   "remove_superfluous_terms \<Gamma> T \<equiv>
     let
       f = \<lambda>S t R. \<exists>s \<in> set S - R. s \<noteq> t \<and> is_wt_instance_of_cond \<Gamma> t s;
       g = \<lambda>S t (U,R). if f S t R then (U, insert t R) else (t#U, R);
       h = \<lambda>S. remdups (fst (foldr (g S) S ([],{})))
     in while (\<lambda>S. h S \<noteq> S) h T"
 
 
 subsubsection \<open>Definitions: Checking Type-Flaw Resistance\<close>
 definition is_TComp_var_instance_closed where
   "is_TComp_var_instance_closed \<Gamma> M \<equiv> \<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. is_Fun (\<Gamma> (Var x)) \<longrightarrow>
       (\<exists>t \<in> M. is_Fun t \<and> \<Gamma> t = \<Gamma> (Var x) \<and> list_all is_Var (args t) \<and> distinct (args t))"
 
 definition finite_SMP_representation where
   "finite_SMP_representation arity Ana \<Gamma> M \<equiv>
     (M = {} \<or> card M > 0) \<and>
     wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity M \<and>
     has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M \<and>
     has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M \<and>
     is_TComp_var_instance_closed \<Gamma> M"
 
 definition comp_tfr\<^sub>s\<^sub>e\<^sub>t where
   "comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> M \<equiv>
     finite_SMP_representation arity Ana \<Gamma> M \<and>
     (let \<delta> = var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M))
      in \<forall>s \<in> M. \<forall>t \<in> M. is_Fun s \<and> is_Fun t \<and> \<Gamma> s \<noteq> \<Gamma> t \<longrightarrow> mgu s (t \<cdot> \<delta>) = None)"
 
 fun comp_tfr\<^sub>s\<^sub>t\<^sub>p where
   "comp_tfr\<^sub>s\<^sub>t\<^sub>p \<Gamma> (\<langle>_: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t) = (mgu t t' \<noteq> None \<longrightarrow> \<Gamma> t = \<Gamma> t')"
 | "comp_tfr\<^sub>s\<^sub>t\<^sub>p \<Gamma> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t) = (
     (\<forall>x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. is_Var (\<Gamma> (Var x))) \<or>
     (\<forall>u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F).
       is_Fun u \<longrightarrow> (args u = [] \<or> (\<exists>s \<in> set (args u). s \<notin> Var ` set X))))"
 | "comp_tfr\<^sub>s\<^sub>t\<^sub>p _ _ = True"
 
 definition comp_tfr\<^sub>s\<^sub>t where
   "comp_tfr\<^sub>s\<^sub>t arity Ana \<Gamma> M S \<equiv>
     list_all (comp_tfr\<^sub>s\<^sub>t\<^sub>p \<Gamma>) S \<and>
     list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (trms_list\<^sub>s\<^sub>t S) \<and>
     has_all_wt_instances_of \<Gamma> (trms\<^sub>s\<^sub>t S) M \<and>
     comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> M"
 
 
 subsubsection \<open>Small Lemmata\<close>
 lemma max_var_set_mono:
   assumes "finite N"
     and "M \<subseteq> N"
   shows "max_var_set M \<le> max_var_set N"
 by (meson assms Max.subset_imp finite.insertI finite_imageI image_mono insert_mono insert_not_empty) 
 
 lemma less_Suc_max_var_set:
   assumes z: "z \<in> X"
     and X: "finite X"
   shows "snd z < Suc (max_var_set X)"
 proof -
   have "snd z \<in> snd ` X" using z by simp
   hence "snd z \<le> Max (insert 0 (snd ` X))" using X by simp
   thus ?thesis using X by simp
 qed
 
 lemma (in typed_model) finite_SMP_representationD:
   assumes "finite_SMP_representation arity Ana \<Gamma> M"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
     and "has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M"
     and "is_TComp_var_instance_closed \<Gamma> M"
     and "finite M"
 using assms wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[of M] unfolding finite_SMP_representation_def list_all_iff card_gt_0_iff
 by blast+
 
 lemma (in typed_model) is_wt_instance_of_condD:
   assumes t_instance_s: "is_wt_instance_of_cond \<Gamma> t s"
   obtains \<delta> where
     "\<Gamma> t = \<Gamma> s" "mgu t s = Some \<delta>"
     "inj_on \<delta> (fv t)" "\<delta> ` (fv t) \<subseteq> range Var"
 using t_instance_s unfolding is_wt_instance_of_cond_def Let_def by (cases "mgu t s") fastforce+
 
 lemma (in typed_model) is_wt_instance_of_condD':
   assumes t_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m t"
     and s_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m s"
     and t_instance_s: "is_wt_instance_of_cond \<Gamma> t s"
   shows "\<exists>\<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>) \<and> t = s \<cdot> \<delta>"
 proof -
   obtain \<delta> where s:
       "\<Gamma> t = \<Gamma> s" "mgu t s = Some \<delta>"
       "inj_on \<delta> (fv t)" "\<delta> ` (fv t) \<subseteq> range Var"
     by (metis is_wt_instance_of_condD[OF t_instance_s])
 
   have 0: "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m s" using s(1) t_wf_trm s_wf_trm by auto
 
   note 1 = mgu_wt_if_same_type[OF s(2) 0 s(1)]
 
   note 2 = conjunct1[OF mgu_gives_MGU[OF s(2)]]
 
   show ?thesis
     using s(1) inj_var_ran_unifiable_has_subst_match[OF 2 s(3,4)]
           wt_subst_compose[OF 1 subst_var_inv_wt[OF 1, of "fv t"]]
           wf_trms_subst_compose[OF mgu_wf_trms[OF s(2) 0] subst_var_inv_wf_trms[of \<delta> "fv t"]]
     by auto
 qed
 
 lemma (in typed_model) is_wt_instance_of_condD'':
   assumes s_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m s"
     and t_instance_s: "is_wt_instance_of_cond \<Gamma> t s"
     and t_var: "t = Var x"
   shows "\<exists>y. s = Var y \<and> \<Gamma> (Var y) = \<Gamma> (Var x)"
 proof -
   obtain \<delta> where \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" and s: "Var x = s \<cdot> \<delta>"
     using is_wt_instance_of_condD'[OF _ s_wf_trm t_instance_s] t_var by auto
   obtain y where y: "s = Var y" using s by (cases s) auto
   show ?thesis using wt_subst_trm''[OF \<delta>] s y by metis
 qed
 
 lemma (in typed_model) has_all_wt_instances_ofD:
   assumes N_instance_M: "has_all_wt_instances_of \<Gamma> N M"
     and t_in_N: "t \<in> N"
   obtains s \<delta> where
     "s \<in> M" "\<Gamma> t = \<Gamma> s" "mgu t s = Some \<delta>"
     "inj_on \<delta> (fv t)" "\<delta> ` (fv t) \<subseteq> range Var"
 by (metis t_in_N N_instance_M is_wt_instance_of_condD has_all_wt_instances_of_def)
 
 lemma (in typed_model) has_all_wt_instances_ofD':
   assumes N_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and M_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and N_instance_M: "has_all_wt_instances_of \<Gamma> N M"
     and t_in_N: "t \<in> N"
   shows "\<exists>\<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>) \<and> t \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
 using assms is_wt_instance_of_condD' unfolding has_all_wt_instances_of_def by fast
 
 lemma (in typed_model) has_all_wt_instances_ofD'':
   assumes N_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and M_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and N_instance_M: "has_all_wt_instances_of \<Gamma> N M"
     and t_in_N: "Var x \<in> N"
   shows "\<exists>y. Var y \<in> M \<and> \<Gamma> (Var y) = \<Gamma> (Var x)"
 using assms is_wt_instance_of_condD'' unfolding has_all_wt_instances_of_def by fast
   
 lemma (in typed_model) has_all_instances_of_if_subset:
   assumes "N \<subseteq> M"
   shows "has_all_wt_instances_of \<Gamma> N M"
 unfolding has_all_wt_instances_of_def
 proof
   fix t assume t: "t \<in> N"
   hence "is_wt_instance_of_cond \<Gamma> t t"
     using inj_onI[of "fv t"] mgu_same_empty[of t]
     unfolding is_wt_instance_of_cond_def by force
   thus "\<exists>s \<in> M. is_wt_instance_of_cond \<Gamma> t s" using t assms by blast
 qed
 
 lemma (in typed_model) SMP_I':
   assumes N_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and M_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and N_instance_M: "has_all_wt_instances_of \<Gamma> N M"
     and t_in_N: "t \<in> N"
   shows "t \<in> SMP M"
 using has_all_wt_instances_ofD'[OF N_wf_trms M_wf_trms N_instance_M t_in_N]
       SMP.Substitution[OF SMP.MP[of _ M]]
 by blast
 
 
 subsubsection \<open>Lemma: Proving Type-Flaw Resistance\<close>
 locale typed_model' = typed_model arity public Ana \<Gamma>
   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"
   +
   assumes \<Gamma>_Var_fst: "\<And>\<tau> n m. \<Gamma> (Var (\<tau>,n)) = \<Gamma> (Var (\<tau>,m))"
     and Ana_const: "\<And>c T. arity c = 0 \<Longrightarrow> Ana (Fun c T) = ([],[])"
     and Ana_subst'_or_Ana_keys_subterm:
       "(\<forall>f T \<delta> K R. Ana (Fun f T) = (K,R) \<longrightarrow> Ana (Fun f T \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>,R \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)) \<or>
        (\<forall>t K R k. Ana t = (K,R) \<longrightarrow> k \<in> set K \<longrightarrow> k \<sqsubset> t)"
 begin
 
 lemma var_rename_inv_comp: "t \<cdot> (var_rename n \<circ>\<^sub>s var_rename_inv n) = t"
 proof (induction t)
   case (Fun f T)
   hence "map (\<lambda>t. t \<cdot> var_rename n \<circ>\<^sub>s var_rename_inv n) T = T" by (simp add: map_idI) 
-  thus ?case by (metis subst_apply_term.simps(2)) 
-qed (simp add: var_rename_def var_rename_inv_def)
+  thus ?case by (metis eval_term.simps(2)) 
+qed (simp add: var_rename_def var_rename_inv_def subst_compose)
 
 lemma var_rename_fv_disjoint:
   "fv s \<inter> fv (t \<cdot> var_rename (max_var s)) = {}"
 proof -
   have 1: "\<forall>v \<in> fv s. snd v \<le> max_var s" by simp
   have 2: "\<forall>v \<in> fv (t \<cdot> var_rename n). snd v > n" for n unfolding var_rename_def by (induct t) auto
   show ?thesis using 1 2 by force
 qed
 
 lemma var_rename_fv_set_disjoint:
   assumes "finite M" "s \<in> M"
   shows "fv s \<inter> fv (t \<cdot> var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M))) = {}"
 proof -
   have 1: "\<forall>v \<in> fv s. snd v \<le> max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M)" using assms
   proof (induction M rule: finite_induct)
     case (insert t M) thus ?case
     proof (cases "t = s")
       case False
       hence "\<forall>v \<in> fv s. snd v \<le> max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M)" using insert by simp
       moreover have "max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M) \<le> max_var_set (fv\<^sub>s\<^sub>e\<^sub>t (insert t M))"
         using insert.hyps(1) insert.prems
         by force
       ultimately show ?thesis by auto
     qed simp
   qed simp
 
   have 2: "\<forall>v \<in> fv (t \<cdot> var_rename n). snd v > n" for n unfolding var_rename_def by (induct t) auto
 
   show ?thesis using 1 2 by force
 qed
 
 lemma var_rename_fv_set_disjoint':
   assumes "finite M"
   shows "fv\<^sub>s\<^sub>e\<^sub>t M \<inter> fv\<^sub>s\<^sub>e\<^sub>t (N \<cdot>\<^sub>s\<^sub>e\<^sub>t var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M))) = {}"
 using var_rename_fv_set_disjoint[OF assms] by auto
 
 lemma var_rename_is_renaming[simp]:
   "subst_range (var_rename n) \<subseteq> range Var"
   "subst_range (var_rename_inv n) \<subseteq> range Var"
 unfolding var_rename_def var_rename_inv_def by auto
 
 lemma var_rename_wt[simp]:
   "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (var_rename n)"
   "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (var_rename_inv n)"
 by (auto simp add: var_rename_def var_rename_inv_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def \<Gamma>_Var_fst)
 
 lemma var_rename_wt':
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "s = m \<cdot> \<delta>"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (var_rename_inv n \<circ>\<^sub>s \<delta>)" "s = m \<cdot> var_rename n \<cdot> var_rename_inv n \<circ>\<^sub>s \<delta>"
 using assms(2) wt_subst_compose[OF var_rename_wt(2)[of n] assms(1)] var_rename_inv_comp[of m n]
 by force+
 
 lemma var_rename_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_range[simp]:
   "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (var_rename n))"
   "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (var_rename_inv n))"
 using var_rename_is_renaming by fastforce+
 
 lemma Fun_range_case:
   "(\<forall>f T. Fun f T \<in> M \<longrightarrow> P f T) \<longleftrightarrow> (\<forall>u \<in> M. case u of Fun f T \<Rightarrow> P f T | _ \<Rightarrow> True)"
   "(\<forall>f T. Fun f T \<in> M \<longrightarrow> P f T) \<longleftrightarrow> (\<forall>u \<in> M. is_Fun u \<longrightarrow> P (the_Fun u) (args u))"
 by (auto split: "term.splits")
 
 lemma is_TComp_var_instance_closedD:
   assumes x: "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)" "\<Gamma> (Var x) = TComp f T"
     and closed: "is_TComp_var_instance_closed \<Gamma> M"
   shows "\<exists>g U. Fun g U \<in> M \<and> \<Gamma> (Fun g U) = \<Gamma> (Var x) \<and> (\<forall>u \<in> set U. is_Var u) \<and> distinct U"
 using assms unfolding is_TComp_var_instance_closed_def list_all_iff list_ex_iff by fastforce
 
 lemma is_TComp_var_instance_closedD':
   assumes "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)" "TComp f T \<sqsubseteq> \<Gamma> (Var x)"
     and closed: "is_TComp_var_instance_closed \<Gamma> M"
     and wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
   shows "\<exists>g U. Fun g U \<in> M \<and> \<Gamma> (Fun g U) = TComp f T \<and> (\<forall>u \<in> set U. is_Var u) \<and> distinct U"
 using assms(1,2)
 proof (induction "\<Gamma> (Var x)" arbitrary: x)
   case (Fun g U)
   note IH = Fun.hyps(1)
   have g: "arity g > 0" using Fun.hyps(2) fun_type_inv[of "Var x"] \<Gamma>_Var_fst by simp_all
   then obtain V where V:
       "Fun g V \<in> M" "\<Gamma> (Fun g V) = \<Gamma> (Var x)" "\<forall>v \<in> set V. \<exists>x. v = Var x"
       "distinct V" "length U = length V"
     using is_TComp_var_instance_closedD[OF Fun.prems(1) Fun.hyps(2)[symmetric] closed(1)]
     by (metis Fun.hyps(2) fun_type_id_eq fun_type_length_eq is_VarE)
   hence U: "U = map \<Gamma> V" using fun_type[OF g(1), of V] Fun.hyps(2) by simp
   hence 1: "\<Gamma> v \<in> set U" when v: "v \<in> set V" for v using v by simp
 
   have 2: "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var z) = \<Gamma> (Var y)" when z: "Var z \<in> set V" for z
     using V(1) fv_subset_subterms Fun_param_in_subterms[OF z] by fastforce
 
   show ?case
   proof (cases "TComp f T = \<Gamma> (Var x)")
     case False
     then obtain u where u: "u \<in> set U" "TComp f T \<sqsubseteq> u"
       using Fun.prems(2) Fun.hyps(2) by moura
     then obtain y where y: "Var y \<in> set V" "\<Gamma> (Var y) = u" using U V(3) \<Gamma>_Var_fst by auto
     show ?thesis using IH[OF _ 2[OF y(1)]] u y(2) by metis
   qed (use V in fastforce)
 qed simp
 
 lemma TComp_var_instance_wt_subst_exists:
   assumes gT: "\<Gamma> (Fun g T) = TComp g (map \<Gamma> U)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun g T)"
     and U: "\<forall>u \<in> set U. \<exists>y. u = Var y" "distinct U"
   shows "\<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> Fun g T = Fun g U \<cdot> \<theta>"
 proof -
   define the_i where "the_i \<equiv> \<lambda>y. THE x. x < length U \<and> U ! x = Var y"
   define \<theta> where \<theta>: "\<theta> \<equiv> \<lambda>y. if Var y \<in> set U then T ! the_i y else Var y"
 
   have g: "arity g > 0" using gT(1,2) fun_type_inv(1) by blast
 
   have UT: "length U = length T" using fun_type_length_eq gT(1) by fastforce
 
   have 1: "the_i y < length U \<and> U ! the_i y = Var y" when y: "Var y \<in> set U" for y
     using theI'[OF distinct_Ex1[OF U(2) y]] unfolding the_i_def by simp
 
   have 2: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
     using \<theta> 1 gT(1) fun_type[OF g] UT
     unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
     by (metis (no_types, lifting) nth_map term.inject(2))
 
   have "\<forall>i<length T. U ! i \<cdot> \<theta> = T ! i"
     using \<theta> 1 U(1) UT distinct_Ex1[OF U(2)] in_set_conv_nth
-    by (metis (no_types, lifting) subst_apply_term.simps(1))
+    by (metis (no_types, lifting) eval_term.simps(1))
   hence "T = map (\<lambda>t. t \<cdot> \<theta>) U" by (simp add: UT nth_equalityI)
   hence 3: "Fun g T = Fun g U \<cdot> \<theta>" by simp
 
   have "subst_range \<theta> \<subseteq> set T" using \<theta> 1 U(1) UT by (auto simp add: subst_domain_def)
   hence 4: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" using gT(2) wf_trm_param by auto
 
   show ?thesis by (metis 2 3 4)
 qed
 
 lemma TComp_var_instance_closed_has_Var:
   assumes closed: "is_TComp_var_instance_closed \<Gamma> M"
     and wf_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and wf_\<delta>x: "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)"
     and y_ex: "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)"
     and t: "t \<sqsubseteq> \<delta> x"
     and \<delta>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
   shows "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var y) = \<Gamma> t"
 proof (cases "\<Gamma> (Var x)")
   case (Var a)
   hence "t = \<delta> x"
     using t wf_\<delta>x \<delta>_wt
     by (metis (full_types) const_type_inv_wf fun_if_subterm subtermeq_Var_const(2) wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
   thus ?thesis using y_ex wt_subst_trm''[OF \<delta>_wt, of "Var x"] by fastforce
 next
   case (Fun f T)
   hence \<Gamma>_\<delta>x: "\<Gamma> (\<delta> x) = TComp f T" using wt_subst_trm''[OF \<delta>_wt, of "Var x"] by auto
 
   show ?thesis
   proof (cases "t = \<delta> x")
     case False
     hence t_subt_\<delta>x: "t \<sqsubset> \<delta> x" using t(1) \<Gamma>_\<delta>x by fastforce
 
     obtain T' where T': "\<delta> x = Fun f T'" using \<Gamma>_\<delta>x t_subt_\<delta>x fun_type_id_eq by (cases "\<delta> x") auto
     
     obtain g S where gS: "Fun g S \<sqsubseteq> \<delta> x" "t \<in> set S" using Fun_ex_if_subterm[OF t_subt_\<delta>x] by blast
   
     have gS_wf: "wf\<^sub>t\<^sub>r\<^sub>m (Fun g S)" by (rule wf_trm_subtermeq[OF wf_\<delta>x gS(1)])
     hence "arity g > 0" using gS(2) by (metis length_pos_if_in_set wf_trm_arity) 
     hence gS_\<Gamma>: "\<Gamma> (Fun g S) = TComp g (map \<Gamma> S)" using fun_type by blast
   
     obtain h U where hU:
         "Fun h U \<in> M" "\<Gamma> (Fun h U) = Fun g (map \<Gamma> S)" "\<forall>u \<in> set U. is_Var u"
       using is_TComp_var_instance_closedD'[OF y_ex _ closed wf_M]
             subtermeq_imp_subtermtypeeq[OF wf_\<delta>x] gS \<Gamma>_\<delta>x Fun gS_\<Gamma>
       by metis
   
     obtain y where y: "Var y \<in> set U" "\<Gamma> (Var y) = \<Gamma> t"
       using hU(3) fun_type_param_ex[OF hU(2) gS(2)] by fast
   
     have "y \<in> fv\<^sub>s\<^sub>e\<^sub>t M" using hU(1) y(1) by force
     thus ?thesis using y(2) closed by metis
   qed (metis y_ex Fun \<Gamma>_\<delta>x)
 qed
 
 lemma TComp_var_instance_closed_has_Fun:
   assumes closed: "is_TComp_var_instance_closed \<Gamma> M"
     and wf_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and wf_\<delta>x: "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)"
     and y_ex: "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)"
     and t: "t \<sqsubseteq> \<delta> x"
     and \<delta>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
     and t_\<Gamma>: "\<Gamma> t = TComp g T"
     and t_fun: "is_Fun t"
   shows "\<exists>m \<in> M. \<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> t = m \<cdot> \<theta> \<and> is_Fun m"
 proof -
   obtain T'' where T'': "t = Fun g T''" using t_\<Gamma> t_fun fun_type_id_eq by blast
 
   have g: "arity g > 0" using t_\<Gamma> fun_type_inv[of t] by simp_all
 
   have "TComp g T \<sqsubseteq> \<Gamma> (Var x)" using \<delta>_wt t t_\<Gamma>
     by (metis wf_\<delta>x subtermeq_imp_subtermtypeeq wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) 
   then obtain U where U:
       "Fun g U \<in> M" "\<Gamma> (Fun g U) = TComp g T" "\<forall>u \<in> set U. \<exists>y. u = Var y"
       "distinct U" "length T'' = length U"
     using is_TComp_var_instance_closedD'[OF y_ex _ closed wf_M]
     by (metis t_\<Gamma> T'' fun_type_id_eq fun_type_length_eq is_VarE)
   hence UT': "T = map \<Gamma> U" using fun_type[OF g, of U] by simp
 
   show ?thesis
     using TComp_var_instance_wt_subst_exists UT' T'' U(1,3,4) t t_\<Gamma> wf_\<delta>x wf_trm_subtermeq
     by (metis term.disc(2))
 qed
 
 lemma TComp_var_and_subterm_instance_closed_has_subterms_instances:
   assumes M_var_inst_cl: "is_TComp_var_instance_closed \<Gamma> M"
     and M_subterms_cl: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
     and M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and t: "t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M"
     and s: "s \<sqsubseteq> t \<cdot> \<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>)"
   shows "\<exists>m \<in> M. \<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> s = m \<cdot> \<theta>"
 using subterm_subst_unfold[OF s]
 proof
   assume "\<exists>s'. s' \<sqsubseteq> t \<and> s = s' \<cdot> \<delta>"
   then obtain s' where s': "s' \<sqsubseteq> t" "s = s' \<cdot> \<delta>" by blast
   then obtain \<theta> where \<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>)" "s' \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
     using t has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl]
           term.order_trans[of s' t]
     by blast
   then obtain m where m: "m \<in> M" "s' = m \<cdot> \<theta>" by blast
 
   have "s = m \<cdot> (\<theta> \<circ>\<^sub>s \<delta>)" using s'(2) m(2) by simp
   thus ?thesis
     using m(1) wt_subst_compose[OF \<theta>(1) \<delta>(1)] wf_trms_subst_compose[OF \<theta>(2) \<delta>(2)] by blast
 next
   assume "\<exists>x \<in> fv t. s \<sqsubset> \<delta> x"
   then obtain x where x: "x \<in> fv t" "s \<sqsubset> \<delta> x" "s \<sqsubseteq> \<delta> x" by blast
 
   note 0 = TComp_var_instance_closed_has_Var[OF M_var_inst_cl M_wf]
   note 1 = has_all_wt_instances_ofD''[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl]
 
   have \<delta>x_wf: "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)" and s_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m s"
     using \<delta>(2) wf_trm_subterm[OF _ x(2)] by fastforce+
 
   have x_fv_ex: "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)"
     using x(1) s fv_subset_subterms[OF t] by auto
 
   obtain y where y: "y \<in> fv\<^sub>s\<^sub>e\<^sub>t M" "\<Gamma> (Var y) = \<Gamma> s"
     using 0[of \<delta> x s, OF \<delta>x_wf x_fv_ex x(3) \<delta>(1)] by metis
   then obtain z where z: "Var z \<in> M" "\<Gamma> (Var z) = \<Gamma> s"
     using 1[of y] vars_iff_subtermeq_set[of y M] by metis
 
   define \<theta> where "\<theta> \<equiv> Var(z := s)::('fun, ('fun, 'atom) term \<times> nat) subst"
 
   have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" "s = Var z \<cdot> \<theta>"
     using z(2) s_wf_trm unfolding \<theta>_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by force+
   thus ?thesis using z(1) by blast
 qed
 
 context
 begin
 private lemma SMP_D_aux1:
   assumes "t \<in> SMP M"
     and closed: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
                 "is_TComp_var_instance_closed \<Gamma> M"
     and wf_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
   shows "\<forall>x \<in> fv t. \<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var y) = \<Gamma> (Var x)"
 using assms(1)
 proof (induction t rule: SMP.induct)
   case (MP t) show ?case
   proof
     fix x assume x: "x \<in> fv t"
     hence "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t M" using MP.hyps vars_iff_subtermeq by fastforce
     then obtain \<delta> s where \<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>)"
         and s: "s \<in> M" "Var x = s \<cdot> \<delta>"
       using has_all_wt_instances_ofD'[OF wf_trms_subterms[OF wf_M] wf_M closed(1)] by blast
     then obtain y where y: "s = Var y" by (cases s) auto
     thus "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var y) = \<Gamma> (Var x)"
       using s wt_subst_trm''[OF \<delta>(1), of "Var y"] by force
   qed
 next
   case (Subterm t t')
   hence "fv t' \<subseteq> fv t" using subtermeq_vars_subset by auto
   thus ?case using Subterm.IH by auto
 next
   case (Substitution t \<delta>)
   note IH = Substitution.IH
   show ?case
   proof
     fix x assume x: "x \<in> fv (t \<cdot> \<delta>)"
     then obtain y where y: "y \<in> fv t" "\<Gamma> (Var x) \<sqsubseteq> \<Gamma> (Var y)"
       using Substitution.hyps(2,3)
       by (metis subst_apply_img_var subtermeqI' subtermeq_imp_subtermtypeeq
                 vars_iff_subtermeq wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def wf_trm_subst_rangeD)
     let ?P = "\<lambda>x. \<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var y) = \<Gamma> (Var x)"
     show "?P x" using y IH
     proof (induction "\<Gamma> (Var y)" arbitrary: y t)
       case (Var a)
       hence "\<Gamma> (Var x) = \<Gamma> (Var y)" by auto
       thus ?case using Var(2,4) by auto
     next
       case (Fun f T)
       obtain z where z: "\<exists>w \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var z) = \<Gamma> (Var w)" "\<Gamma> (Var z) = \<Gamma> (Var y)"
         using Fun.prems(1,3) by blast
       show ?case
       proof (cases "\<Gamma> (Var x) = \<Gamma> (Var y)")
         case True thus ?thesis using Fun.prems by auto
       next
         case False
         then obtain \<tau> where \<tau>: "\<tau> \<in> set T" "\<Gamma> (Var x) \<sqsubseteq> \<tau>" using Fun.prems(2) Fun.hyps(2) by auto
         then obtain U where U:
             "Fun f U \<in> M" "\<Gamma> (Fun f U) = \<Gamma> (Var z)" "\<forall>u \<in> set U. \<exists>v. u = Var v" "distinct U"
           using is_TComp_var_instance_closedD'[OF z(1) _ closed(2) wf_M] Fun.hyps(2) z(2)
           by (metis fun_type_id_eq subtermeqI' is_VarE)
         hence 1: "\<forall>x \<in> fv (Fun f U). \<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var y) = \<Gamma> (Var x)" by force
 
         have "arity f > 0" using U(2) z(2) Fun.hyps(2) fun_type_inv(1) by metis
         hence "\<Gamma> (Fun f U) = TComp f (map \<Gamma> U)" using fun_type by auto
         then obtain u where u: "Var u \<in> set U" "\<Gamma> (Var u) = \<tau>"
           using \<tau>(1) U(2,3) z(2) Fun.hyps(2) by auto
         show ?thesis
           using Fun.hyps(1)[of u "Fun f U"] u \<tau> 1
           by force
       qed
     qed
   qed
 next
   case (Ana t K T k)
   have "fv k \<subseteq> fv t" using Ana_keys_fv[OF Ana.hyps(2)] Ana.hyps(3) by auto
   thus ?case using Ana.IH by auto
 qed
 
 private lemma SMP_D_aux2:
   fixes t::"('fun, ('fun, 'atom) term \<times> nat) term"
   assumes t_SMP: "t \<in> SMP M"
     and t_Var: "\<exists>x. t = Var x"
     and M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
   shows "\<exists>m \<in> M. \<exists>\<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>) \<and> t = m \<cdot> \<delta>"
 proof -
   have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" 
       and M_var_inst_cl: "is_TComp_var_instance_closed \<Gamma> M"
       and M_subterms_cl: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
       and M_Ana_cl: "has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M"
     using finite_SMP_representationD[OF M_SMP_repr] by blast+
 
   have M_Ana_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union> ((set \<circ> fst \<circ> Ana) ` M))"
   proof
     fix k assume "k \<in> \<Union>((set \<circ> fst \<circ> Ana) ` M)"
     then obtain m where m: "m \<in> M" "k \<in> set (fst (Ana m))" by force
     thus "wf\<^sub>t\<^sub>r\<^sub>m k" using M_wf Ana_keys_wf'[of m "fst (Ana m)" _ k] surjective_pairing by blast
   qed
 
   note 0 = has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl]
   note 1 = has_all_wt_instances_ofD'[OF M_Ana_wf M_wf M_Ana_cl]
 
   obtain x y where x: "t = Var x" and y: "y \<in> fv\<^sub>s\<^sub>e\<^sub>t M" "\<Gamma> (Var y) = \<Gamma> (Var x)"
     using t_Var SMP_D_aux1[OF t_SMP M_subterms_cl M_var_inst_cl M_wf] by fastforce
   then obtain m \<delta> where m: "m \<in> M" "m \<cdot> \<delta> = Var y" and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
     using 0[of "Var y"] vars_iff_subtermeq_set[of y M] by fastforce
   obtain z where z: "m = Var z" using m(2) by (cases m) auto
 
   define \<theta> where "\<theta> \<equiv> Var(z := Var x)::('fun, ('fun, 'atom) term \<times> nat) subst"
 
   have "\<Gamma> (Var z) = \<Gamma> (Var x)" using y(2) m(2) z wt_subst_trm''[OF \<delta>, of m] by argo
   hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" unfolding \<theta>_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by force+
   moreover have "t = m \<cdot> \<theta>" using x z unfolding \<theta>_def by simp
   ultimately show ?thesis using m(1) by blast
 qed
 
 private lemma SMP_D_aux3:
   assumes hyps: "t' \<sqsubseteq> t" and wf_t: "wf\<^sub>t\<^sub>r\<^sub>m t" and prems: "is_Fun t'"
     and IH:
       "((\<exists>f. t = Fun f []) \<and> (\<exists>m \<in> M. \<exists>\<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>) \<and> t = m \<cdot> \<delta>)) \<or>
        (\<exists>m \<in> M. \<exists>\<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>) \<and> t = m \<cdot> \<delta> \<and> is_Fun m)"
     and M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
   shows "((\<exists>f. t' = Fun f []) \<and> (\<exists>m \<in> M. \<exists>\<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>) \<and> t' = m \<cdot> \<delta>)) \<or>
          (\<exists>m \<in> M. \<exists>\<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>) \<and> t' = m \<cdot> \<delta> \<and> is_Fun m)"
 proof (cases "\<exists>f. t = Fun f [] \<or> t' = Fun f []")
   case True
   have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" 
     and M_var_inst_cl: "is_TComp_var_instance_closed \<Gamma> M"
     and M_subterms_cl: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
     and M_Ana_cl: "has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M"
   using finite_SMP_representationD[OF M_SMP_repr] by blast+
 
   note 0 = has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl]
   note 1 = TComp_var_instance_closed_has_Fun[OF M_var_inst_cl M_wf]
   note 2 = TComp_var_and_subterm_instance_closed_has_subterms_instances[
             OF M_var_inst_cl M_subterms_cl M_wf]
 
   have wf_t': "wf\<^sub>t\<^sub>r\<^sub>m t'" using hyps wf_t wf_trm_subterm by blast
 
   obtain c where "t = Fun c [] \<or> t' = Fun c []" using True by moura
   thus ?thesis
   proof
     assume c: "t' = Fun c []"
     show ?thesis
     proof (cases "\<exists>f. t = Fun f []")
       case True
       hence "t = t'" using c hyps by force
       thus ?thesis using IH by fast
     next
       case False
       note F = this
       then obtain m \<delta> where m: "m \<in> M" "t = m \<cdot> \<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 IH by blast
 
       show ?thesis using subterm_subst_unfold[OF hyps[unfolded m(2)]]
       proof
         assume "\<exists>m'. m' \<sqsubseteq> m \<and> t' = m' \<cdot> \<delta>"
         then obtain m' where m': "m' \<sqsubseteq> m" "t' = m' \<cdot> \<delta>" by moura
         obtain n \<theta> where n: "n \<in> M" "m' = n \<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 0[of m'] m(1) m'(1) by blast
         have "t' = n \<cdot> (\<theta> \<circ>\<^sub>s \<delta>)" using m'(2) n(2) by auto
         thus ?thesis
           using c n(1) wt_subst_compose[OF \<theta>(1) \<delta>(1)] wf_trms_subst_compose[OF \<theta>(2) \<delta>(2)] by blast
       next
         assume "\<exists>x \<in> fv m. t' \<sqsubset> \<delta> x"
         then obtain x where x: "x \<in> fv m" "t' \<sqsubset> \<delta> x" "t' \<sqsubseteq> \<delta> x" by moura
         have \<delta>x_wf: "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)" using \<delta>(2) by fastforce
         
         have x_fv_ex: "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)" using x m by auto
 
         show ?thesis
         proof (cases "\<Gamma> t'")
           case (Var a)
           show ?thesis
             using c m 2[OF _ hyps[unfolded m(2)] \<delta>]
             by fast
         next
           case (Fun g S)
           show ?thesis
             using c 1[of \<delta> x t', OF \<delta>x_wf x_fv_ex x(3) \<delta>(1) Fun]
             by blast
         qed
       qed
     qed
   qed (use IH hyps in simp)
 next
   case False
   note F = False
   then obtain m \<delta> where m:
       "m \<in> M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "t = m \<cdot> \<delta>" "is_Fun m" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     using IH by moura
   obtain f T where fT: "t' = Fun f T" "arity f > 0" "\<Gamma> t' = TComp f (map \<Gamma> T)"
     using F prems fun_type wf_trm_subtermeq[OF wf_t hyps]
     by (metis is_FunE length_greater_0_conv subtermeqI' wf\<^sub>t\<^sub>r\<^sub>m_def)
 
   have closed: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
                "is_TComp_var_instance_closed \<Gamma> M"
     using M_SMP_repr unfolding finite_SMP_representation_def by metis+
 
   have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" 
     using finite_SMP_representationD[OF M_SMP_repr] by blast
 
   show ?thesis
   proof (cases "\<exists>x \<in> fv m. t' \<sqsubseteq> \<delta> x")
     case True
     then obtain x where x: "x \<in> fv m" "t' \<sqsubseteq> \<delta> x" by moura
     have 1: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t M" using m(1) x(1) by auto
     have 2: "is_Fun (\<delta> x)" using prems x(2) by auto
     have 3: "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)" using m(5) by (simp add: wf_trm_subst_rangeD)
     have "\<not>(\<exists>f. \<delta> x = Fun f [])" using F x(2) by auto
     hence "\<exists>f T. \<Gamma> (Var x) = TComp f T" using 2 3 m(2)
       by (metis (no_types) fun_type is_FunE length_greater_0_conv subtermeqI' wf\<^sub>t\<^sub>r\<^sub>m_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
     moreover have "\<exists>f T. \<Gamma> t' = Fun f T"
       using False prems wf_trm_subtermeq[OF wf_t hyps]
       by (metis (no_types) fun_type is_FunE length_greater_0_conv subtermeqI' wf\<^sub>t\<^sub>r\<^sub>m_def)
     ultimately show ?thesis
       using TComp_var_instance_closed_has_Fun 1 x(2) m(2) prems closed 3 M_wf
       by metis
   next
     case False
     then obtain m' where m': "m' \<sqsubseteq> m" "t' = m' \<cdot> \<delta>" "is_Fun m'"
       using hyps m(3) subterm_subst_not_img_subterm
       by blast
     then obtain \<theta> m'' where \<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>)" "m'' \<in> M" "m' = m'' \<cdot> \<theta>"
       using m(1) has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf closed(1)] by blast
     hence t'_m'': "t' = m'' \<cdot> \<theta> \<circ>\<^sub>s \<delta>" using m'(2) by fastforce
 
     note \<theta>\<delta> = wt_subst_compose[OF \<theta>(1) m(2)] wf_trms_subst_compose[OF \<theta>(2) m(5)]
 
     show ?thesis
     proof (cases "is_Fun m''")
       case True thus ?thesis using \<theta>(3,4) m'(2,3) m(4) fT t'_m'' \<theta>\<delta> by blast
     next
       case False
       then obtain x where x: "m'' = Var x" by moura
       hence "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)" "t' \<sqsubseteq> (\<theta> \<circ>\<^sub>s \<delta>) x"
             "\<Gamma> (Var x) = Fun f (map \<Gamma> T)" "wf\<^sub>t\<^sub>r\<^sub>m ((\<theta> \<circ>\<^sub>s \<delta>) x)"
-        using \<theta>\<delta> t'_m'' \<theta>(3) fv_subset[OF \<theta>(3)] fT(3) subst_apply_term.simps(1)[of x "\<theta> \<circ>\<^sub>s \<delta>"]
+        using \<theta>\<delta> t'_m'' \<theta>(3) fv_subset[OF \<theta>(3)] fT(3) eval_term.simps(1)[of _ "\<theta> \<circ>\<^sub>s \<delta>"]
               wt_subst_trm''[OF \<theta>\<delta>(1), of "Var x"]
-        by (fastforce, blast, argo, fastforce)
+           by force+
       thus ?thesis
         using x TComp_var_instance_closed_has_Fun[
                 of M "\<theta> \<circ>\<^sub>s \<delta>" x t' f "map \<Gamma> T", OF closed(2) M_wf _ _ _ \<theta>\<delta>(1) fT(3) prems]
         by blast
     qed
   qed
 qed
 
 lemma SMP_D:
   assumes "t \<in> SMP M" "is_Fun t"
     and M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
   shows "((\<exists>f. t = Fun f []) \<and> (\<exists>m \<in> M. \<exists>\<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>) \<and> t = m \<cdot> \<delta>)) \<or>
          (\<exists>m \<in> M. \<exists>\<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>) \<and> t = m \<cdot> \<delta> \<and> is_Fun m)"
 proof -
   have wf_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
       and closed: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
                   "has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M"
                   "is_TComp_var_instance_closed \<Gamma> M"
     using finite_SMP_representationD[OF M_SMP_repr] by blast+
 
   show ?thesis using assms(1,2)
   proof (induction t rule: SMP.induct)
     case (MP t)
     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)" "t = t \<cdot> Var" by simp_all
     ultimately show ?case by blast 
   next
     case (Subterm t t')
     hence t_fun: "is_Fun t" by auto
     note * = Subterm.hyps(2) SMP_wf_trm[OF Subterm.hyps(1) wf_M(1)]
              Subterm.prems Subterm.IH[OF t_fun] M_SMP_repr
     show ?case by (rule SMP_D_aux3[OF *])
   next
     case (Substitution t \<delta>)
     have wf: "wf\<^sub>t\<^sub>r\<^sub>m t" by (metis Substitution.hyps(1) wf_M(1) SMP_wf_trm)
     hence wf': "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>)" using Substitution.hyps(3) wf_trm_subst by blast
     show ?case
     proof (cases "\<Gamma> t")
       case (Var a)
       hence 1: "\<Gamma> (t \<cdot> \<delta>) = TAtom a" using Substitution.hyps(2) by (metis wt_subst_trm'') 
       then obtain c where c: "t \<cdot> \<delta> = Fun c []"
         using TAtom_term_cases[OF wf' 1] Substitution.prems by fastforce
       hence "(\<exists>x. t = Var x) \<or> t = t \<cdot> \<delta>" by (cases t) auto
       thus ?thesis
       proof
         assume t_Var: "\<exists>x. t = Var x"
         then obtain x where x: "t = Var x" "\<delta> x = Fun c []" "\<Gamma> (Var x) = TAtom a"
           using c 1 wt_subst_trm''[OF Substitution.hyps(2), of t] by force
         
         obtain m \<theta> where m: "m \<in> M" "t = 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 SMP_D_aux2[OF Substitution.hyps(1) t_Var M_SMP_repr] by moura
 
         have "m \<cdot> (\<theta> \<circ>\<^sub>s \<delta>) = Fun c []" using c m(2) by auto
         thus ?thesis
           using c m(1) wt_subst_compose[OF \<theta>(1) Substitution.hyps(2)]
                 wf_trms_subst_compose[OF \<theta>(2) Substitution.hyps(3)]
           by metis
       qed (use c Substitution.IH in auto)
     next
       case (Fun f T)
       hence 1: "\<Gamma> (t \<cdot> \<delta>) = TComp f T" using Substitution.hyps(2) by (metis wt_subst_trm'')
       have 2: "\<not>(\<exists>f. t = Fun f [])" using Fun TComp_term_cases[OF wf] by auto
       obtain T'' where T'': "t \<cdot> \<delta> = Fun f T''"
         using 1 2 fun_type_id_eq Fun Substitution.prems
         by fastforce
       have f: "arity f > 0" using fun_type_inv[OF 1] by metis
   
       show ?thesis
       proof (cases t)
         case (Fun g U)
         then obtain m \<theta> where m:
             "m \<in> M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "t = m \<cdot> \<theta>" "is_Fun m" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
           using Substitution.IH Fun 2 by moura
         have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<delta>)" "t \<cdot> \<delta> = m \<cdot> (\<theta> \<circ>\<^sub>s \<delta>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<delta>))"
           using wt_subst_compose[OF m(2) Substitution.hyps(2)] m(3)
                 wf_trms_subst_compose[OF m(5) Substitution.hyps(3)]
           by auto
         thus ?thesis using m(1,4) by metis
       next
         case (Var x)
         then obtain y where y: "y \<in> fv\<^sub>s\<^sub>e\<^sub>t M" "\<Gamma> (Var y) = \<Gamma> (Var x)"
           using SMP_D_aux1[OF Substitution.hyps(1) closed(1,3) wf_M] Fun
           by moura
         hence 3: "\<Gamma> (Var y) = TComp f T" using Var Fun \<Gamma>_Var_fst by simp
         
         obtain h V where V:
             "Fun h V \<in> M" "\<Gamma> (Fun h V) = \<Gamma> (Var y)" "\<forall>u \<in> set V. \<exists>z. u = Var z" "distinct V"
           by (metis is_VarE is_TComp_var_instance_closedD[OF _ 3 closed(3)] y(1))
         moreover have "length T'' = length V" using 3 V(2) fun_type_length_eq 1 T'' by metis
         ultimately have TV: "T = map \<Gamma> V"
           by (metis fun_type[OF f(1)] 3 fun_type_id_eq term.inject(2))
   
         obtain \<theta> where \<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>)" "t \<cdot> \<delta> = Fun h V \<cdot> \<theta>"
           using TComp_var_instance_wt_subst_exists 1 3 T'' TV V(2,3,4) wf'
           by (metis fun_type_id_eq)
   
         have 9: "\<Gamma> (Fun h V) = \<Gamma> (\<delta> x)" using y(2) Substitution.hyps(2) V(2) 1 3 Var by auto
   
         show ?thesis using Var \<theta> 9 V(1) by force
       qed
     qed
   next
     case (Ana t K T k)
     have 1: "is_Fun t" using Ana.hyps(2,3) by auto
     then obtain f U where U: "t = Fun f U" by moura
   
     have 2: "fv k \<subseteq> fv t" using Ana_keys_fv[OF Ana.hyps(2)] Ana.hyps(3) by auto
   
     have wf_t: "wf\<^sub>t\<^sub>r\<^sub>m t"
       using SMP_wf_trm[OF Ana.hyps(1)] wf\<^sub>t\<^sub>r\<^sub>m_code wf_M
       by auto
     hence wf_k: "wf\<^sub>t\<^sub>r\<^sub>m k"
       using Ana_keys_wf'[OF Ana.hyps(2)] wf\<^sub>t\<^sub>r\<^sub>m_code Ana.hyps(3)
       by auto
   
     have wf_M_keys: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union>((set \<circ> fst \<circ> Ana) ` M))"
     proof
       fix t assume "t \<in> (\<Union>((set \<circ> fst \<circ> Ana) ` M))"
       then obtain s where s: "s \<in> M" "t \<in> (set \<circ> fst \<circ> Ana) s" by blast
       obtain K R where KR: "Ana s = (K,R)" by (metis surj_pair)
       hence "t \<in> set K" using s(2) by simp
       thus "wf\<^sub>t\<^sub>r\<^sub>m t" using Ana_keys_wf'[OF KR] wf_M s(1) by blast
     qed
   
     show ?case using Ana_subst'_or_Ana_keys_subterm
     proof
       assume "\<forall>t K T k. Ana t = (K, T) \<longrightarrow> k \<in> set K \<longrightarrow> k \<sqsubset> t"
       hence *: "k \<sqsubseteq> t" using Ana.hyps(2,3) by auto
       show ?thesis by (rule SMP_D_aux3[OF * wf_t Ana.prems Ana.IH[OF 1] M_SMP_repr])
     next
       assume Ana_subst':
           "\<forall>f T \<delta> K M. 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>)"
   
       have "arity f > 0" using Ana_const[of f U] U Ana.hyps(2,3) by fastforce
       hence "U \<noteq> []" using wf_t U unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by force
       then obtain m \<delta> where m: "m \<in> M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "t = m \<cdot> \<delta>" "is_Fun m"
         using Ana.IH[OF 1] U by auto
       hence "Ana (t \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>,T \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)" using Ana_subst' U Ana.hyps(2) by auto
       obtain Km Tm where Ana_m: "Ana m = (Km,Tm)" by moura
       hence "Ana (m \<cdot> \<delta>) = (Km \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>,Tm \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)"
         using Ana_subst' U m(4) is_FunE[OF m(5)] Ana.hyps(2)
         by metis
       then obtain km where km: "km \<in> set Km" "k = km \<cdot> \<delta>" using Ana.hyps(2,3) m(4) by auto
       then obtain \<theta> km' where \<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 km': "km' \<in> M" "km = km' \<cdot> \<theta>"
         using Ana_m m(1) has_all_wt_instances_ofD'[OF wf_M_keys wf_M closed(2), of km] by force
   
       have k\<theta>\<delta>: "k = km' \<cdot> \<theta> \<circ>\<^sub>s \<delta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<delta>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<delta>))"
         using km(2) km' wt_subst_compose[OF \<theta>(1) m(2)] wf_trms_subst_compose[OF \<theta>(2) m(3)]
         by auto
   
       show ?case
       proof (cases "is_Fun km'")
         case True thus ?thesis using k\<theta>\<delta> km'(1) by blast
       next
         case False
         note F = False
         then obtain x where x: "km' = Var x" by auto
         hence 3: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t M" using fv_subset[OF km'(1)] by auto
         obtain kf kT where kf: "k = Fun kf kT" using Ana.prems by auto
         show ?thesis
         proof (cases "kT = []")
           case True thus ?thesis using k\<theta>\<delta>(1) k\<theta>\<delta>(2) k\<theta>\<delta>(3) kf km'(1) by blast
         next
           case False
           hence 4: "arity kf > 0" using wf_k kf TAtom_term_cases const_type by fastforce
           then obtain kT' where kT': "\<Gamma> k = TComp kf kT'" by (simp add: fun_type kf) 
           then obtain V where V:
               "Fun kf V \<in> M" "\<Gamma> (Fun kf V) = \<Gamma> (Var x)" "\<forall>u \<in> set V. \<exists>v. u = Var v"
               "distinct V" "is_Fun (Fun kf V)"
             using is_TComp_var_instance_closedD[OF _ _ closed(3), of x]
                   x m(2) k\<theta>\<delta>(1) 3 wt_subst_trm''[OF k\<theta>\<delta>(2)]
             by (metis fun_type_id_eq term.disc(2) is_VarE)
           have 5: "kT' = map \<Gamma> V"
             using fun_type[OF 4] x kT' k\<theta>\<delta> m(2) V(2)
             by (metis term.inject(2) wt_subst_trm'')
           thus ?thesis
             using TComp_var_instance_wt_subst_exists wf_k kf 4 V(3,4) kT' V(1,5)
             by metis
         qed
       qed
     qed
   qed
 qed
 
 lemma SMP_D':
   fixes M
   defines "\<delta> \<equiv> var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M))"
   assumes M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
     and s: "s \<in> SMP M" "is_Fun s" "\<nexists>f. s = Fun f []"
     and t: "t \<in> SMP M" "is_Fun t" "\<nexists>f. t = Fun f []"
   obtains \<sigma> s0 \<theta> t0
   where "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)" "s0 \<in> M" "is_Fun s0" "s = s0 \<cdot> \<sigma>" "\<Gamma> s = \<Gamma> s0"
     and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" "t0 \<in> M" "is_Fun t0" "t = t0 \<cdot> \<delta> \<cdot> \<theta>" "\<Gamma> t = \<Gamma> t0"
 proof -
   obtain \<sigma> s0 where
       s0: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)" "s0 \<in> M" "s = s0 \<cdot> \<sigma>" "is_Fun s0"
     using s(3) SMP_D[OF s(1,2) M_SMP_repr] unfolding \<delta>_def by metis
 
   obtain \<theta> t0 where t0:
       "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" "t0 \<in> M" "t = t0 \<cdot> \<delta> \<cdot> \<theta>" "is_Fun t0"
     using t(3) SMP_D[OF t(1,2) M_SMP_repr] var_rename_wt'[of _ t]
           wf_trms_subst_compose_Var_range(1)[OF _ var_rename_is_renaming(2)]
     unfolding \<delta>_def by metis
 
   have "\<Gamma> s = \<Gamma> s0" "\<Gamma> t = \<Gamma> (t0 \<cdot> \<delta>)" "\<Gamma> (t0 \<cdot> \<delta>) = \<Gamma> t0"
     using s0 t0 wt_subst_trm'' by (metis, metis, metis \<delta>_def var_rename_wt(1))
   thus ?thesis using s0 t0 that by simp
 qed
 
 lemma SMP_D'':
   fixes t::"('fun, ('fun, 'atom) term \<times> nat) term"
   assumes t_SMP: "t \<in> SMP M"
     and M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
   shows "\<exists>m \<in> M. \<exists>\<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>) \<and> t = m \<cdot> \<delta>"
 proof (cases "(\<exists>x. t = Var x) \<or> (\<exists>c. t = Fun c [])")
   case True
   have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" 
       and M_var_inst_cl: "is_TComp_var_instance_closed \<Gamma> M"
       and M_subterms_cl: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
       and M_Ana_cl: "has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M"
     using finite_SMP_representationD[OF M_SMP_repr] by blast+
 
   have M_Ana_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union> ((set \<circ> fst \<circ> Ana) ` M))"
   proof
     fix k assume "k \<in> \<Union>((set \<circ> fst \<circ> Ana) ` M)"
     then obtain m where m: "m \<in> M" "k \<in> set (fst (Ana m))" by force
     thus "wf\<^sub>t\<^sub>r\<^sub>m k" using M_wf Ana_keys_wf'[of m "fst (Ana m)" _ k] surjective_pairing by blast
   qed
 
   show ?thesis using True
   proof
     assume "\<exists>x. t = Var x"
     then obtain x y where x: "t = Var x" and y: "y \<in> fv\<^sub>s\<^sub>e\<^sub>t M" "\<Gamma> (Var y) = \<Gamma> (Var x)"
       using SMP_D_aux1[OF t_SMP M_subterms_cl M_var_inst_cl M_wf] by fastforce
     then obtain m \<delta> where m: "m \<in> M" "m \<cdot> \<delta> = Var y" and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
       using has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl, of "Var y"]
             vars_iff_subtermeq_set[of y M]
       by fastforce
 
     obtain z where z: "m = Var z" using m(2) by (cases m) auto
 
     define \<theta> where "\<theta> \<equiv> Var(z := Var x)::('fun, ('fun, 'atom) term \<times> nat) subst"
 
     have "\<Gamma> (Var z) = \<Gamma> (Var x)" using y(2) m(2) z wt_subst_trm''[OF \<delta>, of m] by argo
     hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" unfolding \<theta>_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by force+
     moreover have "t = m \<cdot> \<theta>" using x z unfolding \<theta>_def by simp
     ultimately show ?thesis using m(1) by blast
   qed (use SMP_D[OF t_SMP _ M_SMP_repr] in blast)
 qed (use SMP_D[OF t_SMP _ M_SMP_repr] in blast)
 end
 
 lemma tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t:
   assumes "comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> M"
   shows "tfr\<^sub>s\<^sub>e\<^sub>t M"
 proof -
   let ?\<delta> = "var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M))"
   have M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
     by (metis comp_tfr\<^sub>s\<^sub>e\<^sub>t_def assms)
 
   have M_finite: "finite M"
     using assms card_gt_0_iff unfolding comp_tfr\<^sub>s\<^sub>e\<^sub>t_def finite_SMP_representation_def by blast
 
   show ?thesis
   proof (unfold tfr\<^sub>s\<^sub>e\<^sub>t_def; intro ballI impI)
     fix s t assume "s \<in> SMP M - Var`\<V>" "t \<in> SMP M - Var`\<V>"
     hence st: "s \<in> SMP M" "is_Fun s" "t \<in> SMP M" "is_Fun t" by auto
     have "\<not>(\<exists>\<delta>. Unifier \<delta> s t)" when st_type_neq: "\<Gamma> s \<noteq> \<Gamma> t"
     proof (cases "\<exists>f. s = Fun f [] \<or> t = Fun f []")
       case False
       then obtain \<sigma> s0 \<theta> t0 where
             s0: "s0 \<in> M" "is_Fun s0" "s = s0 \<cdot> \<sigma>" "\<Gamma> s = \<Gamma> s0"
         and t0: "t0 \<in> M" "is_Fun t0" "t = t0 \<cdot> ?\<delta> \<cdot> \<theta>" "\<Gamma> t = \<Gamma> t0"
         using SMP_D'[OF M_SMP_repr st(1,2) _ st(3,4)] by metis
       hence "\<not>(\<exists>\<delta>. Unifier \<delta> s0 (t0 \<cdot> ?\<delta>))"
         using assms mgu_None_is_subst_neq st_type_neq wt_subst_trm''[OF var_rename_wt(1)]
         unfolding comp_tfr\<^sub>s\<^sub>e\<^sub>t_def Let_def by metis
       thus ?thesis
         using vars_term_disjoint_imp_unifier[OF var_rename_fv_set_disjoint[OF M_finite]] s0(1) t0(1)
         unfolding s0(3) t0(3) by (metis (no_types, opaque_lifting) subst_subst_compose)
     qed (use st_type_neq st(2,4) in auto)
     thus "\<Gamma> s = \<Gamma> t" when "\<exists>\<delta>. Unifier \<delta> s t" by (metis that)
   qed
 qed
 
 lemma tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t':
   assumes "let N = SMP0 Ana \<Gamma> M in set M \<subseteq> set N \<and> comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> (set N)"
   shows "tfr\<^sub>s\<^sub>e\<^sub>t (set M)"
 by (rule tfr_subset(2)[
           OF tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[OF conjunct2[OF assms[unfolded Let_def]]]
              conjunct1[OF assms[unfolded Let_def]]])
 
 lemma tfr\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>t\<^sub>p: "tfr\<^sub>s\<^sub>t\<^sub>p a = comp_tfr\<^sub>s\<^sub>t\<^sub>p \<Gamma> a"
 proof (cases a)
   case (Equality ac t t')
   thus ?thesis
     using mgu_always_unifies[of t _ t'] mgu_gives_MGU[of t t']
     by auto
 next
   case (Inequality X F)
   thus ?thesis
     using tfr\<^sub>s\<^sub>t\<^sub>p.simps(2)[of X F]
           comp_tfr\<^sub>s\<^sub>t\<^sub>p.simps(2)[of \<Gamma> X F]
           Fun_range_case(2)[of "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F)"] 
     unfolding is_Var_def
     by auto
 qed auto
 
 lemma tfr\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>t:
   assumes "comp_tfr\<^sub>s\<^sub>t arity Ana \<Gamma> M S"
   shows "tfr\<^sub>s\<^sub>t S"
 unfolding tfr\<^sub>s\<^sub>t_def
 proof
   have comp_tfr\<^sub>s\<^sub>e\<^sub>t_M: "comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> M"
     using assms unfolding comp_tfr\<^sub>s\<^sub>t_def by blast
   
   have wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
       and wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_S: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
       and S_trms_instance_M: "has_all_wt_instances_of \<Gamma> (trms\<^sub>s\<^sub>t S) M"
     using assms wf\<^sub>t\<^sub>r\<^sub>m_code wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code trms_list\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>t
     unfolding comp_tfr\<^sub>s\<^sub>t_def comp_tfr\<^sub>s\<^sub>e\<^sub>t_def finite_SMP_representation_def list_all_iff
     by blast+
 
   show "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)"
     using tfr_subset(3)[OF tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[OF comp_tfr\<^sub>s\<^sub>e\<^sub>t_M] SMP_SMP_subset]
           SMP_I'[OF wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_S wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_M S_trms_instance_M]
     by blast
 
   have "list_all (comp_tfr\<^sub>s\<^sub>t\<^sub>p \<Gamma>) S" by (metis assms comp_tfr\<^sub>s\<^sub>t_def)
   thus "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" by (induct S) (simp_all add: tfr\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>t\<^sub>p)
 qed
 
 lemma tfr\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>t':
   assumes "comp_tfr\<^sub>s\<^sub>t arity Ana \<Gamma> (set (SMP0 Ana \<Gamma> (trms_list\<^sub>s\<^sub>t S))) S"
   shows "tfr\<^sub>s\<^sub>t S"
 by (rule tfr\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>t[OF assms])
 
 
 
 subsubsection \<open>Lemmata for Checking Ground SMP (GSMP) Disjointness\<close>
 context
 begin
 private lemma ground_SMP_disjointI_aux1:
   fixes M::"('fun, ('fun, 'atom) term \<times> nat) term set"
   assumes f_def: "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>) = {}}"
     and g_def: "g \<equiv> \<lambda>M. {t \<in> M. fv t = {}}"
   shows "f (SMP M) = g (SMP M)"
 proof
   have "t \<in> f (SMP M)" when t: "t \<in> SMP M" "fv t = {}" for t
   proof -
     define \<delta> where "\<delta> \<equiv> Var::('fun, ('fun, 'atom) term \<times> nat) subst"
     have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "t = t \<cdot> \<delta>"
       using subst_apply_term_empty[of t] that(2) wt_subst_Var wf_trm_subst_range_Var
       unfolding \<delta>_def by auto
     thus ?thesis using SMP.Substitution[OF t(1), of \<delta>] t(2) unfolding f_def by fastforce
   qed
   thus "g (SMP M) \<subseteq> f (SMP M)" unfolding g_def by blast
 qed (use f_def g_def in blast)
 
 private lemma ground_SMP_disjointI_aux2:
   fixes M::"('fun, ('fun, 'atom) term \<times> nat) term set"
   assumes f_def: "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>) = {}}"
     and M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
   shows "f M = f (SMP M)"
 proof
   have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" 
       and M_var_inst_cl: "is_TComp_var_instance_closed \<Gamma> M"
       and M_subterms_cl: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
       and M_Ana_cl: "has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M"
     using finite_SMP_representationD[OF M_SMP_repr] by blast+
 
   show "f (SMP M) \<subseteq> f M"
   proof
     fix t assume "t \<in> f (SMP M)"
     then obtain s \<delta> where s: "t = s \<cdot> \<delta>" "s \<in> SMP M" "fv (s \<cdot> \<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>)"
       unfolding f_def by blast
 
     have t_wf: "wf\<^sub>t\<^sub>r\<^sub>m t" using SMP_wf_trm[OF s(2) M_wf] s(1) wf_trm_subst[OF \<delta>(2)] by blast 
 
     obtain m \<theta> where m: "m \<in> M" "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 SMP_D''[OF s(2) M_SMP_repr] by blast
 
     have "t = m \<cdot> (\<theta> \<circ>\<^sub>s \<delta>)" "fv (m \<cdot> (\<theta> \<circ>\<^sub>s \<delta>)) = {}" using s(1,3) m(2) by simp_all
     thus "t \<in> f M"
       using m(1) wt_subst_compose[OF \<theta>(1) \<delta>(1)] wf_trms_subst_compose[OF \<theta>(2) \<delta>(2)]
       unfolding f_def by blast
   qed
 qed (auto simp add: f_def)
 
 private lemma ground_SMP_disjointI_aux3:
   fixes A B C::"('fun, ('fun, 'atom) term \<times> nat) term set"
   defines "P \<equiv> \<lambda>t s. \<exists>\<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>) \<and> Unifier \<delta> t s"
   assumes f_def: "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>) = {}}"
     and Q_def: "Q \<equiv> \<lambda>t. intruder_synth' public arity {} t"
     and R_def: "R \<equiv> \<lambda>t. \<exists>u \<in> C. is_wt_instance_of_cond \<Gamma> t u"
     and AB: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s A" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s B" "fv\<^sub>s\<^sub>e\<^sub>t A \<inter> fv\<^sub>s\<^sub>e\<^sub>t B = {}"
     and C: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s C"
     and ABC: "\<forall>t \<in> A. \<forall>s \<in> B. P t s \<longrightarrow> Q t \<or> R t"
   shows "f A \<inter> f B \<subseteq> f C \<union> {m. {} \<turnstile>\<^sub>c m}"
 proof
   fix t assume "t \<in> f A \<inter> f B"
   then obtain ta tb \<delta>a \<delta>b where
           ta: "t = ta \<cdot> \<delta>a" "ta \<in> A" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>a" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>a)" "fv (ta \<cdot> \<delta>a) = {}"
       and tb: "t = tb \<cdot> \<delta>b" "tb \<in> B" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>b" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>b)" "fv (tb \<cdot> \<delta>b) = {}"
     unfolding f_def by blast
 
   have ta_tb_wf: "wf\<^sub>t\<^sub>r\<^sub>m ta" "wf\<^sub>t\<^sub>r\<^sub>m tb" "fv ta \<inter> fv tb = {}" "\<Gamma> ta = \<Gamma> tb"
     using ta(1,2) tb(1,2) AB fv_subset_subterms
           wt_subst_trm''[OF ta(3), of ta] wt_subst_trm''[OF tb(3), of tb]
     by (fast, fast, blast, simp)
 
   obtain \<theta> where \<theta>: "Unifier \<theta> ta tb" "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 vars_term_disjoint_imp_unifier[OF ta_tb_wf(3), of \<delta>a \<delta>b]
           ta(1) tb(1) wt_Unifier_if_Unifier[OF ta_tb_wf(1,2,4)]
     by blast
   hence "Q ta \<or> R ta" using ABC ta(2) tb(2) unfolding P_def by blast+
   thus "t \<in> f C \<union> {m. {} \<turnstile>\<^sub>c m}"
   proof
     show "Q ta \<Longrightarrow> ?thesis"
       using ta(1) pgwt_ground[of ta] pgwt_is_empty_synth[of ta] subst_ground_ident[of ta \<delta>a]
       unfolding Q_def f_def intruder_synth_code[symmetric] by simp
   next
     assume "R ta"
     then obtain ua \<sigma>a where ua: "ta = ua \<cdot> \<sigma>a" "ua \<in> C" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>a" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>a)"
       using \<theta> ABC ta_tb_wf(1,2) ta(2) tb(2) C is_wt_instance_of_condD'
       unfolding P_def R_def by metis
   
     have "t = ua \<cdot> (\<sigma>a \<circ>\<^sub>s \<delta>a)" "fv t = {}"
       using ua(1) ta(1,5) tb(1,5) by auto
     thus ?thesis
       using ua(2) wt_subst_compose[OF ua(3) ta(3)] wf_trms_subst_compose[OF ua(4) ta(4)]
       unfolding f_def by blast
   qed
 qed
 
 lemma ground_SMP_disjointI:
   fixes A B::"('fun, ('fun, 'atom) term \<times> nat) term set" and C
   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>) = {}}"
     and "g \<equiv> \<lambda>M. {t \<in> M. fv t = {}}"
     and "Q \<equiv> \<lambda>t. intruder_synth' public arity {} t"
     and "R \<equiv> \<lambda>t. \<exists>u \<in> C. is_wt_instance_of_cond \<Gamma> t u"
   assumes AB_fv_disj: "fv\<^sub>s\<^sub>e\<^sub>t A \<inter> fv\<^sub>s\<^sub>e\<^sub>t B = {}"
     and A_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> A"
     and B_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> B"
     and C_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s C"
     and ABC: "\<forall>t \<in> A. \<forall>s \<in> B. \<Gamma> t = \<Gamma> s \<and> mgu t s \<noteq> None \<longrightarrow> Q t \<or> R t"
   shows "g (SMP A) \<inter> g (SMP B) \<subseteq> f C \<union> {m. {} \<turnstile>\<^sub>c m}"
 proof -
   have AB_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s A" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s B"
     using A_SMP_repr B_SMP_repr finite_SMP_representationD(1)
     by (blast, blast)
 
   let ?P = "\<lambda>t s. \<exists>\<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>) \<and> Unifier \<delta> t s"
   have ABC': "\<forall>t \<in> A. \<forall>s \<in> B. ?P t s \<longrightarrow> Q t \<or> R t"
     by (metis (no_types) ABC mgu_None_is_subst_neq wt_subst_trm'')
 
   show ?thesis
     using ground_SMP_disjointI_aux1[OF f_def g_def, of A]
           ground_SMP_disjointI_aux1[OF f_def g_def, of B]
           ground_SMP_disjointI_aux2[OF f_def A_SMP_repr]
           ground_SMP_disjointI_aux2[OF f_def B_SMP_repr]
           ground_SMP_disjointI_aux3[OF f_def Q_def R_def AB_wf AB_fv_disj C_wf ABC']
     by argo
 qed
 
 end
 
 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,3665 +1,3665 @@
 (*  Title:      Typing_Result.thy
     Author:     Andreas Viktor Hess, DTU
     SPDX-License-Identifier: BSD-3-Clause
 *)
 
 section \<open>The Typing Result\<close>
 text\<open>\label{sec:Typing-Result}\<close>
 theory Typing_Result
 imports Typed_Model
 begin
 
 subsection \<open>Locale Setup\<close>
 locale typing_result = typed_model arity public Ana \<Gamma>
   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"
   +
   assumes infinite_typed_consts: "\<And>a. infinite {c. \<Gamma> (Fun c []) = TAtom a \<and> public c}"
     and no_private_funs[simp]: "\<And>f. arity f > 0 \<Longrightarrow> public f"
 begin
 
 subsubsection \<open>Minor Lemmata\<close>
 
 lemma fun_type_inv': assumes "\<Gamma> t = TComp f T" shows "arity f > 0" "public f"
 using assms fun_type_inv by simp_all
 
 lemma infinite_public_consts[simp]: "infinite {c. public c \<and> arity c = 0}"
 proof -
   fix a::'atom
   define A where "A \<equiv> {c. \<Gamma> (Fun c []) = TAtom a \<and> public c}"
   define B where "B \<equiv> {c. public c \<and> arity c = 0}"
 
   have "arity c = 0" when c: "c \<in> A" for c
     using c const_type_inv unfolding A_def by blast
   hence "A \<subseteq> B" unfolding A_def B_def by blast
   hence "infinite B"
     using infinite_typed_consts[of a, unfolded A_def[symmetric]]
     by (metis infinite_super)
   thus ?thesis unfolding B_def by blast
 qed
 
 lemma infinite_fun_syms[simp]:
   "infinite {c. public c \<and> arity c > 0} \<Longrightarrow> infinite \<Sigma>\<^sub>f"
   "infinite \<C>" "infinite \<C>\<^sub>p\<^sub>u\<^sub>b" "infinite (UNIV::'fun set)"
 by (metis \<Sigma>\<^sub>f_unfold finite_Collect_conjI,
     metis infinite_public_consts finite_Collect_conjI,
     use infinite_public_consts \<C>pub_unfold in \<open>force simp add: Collect_conj_eq\<close>,
     metis UNIV_I finite_subset subsetI infinite_public_consts(1))
 
 lemma id_univ_proper_subset[simp]: "\<Sigma>\<^sub>f \<subset> UNIV" "(\<exists>f. arity f > 0) \<Longrightarrow> \<C> \<subset> UNIV"
 by (metis finite.emptyI inf_top.right_neutral top.not_eq_extremum disjoint_fun_syms
           infinite_fun_syms(2) inf_commute)
    (metis top.not_eq_extremum UNIV_I const_arity_eq_zero less_irrefl)
 
 lemma exists_fun_notin_funs_term: "\<exists>f::'fun. f \<notin> funs_term t"
 by (metis UNIV_eq_I finite_fun_symbols infinite_fun_syms(4))
 
 lemma exists_fun_notin_funs_terms:
   assumes "finite M" shows "\<exists>f::'fun. f \<notin> \<Union>(funs_term ` M)"
 by (metis assms finite_fun_symbols infinite_fun_syms(4) ex_new_if_finite finite_UN)
 
 lemma exists_notin_funs\<^sub>s\<^sub>t: "\<exists>f. f \<notin> funs\<^sub>s\<^sub>t (S::('fun,'var) strand)"
 by (metis UNIV_eq_I finite_funs\<^sub>s\<^sub>t infinite_fun_syms(4))
 
 lemma infinite_typed_consts': "infinite {c. \<Gamma> (Fun c []) = TAtom a \<and> public c \<and> arity c = 0}"
 proof -
   { fix c assume "\<Gamma> (Fun c []) = TAtom a" "public c"
     hence "arity c = 0" using const_type[of c] fun_type[of c "[]"] by auto
   } hence "{c. \<Gamma> (Fun c []) = TAtom a \<and> public c \<and> arity c = 0} =
            {c. \<Gamma> (Fun c []) = TAtom a \<and> public c}"
     by auto
   thus "infinite {c. \<Gamma> (Fun c []) = TAtom a \<and> public c \<and> arity c = 0}"
     using infinite_typed_consts[of a] by metis
 qed
 
 lemma atypes_inhabited: "\<exists>c. \<Gamma> (Fun c []) = TAtom a \<and> wf\<^sub>t\<^sub>r\<^sub>m (Fun c []) \<and> public c \<and> arity c = 0"
 proof -
   obtain c where "\<Gamma> (Fun c []) = TAtom a" "public c" "arity c = 0"
     using infinite_typed_consts'(1)[of a] not_finite_existsD by blast
   thus ?thesis using const_type_inv[OF \<open>\<Gamma> (Fun c []) = TAtom a\<close>] unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
 qed
 
 lemma atype_ground_term_ex: "\<exists>t. fv t = {} \<and> \<Gamma> t = TAtom a \<and> wf\<^sub>t\<^sub>r\<^sub>m t"
 using atypes_inhabited[of a] by force
 
 lemma type_ground_inhabited: "\<exists>t'. fv t' = {} \<and> \<Gamma> t = \<Gamma> t'"
 proof -
   { fix \<tau>::"('fun, 'atom) term_type" assume "\<And>f T. Fun f T \<sqsubseteq> \<tau> \<Longrightarrow> 0 < arity f"
     hence "\<exists>t'. fv t' = {} \<and> \<tau> = \<Gamma> t'"
     proof (induction \<tau>)
       case (Fun f T)
       hence "arity f > 0" by auto
     
       from Fun.IH Fun.prems(1) have "\<exists>Y. map \<Gamma> Y = T \<and> (\<forall>x \<in> set Y. fv x = {})"
       proof (induction T)
         case (Cons x X)
         hence "\<And>g Y. Fun g Y \<sqsubseteq> Fun f X \<Longrightarrow> 0 < arity g" by auto
         hence "\<exists>Y. map \<Gamma> Y = X \<and> (\<forall>x\<in>set Y. fv x = {})" using Cons by auto
         moreover have "\<exists>t'. fv t' = {} \<and> x = \<Gamma> t'" using Cons by auto
         ultimately obtain y Y where
             "fv y = {}" "\<Gamma> y = x" "map \<Gamma> Y = X" "\<forall>x\<in>set Y. fv x = {}" 
           using Cons by moura
         hence "map \<Gamma> (y#Y) = x#X \<and> (\<forall>x\<in>set (y#Y). fv x = {})" by auto
         thus ?case by meson 
       qed simp
       then obtain Y where "map \<Gamma> Y = T" "\<forall>x \<in> set Y. fv x = {}" by metis
       hence "fv (Fun f Y) = {}" "\<Gamma> (Fun f Y) = TComp f T" using fun_type[OF \<open>arity f > 0\<close>] by auto
       thus ?case by (metis exI[of "\<lambda>t. fv t = {} \<and> \<Gamma> t = TComp f T" "Fun f Y"])
     qed (metis atype_ground_term_ex)
   }
   thus ?thesis by (metis \<Gamma>_wf'')
 qed
 
 lemma type_wfttype_inhabited:
   assumes "\<And>f T. Fun f T \<sqsubseteq> \<tau> \<Longrightarrow> 0 < arity f" "wf\<^sub>t\<^sub>r\<^sub>m \<tau>"
   shows "\<exists>t. \<Gamma> t = \<tau> \<and> wf\<^sub>t\<^sub>r\<^sub>m t"
 using assms
 proof (induction \<tau>)
   case (Fun f Y)
   have IH: "\<exists>t. \<Gamma> t = y \<and> wf\<^sub>t\<^sub>r\<^sub>m t" when y: "y \<in> set Y " for y
   proof -
     have "wf\<^sub>t\<^sub>r\<^sub>m y"
       using Fun y unfolding wf\<^sub>t\<^sub>r\<^sub>m_def
       by (metis Fun_param_is_subterm term.le_less_trans) 
     moreover have "Fun g Z \<sqsubseteq> y \<Longrightarrow> 0 < arity g" for g Z
       using Fun y by auto
     ultimately show ?thesis using Fun.IH[OF y] by auto
   qed
 
   from Fun have "arity f = length Y" "arity f > 0" unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by force+
   moreover from IH have "\<exists>X. map \<Gamma> X = Y \<and> (\<forall>x \<in> set X. wf\<^sub>t\<^sub>r\<^sub>m x)"
     by (induct Y, simp_all, metis list.simps(9) set_ConsD)
   ultimately show ?case by (metis fun_type length_map wf_trmI)
 qed (use atypes_inhabited wf\<^sub>t\<^sub>r\<^sub>m_def in blast)
 
 lemma type_pgwt_inhabited: "wf\<^sub>t\<^sub>r\<^sub>m t \<Longrightarrow> \<exists>t'. \<Gamma> t = \<Gamma> t' \<and> public_ground_wf_term t'"
 proof -
   assume "wf\<^sub>t\<^sub>r\<^sub>m t"
   { fix \<tau> assume "\<Gamma> t = \<tau>"
     hence "\<exists>t'. \<Gamma> t = \<Gamma> t' \<and> public_ground_wf_term t'" using \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close>
     proof (induction \<tau> arbitrary: t)
       case (Var a t)
       then obtain c where "\<Gamma> t = \<Gamma> (Fun c [])" "arity c = 0" "public c"
         using const_type_inv[of _ "[]" a] infinite_typed_consts(1)[of a]  not_finite_existsD
         by force
       thus ?case using PGWT[OF \<open>public c\<close>, of "[]"] by auto
     next
       case (Fun f Y t)
       have *: "arity f > 0" "public f" "arity f = length Y"
         using fun_type_inv[OF \<open>\<Gamma> t = TComp f Y\<close>] fun_type_inv_wf[OF \<open>\<Gamma> t = TComp f Y\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close>]
         by auto
       have "\<And>y. y \<in> set Y \<Longrightarrow> \<exists>t'. y = \<Gamma> t' \<and> public_ground_wf_term t'"
         using Fun.prems(1) Fun.IH \<Gamma>_wf''[of _ _ t] \<Gamma>_wf'[OF \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close>] type_wfttype_inhabited
         by (metis Fun_param_is_subterm term.order_trans wf_trm_subtermeq) 
       hence "\<exists>X. map \<Gamma> X = Y \<and> (\<forall>x \<in> set X. public_ground_wf_term x)"
         by (induct Y, simp_all, metis list.simps(9) set_ConsD)
       then obtain X where X: "map \<Gamma> X = Y" "\<And>x. x \<in> set X \<Longrightarrow> public_ground_wf_term x" by moura
       hence "arity f = length X" using *(3) by auto
       have "\<Gamma> t = \<Gamma> (Fun f X)" "public_ground_wf_term (Fun f X)"
         using fun_type[OF *(1), of X] Fun.prems(1) X(1) apply simp
         using PGWT[OF *(2) \<open>arity f = length X\<close> X(2)] by metis
       thus ?case by metis
     qed
   }
   thus ?thesis using \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close> by auto
 qed
 
 end
 
 subsection \<open>The Typing Result for the Composition-Only Intruder\<close>
 context typing_result
 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 Send1 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@Send1 (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@Send1 (Fun f X)#S')" by auto
   moreover have "fv (Fun f Y) \<subseteq> fv\<^sub>s\<^sub>t (S@Send1 (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@Send1 (Fun f X)#S'))"
       "Fun f Y \<in> SMP (trms\<^sub>s\<^sub>t (S@Send1 (Fun f X)#S'))"
     using SMP_append[of S "Send1 (Fun f X)#S'"] SMP_Cons[of "Send1 (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 [Send1 (Fun f X)]) \<subseteq> SMP M"
   proof -
     have "SMP (trms\<^sub>s\<^sub>t [Send1 (Fun f X)]) \<subseteq> SMP (trms\<^sub>s\<^sub>t (S@Send1 (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@Send1 (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@Send1 (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@Send1 (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@Send1 (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@Send1 (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 Send1 X@S')) - (Var`\<V>)"
   have "?SMPmap \<subseteq> SMP (trms\<^sub>s\<^sub>t (S@Send1 (Fun f X)#S')) - (Var`\<V>)"
     using SMP_fun_map_snd_subset[of X f]
           SMP_append[of "map Send1 X" S'] SMP_Cons[of "Send1 (Fun f X)" S']
           SMP_append[of S "Send1 (Fun f X)#S'"] SMP_append[of S "map Send1 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@Send1 (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@Send1 (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@Send1 (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@Send1 (Fun f X)#S'))" "Fun f Y \<in> SMP (trms\<^sub>s\<^sub>t (S@Send1 (Fun f X)#S'))"
     using SMP_append[of S "Send1 (Fun f X)#S'"] SMP_Cons[of "Send1 (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
 
 lemma LI_preproc_preserves_tfr:
   assumes "tfr\<^sub>s\<^sub>t S"
   shows "tfr\<^sub>s\<^sub>t (LI_preproc S)"
 unfolding tfr\<^sub>s\<^sub>t_def
 proof
   have S: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using assms unfolding tfr\<^sub>s\<^sub>t_def by metis+
 
   show "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t (LI_preproc S))" by (metis S(1) LI_preproc_trms_eq)
 
   show "list_all tfr\<^sub>s\<^sub>t\<^sub>p (LI_preproc S)" using S(2)
   proof (induction S)
     case (Cons x S)
     have IH: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (LI_preproc S)" using Cons by simp
     have x: "tfr\<^sub>s\<^sub>t\<^sub>p x" using Cons.prems by simp
 
     show ?case using x IH unfolding list_all_iff by (cases x) auto
   qed simp
 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: 
   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 fastforce
   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]] 
         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'' 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]] 
         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" 
         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'' 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]] 
         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) 
       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'' 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]] 
         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" 
         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'' 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)+ 
         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) 
         by (metis Diff_eq_empty_iff Diff_iff Un_upper1 term.order_refl
                   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 
   
   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] 
         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)
+        by (metis ideduct_synth_subst_apply eval_term.simps(1)
                   subst_subst_compose trm_subst_ident')
 
       define M' where "M' \<equiv> M \<union> (ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>)"
 
       have "\<forall>t \<in> set [Var v]. M' \<turnstile>\<^sub>c t \<cdot> (\<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>)" using *[of M'] by simp
       thus ?case
         using strand_sem_append(1)[OF S_sat, of "[Send1 (Var v)]", unfolded M'_def[symmetric]]
               strand_sem_c.simps(1)[of M'] strand_sem_c.simps(2)[of M' "[Var v]" "[]"]
         by presburger
     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 (LI_preproc S))" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t (LI_preproc S))"
             "list_all tfr\<^sub>s\<^sub>t\<^sub>p (LI_preproc S)"
     using assms(5,6) LI_preproc_preserves_tfr 
     unfolding tfr\<^sub>s\<^sub>t_def by (metis, metis LI_preproc_trms_eq, metis)
   have wf_constr: "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r (LI_preproc S) \<theta>" by (metis LI_preproc_preserves_wellformedness assms(3))
   obtain S' \<theta>' where *: "simple S'" "(LI_preproc 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>')" 
     using LI_preserves_welltypedness[OF *(2) wf_constr assms(4,7) tfr]
           LI_preserves_wellformedness[OF *(2) wf_constr]
           LI_preserves_tfr[OF *(2) wf_constr assms(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 list_ex_iff case_prod_unfold 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 typing_result
 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 typing_result
 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,send\<langle>K\<rangle>\<^sub>s\<^sub>t,receive\<langle>T\<rangle>\<^sub>s\<^sub>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>ts\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta> = Step (send\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>\<rangle>\<^sub>s\<^sub>t)"
   "(Step (receive\<langle>ts\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta> = Step (receive\<langle>ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<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>ts\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (receive\<langle>ts\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<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> \<forall>t \<in> set ts. (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>ts\<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> \<forall>t \<in> set ts. (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>ts\<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 ik_rcv_map'
 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>ts\<rangle>\<^sub>s\<^sub>t)] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = [Step (Receive (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta>))]"
   "[Step (send\<langle>ts\<rangle>\<^sub>s\<^sub>t)] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = [Step (Send (ts \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<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,Send K,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,send\<langle>K\<rangle>\<^sub>s\<^sub>t,receive\<langle>M\<rangle>\<^sub>s\<^sub>t}"
 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) 
 
 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>ts\<rangle>\<^sub>s\<^sub>t)] = [Step (send\<langle>ts\<rangle>\<^sub>s\<^sub>t)]"
   "decomp_rm\<^sub>e\<^sub>s\<^sub>t [Step (receive\<langle>ts\<rangle>\<^sub>s\<^sub>t)] = [Step (receive\<langle>ts\<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) 
 
 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>ts\<rangle>\<^sub>s\<^sub>t)]" "well_analyzed [Step (receive\<langle>ts\<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>ts\<rangle>\<^sub>s\<^sub>t)]" "well_analyzed [Step (receive\<langle>ts\<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,Send K,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; [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 * strand_sem_Send_split(2) strand_sem_d.simps(2)
         unfolding strand_sem_eq_defs(2) list_all_iff
         by meson
       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> ts) thus ?case
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[send\<langle>ts\<rangle>\<^sub>s\<^sub>t]"]
             to_st_append[of \<A> "[Step (send\<langle>ts\<rangle>\<^sub>s\<^sub>t)]"]
       by (simp add: sup.commute)
   next
     case (Receive M\<^sub>0 \<I> \<A> ts) thus ?case
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[receive\<langle>ts\<rangle>\<^sub>s\<^sub>t]"]
             to_st_append[of \<A> "[Step (receive\<langle>ts\<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>); [Send1 k]\<rbrakk>\<^sub>d' \<I>" by auto
       hence "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); [Send K]\<rbrakk>\<^sub>d' \<I>"
         using strand_sem_Send_map(4)[of _ "M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" \<I>] strand_sem_Send_map(6)
         unfolding strand_sem_eq_defs(2) by auto
       moreover have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); [Receive M]\<rbrakk>\<^sub>d' \<I>"
         by (metis strand_sem_Receive_map(6) 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,send\<langle>K\<rangle>\<^sub>s\<^sub>t,receive\<langle>M\<rangle>\<^sub>s\<^sub>t]\<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,send\<langle>K\<rangle>\<^sub>s\<^sub>t,receive\<langle>M\<rangle>\<^sub>s\<^sub>t]"
         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; [send\<langle>K\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>c' \<I>"
         using * 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 k \<cdot> \<I>" when k: "k \<in> set K" for k
         using * strand_sem_Send_split(5)[OF _ k] strand_sem_Send_map(5)
         unfolding 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> ts) thus ?case
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[send\<langle>ts\<rangle>\<^sub>s\<^sub>t]"]
             to_st_append[of \<A> "[Step (send\<langle>ts\<rangle>\<^sub>s\<^sub>t)]"]
       by (simp add: sup.commute)
   next
     case (Receive M\<^sub>0 \<I> \<A> ts) thus ?case
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[receive\<langle>ts\<rangle>\<^sub>s\<^sub>t]"]
             to_st_append[of \<A> "[Step (receive\<langle>ts\<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>); [Send1 k]\<rbrakk>\<^sub>c' \<I>" by auto
       hence "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); [Send K]\<rbrakk>\<^sub>c' \<I>"
         using strand_sem_Send_map(3)[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_Send_map(5)
         unfolding strand_sem_eq_defs(1)
         by auto
       moreover have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); [Receive M]\<rbrakk>\<^sub>c' \<I>"
         by (metis strand_sem_Receive_map(5) 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,send\<langle>K\<rangle>\<^sub>s\<^sub>t,receive\<langle>M\<rangle>\<^sub>s\<^sub>t]\<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 (metis Un_subset_iff Un_upper1 Un_upper2 image_mono)
 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
     unfolding list_all_iff 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) 
 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 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 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 decomps\<^sub>e\<^sub>s\<^sub>t_exist_subst_list:
   assumes "\<forall>t \<in> set ts. 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>.
           \<forall>t \<in> set ts. ik\<^sub>e\<^sub>s\<^sub>t (A@D) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
     (is "\<exists>D \<in> ?A. ?B D ts")
 proof -
   note 0 = decomps\<^sub>e\<^sub>s\<^sub>t_exist_subst[OF _ assms(2-6)]
 
   show ?thesis using assms(1)
   proof (induction ts)
     case (Cons t ts)
     have 1: "ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>" and 2: "\<forall>t \<in> set ts. ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>"
       using Cons.prems by auto
 
     obtain D where D: "D \<in> ?A" "ik\<^sub>e\<^sub>s\<^sub>t (A@D) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
       using 0[OF 1] by blast
 
     obtain D' where D': "D' \<in> ?A" "?B D' ts"
       using Cons.IH[OF 2] by auto
 
     have "ik\<^sub>e\<^sub>s\<^sub>t (A@D@D') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
       using ideduct_synth_mono[OF D(2)] ik\<^sub>e\<^sub>s\<^sub>t_append_subst(2)[of \<I> "A@D" D'] by fastforce
     hence "?B (D@D') (t#ts)"
       using D'(2) ideduct_synth_mono[of "ik\<^sub>e\<^sub>s\<^sub>t (A@D') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" _ "ik\<^sub>e\<^sub>s\<^sub>t (A@D@D') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"]
             ik\<^sub>e\<^sub>s\<^sub>t_append_subst(2)[of \<I>]
       by auto
     thus ?case
       using decomps\<^sub>e\<^sub>s\<^sub>t_append[OF D(1) D'(1)] by blast
   qed (fastforce intro: decomps\<^sub>e\<^sub>s\<^sub>t.Nil)
 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>ts\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
   shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \<S> (send\<langle>ts\<rangle>\<^sub>s\<^sub>t#S)) (\<A>@[Step (receive\<langle>ts\<rangle>\<^sub>s\<^sub>t)])"
 unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
 proof (intro conjI)
   let ?S = "send\<langle>ts\<rangle>\<^sub>s\<^sub>t#S"
   let ?A = "\<A>@[Step (receive\<langle>ts\<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\<^sub>s\<^sub>e\<^sub>t (set ts)"
     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\<^sub>s\<^sub>e\<^sub>t (set ts)" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = bvars\<^sub>e\<^sub>s\<^sub>t \<A>"
            "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<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>ts\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
   shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \<S> (receive\<langle>ts\<rangle>\<^sub>s\<^sub>t#S)) (\<A>@[Step (send\<langle>ts\<rangle>\<^sub>s\<^sub>t)])"
 unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
 proof (intro conjI)
   let ?S = "receive\<langle>ts\<rangle>\<^sub>s\<^sub>t#S"
   let ?A = "\<A>@[Step (send\<langle>ts\<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\<^sub>s\<^sub>e\<^sub>t (set ts)"
     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\<^sub>s\<^sub>e\<^sub>t (set ts)" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = bvars\<^sub>e\<^sub>s\<^sub>t \<A>"
             "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<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>" 
       "\<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>ts\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>" "\<S>' = update\<^sub>s\<^sub>t \<S> (send\<langle>ts\<rangle>\<^sub>s\<^sub>t#S)" "\<A>' = \<A>@[Step (receive\<langle>ts\<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> set ts" "\<Union>(trms\<^sub>s\<^sub>t ` \<S>') \<union> set ts = \<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_commute Un_left_commute)
 qed
 
 private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_rcv:
   assumes "receive\<langle>ts\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>" "\<S>' = update\<^sub>s\<^sub>t \<S> (receive\<langle>ts\<rangle>\<^sub>s\<^sub>t#S)" "\<A>' = \<A>@[Step (send\<langle>ts\<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> set ts" "\<Union>(trms\<^sub>s\<^sub>t ` \<S>') \<union> set ts = \<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_commute Un_left_commute)
 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>ts\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
           "\<S>' = update\<^sub>s\<^sub>t \<S> (send\<langle>ts\<rangle>\<^sub>s\<^sub>t#S)"
           "\<A>' = \<A>@[Step (receive\<langle>ts\<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> set ts" using assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto
     moreover have "set ts \<subseteq> \<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 
   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 ts S)
     hence "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>1) (receive\<langle>ts\<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\<^sub>s\<^sub>e\<^sub>t (set ts) \<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 ts) 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)) 
     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> (\<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 
   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" 
     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 
     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 
       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 
     case (Send ts S)
     hence "fv\<^sub>e\<^sub>s\<^sub>t \<A>2 = fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "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>ts\<rangle>\<^sub>s\<^sub>t#S) = fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<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 ts S)
     hence "fv\<^sub>e\<^sub>s\<^sub>t \<A>2 = fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)" "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>ts\<rangle>\<^sub>s\<^sub>t#S) = fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<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      
   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) 
     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) 
     ultimately show ?case using \<A>1d(2) by auto
   next
     case (Receive ts S)
     hence "\<forall>t \<in> set ts. 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>ts\<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 *: "\<forall>t \<in> set ts. 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>"
         "\<forall>t \<in> set ts. 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_list[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>ts\<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>ts\<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>ts\<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)"] 
         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)"] 
         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)"] 
         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
 
diff --git a/thys/Weighted_Path_Order/WPO.thy b/thys/Weighted_Path_Order/WPO.thy
--- a/thys/Weighted_Path_Order/WPO.thy
+++ b/thys/Weighted_Path_Order/WPO.thy
@@ -1,1715 +1,1715 @@
 section \<open>The Weighted Path Order\<close>
 
 text \<open>This is a version of WPO that also permits multiset comparisons of lists of terms.
   It therefore generalizes RPO.\<close>
 
 theory WPO
   imports
     Knuth_Bendix_Order.Lexicographic_Extension
     First_Order_Terms.Subterm_and_Context
     Knuth_Bendix_Order.Order_Pair
     Polynomial_Factorization.Missing_List
     Status
     Precedence
     Multiset_Extension2
     HOL.Zorn
 begin
 
 datatype order_tag = Lex | Mul
 
 locale wpo =
   fixes n :: nat
     and S NS :: "('f, 'v) term rel"
     and "prc" :: "('f \<times> nat \<Rightarrow> 'f \<times> nat \<Rightarrow> bool \<times> bool)"
     and prl :: "'f \<times> nat \<Rightarrow> bool"
     and \<sigma>\<sigma> :: "'f status"
     and c :: "'f \<times> nat \<Rightarrow> order_tag" 
     and ssimple :: bool
     and large :: "'f \<times> nat \<Rightarrow> bool" 
 begin
 
 fun wpo :: "('f, 'v) term \<Rightarrow> ('f, 'v) term \<Rightarrow> bool \<times> bool" 
   where
     "wpo s t = (if (s,t) \<in> S then (True, True) else 
         if (s,t) \<in> NS then (case s of
       Var x \<Rightarrow> (False, 
         (case t of 
           Var y \<Rightarrow> x = y 
         | Fun g ts \<Rightarrow> status \<sigma>\<sigma> (g, length ts) = [] \<and> prl (g, length ts)))
     | Fun f ss \<Rightarrow>
         if \<exists> i \<in> set (status \<sigma>\<sigma> (f, length ss)). snd (wpo (ss ! i) t) then (True, True)
         else
           (case t of
             Var _ \<Rightarrow> (False, ssimple \<and> large (f, length ss))
           | Fun g ts \<Rightarrow> 
             (case prc (f, length ss) (g, length ts) of (prs, prns) \<Rightarrow>            
               if prns \<and> (\<forall> j \<in> set (status \<sigma>\<sigma> (g, length ts)). fst (wpo s (ts ! j))) then 
                 if prs then (True, True)
                 else let ss' = map (\<lambda> i. ss ! i) (status \<sigma>\<sigma> (f, length ss));
                          ts' = map (\<lambda> i. ts ! i) (status \<sigma>\<sigma> (g, length ts));
                          cf = c (f,length ss);
                          cg = c (g,length ts)    
                    in if cf = Lex \<and> cg = Lex 
                       then lex_ext wpo n ss' ts'
                       else if cf = Mul \<and> cg = Mul
                            then mul_ext wpo ss' ts'
                            else (length ss' \<noteq> 0 \<and> length ts' = 0, length ts' = 0)
               else (False, False))))
       else (False, False))"
 
 declare wpo.simps [simp del]
 
 abbreviation wpo_s (infix "\<succ>" 50) where "s \<succ> t \<equiv> fst (wpo s t)"
 abbreviation wpo_ns (infix "\<succeq>" 50) where "s \<succeq> t \<equiv> snd (wpo s t)"
 
 abbreviation "WPO_S \<equiv> {(s,t). s \<succ> t}"
 abbreviation "WPO_NS \<equiv> {(s,t). s \<succeq> t}"
 
 lemma wpo_s_imp_ns: "s \<succ> t \<Longrightarrow> s \<succeq> t"
   using lex_ext_stri_imp_nstri
   unfolding wpo.simps[of s t]
   by (auto simp: Let_def mul_ext_stri_imp_nstri split: term.splits if_splits prod.splits)
 
 lemma S_imp_wpo_s: "(s,t) \<in> S \<Longrightarrow> s \<succ> t" by (simp add: wpo.simps)
 
 end
 
 declare wpo.wpo.simps[code]
 
 
 definition strictly_simple_status :: "'f status \<Rightarrow> ('f,'v)term rel \<Rightarrow> bool" where
   "strictly_simple_status \<sigma> rel = 
     (\<forall> f ts i. i \<in> set (status \<sigma> (f,length ts)) \<longrightarrow> (Fun f ts, ts ! i) \<in> rel)" 
 
 definition trans_precedence where "trans_precedence prc = (\<forall> f g h. 
   (fst (prc f g) \<longrightarrow> snd (prc g h) \<longrightarrow> fst (prc f h)) \<and>
   (snd (prc f g) \<longrightarrow> fst (prc g h) \<longrightarrow> fst (prc f h)) \<and>
   (snd (prc f g) \<longrightarrow> snd (prc g h) \<longrightarrow> snd (prc f h)))" 
   
   
 
 locale wpo_with_basic_assms = wpo +
   order_pair + irrefl_precedence +
   constrains S :: "('f, 'v) term rel" and NS :: _
     and prc :: "'f \<times> nat \<Rightarrow> 'f \<times> nat \<Rightarrow> bool \<times> bool"
     and prl :: "'f \<times> nat \<Rightarrow> bool"
     and ssimple :: bool
     and large :: "'f \<times> nat \<Rightarrow> bool" 
     and c :: "'f \<times> nat \<Rightarrow> order_tag" 
     and n :: nat
     and \<sigma>\<sigma> :: "'f status"
   assumes subst_S: "(s,t) \<in> S \<Longrightarrow> (s \<cdot> \<sigma>, t \<cdot> \<sigma>) \<in> S"
     and subst_NS: "(s,t) \<in> NS \<Longrightarrow> (s \<cdot> \<sigma>, t \<cdot> \<sigma>) \<in> NS"
     and irrefl_S: "irrefl S"
     and S_imp_NS: "S \<subseteq> NS"
     and ss_status: "ssimple \<Longrightarrow> i \<in> set (status \<sigma>\<sigma> fn) \<Longrightarrow> simple_arg_pos S fn i"
     and large: "ssimple \<Longrightarrow> large fn \<Longrightarrow> fst (prc fn gm) \<or> snd (prc fn gm) \<and> status \<sigma>\<sigma> gm = []"  
     and large_trans: "ssimple \<Longrightarrow> large fn \<Longrightarrow> snd (prc gm fn) \<Longrightarrow> large gm"  
     and ss_S_non_empty: "ssimple \<Longrightarrow> S \<noteq> {}"
 begin
 abbreviation "\<sigma> \<equiv> status \<sigma>\<sigma>"
 
 lemma ss_NS_not_UNIV: "ssimple \<Longrightarrow> NS \<noteq> UNIV"
 proof
   assume "ssimple" "NS = UNIV" 
   with ss_S_non_empty obtain a b where "(a,b) \<in> S" "(b,a) \<in> NS" by auto
   from compat_S_NS_point[OF this] have "(a,a) \<in> S" .
   with irrefl_S show False unfolding irrefl_def by auto
 qed
 
 lemmas \<sigma> = status[of \<sigma>\<sigma>]
 lemma \<sigma>E: "i \<in> set (\<sigma> (f, length ss)) \<Longrightarrow> ss ! i \<in> set ss" by (rule status_aux)
 
 lemma wpo_ns_imp_NS: "s \<succeq> t \<Longrightarrow> (s,t) \<in> NS" 
   using S_imp_NS
   by (cases s, auto simp: wpo.simps[of _ t], cases t, 
       auto simp: refl_NS_point split: if_splits)
 
 lemma wpo_s_imp_NS: "s \<succ> t \<Longrightarrow> (s,t) \<in> NS" 
   by (rule wpo_ns_imp_NS[OF wpo_s_imp_ns])
 
 lemma wpo_least_1: assumes "prl (f,length ss)" 
   and "(t, Fun f ss) \<in> NS"
   and "\<sigma> (f,length ss) = []"
 shows "t \<succeq> Fun f ss"
 proof (cases t)
   case (Var x)
   with assms show ?thesis by (simp add: wpo.simps)
 next
   case (Fun g ts)
   let ?f = "(f,length ss)"
   let ?g = "(g,length ts)"
   obtain s ns where "prc ?g ?f = (s,ns)" by force
   with prl[OF assms(1), of ?g] have prc: "prc ?g ?f = (s,True)" by auto
   show ?thesis using assms(2)
     unfolding Fun 
     unfolding wpo.simps[of "Fun g ts" "Fun f ss"] term.simps assms(3)
     by (auto simp: prc lex_ext_least_1 mul_ext_def ns_mul_ext_bottom Let_def)
 qed
 
 lemma wpo_least_2: assumes "prl (f,length ss)" (is "prl ?f")
   and "(Fun f ss, t) \<notin> S"
   and "\<sigma> (f,length ss) = []"
 shows "\<not> Fun f ss \<succ> t"
 proof (cases t)
   case (Var x)
   with Var show ?thesis using assms(2-3) by (auto simp: wpo.simps split: if_splits)
 next
   case (Fun g ts)
   let ?g = "(g,length ts)"
   obtain s ns where "prc ?f ?g = (s,ns)" by force
   with prl2[OF assms(1), of ?g] have prc: "prc ?f ?g = (False,ns)" by auto
   show ?thesis using assms(2) assms(3) unfolding Fun 
     by (simp add: wpo.simps[of _ "Fun g ts"] lex_ext_least_2 prc
         mul_ext_def s_mul_ext_bottom_strict Let_def)
 qed
 
 lemma wpo_least_3: assumes "prl (f,length ss)" (is "prl ?f") 
   and ns: "Fun f ss \<succeq> t"
   and NS: "(u, Fun f ss) \<in> NS"
   and ss: "\<sigma> (f,length ss) = []"
   and S: "\<And> x. (Fun f ss, x) \<notin> S"
   and u: "u = Var x" 
 shows "u \<succeq> t"
 proof (cases "(Fun f ss, t) \<in> S \<or> (u, Fun f ss) \<in> S \<or> (u, t) \<in> S")
   case True
   with wpo_ns_imp_NS[OF ns] NS compat_NS_S_point compat_S_NS_point have "(u, t) \<in> S" by blast
   from wpo_s_imp_ns[OF S_imp_wpo_s[OF this]] show ?thesis .
 next
   case False
   from trans_NS_point[OF NS wpo_ns_imp_NS[OF ns]] have utA: "(u, t) \<in> NS" .
   show ?thesis
   proof (cases t)
     case t: (Var y)
     with ns False ss have *: "ssimple" "large (f,length ss)" 
       by (auto simp: wpo.simps split: if_splits)
     show ?thesis 
     proof (cases "x = y")
       case True
       thus ?thesis using ns * False utA ss
         unfolding wpo.simps[of u t] wpo.simps[of "Fun f ss" t]
         unfolding t u term.simps
         by (auto split: if_splits)
     next
       case False
       from utA[unfolded t u] 
       have "(Var x, Var y) \<in> NS" .
       from False subst_NS[OF this, of "\<lambda> z. if z = x then v else w" for v w]
       have "(v,w) \<in> NS" for v w by auto
       hence "NS = UNIV" by auto
       with ss_NS_not_UNIV[OF \<open>ssimple\<close>]
       have False by auto
       thus ?thesis ..
     qed
   next
     case (Fun g ts)
     let ?g = "(g,length ts)"
     obtain s ns where "prc ?f ?g = (s,ns)" by force
     with prl2[OF \<open>prl ?f\<close>, of ?g] have prc: "prc ?f ?g = (False,ns)" by auto
     show ?thesis
     proof (cases "\<sigma> ?g")
       case Nil
       with False Fun assms prc have "prc ?f ?g = (False,True)" 
         by (auto simp:  wpo.simps split: if_splits)
       with prl3[OF \<open>prl ?f\<close>, of ?g] have "prl ?g" by auto
       show ?thesis using utA unfolding Fun by (rule wpo_least_1[OF \<open>prl ?g\<close>], simp add: Nil)
     next
       case (Cons t1 tts)
       have "\<not> wpo_s (Fun f ss) (ts ! t1)" by (rule wpo_least_2[OF \<open>prl ?f\<close> S ss])
       with \<open>wpo_ns (Fun f ss) t\<close> False Fun Cons 
       have False by (simp add: ss wpo.simps split: if_splits)
       then show ?thesis ..
     qed
   qed
 qed
 
 (* Transitivity / compatibility of the orders *)
 lemma wpo_compat': assumes SN: "\<And> f. prl f \<Longrightarrow> SN S" (* it is not clear whether this is really required *)
   shows "(s \<succeq> t \<and> t \<succ> u \<longrightarrow> s \<succ> u) \<and>
   (s \<succ> t \<and> t \<succeq> u \<longrightarrow> s \<succ> u) \<and>
   (s \<succeq> t \<and> t \<succeq> u \<longrightarrow> s \<succeq> u)" (is "?tran s t u")
 proof (induct "(s,t,u)" arbitrary: s t u rule: wf_induct[OF wf_measures[of "[\<lambda> (s,t,u). size s, \<lambda> (s,t,u). size t, \<lambda> (s,t,u). size u]"]])
   case 1
   note ind = 1[simplified]
   show "?tran s t u"
   proof (cases "(s,t) \<in> S \<or> (t,u) \<in> S \<or> (s,u) \<in> S")
     case True
     {
       assume st: "wpo_ns s t" and tu: "wpo_ns t u"
       from wpo_ns_imp_NS[OF st] wpo_ns_imp_NS[OF tu]
         True compat_NS_S_point compat_S_NS_point have "(s,u) \<in> S" by blast
       from S_imp_wpo_s[OF this] have "wpo_s s u" .
     }
     with wpo_s_imp_ns show ?thesis by blast
   next
   case False
     then have stS: "(s,t) \<notin> S" and tuS: "(t,u) \<notin> S" and suS: "(s,u) \<notin> S" by auto
     show ?thesis
     proof (cases t)
       note [simp] = wpo.simps[of s u] wpo.simps[of s t] wpo.simps[of t u]
       case (Var x)
       note wpo.simps[simp]
       show ?thesis
       proof safe
         assume "wpo_s t u"
         with Var tuS show "wpo_s s u" by (auto split: if_splits)
       next
         assume gr: "wpo_s s t" and ge: "wpo_ns t u"
         from wpo_s_imp_NS[OF gr] have stA: "(s,t) \<in> NS" .
         from wpo_ns_imp_NS[OF ge] have tuA: "(t,u) \<in> NS" .
         from trans_NS_point[OF stA tuA] have suA: "(s,u) \<in> NS" .
         show "wpo_s s u"
         proof (cases u)
           case (Var y)
           with ge \<open>t = Var x\<close> tuS have "t = u" by (auto split: if_splits)
           with gr show ?thesis by auto
         next
           case (Fun h us)
           let ?h = "(h,length us)"
           from Fun ge Var tuS have us: "\<sigma> ?h = []" and pri: "prl ?h" by (auto split: if_splits)
           from gr Var tuS ge stS obtain f ss where s: "s = Fun f ss" by (cases s, auto split: if_splits)
           let ?f = "(f,length ss)"
           from s gr Var False obtain i where i: "i \<in> set (\<sigma> ?f)" and sit: "ss ! i \<succeq> t" by (auto split: if_splits)        
           from trans_NS_point[OF wpo_ns_imp_NS[OF sit] tuA] have siu: "(ss ! i,u) \<in> NS" .
           from wpo_least_1[OF pri siu[unfolded Fun us] us]
           have "ss ! i \<succeq> u" unfolding Fun us .
           with i have "\<exists> i \<in> set (\<sigma> ?f). ss ! i \<succeq> u" by blast
           with s suA show ?thesis by simp
         qed
       next
         assume ge1: "wpo_ns s t" and ge2: "wpo_ns t u"
         show "wpo_ns s u"
         proof (cases u)
           case (Var y)
           with ge2 \<open>t = Var x\<close> tuS have "t = u" by (auto split: if_splits)
           with ge1 show ?thesis by auto
         next
           case (Fun h us)
           let ?h = "(h,length us)"
           from Fun ge2 Var tuS have us: "\<sigma> ?h = []" and pri: "prl ?h" by (auto split: if_splits)
           show ?thesis unfolding Fun us
             by (rule wpo_least_1[OF pri trans_NS_point[OF wpo_ns_imp_NS[OF ge1] 
                     wpo_ns_imp_NS[OF ge2[unfolded Fun us]]] us]) 
         qed
       qed
     next
       case (Fun g ts)
       let ?g = "(g,length ts)"
       let ?ts = "set (\<sigma> ?g)"
       let ?t = "Fun g ts"
       from Fun have t: "t = ?t" .
       show ?thesis 
       proof (cases s)
         case (Var x)
         show ?thesis
         proof safe
           assume gr: "wpo_s s t"
           with Var Fun stS show "wpo_s s u" by (auto simp: wpo.simps split: if_splits)
         next
           assume ge: "wpo_ns s t" and gr: "wpo_s t u"
           with Var Fun stS have pri: "prl ?g" and "\<sigma> ?g = []" by (auto simp: wpo.simps split: if_splits)
           with gr Fun show "wpo_s s u" using wpo_least_2[OF pri, of u] False by auto
         next
           assume ge1: "wpo_ns s t" and ge2: "wpo_ns t u"
           with Var Fun stS have pri: "prl ?g" and empty: "\<sigma> ?g = []" by (auto simp: wpo.simps split: if_splits)
           from wpo_ns_imp_NS[OF ge1] Var Fun empty have ns: "(Var x, Fun g ts) \<in> NS" by simp
           show "wpo_ns s u"
           proof (rule wpo_least_3[OF pri ge2[unfolded Fun empty] 
                 wpo_ns_imp_NS[OF ge1[unfolded Fun empty]] empty _ Var], rule)
             fix v
             assume S: "(Fun g ts, v) \<in> S"
             from compat_NS_S_point[OF ns S] have xv: "(Var x, v) \<in> S" .
             from assms[OF pri] have SN: "SN S" .
             from SN_imp_minimal[OF SN, rule_format, of undefined UNIV]
             obtain s where "\<And> u. (s,u) \<notin> S" by blast
             with subst_S[OF xv, of "\<lambda> _. s"]
             show False by auto
           qed
         qed
       next
         case (Fun f ss)
         let ?s = "Fun f ss"
         let ?f = "(f,length ss)"
         let ?ss = "set (\<sigma> ?f)"
         from Fun have s: "s = ?s" .
         let ?s1 = "\<exists> i \<in> ?ss. ss ! i \<succeq> t"
         let ?t1 = "\<exists> j \<in> ?ts. ts ! j \<succeq> u"
         let ?ls = "length ss"
         let ?lt = "length ts"
         obtain ps pns where prc: "prc ?f ?g = (ps,pns)" by force
         let ?tran2 = "\<lambda> a b c.  
            ((wpo_ns a b) \<and> (wpo_s b c) \<longrightarrow> (wpo_s a c)) \<and>
            ((wpo_s a b) \<and> (wpo_ns b c) \<longrightarrow> (wpo_s a c)) \<and> 
            ((wpo_ns a b) \<and> (wpo_ns b c) \<longrightarrow> (wpo_ns a c)) \<and> 
            ((wpo_s a b) \<and> (wpo_s b c) \<longrightarrow> (wpo_s a c))"
         from s have "\<forall> s' \<in> set ss. size s' < size s" by (auto simp: size_simps)
         with ind have ind2: "\<And> s' t' u'. \<lbrakk>s' \<in> set ss\<rbrakk> \<Longrightarrow> ?tran s' t' u'" by blast
         with wpo_s_imp_ns have ind3: "\<And> us s' t' u'. \<lbrakk>s' \<in> set ss; t' \<in> set ts\<rbrakk> \<Longrightarrow> ?tran2 s' t' u'" by blast
         let ?mss = "map (\<lambda> i. ss ! i) (\<sigma> ?f)"
         let ?mts = "map (\<lambda> j. ts ! j) (\<sigma> ?g)"
         have ind3': "\<And> us s' t' u'. \<lbrakk>s' \<in> set ?mss; t' \<in> set ?mts\<rbrakk> \<Longrightarrow> ?tran2 s' t' u'" 
           by (rule ind3, auto simp: status_aux)
         {
           assume ge1: "s \<succeq> t" and ge2: "t \<succ> u"
           from wpo_ns_imp_NS[OF ge1] have stA: "(s,t) \<in> NS" .
           from wpo_s_imp_NS[OF ge2] have tuA: "(t,u) \<in> NS" .
           from trans_NS_point[OF stA tuA] have suA: "(s,u) \<in> NS" .
           have "s \<succ> u"
           proof (cases ?s1)
             case True
             from this obtain i where i: "i \<in> ?ss" and ges: "ss ! i \<succeq> t" by auto
             from \<sigma>E[OF i] have s': "ss ! i \<in> set ss" .
             with i s s' ind2[of "ss ! i" t u, simplified] ges ge2 have "ss ! i \<succ> u" by auto
             then have "ss ! i \<succeq> u" by (rule wpo_s_imp_ns)
             with i s suA show ?thesis by (cases u, auto simp: wpo.simps split: if_splits)
           next
             case False
             show ?thesis
             proof (cases ?t1)
               case True
               from this obtain j where j: "j \<in> ?ts" and ges: "ts ! j \<succeq> u" by auto
               from \<sigma>E[OF j] have t': "ts ! j \<in> set ts" by auto
               from j t' t stS False ge1 s have ge1': "s \<succ> ts ! j" unfolding wpo.simps[of s t]
                 by (auto split: if_splits prod.splits)        
               from t' s t ge1' ges ind[rule_format, of s "ts ! j" u, simplified] 
               show "s \<succ> u"
                 using suA size_simps supt.intros unfolding wpo.simps[of s u] 
                 by (auto split: if_splits)
             next
               case False
               from t this ge2 tuS obtain h us where u: "u = Fun h us" 
                 by (cases u, auto simp: wpo.simps split: if_splits)
               let ?u = "Fun h us"
               let ?h = "(h,length us)"
               let ?us = "set (\<sigma> ?h)"
               let ?mus = "map (\<lambda> k. us ! k) (\<sigma> ?h)"
               from s t u ge1 ge2 have ge1: "?s \<succeq> ?t" and ge2: "?t \<succ> ?u" by auto
               from stA stS s t have stAS: "((?s,?t) \<in> S) = False" "((?s,?t) \<in> NS) = True" by auto
               from tuA tuS t u have tuAS: "((?t,?u) \<in> S) = False" "((?t,?u) \<in> NS) = True" by auto
               note ge1 = ge1[unfolded wpo.simps[of ?s ?t] stAS, simplified]
               note ge2 = ge2[unfolded wpo.simps[of ?t ?u] tuAS, simplified]              
               obtain ps2 pns2 where prc2: "prc ?g ?h = (ps2,pns2)" by force
               obtain ps3 pns3 where prc3: "prc ?f ?h = (ps3,pns3)" by force
               from \<open>\<not> ?s1\<close> t ge1 have st': "\<forall> j \<in> ?ts. ?s \<succ> ts ! j" by (auto split: if_splits prod.splits)
               from \<open>\<not> ?t1\<close> t u ge2 tuS have tu': "\<forall> k \<in> ?us. ?t \<succ> us ! k" by (auto split: if_splits prod.splits)
               from \<open>\<not> ?s1\<close> s t ge1 stS st' have fg: "pns" by (cases ?thesis, auto simp: prc) 
               from \<open>\<not> ?t1\<close> u ge2 tu' have gh: "pns2" by (cases ?thesis, auto simp: prc2)
               from \<open>\<not> ?s1\<close> have "?s1 = False" by simp
               note ge1 = ge1[unfolded this[unfolded t] if_False term.simps prc split]
               from \<open>\<not> ?t1\<close> have "?t1 = False" by simp
               note ge2 = ge2[unfolded this[unfolded u] if_False term.simps prc2 split]
               note compat = prc_compat[OF prc prc2 prc3]
               from fg gh compat have fh: "pns3" by simp 
               {
                 fix k
                 assume k: "k \<in> ?us"
                 from \<sigma>E[OF this] have "size (us ! k) < size u" unfolding u using size_simps by auto
                 with tu'[folded t] \<open>s \<succeq> t\<close> 
                   ind[rule_format, of s t "us ! k"] k have "s \<succ> us ! k" by blast
               } note su' = this
               show ?thesis
               proof (cases ps3)
                 case True
                 with su' s u fh prc3 suA show ?thesis by (auto simp: wpo.simps)
               next
                 case False
                 from False fg gh compat have nfg: "\<not> ps" and ngh: "\<not> ps2" and *: "ps = False" "ps2 = False" by blast+
                 note ge1 = ge1[unfolded * if_False]
                 note ge2 = ge2[unfolded * if_False]
                 show ?thesis
                 proof (cases "c ?f")
                   case Mul note cf = this
                   show ?thesis
                   proof (cases "c ?g")
                     case Mul note cg = this
                     show ?thesis
                     proof (cases "c ?h")
                       case Mul note ch = this
                       from ge1[unfolded cf cg]
                       have mul1: "snd (mul_ext wpo ?mss ?mts)" by (auto split: if_splits)
                       from ge2[unfolded cg ch]
                       have mul2: "fst (mul_ext wpo ?mts ?mus)" by (auto split: if_splits)
                       from mul1 mul2 mul_ext_compat[OF ind3', of ?mss ?mts ?mus]
                       have "fst (mul_ext wpo ?mss ?mus)"  by auto
                       with s u fh su' prc3 cf ch suA show ?thesis unfolding wpo.simps[of s u] by simp
                     next
                       case Lex note ch = this
                       from gh u ge2 tu' prc2 ngh cg ch have us_e: "?mus = []" by simp
                       from gh u ge2 tu' prc2 ngh cg ch have ts_ne: "?mts \<noteq> []" by (auto split: if_splits)
                       from ns_mul_ext_bottom_uniqueness[of "mset ?mts"]
                       have "\<And>f. snd (mul_ext f [] ?mts) \<Longrightarrow> ?mts = []" unfolding mul_ext_def by (simp add: Let_def)
                       with ts_ne fg \<open>\<not> ?s1\<close> t ge1 st' prc nfg cf cg have ss_ne: "?mss \<noteq> []"
                         by (cases ss) auto
                       from us_e ss_ne s u fh su' prc3 cf cg ch suA show ?thesis unfolding wpo.simps[of s u] by simp
                     qed
                   next
                     case Lex note cg = this
                     from fg \<open>\<not> ?s1\<close> t ge1 st' prc nfg cf cg have ts_e: "?mts = []" by simp
                     with gh \<open>\<not> ?t1\<close> u ge2 tu' prc2 ngh cg show ?thesis
                       by (cases "c ?h") (simp_all add: lex_ext_least_2)
                   qed
                 next
                   case Lex note cf = this 
                   show ?thesis
                   proof (cases "c ?g")
                     case Mul note cg = this
                     from fg \<open>\<not> ?s1\<close> t ge1 st' prc nfg cf cg have ts_e: "?mts = []" by simp
                     with gh \<open>\<not> ?t1\<close> u ge2 tu' prc2 ngh cg show ?thesis
                       by (cases "c ?h") (auto simp: Let_def s_mul_ext_def s_mul_ext_bottom mul_ext_def elim: mult2_alt_sE)
                   next
                     case Lex note cg = this
                     show ?thesis
                     proof (cases "c ?h")
                       case Mul note ch = this
                       from gh u ge2 tu' ngh cg ch have us_e: "?mus = []" by simp
                       from gh u ge2 tu' ngh cg ch have ts_ne: "?mts \<noteq> []" by simp
                       from lex_ext_iff[of _ _ "[]" ?mts]
                       have "\<And>f. snd (lex_ext f n [] ?mts) \<Longrightarrow> ?mts = []" by simp
                       with ts_ne fg t ge1 st' nfg cf cg have ss_ne: "?mss \<noteq> []" by auto
                       from us_e ss_ne s u fh su' prc3 cf cg ch suA show ?thesis unfolding wpo.simps[of s u] by simp
                     next
                       case Lex note ch = this
                       from fg t ge1 st' nfg cf cg
                       have lex1: "snd (lex_ext wpo n ?mss ?mts)" by auto
                       from gh u ge2 tu' ngh cg ch
                       have lex2: "fst (lex_ext wpo n ?mts ?mus)" by auto
                       from lex1 lex2 lex_ext_compat[OF ind3', of ?mss ?mts ?mus]
                       have "fst (lex_ext wpo n ?mss ?mus)" by auto
                       with s u fh su' prc3 cf cg ch suA show ?thesis unfolding wpo.simps[of s u] by simp
                     qed
                   qed
                 qed
               qed
             qed
           qed
         }
         moreover
         {
           assume ge1: "s \<succ> t" and ge2: "t \<succeq> u"
           from wpo_s_imp_NS[OF ge1] have stA: "(s,t) \<in> NS" .
           from wpo_ns_imp_NS[OF ge2] have tuA: "(t,u) \<in> NS" .
           from trans_NS_point[OF stA tuA] have suA: "(s,u) \<in> NS" .
           have "s \<succ> u"
           proof (cases ?s1)
             case True
             from True obtain i where i: "i \<in> ?ss" and ges: "ss ! i \<succeq> t" by auto
             from \<sigma>E[OF i] have s': "ss ! i \<in> set ss" by auto
             with s s' ind2[of "ss ! i" t u, simplified] ges ge2 have "ss ! i \<succeq> u" by auto
             with i s' s suA show ?thesis by (cases u, auto simp: wpo.simps split: if_splits)
           next
             case False
             show ?thesis
             proof (cases ?t1)
               case True
               from this obtain j where j: "j \<in> ?ts" and ges: "ts ! j \<succeq> u" by auto
               from \<sigma>E[OF j] have t': "ts ! j \<in> set ts" .
               from j t' t stS False ge1 s have ge1': "s \<succ> ts ! j" unfolding wpo.simps[of s t]
                 by (auto split: if_splits prod.splits)        
               from t' s t ge1' ges ind[rule_format, of s "ts ! j" u, simplified] 
               show "s \<succ> u"
                 using suA size_simps supt.intros unfolding wpo.simps[of s u] 
                 by (auto split: if_splits)
             next
               case False
               show ?thesis
               proof (cases u)
                 case u: (Fun h us)
                 let ?u = "Fun h us"
                 let ?h = "(h,length us)"
                 let ?us = "set (\<sigma> ?h)"
                 let ?mss = "map (\<lambda> i. ss ! i) (\<sigma> ?f)"
                 let ?mts = "map (\<lambda> j. ts ! j) (\<sigma> ?g)"
                 let ?mus = "map (\<lambda> k. us ! k) (\<sigma> ?h)"
                 note \<sigma>E =  \<sigma>E[of _ f ss] \<sigma>E[of _ g ts] \<sigma>E[of _ h us]
                 from s t u ge1 ge2 have ge1: "?s \<succ> ?t" and ge2: "?t \<succeq> ?u" by auto
                 from stA stS s t have stAS: "((?s,?t) \<in> S) = False" "((?s,?t) \<in> NS) = True" by auto
                 from tuA tuS t u have tuAS: "((?t,?u) \<in> S) = False" "((?t,?u) \<in> NS) = True" by auto
                 note ge1 = ge1[unfolded wpo.simps[of ?s ?t] stAS, simplified]
                 note ge2 = ge2[unfolded wpo.simps[of ?t ?u] tuAS, simplified]
                 let ?lu = "length us"
                 obtain ps2 pns2 where prc2: "prc ?g ?h = (ps2,pns2)" by force
                 obtain ps3 pns3 where prc3: "prc ?f ?h = (ps3,pns3)" by force
                 from \<open>\<not> ?s1\<close> t ge1 have st': "\<forall> j \<in> ?ts. ?s \<succ> ts ! j" by (auto split: if_splits prod.splits)
                 from \<open>\<not> ?t1\<close> t u ge2 tuS have tu': "\<forall> k \<in> ?us. ?t \<succ> us ! k" by (auto split: if_splits prod.splits)
                 from \<open>\<not> ?s1\<close> s t ge1 stS st' have fg: "pns" by (cases ?thesis, auto simp: prc) 
                 from \<open>\<not> ?t1\<close> u ge2 tu' have gh: "pns2" by (cases ?thesis, auto simp: prc2)
                 from \<open>\<not> ?s1\<close> have "?s1 = False" by simp
                 note ge1 = ge1[unfolded this[unfolded t] if_False term.simps prc split]
                 from \<open>\<not> ?t1\<close> have "?t1 = False" by simp
                 note ge2 = ge2[unfolded this[unfolded u] if_False term.simps prc2 split]
                 note compat = prc_compat[OF prc prc2 prc3]
                 from fg gh compat have fh: "pns3" by simp 
                 {
                   fix k
                   assume k: "k \<in> ?us"
                   from \<sigma>E(3)[OF this] have "size (us ! k) < size u" unfolding u using size_simps by auto
                   with tu'[folded t] wpo_s_imp_ns[OF \<open>s \<succ> t\<close>] 
                     ind[rule_format, of s t "us ! k"] k have "s \<succ> us ! k" by blast
                 } note su' = this
                 show ?thesis
                 proof (cases ps3)
                   case True
                   with su' s u fh prc3 suA show ?thesis by (auto simp: wpo.simps)
                 next
                   case False
                   from False fg gh compat have nfg: "\<not> ps" and ngh: "\<not> ps2" and *: "ps = False" "ps2 = False" by blast+
                   note ge1 = ge1[unfolded * if_False]
                   note ge2 = ge2[unfolded * if_False]
                   show ?thesis
                   proof (cases "c ?f")
                     case Mul note cf = this
                     show ?thesis
                     proof (cases "c ?g")
                       case Mul note cg = this
                       show ?thesis
                       proof (cases "c ?h")
                         case Mul note ch = this
                         from fg t ge1 st' nfg cf cg
                         have mul1: "fst (mul_ext wpo ?mss ?mts)" by auto
                         from gh u ge2 tu' ngh cg ch
                         have mul2: "snd (mul_ext wpo ?mts ?mus)" by auto
                         from mul1 mul2 mul_ext_compat[OF ind3', of ?mss ?mts ?mus]
                         have "fst (mul_ext wpo ?mss ?mus)" by auto
                         with s u fh su' prc3 cf ch suA show ?thesis unfolding wpo.simps[of s u] by simp
                       next
                         case Lex note ch = this
                         from gh u ge2 tu' ngh cg ch have us_e: "?mus = []" by simp
                         from fg t ge1 st' nfg cf cg s_mul_ext_bottom_strict
                         have ss_ne: "?mss \<noteq> []" by (cases ?mss) (auto simp: Let_def mul_ext_def)
                         from us_e ss_ne s u fh su' prc3 cf cg ch suA show ?thesis unfolding wpo.simps[of s u] by simp
                       qed
                     next
                       case Lex note cg = this
                       from fg t ge1 st' prc nfg cf cg s_mul_ext_bottom_strict
                       have ss_ne: "?mss \<noteq> []" by (auto simp: mul_ext_def)
                       from fg t ge1 st' nfg cf cg have ts_e: "?mts = []" by simp
                       show ?thesis
                       proof (cases "c ?h")
                         case Mul note ch = this
                         with gh u ge2 tu' ngh cg ch ns_mul_ext_bottom_uniqueness
                         have "?mus = []" by simp
                         with ss_ne s u fh su' prc3 cf cg ch s_mul_ext_bottom suA
                         show ?thesis unfolding wpo.simps[of s u] by (simp add: Let_def mul_ext_def s_mul_ext_def mult2_alt_s_def)
                       next
                         case Lex note ch = this
                         from lex_ext_iff[of _ _ "[]" ?mus]
                         have "\<And>f. snd (lex_ext f n [] ?mus) \<Longrightarrow> ?mus = []" by simp
                         with ts_e gh u ge2 tu' ngh cg ch
                         have "?mus = []" by simp
                         with ss_ne s u fh su' prc3 cf cg ch s_mul_ext_bottom suA
                         show ?thesis unfolding wpo.simps[of s u] by (simp add: mul_ext_def)
                       qed
                     qed
                   next
                     case Lex note cf = this
                     show ?thesis
                     proof (cases "c ?g")
                       case Mul note cg = this
                       from fg t ge1 st' nfg cf cg have ss_ne: "?mss \<noteq> []" by simp
                       from fg t ge1 st' nfg cf cg have ts_e: "?mts = []" by simp
                       show ?thesis
                       proof (cases "c ?h")
                         case Mul note ch = this
                         from ts_e gh u ge2 tu' ngh cg ch
                           ns_mul_ext_bottom_uniqueness[of "mset ?mus"]
                         have "?mus = []" by (simp add: mul_ext_def Let_def)
                         with ss_ne s u fh su' prc3 cf cg ch s_mul_ext_bottom suA
                         show ?thesis unfolding wpo.simps[of s u] by (simp add: mul_ext_def)
                       next
                         case Lex note ch = this
                         from gh u ge2 tu' prc2 ngh cg ch have "?mus = []" by simp
                         with ss_ne s u fh su' prc3 cf cg ch suA
                         show ?thesis unfolding wpo.simps[of s u] by (simp add: lex_ext_iff) 
                       qed
                     next
                       case Lex note cg = this
                       show ?thesis
                       proof (cases "c ?h")
                         case Mul note ch = this
                         from gh u ge2 tu' ngh cg ch have us_e: "?mus = []" by simp
                         have "\<And>f. fst (lex_ext f n ?mss ?mts) \<Longrightarrow> ?mss \<noteq> []"
                           by (cases ?mss) (simp_all add: lex_ext_iff)
                         with fg t ge1 st' prc nfg cf cg have ss_ne: "?mss \<noteq> []" by simp
                         with us_e s u fh su' prc3 cf cg ch suA show ?thesis unfolding wpo.simps[of s u] by simp
                       next
                         case Lex note ch = this
                         from fg t ge1 st' nfg cf cg
                         have lex1: "fst (lex_ext wpo n ?mss ?mts)" by auto
                         from gh u ge2 tu' ngh cg ch
                         have lex2: "snd (lex_ext wpo n ?mts ?mus)" by auto
                         from lex1 lex2 lex_ext_compat[OF ind3', of ?mss ?mts ?mus]
                         have "fst (lex_ext wpo n ?mss ?mus)" by auto
                         with s u fh su' prc3 cf cg ch suA show ?thesis unfolding wpo.simps[of s u] by simp
                       qed
                     qed
                   qed
                 qed              
               next
                 case (Var z)
                 from ge2 \<open>\<not> ?t1\<close> tuS have "ssimple" "large ?g" unfolding Var t
                   by (auto simp: wpo.simps split: if_splits)    
                 from large[OF this, of ?f]
                 have large: "fst (prc ?g ?f) \<or> snd (prc ?g ?f) \<and> \<sigma> ?f = []" by auto
                 obtain fgs fgns where prc_fg: "prc ?f ?g = (fgs,fgns)" by (cases "prc ?f ?g", auto) 
                 from ge1 \<open>\<not> ?s1\<close> stS have weak_fg: "snd (prc ?f ?g)" unfolding s t using prc_fg
                   by (auto simp: wpo.simps split: if_splits)
                 have prc_irrefl: "\<not> fst (prc ?f ?f)" using prc_refl by simp
                 from large have False
                 proof
                   assume "fst (prc ?g ?f)" 
                   with weak_fg have "fst (prc ?f ?f)" by (metis prc_compat prod.collapse)
                   with prc_irrefl show False by auto
                 next
                   assume weak: "snd (prc ?g ?f) \<and> \<sigma> ?f = []" 
                   let ?mss = "map (\<lambda> i. ss ! i) (\<sigma> ?f)"
                   let ?mts = "map (\<lambda> j. ts ! j) (\<sigma> ?g)"
                   {
                     assume "fst (prc ?f ?g)" 
                     with weak have "fst (prc ?f ?f)" by (metis prc_compat prod.collapse)
                     with prc_irrefl have False by auto
                   }
                   hence "\<not> fst (prc ?f ?g)" by auto
                   with ge1 \<open>\<not> ?s1\<close> stS prc_fg 
                   have "fst (lex_ext wpo n ?mss ?mts) \<or> fst (mul_ext wpo ?mss ?mts) \<or> ?mss \<noteq> []" 
                     unfolding wpo.simps[of s t] unfolding s t 
                     by (auto simp: Let_def split: if_splits)
                   with weak have "fst (lex_ext wpo n [] ?mts) \<or> fst (mul_ext wpo [] ?mts)" by auto
                   thus False using lex_ext_least_2 by (auto simp: mul_ext_def Let_def s_mul_ext_bottom_strict) 
                 qed
                 thus ?thesis ..
               qed
             qed
           qed
         }
         moreover
         {
           assume ge1: "s \<succeq> t" and ge2: "t \<succeq> u" and ngt1: "\<not> s \<succ> t" and ngt2: "\<not> t \<succ> u"
           from wpo_ns_imp_NS[OF ge1] have stA: "(s,t) \<in> NS" .
           from wpo_ns_imp_NS[OF ge2] have tuA: "(t,u) \<in> NS" .
           from trans_NS_point[OF stA tuA] have suA: "(s,u) \<in> NS" .
           from ngt1 stA have "\<not> ?s1" unfolding s t by (auto simp: wpo.simps split: if_splits)
           from ngt2 tuA have "\<not> ?t1" unfolding t by (cases u, auto simp: wpo.simps split: if_splits)
           have "s \<succeq> u"
           proof (cases u)
             case u: (Var x)
             from t \<open>\<not> ?t1\<close> ge2 tuA ngt2 have large: "ssimple" "large ?g" unfolding u
               by (auto simp: wpo.simps split: if_splits)
             from s t ngt1 ge1 have "snd (prc ?f ?g)" 
               by (auto simp: wpo.simps split: if_splits prod.splits)
             from large_trans[OF large this] suA large
             show ?thesis unfolding wpo.simps[of s u] using s u by auto
           next
             case u: (Fun h us)
             let ?u = "Fun h us"	 
             let ?h = "(h,length us)"
             let ?us = "set (\<sigma> ?h)"
             let ?mss = "map (\<lambda> i. ss ! i) (\<sigma> ?f)"
             let ?mts = "map (\<lambda> j. ts ! j) (\<sigma> ?g)"
             let ?mus = "map (\<lambda> k. us ! k) (\<sigma> ?h)"   
             from s t u ge1 ge2 have ge1: "?s \<succeq> ?t" and ge2: "?t \<succeq> ?u" by auto
             from stA stS s t have stAS: "((?s,?t) \<in> S) = False" "((?s,?t) \<in> NS) = True" by auto
             from tuA tuS t u have tuAS: "((?t,?u) \<in> S) = False" "((?t,?u) \<in> NS) = True" by auto
             note ge1 = ge1[unfolded wpo.simps[of ?s ?t] stAS, simplified]
             note ge2 = ge2[unfolded wpo.simps[of ?t ?u] tuAS, simplified]
             from s t u ngt1 ngt2 have ngt1: "\<not> ?s \<succ> ?t" and ngt2: "\<not> ?t \<succ> ?u" by auto
             note ngt1 = ngt1[unfolded wpo.simps[of ?s ?t] stAS, simplified]
             note ngt2 = ngt2[unfolded wpo.simps[of ?t ?u] tuAS, simplified]
             from \<open>\<not> ?s1\<close> t ge1 have st': "\<forall> j \<in> ?ts. ?s \<succ> ts ! j" by (cases ?thesis, auto)
             from \<open>\<not> ?t1\<close> u ge2 have tu': "\<forall> k \<in> ?us. ?t \<succ> us ! k" by (cases ?thesis, auto)
             let ?lu = "length us"        
             obtain ps2 pns2 where prc2: "prc ?g ?h = (ps2,pns2)" by force
             obtain ps3 pns3 where prc3: "prc ?f ?h = (ps3,pns3)" by force
             from \<open>\<not> ?s1\<close> t ge1 st' have fg: "pns" by (cases ?thesis, auto simp: prc) 
             from \<open>\<not> ?t1\<close> u ge2 tu' have gh: "pns2" by (cases ?thesis, auto simp: prc2)
             note compat = prc_compat[OF prc prc2 prc3]
             from \<open>\<not> ?s1\<close> have "?s1 = False" by simp
             note ge1 = ge1[unfolded this[unfolded t] if_False term.simps prc split]
             from \<open>\<not> ?t1\<close> have "?t1 = False" by simp
             note ge2 = ge2[unfolded this[unfolded u] if_False term.simps prc2 split]
             from compat fg gh have fh: pns3 by blast
             {
               fix k
               assume k: "k \<in> ?us"
               from \<sigma>E[OF this] have "size (us ! k) < size u" unfolding u using size_simps by auto
               with tu'[folded t] \<open>s \<succeq> t\<close>
                 ind[rule_format, of s t "us ! k"] k have "s \<succ> us ! k" by blast
             } note su' = this
             from \<open>\<not> ?s1\<close> st' ge1 ngt1 s t have nfg: "\<not> ps"
               by (simp, cases ?thesis, simp, cases ps, auto simp: prc fg) 
             from \<open>\<not> ?t1\<close> tu' ge2 ngt2 t u have ngh: "\<not> ps2"
               by (simp, cases ?thesis, simp, cases ps2, auto simp: prc2 gh)
             show "s \<succeq> u"
             proof (cases "c ?f")
               case Mul note cf = this
               show ?thesis
               proof (cases "c ?g")
                 case Mul note cg = this
                 show ?thesis
                 proof (cases "c ?h")
                   case Mul note ch = this
                   from fg t ge1 st' nfg cf cg
                   have mul1: "snd (mul_ext wpo ?mss ?mts)" by auto
                   from gh u ge2 tu' ngh cg ch
                   have mul2: "snd (mul_ext wpo ?mts ?mus)" by auto
                   from mul1 mul2 mul_ext_compat[OF ind3', of ?mss ?mts ?mus]
                   have "snd (mul_ext wpo ?mss ?mus)" by auto
                   with s u fh su' prc3 cf ch suA show ?thesis unfolding wpo.simps[of s u] by simp
                 next
                   case Lex note ch = this
                   from gh u ge2 tu' ngh cg ch have us_e: "?mus = []" by simp
                   with s u fh su' prc3 cf cg ch suA show ?thesis unfolding wpo.simps[of s u] by simp
                 qed
               next
                 case Lex note cg = this
                 from fg t ge1 st' nfg cf cg have ts_e: "?mts = []" by simp
                 show ?thesis
                 proof (cases "c ?h")
                   case Mul note ch = this
                   with gh u ge2 tu' ngh cg ch have "?mus = []" by simp
                   with s u fh su' prc3 cf cg ch ns_mul_ext_bottom suA
                   show ?thesis unfolding wpo.simps[of s u] by (simp add: ns_mul_ext_def mul_ext_def Let_def mult2_alt_ns_def)
                 next
                   case Lex note ch = this
                   have "\<And>f. snd (lex_ext f n [] ?mus) \<Longrightarrow> ?mus = []" by (simp_all add: lex_ext_iff)
                   with ts_e gh u ge2 tu' ngh cg ch have "?mus = []" by simp
                   with s u fh su' prc3 cf cg ch suA show ?thesis unfolding wpo.simps[of s u] by simp
                 qed
               qed
             next
               case Lex note cf = this
               show ?thesis
               proof (cases "c ?g")
                 case Mul note cg = this
                 from fg t ge1 st' prc nfg cf cg have ts_e: "?mts = []" by simp
                 show ?thesis
                 proof (cases "c ?h")
                   case Mul note ch = this
                   with ts_e gh u ge2 tu' ngh cg ch
                     ns_mul_ext_bottom_uniqueness[of "mset ?mus"]
                   have "?mus = []" by (simp add: Let_def mul_ext_def)
                   with s u fh su' prc3 cf cg ch suA show ?thesis unfolding wpo.simps[of s u] by simp
                 next
                   case Lex note ch = this
                   with gh u ge2 tu' prc2 ngh cg ch have "?mus = []" by simp
                   with s u fh su' prc3 cf cg ch suA show ?thesis unfolding wpo.simps[of s u] by (simp add: lex_ext_least_1)
                 qed
               next
                 case Lex note cg = this
                 show ?thesis
                 proof (cases "c ?h")
                   case Mul note ch = this
                   with gh u ge2 tu' ngh cg ch have "?mus = []" by simp
                   with s u fh su' prc3 cf cg ch suA show ?thesis unfolding wpo.simps[of s u] by (simp add: lex_ext_least_1)
                 next
                   case Lex note ch = this
                   from st' ge1 s t fg nfg cf cg
                   have lex1: "snd (lex_ext wpo n ?mss ?mts)" by (auto simp: prc)
                   from tu' ge2 t u gh ngh cg ch
                   have lex2: "snd (lex_ext wpo n ?mts ?mus)" by (auto simp: prc2)
                   from lex1 lex2 lex_ext_compat[OF ind3', of ?mss ?mts ?mus]
                   have "snd (lex_ext wpo n ?mss ?mus)" by auto
                   with fg gh su' s u fh cf cg ch suA show ?thesis unfolding wpo.simps[of s u] by (auto simp: prc3)
                 qed
               qed
             qed
           qed
         }
         ultimately
         show ?thesis using wpo_s_imp_ns by auto
       qed
     qed
   qed
 qed
 
 context
   assumes ssimple: "strictly_simple_status \<sigma>\<sigma> NS"
 begin
 lemma NS_arg': 
   assumes i: "i \<in> set (\<sigma> (f,length ts))"
   shows "(Fun f ts, ts ! i) \<in> NS" 
   using assms ssimple unfolding simple_arg_pos_def strictly_simple_status_def by simp
 
 lemma wpo_ns_refl': 
   shows "s \<succeq> s"
 proof (induct s)
   case (Fun f ss)
   {
     fix i
     assume si: "i \<in> set (\<sigma> (f,length ss))"
     from NS_arg'[OF this] have "(Fun f ss, ss ! i) \<in> NS" .
     with si Fun[OF status_aux[OF si]] have "wpo_s (Fun f ss) (ss ! i)" unfolding wpo.simps[of "Fun f ss" "ss ! i"]
       by auto
   } note wpo_s = this
   let ?ss = "map (\<lambda> i. ss ! i) (\<sigma> (f,length ss))"
   have rec11: "snd (lex_ext wpo n ?ss ?ss)"
     by (rule all_nstri_imp_lex_nstri, insert \<sigma>E[of _ f ss], auto simp: Fun)
   have rec12: "snd (mul_ext wpo ?ss ?ss)"
     unfolding mul_ext_def Let_def snd_conv 
     by (intro ns_mul_ext_refl_local,
         unfold locally_refl_def, auto simp: in_multiset_in_set[of ?ss] intro!: Fun status_aux)
   from rec11 rec12 show ?case using refl_NS_point wpo_s
     by (cases "c (f,length ss)", auto simp: wpo.simps[of "Fun f ss" "Fun f ss"] prc_refl)
 qed (simp add: wpo.simps refl_NS_point)
 
 lemma wpo_stable': fixes \<delta> :: "('f,'v)subst"
   shows "(s \<succ> t \<longrightarrow> s \<cdot> \<delta> \<succ> t \<cdot> \<delta>) \<and> (s \<succeq> t \<longrightarrow> s \<cdot> \<delta> \<succeq> t \<cdot> \<delta>)"
     (is "?p s t")
 proof (induct "(s,t)" arbitrary:s t rule: wf_induct[OF wf_measure[of "\<lambda> (s,t). size s + size t"]])
   case (1 s t)
   from 1
   have "\<forall> s' t'. size s' + size t' < size s + size t \<longrightarrow> ?p s' t'" by auto
   note IH = this[rule_format]
   let ?s = "s \<cdot> \<delta>"
   let ?t = "t \<cdot> \<delta>"
   note simps = wpo.simps[of s t] wpo.simps[of ?s ?t]
   show "?case"
   proof (cases "((s,t) \<in> S \<or> (?s,?t) \<in> S) \<or> ((s,t) \<notin> NS \<or> \<not> wpo_ns s t)")
     case True
     then show ?thesis
     proof
       assume "(s,t) \<in> S \<or> (?s,?t) \<in> S"
       with subst_S[of s t \<delta>] have "(?s,?t) \<in> S" by blast
       from S_imp_wpo_s[OF this] have "wpo_s ?s ?t" .
       with wpo_s_imp_ns[OF this] show ?thesis by blast
     next
       assume "(s,t) \<notin> NS \<or> \<not> wpo_ns s t"
       with wpo_ns_imp_NS have st: "\<not> wpo_ns s t" by auto
       with wpo_s_imp_ns have "\<not> wpo_s s t" by auto
       with st show ?thesis by blast
     qed
   next
     case False
     then have not: "((s,t) \<in> S) = False" "((?s,?t) \<in> S) = False" 
       and stA: "(s,t) \<in> NS" and ns: "wpo_ns s t" by auto
     from subst_NS[OF stA] have sstsA: "(?s,?t) \<in> NS" by auto
     from stA sstsA have id: "((s,t) \<in> NS) = True" "((?s,?t) \<in> NS) = True" by auto
     note simps = simps[unfolded id not if_False if_True]
     show ?thesis
     proof (cases s)
       case (Var x) note s = this
       show ?thesis
       proof (cases t)
         case (Var y) note t = this
         show ?thesis unfolding simps(1) unfolding s t using wpo_ns_refl'[of "\<delta> y"] by auto
       next
         case (Fun g ts) note t = this
         let ?g = "(g,length ts)"
         show ?thesis
         proof (cases "\<delta> x")
           case (Var y)
           then show ?thesis unfolding simps unfolding s t by simp
         next
           case (Fun f ss)
           let ?f = "(f, length ss)"
           show ?thesis 
           proof (cases "prl ?g")
             case False then show ?thesis unfolding simps unfolding s t Fun by auto
           next
             case True
             obtain s ns where "prc ?f ?g = (s,ns)" by force
             with prl[OF True, of ?f] have prc: "prc ?f ?g = (s, True)" by auto
             show ?thesis unfolding simps unfolding s t Fun 
               by (auto simp: Fun prc mul_ext_def ns_mul_ext_bottom Let_def intro!: all_nstri_imp_lex_nstri[of "[]", simplified])
           qed
         qed
       qed
     next
       case (Fun f ss) note s = this
       let ?f = "(f,length ss)"
       let ?ss = "set (\<sigma> ?f)"
       {
         fix i
         assume i: "i \<in> ?ss" and ns: "wpo_ns (ss ! i) t"
         from IH[of "ss ! i" t] \<sigma>E[OF i] ns have "wpo_ns (ss ! i \<cdot> \<delta>) ?t" using s
           by (auto simp: size_simps)
         then have "wpo_s ?s ?t" using i sstsA \<sigma>[of f "length ss"] unfolding simps unfolding s by force
         with wpo_s_imp_ns[OF this] have ?thesis by blast
       } note si_arg = this        
       show ?thesis
       proof (cases t)
         case t: (Var y) 
         show ?thesis
         proof (cases "\<exists>i\<in>?ss. wpo_ns (ss ! i) t")
           case True
           then obtain i
             where si: "i \<in> ?ss" and ns: "wpo_ns (ss ! i) t" 
             unfolding s t by auto
           from si_arg[OF this] show ?thesis .
         next
           case False
           with ns[unfolded simps] s t
           have ssimple and largef: "large ?f" by (auto split: if_splits)
           from False s t not 
           have "\<not> wpo_s s t" unfolding wpo.simps[of s t] by auto
           moreover          
           have "wpo_ns ?s ?t" 
           proof (cases "\<delta> y")
             case (Var z)
             show ?thesis unfolding wpo.simps[of ?s ?t] not id 
               unfolding s t using Var \<open>ssimple\<close> largef by auto
           next
             case (Fun g ts)
             let ?g = "(g,length ts)" 
             obtain ps pns where prc: "prc ?f ?g = (ps,pns)" by (cases "prc ?f ?g", auto)
             from prc_stri_imp_nstri[of ?f ?g] prc have ps: "ps \<Longrightarrow> pns" by auto
             {
               fix j
               assume "j \<in> set (\<sigma> ?g)"
               with set_status_nth[OF refl this] ss_status[OF \<open>ssimple\<close> this] t Fun
               have "(t \<cdot> \<delta>, ts ! j) \<in> S" by (auto simp: simple_arg_pos_def)
               with sstsA have S: "(s \<cdot> \<delta>, ts ! j) \<in> S" by (metis compat_NS_S_point)
               hence "wpo_s (s \<cdot> \<delta>) (ts ! j)" by (rule S_imp_wpo_s)
             } note ssimple = this
             from large[OF \<open>ssimple\<close> largef, of ?g, unfolded prc]
             have "ps \<or> pns \<and>  \<sigma> ?g = []" by auto 
             thus ?thesis using ssimple unfolding wpo.simps[of ?s ?t] not id 
               unfolding s t using Fun prc ps by (auto simp: lex_ext_least_1 mul_ext_def Let_def ns_mul_ext_bottom)
           qed
           ultimately show ?thesis by blast
         qed
       next
         case (Fun g ts) note t = this
         let ?g = "(g,length ts)"
         let ?ts = "set (\<sigma> ?g)"
         obtain prs prns where p: "prc ?f ?g = (prs, prns)" by force
         note ns = ns[unfolded simps, unfolded s t p term.simps split]
         show ?thesis
         proof (cases "\<exists> i \<in> ?ss. wpo_ns (ss ! i) t")
           case True
           with si_arg show ?thesis by blast
         next
           case False
           then have id: "(\<exists> i \<in> ?ss. wpo_ns (ss ! i) (Fun g ts)) = False" unfolding t by auto
           note ns = ns[unfolded this if_False]
           let ?mss = "map (\<lambda> s . s \<cdot> \<delta>) ss"
           let ?mts = "map (\<lambda> t . t \<cdot> \<delta>) ts"
           from ns have prns and s_tj: "\<And> j. j \<in> ?ts \<Longrightarrow> wpo_s (Fun f ss) (ts ! j)" 
             by (auto split: if_splits)
           {
             fix j
             assume j: "j \<in> ?ts"
             from \<sigma>E[OF this]
             have "size s + size (ts ! j) < size s + size t" unfolding t by (auto simp: size_simps)
             from IH[OF this] s_tj[OF j, folded s] have wpo: "wpo_s ?s (ts ! j \<cdot> \<delta>)" by auto
             from j \<sigma>[of g "length ts"] have "j < length ts" by auto
             with wpo have "wpo_s ?s (?mts ! j)" by auto
           } note ss_ts = this
           note \<sigma>E = \<sigma>E[of _ f ss] \<sigma>E[of _ g ts]
           show ?thesis
           proof (cases prs)
             case True
             with ss_ts sstsA p \<open>prns\<close> have "wpo_s ?s ?t" unfolding simps unfolding s t 
               by (auto split: if_splits)
             with wpo_s_imp_ns[OF this] show ?thesis by blast
           next
             case False
             let ?mmss = "map ((!) ss) (\<sigma> ?f)"
             let ?mmts = "map ((!) ts) (\<sigma> ?g)"
             let ?Mmss = "map ((!) ?mss) (\<sigma> ?f)"
             let ?Mmts = "map ((!) ?mts) (\<sigma> ?g)"
             have id_map: "?Mmss = map (\<lambda> t. t \<cdot> \<delta>) ?mmss" "?Mmts = map (\<lambda> t. t \<cdot> \<delta>) ?mmts"
               unfolding map_map o_def by (auto simp: set_status_nth)
             let ?ls = "length (\<sigma> ?f)"
             let ?lt = "length (\<sigma> ?g)"
             {
               fix si tj
               assume *: "si \<in> set ?mmss" "tj \<in> set ?mmts" 
               have "(wpo_s si tj \<longrightarrow> wpo_s (si \<cdot> \<delta>) (tj \<cdot> \<delta>)) \<and> (wpo_ns si tj \<longrightarrow> wpo_ns (si \<cdot> \<delta>) (tj \<cdot> \<delta>))" 
               proof (intro IH add_strict_mono)
                 from *(1) have "si \<in> set ss" using set_status_nth[of _ _ _ \<sigma>\<sigma>] by auto
                 then show "size si < size s" unfolding s by (auto simp: termination_simp)
                 from *(2) have "tj \<in> set ts" using set_status_nth[of _ _ _ \<sigma>\<sigma>] by auto
                 then show "size tj < size t" unfolding t by (auto simp: termination_simp)
               qed
               hence "wpo_s si tj \<Longrightarrow> wpo_s (si \<cdot> \<delta>) (tj \<cdot> \<delta>)"
                 "wpo_ns si tj \<Longrightarrow> wpo_ns (si \<cdot> \<delta>) (tj \<cdot> \<delta>)" by blast+
             } note IH' = this
             {
               fix i 
               assume "i < ?ls" "i < ?lt" 
               then have i_f: "i < length (\<sigma> ?f)" and i_g: "i < length (\<sigma> ?g)" by auto
               with \<sigma>[of f "length ss"] \<sigma>[of g "length ts"] have i: "\<sigma> ?f ! i < length ss" "\<sigma> ?g ! i < length ts" 
                 unfolding set_conv_nth by auto
               then have "size (ss ! (\<sigma> ?f ! i)) < size s" "size (ts ! (\<sigma> ?g ! i)) < size t" unfolding s t by (auto simp: size_simps)
               then have "size (ss ! (\<sigma> ?f ! i)) + size (ts ! (\<sigma> ?g ! i)) < size s + size t" by simp
               from IH[OF this] i i_f i_g
               have "(wpo_s (?mmss ! i) (?mmts ! i) \<Longrightarrow>
                      wpo_s (?mss ! (\<sigma> ?f ! i)) (?mts ! (\<sigma> ?g ! i)))" 
                 "(wpo_ns (?mmss ! i) (?mmts ! i) \<Longrightarrow>
                      wpo_ns (?mss ! (\<sigma> ?f ! i)) (?mts ! (\<sigma> ?g ! i)))" by auto
             } note IH = this
             consider (Lex) "c ?f = Lex" "c ?g = Lex" | (Mul) "c ?f = Mul" "c ?g = Mul" | (Diff) "c ?f \<noteq> c ?g" 
               by (cases "c ?f"; cases "c ?g", auto)
             thus ?thesis
             proof cases
               case Lex
               from Lex False ns have "snd (lex_ext wpo n ?mmss ?mmts)" by (auto split: if_splits)
               from this[unfolded lex_ext_iff snd_conv]
               have len: "(?ls = ?lt \<or> ?lt \<le> n)"
                 and choice: "(\<exists>i< ?ls.
                i < ?lt \<and> (\<forall>j<i. wpo_ns (?mmss ! j) (?mmts ! j)) \<and> wpo_s (?mmss ! i) (?mmts ! i)) \<or>
                (\<forall>i< ?lt. wpo_ns (?mmss ! i) (?mmts ! i)) \<and> ?lt \<le> ?ls" (is "?stri \<or> ?nstri") by auto
               from choice have "?stri \<or> (\<not> ?stri \<and> ?nstri)" by blast
               then show ?thesis
               proof
                 assume ?stri
                 then obtain i where i: "i < ?ls" "i < ?lt"
                   and NS: "(\<forall>j<i. wpo_ns (?mmss ! j) (?mmts ! j))" and S: "wpo_s (?mmss ! i) (?mmts ! i)" by auto
                 with IH have "(\<forall>j<i. wpo_ns (?Mmss ! j) (?Mmts ! j))" "wpo_s (?Mmss ! i) (?Mmts ! i)" by auto
                 with i len have "fst (lex_ext wpo n ?Mmss ?Mmts)" unfolding lex_ext_iff
                   by auto
                 with Lex ss_ts sstsA p \<open>prns\<close> have "wpo_s ?s ?t" unfolding simps unfolding s t 
                   by (auto split: if_splits)
                 with wpo_s_imp_ns[OF this] show ?thesis by blast
               next
                 assume "\<not> ?stri \<and> ?nstri"
                 then have ?nstri and nstri: "\<not> ?stri" by blast+
                 with IH have "(\<forall>i< ?lt. wpo_ns (?Mmss ! i) (?Mmts ! i)) \<and> ?lt \<le> ?ls" by auto
                 with len have "snd (lex_ext wpo n ?Mmss ?Mmts)" unfolding lex_ext_iff
                   by auto
                 with Lex ss_ts sstsA p \<open>prns\<close> have ns: "wpo_ns ?s ?t" unfolding simps unfolding s t 
                   by (auto split: if_splits)
                 {
                   assume "wpo_s s t"
                   from Lex this[unfolded simps, unfolded s t term.simps p split id] False
                   have "fst (lex_ext wpo n ?mmss ?mmts)" by (auto split: if_splits)
                   from this[unfolded lex_ext_iff fst_conv] nstri
                   have "(\<forall>i< ?lt. wpo_ns (?mmss ! i) (?mmts ! i)) \<and> ?lt < ?ls" by auto
                   with IH have "(\<forall>i< ?lt. wpo_ns (?Mmss ! i) (?Mmts ! i)) \<and> ?lt < ?ls" by auto
                   then have "fst (lex_ext wpo n ?Mmss ?Mmts)" using len unfolding lex_ext_iff by auto
                   with Lex ss_ts sstsA p \<open>prns\<close> have ns: "wpo_s ?s ?t" unfolding simps unfolding s t 
                     by (auto split: if_splits)
                 }
                 with ns show ?thesis by blast
               qed
             next
               case Diff
               thus ?thesis using ns ss_ts sstsA p \<open>prns\<close> unfolding simps unfolding s t
                 by (auto simp: Let_def split: if_splits)
             next
               case Mul
               from Mul False ns have ge: "snd (mul_ext wpo ?mmss ?mmts)" by (auto split: if_splits)
               have ge: "snd (mul_ext wpo ?Mmss ?Mmts)" unfolding id_map
                 by (rule nstri_mul_ext_map[OF _ _ ge], (intro IH', auto)+)
               {
                 assume gr: "fst (mul_ext wpo ?mmss ?mmts)" 
                 have gr\<sigma>: "fst (mul_ext wpo ?Mmss ?Mmts)" unfolding id_map
                   by (rule stri_mul_ext_map[OF _ _ gr], (intro IH', auto)+)
               } note gr = this
               from ge gr
               show ?thesis 
                 using ss_ts \<open>prns\<close> unfolding simps 
-                unfolding s t term.simps p split subst_apply_term.simps length_map Mul
+                unfolding s t term.simps p split eval_term.simps length_map Mul
                 by (simp add: id_map id)
             qed
           qed
         qed
       qed
     qed
   qed
 qed
 
 lemma subterm_wpo_s_arg': assumes i: "i \<in> set (\<sigma> (f,length ss))"
   shows "Fun f ss \<succ> ss ! i"
 proof -
   have refl: "ss ! i \<succeq> ss ! i" by (rule wpo_ns_refl')
   with i have "\<exists> t \<in> set (\<sigma> (f,length ss)). ss ! i \<succeq> ss ! i" by auto
   with NS_arg'[OF i] i
   show ?thesis by (auto simp: wpo.simps split: if_splits)
 qed
 
 context
   fixes f s t bef aft
   assumes ctxt_NS: "(s,t) \<in> NS \<Longrightarrow> (Fun f (bef @ s # aft), Fun f (bef @ t # aft)) \<in> NS"
   and SN: "\<And>f. prl f \<Longrightarrow> SN S" 
 begin
 
 lemma wpo_ns_pre_mono': 
   defines "\<sigma>f \<equiv> \<sigma> (f, Suc (length bef + length aft))"
   assumes rel: "(wpo_ns s t)"
   shows "(\<forall>j\<in>set \<sigma>f. Fun f (bef @ s # aft) \<succ> (bef @ t # aft) ! j)
     \<and> (Fun f (bef @ s # aft), (Fun f (bef @ t # aft))) \<in> NS
     \<and> (\<forall> i < length \<sigma>f. ((map ((!) (bef @ s # aft)) \<sigma>f) ! i) \<succeq> ((map ((!) (bef @ t # aft)) \<sigma>f) ! i))"
     (is "_ \<and> _ \<and> ?three")
 proof -
   let ?ss = "bef @ s # aft"
   let ?ts = "bef @ t # aft"
   let ?s = "Fun f ?ss"
   let ?t = "Fun f ?ts"
   let ?len = "Suc (length bef + length aft)"
   let ?f = "(f, ?len)"
   let ?\<sigma> = "\<sigma> ?f"
   from wpo_ns_imp_NS[OF rel] have stA: "(s,t) \<in> NS" .
   have ?three unfolding \<sigma>f_def
   proof (intro allI impI)
     fix i
     assume "i < length ?\<sigma>"
     then have id: "\<And> ss. (map ((!) ss) ?\<sigma>) ! i = ss ! (?\<sigma> ! i)" by auto
     show "wpo_ns ((map ((!) ?ss) ?\<sigma>) ! i) ((map ((!) ?ts) ?\<sigma>) ! i)"
     proof (cases "?\<sigma> ! i = length bef")
       case True
       then show ?thesis unfolding id using rel by auto
     next
       case False
       from append_Cons_nth_not_middle[OF this, of s aft t] wpo_ns_refl'
       show ?thesis unfolding id by auto
     qed
   qed
   have "\<forall>j\<in>set ?\<sigma>. wpo_s ?s ((bef @ t # aft) ! j)" (is ?one)
   proof
     fix j
     assume j: "j \<in> set ?\<sigma>"
     then have "j \<in> set (\<sigma> (f,length ?ss))" by simp
     from subterm_wpo_s_arg'[OF this]
     have s: "wpo_s ?s (?ss ! j)" .
     show "wpo_s ?s (?ts ! j)"
     proof (cases "j = length bef")
       case False
       then have "?ss ! j = ?ts ! j" by (rule append_Cons_nth_not_middle)
       with s show ?thesis by simp
     next
       case True
       with s have "wpo_s ?s s" by simp
       with rel wpo_compat'[OF SN] have "wpo_s ?s t" by fast
       with True show ?thesis by simp
     qed
   qed
   with \<open>?three\<close> ctxt_NS[OF stA] show ?thesis unfolding \<sigma>f_def by auto
 qed
 
 lemma wpo_ns_mono':
   assumes rel: "s \<succeq> t"
   shows "Fun f (bef @ s # aft) \<succeq> Fun f (bef @ t # aft)"
 proof - 
   let ?ss = "bef @ s # aft"
   let ?ts = "bef @ t # aft"
   let ?s = "Fun f ?ss"
   let ?t = "Fun f ?ts"  
   let ?len = "Suc (length bef + length aft)"
   let ?f = "(f, ?len)"
   let ?\<sigma> = "\<sigma> ?f"
   from wpo_ns_pre_mono'[OF rel]
   have id: "(\<forall>j\<in>set ?\<sigma>. wpo_s ?s ((bef @ t # aft) ! j)) = True" 
     "((?s,?t) \<in> NS) = True" 
     "length ?ss = ?len" "length ?ts = ?len"
     by auto 
   have "snd (lex_ext wpo n (map ((!) ?ss) ?\<sigma>) (map ((!) ?ts) ?\<sigma>))"
     by (rule all_nstri_imp_lex_nstri, intro allI impI, insert wpo_ns_pre_mono'[OF rel], auto)
   moreover have "snd (mul_ext wpo (map ((!) ?ss) ?\<sigma>) (map ((!) ?ts) ?\<sigma>))"
     by (rule all_nstri_imp_mul_nstri, intro allI impI, insert wpo_ns_pre_mono'[OF rel], auto)
   ultimately show ?thesis unfolding wpo.simps[of ?s ?t] term.simps id prc_refl
     using order_tag.exhaust by (auto simp: Let_def)
 qed
 
 end
 end
 end
 
 locale wpo_with_assms = wpo_with_basic_assms + SN_order_pair + precedence +
   constrains S :: "('f, 'v) term rel" and NS :: _
     and prc :: "'f \<times> nat \<Rightarrow> 'f \<times> nat \<Rightarrow> bool \<times> bool"
     and prl :: "'f \<times> nat \<Rightarrow> bool"
     and ssimple :: bool
     and large :: "'f \<times> nat \<Rightarrow> bool" 
     and c :: "'f \<times> nat \<Rightarrow> order_tag" 
     and n :: nat
     and \<sigma>\<sigma> :: "'f status"
   assumes ctxt_NS: "(s,t) \<in> NS \<Longrightarrow> (Fun f (bef @ s # aft), Fun f (bef @ t # aft)) \<in> NS" 
     and ws_status: "i \<in> set (status \<sigma>\<sigma> fn) \<Longrightarrow> simple_arg_pos NS fn i"
 begin
 
 lemma ssimple: "strictly_simple_status \<sigma>\<sigma> NS" 
    using ws_status set_status_nth unfolding strictly_simple_status_def simple_arg_pos_def by fastforce
    
 lemma trans_prc: "trans_precedence prc" 
   unfolding trans_precedence_def 
 proof (intro allI, goal_cases)
   case (1 f g h)
   show ?case using prc_compat[of f g _ _ h] by (cases "prc f g"; cases "prc g h"; cases "prc f h", auto)
 qed
 
 lemma NS_arg: assumes i: "i \<in> set (\<sigma> (f,length ts))"
   shows "(Fun f ts, ts ! i) \<in> NS"
   using NS_arg'[OF ssimple i] .
 
 lemma NS_subterm: assumes all: "\<And> f k. set (\<sigma> (f,k)) = {0 ..< k}"
   shows "s \<unrhd> t \<Longrightarrow> (s,t) \<in> NS"
 proof (induct s t rule: supteq.induct)
   case (refl)
   from refl_NS show ?case unfolding refl_on_def by blast
 next
   case (subt s ss t f)
   from subt(1) obtain i where i: "i < length ss" and s: "s = ss ! i" unfolding set_conv_nth by auto
   from NS_arg[of i f ss, unfolded all] s i have "(Fun f ss, s) \<in> NS" by auto
   from trans_NS_point[OF this subt(3)] show ?case .
 qed
 
 lemma wpo_ns_refl: "s \<succeq> s"
   using wpo_ns_refl'[OF ssimple] .
 
 
 lemma Var_not_S[simp]: "(Var x, t) \<notin> S" 
 proof 
   assume st: "(Var x, t) \<in> S" 
   from SN_imp_minimal[OF SN, rule_format, of undefined UNIV]
   obtain s where "\<And> u. (s,u) \<notin> S" by blast
   with subst_S[OF st, of "\<lambda> _. s"]
   show False by auto
 qed
 
 
 (* Transitivity / compatibility of the orders *)
 lemma wpo_compat: "
   (s \<succeq> t \<and> t \<succ> u \<longrightarrow> s \<succ> u) \<and>
   (s \<succ> t \<and> t \<succeq> u \<longrightarrow> s \<succ> u) \<and>
   (s \<succeq> t \<and> t \<succeq> u \<longrightarrow> s \<succeq> u)" 
   by (rule wpo_compat'[OF SN])
 
 lemma subterm_wpo_s_arg: assumes i: "i \<in> set (\<sigma> (f,length ss))"
   shows "Fun f ss \<succ> ss ! i"
   by (rule subterm_wpo_s_arg'[OF ssimple i])
 
 lemma subterm_wpo_ns_arg: assumes i: "i \<in> set (\<sigma> (f,length ss))"
   shows "Fun f ss \<succeq> ss ! i"
   by (rule wpo_s_imp_ns[OF subterm_wpo_s_arg[OF i]])
 
 lemma wpo_ns_mono:
   assumes rel: "s \<succeq> t"
   shows "Fun f (bef @ s # aft) \<succeq> Fun f (bef @ t # aft)"
   by (rule wpo_ns_mono'[OF ssimple ctxt_NS SN rel])
 
 lemma wpo_ns_pre_mono: fixes f and bef aft :: "('f,'v)term list"
   defines "\<sigma>f \<equiv> \<sigma> (f, Suc (length bef + length aft))"
   assumes rel: "(wpo_ns s t)"
   shows "(\<forall>j\<in>set \<sigma>f. Fun f (bef @ s # aft) \<succ> (bef @ t # aft) ! j)
     \<and> (Fun f (bef @ s # aft), (Fun f (bef @ t # aft))) \<in> NS
     \<and> (\<forall> i < length \<sigma>f. ((map ((!) (bef @ s # aft)) \<sigma>f) ! i) \<succeq> ((map ((!) (bef @ t # aft)) \<sigma>f) ! i))"
   unfolding \<sigma>f_def
   by (rule wpo_ns_pre_mono'[OF ssimple ctxt_NS SN rel])
 
 lemma wpo_stable: fixes \<delta> :: "('f,'v)subst"
   shows "(s \<succ> t \<longrightarrow> s \<cdot> \<delta> \<succ> t \<cdot> \<delta>) \<and> (s \<succeq> t \<longrightarrow> s \<cdot> \<delta> \<succeq> t \<cdot> \<delta>)"
   by (rule wpo_stable'[OF ssimple])
 
 lemma WPO_S_SN: "SN WPO_S"
 proof - 
   {
     fix t :: "('f,'v)term"
     let ?S = "\<lambda>x. SN_on WPO_S {x}"
     note iff = SN_on_all_reducts_SN_on_conv[of WPO_S]
     {
       fix x
       have "?S (Var x)" unfolding iff[of "Var x"]
       proof (intro allI impI)
         fix s
         assume "(Var x, s) \<in> WPO_S"
         then have False by (cases s, auto simp: wpo.simps split: if_splits)
         then show "?S s" ..
       qed
     } note var_SN = this
     have "?S t"
     proof (induct t)
       case (Var x) show ?case by (rule var_SN)
     next
       case (Fun f ts)
       let ?Slist = "\<lambda> f ys. \<forall> i \<in> set (\<sigma> f). ?S (ys ! i)"
       let ?r3 = "{((f,ab), (g,ab')). ((c f = c g) \<longrightarrow> (?Slist f ab \<and> 
           (c f = Mul \<longrightarrow> fst (mul_ext wpo (map ((!) ab) (\<sigma> f)) (map ((!) ab') (\<sigma> g)))) \<and>
           (c f = Lex \<longrightarrow> fst (lex_ext wpo n (map ((!) ab) (\<sigma> f)) (map ((!) ab') (\<sigma> g))))))
        \<and> ((c f \<noteq> c g) \<longrightarrow> (map ((!) ab) (\<sigma> f) \<noteq> [] \<and> (map ((!) ab') (\<sigma> g)) = []))}"
       let ?r0 = "lex_two {(f,g). fst (prc f g)} {(f,g). snd (prc f g)} ?r3"
       {
         fix ab
         {
           assume "\<exists>S. S 0 = ab \<and> (\<forall>i. (S i, S (Suc i)) \<in> ?r3)"
           then obtain S where
             S0: "S 0 = ab" and
             SS: "\<forall>i. (S i, S (Suc i)) \<in> ?r3"
             by auto
           let ?Sf = "\<lambda>i. fst (fst (S i))"
           let ?Sn = "\<lambda>i. snd (fst (S i))"
           let ?Sfn = "\<lambda> i. fst (S i)"
           let ?Sts = "\<lambda>i. snd (S i)"
           let ?Sts\<sigma> = "\<lambda>i. map ((!) (?Sts i)) (\<sigma> (?Sfn i))"
           have False
           proof (cases "\<forall>i. c (?Sfn i) = Mul")
             case True
             let ?r' = "{((f,ys), (g,xs)).
                 (\<forall> yi \<in>set ((map ((!) ys) (\<sigma> f))). SN_on WPO_S {yi})
                 \<and> fst (mul_ext wpo (map ((!) ys) (\<sigma> f)) (map ((!) xs) (\<sigma> g)))}"
             {
               fix i
               from True[rule_format, of i] and True[rule_format, of "Suc i"]
                 and SS[rule_format, of i]
               have "(S i, S (Suc i)) \<in> ?r'" by auto
             }
             then have Hf: "\<not> SN_on ?r' {S 0}"
               unfolding SN_on_def by auto
             from mul_ext_SN[of wpo, rule_format, OF wpo_ns_refl]
               and wpo_compat wpo_s_imp_ns
             have tmp: "SN {(ys, xs). (\<forall>y\<in>set ys. SN_on {(s, t). wpo_s s t} {y}) \<and> fst (mul_ext wpo ys xs)}" 
               (is "SN ?R") by blast
             have id: "?r' = inv_image ?R (\<lambda> (f,ys). map ((!) ys) (\<sigma> f))" by auto
             from SN_inv_image[OF tmp]
             have "SN ?r'" unfolding id . 
             from SN_on_subset2[OF subset_UNIV[of "{S 0}"], OF this]
             have "SN_on ?r' {(S 0)}" .
             with Hf show ?thesis ..
           next
             case False note HMul = this
             show ?thesis
             proof (cases "\<forall>i. c (?Sfn i) = Lex")
               case True
               let ?r' = "{((f,ys), (g,xs)).
                 (\<forall> yi \<in>set ((map ((!) ys) (\<sigma> f))). SN_on WPO_S {yi})
                 \<and> fst (lex_ext wpo n (map ((!) ys) (\<sigma> f)) (map ((!) xs) (\<sigma> g)))}"
               {
                 fix i
                 from SS[rule_format, of i] True[rule_format, of i] True[rule_format, of "Suc i"]
                 have "(S i, S (Suc i)) \<in> ?r'" by auto
               }
               then have Hf: "\<not> SN_on ?r' {S 0}"
                 unfolding SN_on_def by auto
               from wpo_compat have "\<And> x y z. wpo_ns x y \<Longrightarrow> wpo_s y z \<Longrightarrow> wpo_s x z" by blast
               from lex_ext_SN[of "wpo" n, OF this] 
               have tmp: "SN {(ys, xs). (\<forall>y\<in>set ys. SN_on WPO_S {y}) \<and> fst (lex_ext wpo n ys xs)}" 
                 (is "SN ?R") .
               have id: "?r' = inv_image ?R (\<lambda> (f,ys). map ((!) ys) (\<sigma> f))" by auto
               from SN_inv_image[OF tmp]
               have "SN ?r'" unfolding id . 
               then have "SN_on ?r' {(S 0)}" unfolding SN_defs by blast
               with Hf show False .. 
             next
               case False note HLex = this
               from HMul and HLex
               have "\<exists>i. c (?Sfn i) \<noteq> c (?Sfn (Suc i))"
               proof (cases ?thesis, simp)
                 case False
                 then have T: "\<forall>i. c (?Sfn i) = c (?Sfn (Suc i))" by simp
                 {
                   fix i
                   have "c (?Sfn i) = c (?Sfn 0)"
                   proof (induct i)
                     case (Suc j) then show ?case by (simp add: T[rule_format, of j])
                   qed simp
                 }
                 then show ?thesis using HMul HLex
                   by (cases "c (?Sfn 0)") auto
               qed
               then obtain i where
                 Hdiff: "c (?Sfn i) \<noteq> c (?Sfn (Suc i))"
                 by auto
               from Hdiff have Hf: "?Sts\<sigma> (Suc i) = []"
                 using SS[rule_format, of i] by auto
               show ?thesis
               proof (cases "c (?Sfn (Suc i)) = c (?Sfn (Suc (Suc i)))")
                 case False then show ?thesis using Hf and SS[rule_format, of "Suc i"] by auto
               next
                 case True
                 show ?thesis
                 proof (cases "c (?Sfn (Suc i))")
                   case Mul
                   with True and SS[rule_format, of "Suc i"]
                   have "fst (mul_ext wpo (?Sts\<sigma> (Suc i)) (?Sts\<sigma> (Suc (Suc i))))" 
                     by auto
                   with Hf and s_mul_ext_bottom_strict show ?thesis
                     by (simp add: Let_def mul_ext_def s_mul_ext_bottom_strict)
                 next
                   case Lex
                   with True and SS[rule_format, of "Suc i"]
                   have "fst (lex_ext wpo n (?Sts\<sigma> (Suc i)) (?Sts\<sigma> (Suc (Suc i))))"
                     by auto
                   with Hf show ?thesis by (simp add: lex_ext_iff)
                 qed
               qed
             qed
           qed
         }
       }
       then have "SN ?r3" unfolding SN_on_def by blast
       have SN1:"SN ?r0" 
       proof (rule lex_two[OF _ prc_SN \<open>SN ?r3\<close>])
         let ?r' = "{(f,g). fst (prc f g)}"
         let ?r = "{(f,g). snd (prc f g)}"
         {
           fix a1 a2 a3
           assume "(a1,a2) \<in> ?r" "(a2,a3) \<in> ?r'"
           then have "(a1,a3) \<in> ?r'"
             by (cases "prc a1 a2", cases "prc a2 a3", cases "prc a1 a3", 
                 insert prc_compat[of a1 a2 _ _ a3], force)
         }
         then show "?r O ?r' \<subseteq> ?r'" by auto
       qed
       let ?m = "\<lambda> (f,ts). ((f,length ts), ((f, length ts), ts))"
       let ?r = "{(a,b). (?m a, ?m b) \<in> ?r0}"
       have SN_r: "SN ?r" using SN_inv_image[OF SN1, of ?m] unfolding inv_image_def by fast
       let ?SA = "(\<lambda> x y. (x,y) \<in> S)"
       let ?NSA = "(\<lambda> x y. (x,y) \<in> NS)"
       let ?rr = "lex_two S NS ?r"
       define rr where "rr = ?rr" 
       from lex_two[OF compat_NS_S SN SN_r]
       have SN_rr: "SN rr" unfolding rr_def by auto
       let ?rrr = "inv_image rr (\<lambda> (f,ts). (Fun f ts, (f,ts)))"
       have SN_rrr: "SN ?rrr" 
         by (rule SN_inv_image[OF SN_rr])
       let ?ind = "\<lambda> (f,ts). ?Slist (f,length ts) ts \<longrightarrow> ?S (Fun f ts)"
       have "?ind (f,ts)"
       proof (rule SN_induct[OF SN_rrr, of ?ind])
         fix fts
         assume ind: "\<And> gss. (fts,gss) \<in> ?rrr \<Longrightarrow> ?ind gss"
         obtain f ts where Pair: "fts = (f,ts)" by force
         let ?f = "(f,length ts)"
         note ind = ind[unfolded Pair]
         show "?ind fts" unfolding Pair split
         proof (intro impI)
           assume ts: "?Slist ?f ts"
           let ?t = "Fun f ts"	
           show "?S ?t"
           proof (simp only: iff[of ?t], intro allI impI)
             fix s
             assume "(?t,s) \<in> WPO_S"
             then have "?t \<succ> s" by simp
             then show "?S s"
             proof (induct s, simp add: var_SN)
               case (Fun g ss) note IH = this
               let ?s = "Fun g ss"
               let ?g = "(g,length ss)"
               from Fun have t_gr_s: "?t \<succ> ?s" by auto
               show "?S ?s"
               proof (cases "\<exists> i \<in> set (\<sigma> ?f). ts ! i \<succeq> ?s")
                 case True
                 then obtain i where "i \<in> set (\<sigma> ?f)" and ge: "ts ! i \<succeq> ?s" by auto	      
                 with ts have "?S (ts ! i)" by auto
                 show "?S ?s"
                 proof (unfold iff[of ?s], intro allI impI)
                   fix u
                   assume "(?s,u) \<in> WPO_S"
                   with wpo_compat ge have u: "ts ! i \<succ> u" by blast
                   with \<open>?S (ts ! i)\<close>[unfolded iff[of "ts ! i"]]
                   show "?S u" by simp
                 qed
               next
                 case False note oFalse = this
                 from wpo_s_imp_NS[OF t_gr_s]
                 have t_NS_s: "(?t,?s) \<in> NS" .
                 show ?thesis
                 proof (cases "(?t,?s) \<in> S")
                   case True
                   then have "((f,ts),(g,ss)) \<in> ?rrr" unfolding rr_def by auto
                   with ind have ind: "?ind (g,ss)" by auto
                   {
                     fix i
                     assume i: "i \<in> set (\<sigma> ?g)"
                     have "?s \<succeq> ss ! i" by (rule subterm_wpo_ns_arg[OF i])
                     with t_gr_s have ts: "?t \<succ> ss ! i" using wpo_compat by blast
                     have "?S (ss ! i)" using IH(1)[OF \<sigma>E[OF i] ts] by auto
                   } note SN_ss = this
                   from ind SN_ss show ?thesis by auto
                 next
                   case False 
                   with t_NS_s oFalse 
                   have id: "(?t,?s) \<in> S = False" "(?t,?s) \<in> NS = True" by simp_all
                   let ?ls = "length ss"
                   let ?lt = "length ts"
                   let ?f = "(f,?lt)"
                   let ?g = "(g,?ls)"
                   obtain s1 ns1 where prc1: "prc ?f ?g = (s1,ns1)" by force
                   note t_gr_s = t_gr_s[unfolded wpo.simps[of ?t ?s], 
                       unfolded term.simps id if_True if_False prc1 split]
                   from oFalse t_gr_s have f_ge_g: "ns1"
                     by (cases ?thesis, auto)
                   from oFalse t_gr_s f_ge_g have small_ss: "\<forall> i \<in> set (\<sigma> ?g). ?t \<succ> ss ! i"
                     by (cases ?thesis, auto)
                   with Fun \<sigma>E[of _ g ss] have ss_S: "?Slist ?g ss" by auto
                   show ?thesis
                   proof (cases s1)
                     case True
                     then have "((f,ts),(g,ss)) \<in> ?r"  by (simp add: prc1)
                     with t_NS_s have "((f,ts),(g,ss)) \<in> ?rrr" unfolding rr_def by auto
                     with ind have "?ind (g,ss)" by auto
                     with ss_S show ?thesis by auto
                   next
                     case False
                     consider (Diff) "c ?f \<noteq> c ?g" | (Lex) "c ?f = Lex" "c ?g = Lex" | (Mul) "c ?f = Mul" "c ?g = Mul" 
                       by (cases "c ?f"; cases "c ?g", auto)
                     thus ?thesis
                     proof cases
                       case Diff
                       with False oFalse f_ge_g t_gr_s small_ss prc1 t_NS_s
                       have "((f,ts),(g,ss)) \<in> ?rrr" unfolding rr_def by (cases "c ?f"; cases "c ?g", auto)
                       with ind have "?ind (g,ss)" using Pair by auto
                       with ss_S show ?thesis by simp
                     next
                       case Lex
                       from False oFalse t_gr_s small_ss f_ge_g Lex
                       have lex: "fst (lex_ext wpo n (map ((!) ts) (\<sigma> ?f)) (map ((!) ss) (\<sigma> ?g)))"
                         by auto
                       from False lex ts f_ge_g Lex have "((f,ts),(g,ss)) \<in> ?r"
                         by (simp add: prc1)
                       with t_NS_s have "((f,ts),(g,ss)) \<in> ?rrr" unfolding rr_def by auto
                       with ind have "?ind (g,ss)" by auto
                       with ss_S show ?thesis by auto
                     next
                       case Mul
                       from False oFalse t_gr_s small_ss f_ge_g Mul
                       have mul: "fst (mul_ext wpo (map ((!) ts) (\<sigma> ?f)) (map ((!) ss) (\<sigma> ?g)))"
                         by auto
                       from False mul ts f_ge_g Mul have "((f,ts),(g,ss)) \<in> ?r"
                         by (simp add: prc1)
                       with t_NS_s have "((f,ts),(g,ss)) \<in> ?rrr" unfolding rr_def by auto
                       with ind have "?ind (g,ss)" by auto
                       with ss_S show ?thesis by auto
                     qed
                   qed
                 qed
               qed
             qed
           qed
         qed
       qed
       with Fun show ?case using \<sigma>E[of _ f ts] by simp
     qed
   }
   from SN_I[OF this]
   show "SN {(s::('f, 'v)term, t). fst (wpo s t)}" .
 qed
 
 theorem WPO_SN_order_pair: "SN_order_pair WPO_S WPO_NS"
 proof
   show "refl WPO_NS" using wpo_ns_refl unfolding refl_on_def by auto
   show "trans WPO_NS" using wpo_compat unfolding trans_def by blast
   show "trans WPO_S" using wpo_compat wpo_s_imp_ns unfolding trans_def by blast
   show "WPO_NS O WPO_S \<subseteq> WPO_S" using wpo_compat by blast
   show "WPO_S O WPO_NS \<subseteq> WPO_S" using wpo_compat by blast
   show "SN WPO_S" using WPO_S_SN .
 qed
 
 theorem WPO_S_subst: "(s,t) \<in> WPO_S \<Longrightarrow> (s \<cdot> \<sigma>, t \<cdot> \<sigma>) \<in> WPO_S" for \<sigma>
   using wpo_stable by auto
 
 theorem WPO_NS_subst: "(s,t) \<in> WPO_NS \<Longrightarrow> (s \<cdot> \<sigma>, t \<cdot> \<sigma>) \<in> WPO_NS" for \<sigma>
   using wpo_stable by auto
 
 theorem WPO_NS_ctxt: "(s,t) \<in> WPO_NS \<Longrightarrow> (Fun f (bef @ s # aft), Fun f (bef @ t # aft)) \<in> WPO_NS" 
   using wpo_ns_mono by blast
 
 theorem WPO_S_subset_WPO_NS: "WPO_S \<subseteq> WPO_NS" 
   using wpo_s_imp_ns by blast
 
 
 context (* if \<sigma> is the full status, then WPO_S is a simplification order *)
   assumes \<sigma>_full: "\<And> f k. set (\<sigma> (f,k)) = {0 ..< k}"
 begin
 
 lemma subterm_wpo_s: "s \<rhd> t \<Longrightarrow> s \<succ> t"
 proof (induct s t rule: supt.induct)
   case (arg s ss f)
   from arg[unfolded set_conv_nth] obtain i where i: "i < length ss" and s: "s = ss ! i" by auto  
   from \<sigma>_full[of f "length ss"] i have ii: "i \<in> set (\<sigma> (f,length ss))" by auto
   from subterm_wpo_s_arg[OF ii] s show ?case by auto
 next
   case (subt s ss t f)
   from subt wpo_s_imp_ns have "\<exists> s \<in> set ss. wpo_ns s t" by blast
   from this[unfolded set_conv_nth] obtain i where ns: "ss ! i \<succeq> t" and i: "i < length ss" by auto
   from \<sigma>_full[of f "length ss"] i have ii: "i \<in> set (\<sigma> (f,length ss))" by auto
   from subt have "Fun f ss \<unrhd> t" by auto
   from NS_subterm[OF \<sigma>_full this] ns ii
   show ?case by (auto simp: wpo.simps split: if_splits)
 qed
 
 (* Compatibility of the subterm relation with the order relation:
     a subterm is smaller *)
 lemma subterm_wpo_ns: assumes supteq: "s \<unrhd> t" shows "s \<succeq> t" 
 proof -
   from supteq have "s = t \<or> s \<rhd> t" by auto
   then show ?thesis
   proof
     assume "s = t" then show ?thesis using wpo_ns_refl by blast
   next
     assume "s \<rhd> t"
     from wpo_s_imp_ns[OF subterm_wpo_s[OF this]]
     show ?thesis .
   qed
 qed
 
 lemma wpo_s_mono: assumes rels: "s \<succ> t"
   shows "Fun f (bef @ s # aft) \<succ> Fun f (bef @ t # aft)"
 proof -
   let ?ss = "bef @ s # aft"
   let ?ts = "bef @ t # aft"
   let ?s = "Fun f ?ss"
   let ?t = "Fun f ?ts"
   let ?len = "Suc (length bef + length aft)"
   let ?f = "(f, ?len)"
   let ?\<sigma> = "\<sigma> ?f"
   from wpo_s_imp_ns[OF rels] have rel: "wpo_ns s t" .
   from wpo_ns_pre_mono[OF rel]
   have id: "(\<forall>j\<in>set ?\<sigma>. wpo_s ?s ((bef @ t # aft) ! j)) = True" 
     "((?s,?t) \<in> NS) = True" 
     "length ?ss = ?len" "length ?ts = ?len"
     by auto 
   let ?lb = "length bef" 
   from \<sigma>_full[of f ?len] have lb_mem: "?lb \<in> set ?\<sigma>" by auto
   then obtain i where \<sigma>i: "?\<sigma> ! i = ?lb" and i: "i < length ?\<sigma>" 
     unfolding set_conv_nth by force
   let ?mss = "map ((!) ?ss) ?\<sigma>"
   let ?mts = "map ((!) ?ts) ?\<sigma>"
   have "fst (lex_ext wpo n ?mss ?mts)" 
     unfolding lex_ext_iff fst_conv
   proof (intro conjI, force, rule disjI1, unfold length_map id, intro exI conjI, rule i, rule i, 
       intro allI impI)
     show "wpo_s (?mss ! i) (?mts ! i)" using \<sigma>i i rels by simp
   next
     fix j
     assume "j < i"
     with i have j: "j < length ?\<sigma>" by auto
     with wpo_ns_pre_mono[OF rel]
     show "?mss ! j \<succeq> ?mts ! j" by blast
   qed
   moreover 
   obtain lb nlb where part: "partition ((=) ?lb) ?\<sigma> = (lb, nlb)" by force
   hence mset_\<sigma>: "mset ?\<sigma> = mset lb + mset nlb" 
     by (induct ?\<sigma>, auto)
   let ?mlbs = "map ((!) ?ss) lb" 
   let ?mnlbs = "map ((!) ?ss) nlb" 
   let ?mlbt = "map ((!) ?ts) lb" 
   let ?mnlbt = "map ((!) ?ts) nlb" 
   have id1: "mset ?mss = mset ?mnlbs + mset ?mlbs" using mset_\<sigma> by auto
   have id2: "mset ?mts = mset ?mnlbt + mset ?mlbt" using mset_\<sigma> by auto
   from part lb_mem have lb: "?lb \<in> set lb" by auto
   have "fst (mul_ext wpo ?mss ?mts)" 
     unfolding mul_ext_def Let_def fst_conv
   proof (intro s_mul_extI_old, rule id1, rule id2)
     from lb show "mset ?mlbs \<noteq> {#}" by auto
     {
       fix i
       assume "i < length ?mnlbt" 
       then obtain j where id: "?mnlbs ! i = ?ss ! j" "?mnlbt ! i = ?ts ! j" "j \<in> set nlb" by auto
       with part have "j \<noteq> ?lb" by auto
       hence "?ss ! j = ?ts ! j" by (auto simp: nth_append)
       thus "(?mnlbs ! i, ?mnlbt ! i) \<in> WPO_NS" unfolding id using wpo_ns_refl by auto
     }
     fix u
     assume "u \<in># mset ?mlbt" 
     hence "u = t" using part by auto
     moreover have "s \<in># mset ?mlbs" using lb by force
     ultimately show "\<exists> v. v \<in>#  mset ?mlbs \<and> (v,u) \<in> WPO_S" using rels by force
   qed auto
   ultimately show ?thesis unfolding wpo.simps[of ?s ?t] term.simps id prc_refl
     using order_tag.exhaust by (auto simp: Let_def)
 qed
 
 theorem WPO_S_ctxt: "(s,t) \<in> WPO_S \<Longrightarrow> (Fun f (bef @ s # aft), Fun f (bef @ t # aft)) \<in> WPO_S" 
   using wpo_s_mono by blast
 
 theorem supt_subset_WPO_S: "{\<rhd>} \<subseteq> WPO_S" 
   using subterm_wpo_s by blast
 
 theorem supteq_subset_WPO_NS: "{\<unrhd>} \<subseteq> WPO_NS" 
   using subterm_wpo_ns by blast
 
 end
 
 end
 
 end