(*
(C) Copyright Andreas Viktor Hess, DTU, 2015-2020

All Rights Reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

- Redistributions of source code must retain the above copyright
  notice, this list of conditions and the following disclaimer.

- Redistributions in binary form must reproduce the above copyright
  notice, this list of conditions and the following disclaimer in the
  documentation and/or other materials provided with the distribution.

- Neither the name of the copyright holder nor the names of its
  contributors may be used to endorse or promote products
  derived from this software without specific prior written
  permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

(*  Title:      Typing_Result.thy
    Author:     Andreas Viktor Hess, DTU
*)

section \<open>The Typing Result\<close>
text \<open>\label{sec:Typing-Result}\<close>

theory Typing_Result
imports Typed_Model
begin

subsection \<open>The Typing Result for the Composition-Only Intruder\<close>
context typed_model
begin

subsubsection \<open>Well-typedness and Type-Flaw Resistance Preservation\<close>
context
begin

private lemma LI_preserves_tfr_stp_all_single:
  assumes "(S,\<theta>) \<leadsto> (S',\<theta>')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
  and "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
  shows "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'"
using assms
proof (induction rule: LI_rel.induct)
  case (Compose S X f S' \<theta>)
  hence "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" by simp_all
  moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (map Send X)" by (induct X) auto
  ultimately show ?case by simp
next
  case (Unify S f Y \<delta> X S' \<theta>)
  hence "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')" by simp

  have "fv\<^sub>s\<^sub>t (S@Send (Fun f X)#S') \<inter> bvars\<^sub>s\<^sub>t (S@S') = {}"
    using Unify.prems(1) by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
  moreover have "fv (Fun f X) \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f X)#S')" by auto
  moreover have "fv (Fun f Y) \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f X)#S')"
    using Unify.hyps(2) fv_subset_if_in_strand_ik'[of "Fun f Y" S] by force
  ultimately have bvars_disj:
      "bvars\<^sub>s\<^sub>t (S@S') \<inter> fv (Fun f X) = {}" "bvars\<^sub>s\<^sub>t (S@S') \<inter> fv (Fun f Y) = {}"
    by blast+

  have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" using Unify.prems(5) by simp
  moreover have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)"
  proof -
    obtain x where "x \<in> set S" "Fun f Y \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p x)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p x)"
      using Unify.hyps(2) Unify.prems(5) by force+
    thus ?thesis using wf_trm_subterm by auto
  qed
  moreover have
      "Fun f X \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" "Fun f Y \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))"
    using SMP_append[of S "Send (Fun f X)#S'"] SMP_Cons[of "Send (Fun f X)" S']
          SMP_ikI[OF Unify.hyps(2)]
    by auto
  hence "\<Gamma> (Fun f X) = \<Gamma> (Fun f Y)"
    using Unify.prems(4) mgu_gives_MGU[OF Unify.hyps(3)[symmetric]]
    unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
  ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" using mgu_wt_if_same_type[OF Unify.hyps(3)[symmetric]] by metis
  moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
    using mgu_wf_trm[OF Unify.hyps(3)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)\<close>]
    by (metis wf_trm_subst_range_iff)
  moreover have "bvars\<^sub>s\<^sub>t (S@S') \<inter> range_vars \<delta> = {}"
    using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] bvars_disj by fast
  ultimately show ?case using tfr_stp_all_wt_subst_apply[OF \<open>list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')\<close>] by metis
next
  case (Equality S \<delta> t t' a S' \<theta>)
  have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')" "\<Gamma> t = \<Gamma> t'"
    using tfr_stp_all_same_type[of S a t t' S']
          tfr_stp_all_split(5)[of S _ S']
          MGU_is_Unifier[OF mgu_gives_MGU[OF Equality.hyps(2)[symmetric]]]
          Equality.prems(3)
    by blast+
  moreover have "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" using Equality.prems(5) by auto
  ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
    using mgu_wt_if_same_type[OF Equality.hyps(2)[symmetric]]
    by metis
  moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
    using mgu_wf_trm[OF Equality.hyps(2)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m t'\<close>]
    by (metis wf_trm_subst_range_iff)
  moreover have "fv\<^sub>s\<^sub>t (S@Equality a t t'#S') \<inter> bvars\<^sub>s\<^sub>t (S@Equality a t t'#S') = {}"
    using Equality.prems(1) by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
  hence "bvars\<^sub>s\<^sub>t (S@S') \<inter> fv t = {}" "bvars\<^sub>s\<^sub>t (S@S') \<inter> fv t' = {}" by auto
  hence "bvars\<^sub>s\<^sub>t (S@S') \<inter> range_vars \<delta> = {}"
    using mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] by fast
  ultimately show ?case using tfr_stp_all_wt_subst_apply[OF \<open>list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')\<close>] by metis
qed

private lemma LI_in_SMP_subset_single:
  assumes "(S,\<theta>) \<leadsto> (S',\<theta>')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
          "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
  and "trms\<^sub>s\<^sub>t S \<subseteq> SMP M"
  shows "trms\<^sub>s\<^sub>t S' \<subseteq> SMP M"
using assms
proof (induction rule: LI_rel.induct)
  case (Compose S X f S' \<theta>)
  hence "SMP (trms\<^sub>s\<^sub>t [Send (Fun f X)]) \<subseteq> SMP M"
  proof -
    have "SMP (trms\<^sub>s\<^sub>t [Send (Fun f X)]) \<subseteq> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))"
      using trms\<^sub>s\<^sub>t_append SMP_mono by auto
    thus ?thesis
      using SMP_union[of "trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S')" M]
            SMP_subset_union_eq[OF Compose.prems(6)]
      by auto
  qed
  thus ?case using Compose.prems(6) by auto
next
  case (Unify S f Y \<delta> X S' \<theta>)
  have "Fun f X \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" by auto
  moreover have "MGU \<delta> (Fun f X) (Fun f Y)"
    by (metis mgu_gives_MGU[OF Unify.hyps(3)[symmetric]])
  moreover have
        "\<And>x. x \<in> set S \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p x)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)"
    using Unify.prems(4) by force+
  moreover have "Fun f Y \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))"
    by (meson SMP_ikI Unify.hyps(2) contra_subsetD ik_append_subset(1))
  ultimately have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)" "\<Gamma> (Fun f X) = \<Gamma> (Fun f Y)"
    using ik\<^sub>s\<^sub>t_subterm_exD[OF \<open>Fun f Y \<in> ik\<^sub>s\<^sub>t S\<close>] \<open>tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))\<close>
    unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (metis (full_types) SMP_wf_trm Unify.prems(4), blast)
  hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" by (metis mgu_wt_if_same_type[OF Unify.hyps(3)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close>])
  moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
    using mgu_wf_trm[OF Unify.hyps(3)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)\<close>] by simp
  ultimately have "trms\<^sub>s\<^sub>t ((S@Send (Fun f X)#S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> SMP M"
    using SMP.Substitution Unify.prems(6) wt_subst_SMP_subset by metis
  thus ?case by auto
next
  case (Equality S \<delta> t t' a S' \<theta>)
  hence "\<Gamma> t = \<Gamma> t'"
    using tfr_stp_all_same_type MGU_is_Unifier[OF mgu_gives_MGU[OF Equality.hyps(2)[symmetric]]]
    by metis
  moreover have "t \<in> SMP (trms\<^sub>s\<^sub>t (S@Equality a t t'#S'))" "t' \<in> SMP (trms\<^sub>s\<^sub>t (S@Equality a t t'#S'))"
    using Equality.prems(1) by auto
  moreover have "MGU \<delta> t t'" using mgu_gives_MGU[OF Equality.hyps(2)[symmetric]] by metis
  moreover have "\<And>x. x \<in> set S \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p x)" "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'"
    using Equality.prems(4) by force+
  ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" by (metis mgu_wt_if_same_type[OF Equality.hyps(2)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close>])
  moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
    using mgu_wf_trm[OF Equality.hyps(2)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m t'\<close>] by simp
  ultimately have "trms\<^sub>s\<^sub>t ((S@Equality a t t'#S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> SMP M"
    using SMP.Substitution Equality.prems wt_subst_SMP_subset by metis
  thus ?case by auto
qed

private lemma LI_preserves_tfr_single:
  assumes "(S,\<theta>) \<leadsto> (S',\<theta>')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
          "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
          "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
  shows "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S') \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')"
using assms
proof (induction rule: LI_rel.induct)
  case (Compose S X f S' \<theta>)
  let ?SMPmap = "SMP (trms\<^sub>s\<^sub>t (S@map Send X@S')) - (Var`\<V>)"
  have "?SMPmap \<subseteq> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S')) - (Var`\<V>)"
    using SMP_fun_map_snd_subset[of X f]
          SMP_append[of "map Send X" S'] SMP_Cons[of "Send (Fun f X)" S']
          SMP_append[of S "Send (Fun f X)#S'"] SMP_append[of S "map Send X@S'"]
    by auto
  hence "\<forall>s \<in> ?SMPmap. \<forall>t \<in> ?SMPmap. (\<exists>\<delta>. Unifier \<delta> s t) \<longrightarrow> \<Gamma> s = \<Gamma> t"
    using Compose unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (meson subsetCE)
  thus ?case
    using LI_preserves_trm_wf[OF r_into_rtrancl[OF LI_rel.Compose[OF Compose.hyps]], of S']
          Compose.prems(5)
    unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
next
  case (Unify S f Y \<delta> X S' \<theta>)
  let ?SMP\<delta> = "SMP (trms\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)) - (Var`\<V>)"

  have "SMP (trms\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)) \<subseteq> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))"
  proof
    fix s assume "s \<in> SMP (trms\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>))" thus "s \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))"
      using LI_in_SMP_subset_single[
              OF LI_rel.Unify[OF Unify.hyps] Unify.prems(1,2,4,5,6)
                 MP_subset_SMP(2)[of "S@Send (Fun f X)#S'"]]
      by (metis SMP_union SMP_subset_union_eq Un_iff)
  qed
  hence "\<forall>s \<in> ?SMP\<delta>. \<forall>t \<in> ?SMP\<delta>. (\<exists>\<delta>. Unifier \<delta> s t) \<longrightarrow> \<Gamma> s = \<Gamma> t"
    using Unify.prems(4) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (meson Diff_iff subsetCE)
  thus ?case
    using LI_preserves_trm_wf[OF r_into_rtrancl[OF LI_rel.Unify[OF Unify.hyps]], of S']
          Unify.prems(5)
    unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
next
  case (Equality S \<delta> t t' a S' \<theta>)
  let ?SMP\<delta> = "SMP (trms\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)) - (Var`\<V>)"

  have "SMP (trms\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)) \<subseteq> SMP (trms\<^sub>s\<^sub>t (S@Equality a t t'#S'))"
  proof
    fix s assume "s \<in> SMP (trms\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>))" thus "s \<in> SMP (trms\<^sub>s\<^sub>t (S@Equality a t t'#S'))"
      using LI_in_SMP_subset_single[
              OF LI_rel.Equality[OF Equality.hyps] Equality.prems(1,2,4,5,6)
                 MP_subset_SMP(2)[of "S@Equality a t t'#S'"]]
      by (metis SMP_union SMP_subset_union_eq Un_iff)
  qed
  hence "\<forall>s \<in> ?SMP\<delta>. \<forall>t \<in> ?SMP\<delta>. (\<exists>\<delta>. Unifier \<delta> s t) \<longrightarrow> \<Gamma> s = \<Gamma> t"
    using Equality.prems unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (meson Diff_iff subsetCE)
  thus ?case
    using LI_preserves_trm_wf[OF r_into_rtrancl[OF LI_rel.Equality[OF Equality.hyps]], of _ S']
          Equality.prems
    unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
qed

private lemma LI_preserves_welltypedness_single:
  assumes "(S,\<theta>) \<leadsto> (S',\<theta>')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
  and "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
  shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>' \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>')"
using assms
proof (induction rule: LI_rel.induct)
  case (Unify S f Y \<delta> X S' \<theta>)
  have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" using Unify.prems(5) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by simp
  moreover have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)"
  proof -
    obtain x where "x \<in> set S" "Fun f Y \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p x)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p x)"
      using Unify.hyps(2) Unify.prems(5) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by force
    thus ?thesis using wf_trm_subterm by auto
  qed
  moreover have
      "Fun f X \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" "Fun f Y \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))"
    using SMP_append[of S "Send (Fun f X)#S'"] SMP_Cons[of "Send (Fun f X)" S']
          SMP_ikI[OF Unify.hyps(2)]
    by auto
  hence "\<Gamma> (Fun f X) = \<Gamma> (Fun f Y)"
    using Unify.prems(4) mgu_gives_MGU[OF Unify.hyps(3)[symmetric]]
    unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
  ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" using mgu_wt_if_same_type[OF Unify.hyps(3)[symmetric]] by metis

  have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
    by (meson mgu_wf_trm[OF Unify.hyps(3)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)\<close>]
              wf_trm_subst_range_iff)
  hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<delta>))"
    using wf_trm_subst_range_iff wf_trm_subst \<open>wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)\<close>
    unfolding subst_compose_def
    by (metis (no_types, lifting))
  thus ?case by (metis wt_subst_compose[OF \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>\<close>])
next
  case (Equality S \<delta> t t' a S' \<theta>)
  have "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" using Equality.prems(5) by simp_all
  moreover have "\<Gamma> t = \<Gamma> t'"
    using \<open>list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@Equality a t t'#S')\<close>
          MGU_is_Unifier[OF mgu_gives_MGU[OF Equality.hyps(2)[symmetric]]]
    by auto
  ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" using mgu_wt_if_same_type[OF Equality.hyps(2)[symmetric]] by metis

  have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
    by (meson mgu_wf_trm[OF Equality.hyps(2)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m t'\<close>] wf_trm_subst_range_iff)
  hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<delta>))"
    using wf_trm_subst_range_iff wf_trm_subst \<open>wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)\<close>
    unfolding subst_compose_def
    by (metis (no_types, lifting))
  thus ?case by (metis wt_subst_compose[OF \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>\<close>])
qed metis

lemma LI_preserves_welltypedness:
  assumes "(S,\<theta>) \<leadsto>\<^sup>* (S',\<theta>')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
    and "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
  shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>'" (is "?A \<theta>'")
    and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>')" (is "?B \<theta>'")
proof -
  have "?A \<theta>' \<and> ?B \<theta>'" using assms
  proof (induction S \<theta> rule: converse_rtrancl_induct2)
    case (step S1 \<theta>1 S2 \<theta>2)
    hence "?A \<theta>2 \<and> ?B \<theta>2" using LI_preserves_welltypedness_single by presburger
    moreover have "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S2 \<theta>2"
      by (fact LI_preserves_wellformedness[OF r_into_rtrancl[OF step.hyps(1)] step.prems(1)])
    moreover have "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S2)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S2)"
      using LI_preserves_tfr_single[OF step.hyps(1)] step.prems by presburger+
    moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S2"
      using LI_preserves_tfr_stp_all_single[OF step.hyps(1)] step.prems by fastforce
    ultimately show ?case using step.IH by presburger
  qed simp
  thus "?A \<theta>'" "?B \<theta>'" by simp_all
qed

lemma LI_preserves_tfr:
  assumes "(S,\<theta>) \<leadsto>\<^sup>* (S',\<theta>')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
    and "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
  shows "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S')" (is "?A S'")
    and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')" (is "?B S'")
    and "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" (is "?C S'")
proof -
  have "?A S' \<and> ?B S' \<and> ?C S'" using assms
  proof (induction S \<theta> rule: converse_rtrancl_induct2)
    case (step S1 \<theta>1 S2 \<theta>2)
    have "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S2 \<theta>2" "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S2)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S2)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S2"
      using LI_preserves_wellformedness[OF r_into_rtrancl[OF step.hyps(1)] step.prems(1)]
            LI_preserves_tfr_single[OF step.hyps(1) step.prems(1,2)]
            LI_preserves_tfr_stp_all_single[OF step.hyps(1) step.prems(1,2)]
            step.prems(3,4,5,6)
      by metis+
    moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>2" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>2)"
      using LI_preserves_welltypedness[OF r_into_rtrancl[OF step.hyps(1)] step.prems]
      by simp_all
    ultimately show ?case using step.IH by presburger
  qed blast
  thus "?A S'" "?B S'" "?C S'" by simp_all
qed
end

subsubsection \<open>Simple Constraints are Well-typed Satisfiable\<close>
text \<open>Proving the existence of a well-typed interpretation\<close>
context
begin
lemma wt_interpretation_exists:
  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 (simp add: empty_fv_not_var)
  hence "subst_domain \<I> = UNIV" by auto
  moreover have "ground (subst_range \<I>)" by (simp add: props pgwt_ground)
  ultimately show "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" by metis
  show "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def using props by simp
  show "subst_range \<I> \<subseteq> public_ground_wf_terms" by (auto simp add: props)
qed

lemma wt_grounding_subst_exists:
  "\<exists>\<theta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>) \<and> fv (t \<cdot> \<theta>) = {}"
proof -
  obtain \<theta> where \<theta>: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "subst_range \<theta> \<subseteq> public_ground_wf_terms"
    using wt_interpretation_exists by blast
  show ?thesis using pgwt_wellformed interpretation_grounds[OF \<theta>(1)] \<theta>(2,3) by blast
qed

private fun fresh_pgwt::"'fun set \<Rightarrow> ('fun,'atom) term_type \<Rightarrow> ('fun,'var) term"  where
  "fresh_pgwt S (TAtom a) =
    Fun (SOME c. c \<notin> S \<and> \<Gamma> (Fun c []) = TAtom a \<and> public c) []"
| "fresh_pgwt S (TComp f T) = Fun f (map (fresh_pgwt S) T)"

private lemma fresh_pgwt_same_type:
  assumes "finite S" "wf\<^sub>t\<^sub>r\<^sub>m t"
  shows "\<Gamma> (fresh_pgwt S (\<Gamma> t)) = \<Gamma> t"
proof -
  let ?P = "\<lambda>\<tau>::('fun,'atom) term_type. wf\<^sub>t\<^sub>r\<^sub>m \<tau> \<and> (\<forall>f T. TComp f T \<sqsubseteq> \<tau> \<longrightarrow> 0 < arity f)"
  { fix \<tau> assume "?P \<tau>" hence "\<Gamma> (fresh_pgwt S \<tau>) = \<tau>"
    proof (induction \<tau>)
      case (Var a)
      let ?P = "\<lambda>c. c \<notin> S \<and> \<Gamma> (Fun c []) = Var a \<and> public c"
      let ?Q = "\<lambda>c. \<Gamma> (Fun c []) = Var a \<and> public c"
      have " {c. ?Q c} - S = {c. ?P c}" by auto
      hence "infinite {c. ?P c}"
        using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]]
        by metis
      hence "\<exists>c. ?P c" using not_finite_existsD by blast
      thus ?case using someI_ex[of ?P] by auto
    next
      case (Fun f T)
      have f: "0 < arity f" using Fun.prems fun_type_inv by auto
      have "\<And>t. t \<in> set T \<Longrightarrow> ?P t"
        using Fun.prems wf_trm_subtermeq term.le_less_trans Fun_param_is_subterm
        by metis
      hence "\<And>t. t \<in> set T \<Longrightarrow> \<Gamma> (fresh_pgwt S t) = t" using Fun.prems Fun.IH by auto
      hence "map \<Gamma> (map (fresh_pgwt S) T) = T"  by (induct T) auto
      thus ?case using fun_type[OF f] by simp
    qed
  } thus ?thesis using assms(1) \<Gamma>_wf'[OF assms(2)] \<Gamma>_wf(1) by auto
qed

private lemma fresh_pgwt_empty_synth:
  assumes "finite S" "wf\<^sub>t\<^sub>r\<^sub>m t"
  shows "{} \<turnstile>\<^sub>c fresh_pgwt S (\<Gamma> t)"
proof -
  let ?P = "\<lambda>\<tau>::('fun,'atom) term_type. wf\<^sub>t\<^sub>r\<^sub>m \<tau> \<and> (\<forall>f T. TComp f T \<sqsubseteq> \<tau> \<longrightarrow> 0 < arity f)"
  { fix \<tau> assume "?P \<tau>" hence "{} \<turnstile>\<^sub>c fresh_pgwt S \<tau>"
    proof (induction \<tau>)
      case (Var a)
      let ?P = "\<lambda>c. c \<notin> S \<and> \<Gamma> (Fun c []) = Var a \<and> public c"
      let ?Q = "\<lambda>c. \<Gamma> (Fun c []) = Var a \<and> public c"
      have " {c. ?Q c} - S = {c. ?P c}" by auto
      hence "infinite {c. ?P c}"
        using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]]
        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(1) by auto
qed

private lemma fresh_pgwt_has_fresh_const:
  assumes "finite S" "wf\<^sub>t\<^sub>r\<^sub>m t"
  obtains c where "Fun c [] \<sqsubseteq> fresh_pgwt S (\<Gamma> t)" "c \<notin> S"
proof -
  let ?P = "\<lambda>\<tau>::('fun,'atom) term_type. wf\<^sub>t\<^sub>r\<^sub>m \<tau> \<and> (\<forall>f T. TComp f T \<sqsubseteq> \<tau> \<longrightarrow> 0 < arity f)"
  { fix \<tau> assume "?P \<tau>" hence "\<exists>c. Fun c [] \<sqsubseteq> fresh_pgwt S \<tau> \<and> c \<notin> S"
    proof (induction \<tau>)
      case (Var a)
      let ?P = "\<lambda>c. c \<notin> S \<and> \<Gamma> (Fun c []) = Var a \<and> public c"
      let ?Q = "\<lambda>c. \<Gamma> (Fun c []) = Var a \<and> public c"
      have " {c. ?Q c} - S = {c. ?P c}" by auto
      hence "infinite {c. ?P c}"
        using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]]
        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(1) by blast
qed

private lemma fresh_pgwt_subterm_fresh:
  assumes "finite S" "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m s" "funs_term s \<subseteq> S"
  shows "s \<notin> subterms (fresh_pgwt S (\<Gamma> t))"
proof -
  let ?P = "\<lambda>\<tau>::('fun,'atom) term_type. wf\<^sub>t\<^sub>r\<^sub>m \<tau> \<and> (\<forall>f T. TComp f T \<sqsubseteq> \<tau> \<longrightarrow> 0 < arity f)"
  { fix \<tau> assume "?P \<tau>" hence "s \<notin> subterms (fresh_pgwt S \<tau>)"
    proof (induction \<tau>)
      case (Var a)
      let ?P = "\<lambda>c. c \<notin> S \<and> \<Gamma> (Fun c []) = Var a \<and> public c"
      let ?Q = "\<lambda>c. \<Gamma> (Fun c []) = Var a \<and> public c"
      have " {c. ?Q c} - S = {c. ?P c}" by auto
      hence "infinite {c. ?P c}"
        using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]]
        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(1) by auto
qed

private lemma wt_fresh_pgwt_term_exists:
  assumes "finite T" "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s T"
  obtains t where "\<Gamma> t = \<Gamma> s" "{} \<turnstile>\<^sub>c t" "\<forall>s \<in> T. \<forall>u \<in> subterms s. u \<notin> subterms t"
proof -
  have finite_S: "finite (\<Union>(funs_term ` T))" using assms(1) by auto

  have 1: "\<Gamma> (fresh_pgwt (\<Union>(funs_term ` T)) (\<Gamma> s)) = \<Gamma> s"
    using fresh_pgwt_same_type[OF finite_S assms(2)] by auto

  have 2: "{} \<turnstile>\<^sub>c fresh_pgwt (\<Union>(funs_term ` T)) (\<Gamma> s)"
    using fresh_pgwt_empty_synth[OF finite_S assms(2)] by auto

  have 3: "\<forall>v \<in> T. \<forall>u \<in> subterms v. u \<notin> subterms (fresh_pgwt (\<Union>(funs_term ` T)) (\<Gamma> s))"
    using fresh_pgwt_subterm_fresh[OF finite_S assms(2)] assms(3)
          wf_trm_subtermeq subtermeq_imp_funs_term_subset
    by force

  show ?thesis by (rule that[OF 1 2 3])
qed

lemma wt_bij_finite_subst_exists:
  assumes "finite (S::'var set)" "finite (T::('fun,'var) terms)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s T"
  shows "\<exists>\<sigma>::('fun,'var) subst.
              subst_domain \<sigma> = S
            \<and> bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)
            \<and> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>) \<subseteq> {t. {} \<turnstile>\<^sub>c t} - T
            \<and> (\<forall>s \<in> subst_range \<sigma>. \<forall>u \<in> subst_range \<sigma>. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u)
            \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>
            \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
using assms
proof (induction rule: finite_induct)
  case empty
  have "subst_domain Var = {}"
       "bij_betw Var (subst_domain Var) (subst_range Var)"
       "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range Var) \<subseteq> {t. {} \<turnstile>\<^sub>c t} - T"
       "\<forall>s \<in> subst_range Var. \<forall>u \<in> subst_range Var. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u"
       "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)"
    unfolding bij_betw_def
    by auto
  thus ?case by (force simp add: subst_domain_def)
next
  case (insert x S)
  then obtain \<sigma> where \<sigma>:
      "subst_domain \<sigma> = S" "bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)"
      "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>) \<subseteq> {t. {} \<turnstile>\<^sub>c t} - T"
      "\<forall>s \<in> subst_range \<sigma>. \<forall>u \<in> subst_range \<sigma>. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u"
      "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
    by (auto simp del: subst_range.simps)

  have *: "finite (T \<union> subst_range \<sigma>)"
    using insert.prems(1) insert.hyps(1) \<sigma>(1) by simp
  have **: "wf\<^sub>t\<^sub>r\<^sub>m (Var x)" by simp
  have ***: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (T \<union> subst_range \<sigma>)" using assms(3) \<sigma>(6) by blast
  obtain t where t:
      "\<Gamma> t = \<Gamma> (Var x)" "{} \<turnstile>\<^sub>c t"
      "\<forall>s \<in> T \<union> subst_range \<sigma>. \<forall>u \<in> subterms s. u \<notin> subterms t"
    using wt_fresh_pgwt_term_exists[OF * ** ***] by auto

  obtain \<theta> where \<theta>: "\<theta> \<equiv> \<lambda>y. if x = y then t else \<sigma> y" by simp

  have t_ground: "fv t = {}" using t(2) pgwt_ground[of t] pgwt_is_empty_synth[of t] by auto
  hence x_dom: "x \<notin> subst_domain \<sigma>" "x \<in> subst_domain \<theta>" using insert.hyps(2) \<sigma>(1) \<theta> by auto
  moreover have "subst_range \<sigma> \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>)" by auto
  hence ground_imgs: "ground (subst_range \<sigma>)"
    using \<sigma>(3) pgwt_ground pgwt_is_empty_synth
    by force
  ultimately have x_img: "\<sigma> x \<notin> subst_range \<sigma>"
    using ground_subst_dom_iff_img
    by (auto simp add: subst_domain_def)

  have "ground (insert t (subst_range \<sigma>))"
    using ground_imgs x_dom t_ground
    by auto
  have \<theta>_dom: "subst_domain \<theta> = insert x (subst_domain \<sigma>)"
    using \<theta> t_ground by (auto simp add: subst_domain_def)
  have \<theta>_img: "subst_range \<theta> = insert t (subst_range \<sigma>)"
  proof
    show "subst_range \<theta> \<subseteq> insert t (subst_range \<sigma>)"
    proof
      fix t' assume "t' \<in> subst_range \<theta>"
      then obtain y where "y \<in> subst_domain \<theta>" "t' = \<theta> y" by auto
      thus "t' \<in> insert t (subst_range \<sigma>)" using \<theta> by (auto simp add: subst_domain_def)
    qed
    show "insert t (subst_range \<sigma>) \<subseteq> subst_range \<theta>"
    proof
      fix t' assume t': "t' \<in> insert t (subst_range \<sigma>)"
      hence "fv t' = {}" using ground_imgs x_img t_ground by auto
      hence "t' \<noteq> Var x" by auto
      show "t' \<in> subst_range \<theta>"
      proof (cases "t' = t")
        case False
        hence "t' \<in> subst_range \<sigma>" using t' by auto
        then obtain y where "\<sigma> y \<in> subst_range \<sigma>" "t' = \<sigma> y" by auto
        hence "y \<in> subst_domain \<sigma>" "t' \<noteq> Var y"
          using ground_subst_dom_iff_img[OF ground_imgs(1)]
          by (auto simp add: subst_domain_def simp del: subst_range.simps)
        hence "x \<noteq> y" using x_dom by auto
        hence "\<theta> y = \<sigma> y" unfolding \<theta> by auto
        thus ?thesis using \<open>t' \<noteq> Var y\<close> \<open>t' = \<sigma> y\<close> subst_imgI[of \<theta> y] by auto
      qed (metis subst_imgI \<theta> \<open>t' \<noteq> Var x\<close>)
    qed
  qed
  hence \<theta>_ground_img: "ground (subst_range \<theta>)"
    using ground_imgs t_ground
    by auto

  have "subst_domain \<theta> = insert x S" using \<theta>_dom \<sigma>(1) by auto
  moreover have "bij_betw \<theta> (subst_domain \<theta>) (subst_range \<theta>)"
  proof (intro bij_betwI')
    fix y z assume *: "y \<in> subst_domain \<theta>" "z \<in> subst_domain \<theta>"
    hence "fv (\<theta> y) = {}" "fv (\<theta> z) = {}" using \<theta>_ground_img by auto
    { assume "\<theta> y = \<theta> z" hence "y = z"
      proof (cases "\<theta> y \<in> subst_range \<sigma> \<and> \<theta> z \<in> subst_range \<sigma>")
        case True
        hence **: "y \<in> subst_domain \<sigma>" "z \<in> subst_domain \<sigma>"
          using \<theta> \<theta>_dom True * t(3) by (metis Un_iff term.order_refl insertE)+
        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)
                  subst_subst_compose trm_subst_ident')
      thus ?case using strand_sem_append(1)[OF S_sat] by (metis strand_sem_c.simps(1,2))
    next
      case (ConsIneq X F S)
      have dom_disj: "subst_domain \<theta> \<inter> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = {}"
        using ConsIneq.prems(1) subst_dom_vars_in_subst
        by force
      hence *: "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta> = F" by blast

      have **: "ineq_model \<sigma> X F" by (meson ConsIneq.prems(2) in_set_conv_decomp)

      have "\<And>x. x \<in> vars\<^sub>s\<^sub>t S \<Longrightarrow> x \<in> vars\<^sub>s\<^sub>t (S@[Inequality X F])"
           "\<And>x. x \<in> set S \<Longrightarrow> x \<in> set (S@[Inequality X F])" by auto
      hence IH: "\<lbrakk>M; S\<rbrakk>\<^sub>c (\<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>)" by (metis ConsIneq.IH ConsIneq.prems(1,2,3,4))

      have "ineq_model (\<sigma> \<circ>\<^sub>s \<I>) X F"
      proof -
        have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) \<subseteq> subst_domain \<sigma>" when "?P \<delta> X" for \<delta>
          using ConsIneq.prems(3)[OF _ that] by simp
        hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<subseteq> subst_domain \<sigma>"
          using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_subset ex_P
          by (metis Diff_subset_conv Un_commute)
        thus ?thesis by (metis ineq_model_ground_subst[OF _ \<sigma>_img_ground **])
      qed
      hence "ineq_model (\<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>) X F"
        using * ineq_model_subst' subst_compose_assoc ConsIneq.prems(4)
        by (metis UnCI list.set_intros(1) set_append)
      thus ?case using IH by (auto simp add: ineq_model_def)
    qed auto
  }
  moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>))"
    by (metis wt_subst_compose \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>\<close> \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<close>,
        metis assms(4) \<I>_wf_trm \<sigma>_wf_trm wf_trm_subst subst_img_comp_subset')
  ultimately show ?thesis
    using interpretation_comp(1)[OF \<open>interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<close>, of "\<theta> \<circ>\<^sub>s \<sigma>"]
          subst_idem_support[OF \<open>subst_idem \<theta>\<close>, of "\<sigma> \<circ>\<^sub>s \<I>"] subst_compose_assoc
    unfolding constr_sem_c_def by metis
qed
end


subsubsection \<open>Theorem: Type-flaw resistant constraints are well-typed satisfiable (composition-only)\<close>
text \<open>
  There exists well-typed models of satisfiable type-flaw resistant constraints in the
  semantics where the intruder is limited to composition only (i.e., he cannot perform
  decomposition/analysis of deducible messages).
\<close>
theorem wt_attack_if_tfr_attack:
  assumes "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
    and "\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>"
    and "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>"
    and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
    and "tfr\<^sub>s\<^sub>t S"
    and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
    and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
  obtains \<I>\<^sub>\<tau> where "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>"
    and "\<I>\<^sub>\<tau> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>"
    and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>"
    and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>)"
proof -
  have tfr: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
    using assms(5,6) unfolding tfr\<^sub>s\<^sub>t_def by metis+
  obtain S' \<theta>' where *: "simple S'" "(S,\<theta>) \<leadsto>\<^sup>* (S',\<theta>')" "\<lbrakk>{}; S'\<rbrakk>\<^sub>c \<I>"
    using LI_completeness[OF assms(3,2)] unfolding constr_sem_c_def
    by (meson term.order_refl)
  have **: "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S' \<theta>'" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>'" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>')"
    using LI_preserves_welltypedness[OF *(2) assms(3,4,7) tfr]
          LI_preserves_wellformedness[OF *(2) assms(3)]
          LI_preserves_tfr[OF *(2) assms(3,4,7) tfr]
    by metis+

  define A where "A \<equiv> {x \<in> vars\<^sub>s\<^sub>t S'. \<exists>X F. Inequality X F \<in> set S' \<and> x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<and> x \<notin> set X}"
  define B where "B \<equiv> UNIV - A"

  let ?\<I> = "rm_vars B \<I>"

  have gr\<I>: "ground (subst_range \<I>)" "ground (subst_range ?\<I>)"
    using assms(1) rm_vars_img_subset[of B \<I>] by (auto simp add: subst_domain_def)

  { fix X F
    assume "Inequality X F \<in> set S'"
    hence *: "ineq_model \<I> X F"
      using strand_sem_c_imp_ineq_model[OF *(3)]
      by (auto simp del: subst_range.simps)
    hence "ineq_model ?\<I> X F"
    proof -
      { fix \<delta>
        assume 1: "subst_domain \<delta> = set X" "ground (subst_range \<delta>)"
            and 2: "list_ex (\<lambda>f. fst f \<cdot> \<delta> \<circ>\<^sub>s \<I> \<noteq> snd f \<cdot> \<delta> \<circ>\<^sub>s \<I>) F"
        have "list_ex (\<lambda>f. fst f \<cdot> \<delta> \<circ>\<^sub>s rm_vars B \<I> \<noteq> snd f \<cdot> \<delta> \<circ>\<^sub>s rm_vars B \<I>) F" using 2
        proof (induction F)
          case (Cons g G)
          obtain t t' where g: "g = (t,t')" by (metis surj_pair)
          thus ?case
            using Cons Unifier_ground_rm_vars[OF gr\<I>(1), of "t \<cdot> \<delta>" B "t' \<cdot> \<delta>"]
            by auto
        qed simp
      } thus ?thesis using * unfolding ineq_model_def by simp
    qed
  } moreover have "subst_domain \<I> = UNIV" using assms(1) by metis
  hence "subst_domain ?\<I> = A" using rm_vars_dom[of B \<I>] B_def by blast
  ultimately obtain \<I>\<^sub>\<tau> where
      "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>" "\<I>\<^sub>\<tau> \<Turnstile>\<^sub>c \<langle>S', \<theta>'\<rangle>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>)"
    using wt_sat_if_simple[OF *(1) **(1,2,5,4) _ gr\<I>(2) _ **(3)] A_def
    by (auto simp del: subst_range.simps)
  thus ?thesis using that LI_soundness[OF assms(3) *(2)] by metis
qed

text \<open>
  Contra-positive version: if a type-flaw resistant constraint does not have a well-typed model
  then it is unsatisfiable
\<close>
corollary secure_if_wt_secure:
  assumes "\<not>(\<exists>\<I>\<^sub>\<tau>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> (\<I>\<^sub>\<tau> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>) \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>)"
  and     "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "tfr\<^sub>s\<^sub>t S"
  and     "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
  shows "\<not>(\<exists>\<I>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I> \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>))"
using wt_attack_if_tfr_attack[OF _ _ assms(2,3,4,5,6)] assms(1) by metis

end


subsection \<open>Lifting the Composition-Only Typing Result to the Full Intruder Model\<close>
context typed_model
begin

subsubsection \<open>Analysis Invariance\<close>
definition (in typed_model) Ana_invar_subst where
  "Ana_invar_subst \<M> \<equiv>
    (\<forall>f T K M \<delta>. Fun f T \<in> (subterms\<^sub>s\<^sub>e\<^sub>t \<M>) \<longrightarrow>
                 Ana (Fun f T) = (K, M) \<longrightarrow> Ana (Fun f T \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>, M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>))"

lemma (in typed_model) Ana_invar_subst_subset:
  assumes "Ana_invar_subst M" "N \<subseteq> M"
  shows "Ana_invar_subst N"
using assms unfolding Ana_invar_subst_def by blast

lemma (in typed_model) Ana_invar_substD:
  assumes "Ana_invar_subst \<M>"
  and "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t \<M>" "Ana (Fun f T) = (K, M)"
  shows "Ana (Fun f T \<cdot> \<I>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>, M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>)"
using assms Ana_invar_subst_def by blast

end


subsubsection \<open>Preliminary Definitions\<close>
text \<open>Strands extended with "decomposition steps"\<close>
datatype (funs\<^sub>e\<^sub>s\<^sub>t\<^sub>p: 'a, vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p: 'b) extstrand_step =
  Step   "('a,'b) strand_step"
| Decomp "('a,'b) term"

context typed_model
begin

context
begin
private fun trms\<^sub>e\<^sub>s\<^sub>t\<^sub>p where
  "trms\<^sub>e\<^sub>s\<^sub>t\<^sub>p (Step x) = trms\<^sub>s\<^sub>t\<^sub>p x"
| "trms\<^sub>e\<^sub>s\<^sub>t\<^sub>p (Decomp t) = {t}"

private abbreviation trms\<^sub>e\<^sub>s\<^sub>t where "trms\<^sub>e\<^sub>s\<^sub>t S \<equiv> \<Union>(trms\<^sub>e\<^sub>s\<^sub>t\<^sub>p ` set S)"

private type_synonym ('a,'b) extstrand = "('a,'b) extstrand_step list"
private type_synonym ('a,'b) extstrands = "('a,'b) extstrand set"

private definition decomp::"('fun,'var) term \<Rightarrow> ('fun,'var) strand" where
  "decomp t \<equiv> (case (Ana t) of (K,T) \<Rightarrow> send\<langle>t\<rangle>\<^sub>s\<^sub>t#map Send K@map Receive T)"

private fun to_st where
  "to_st [] = []"
| "to_st (Step x#S) = x#(to_st S)"
| "to_st (Decomp t#S) = (decomp t)@(to_st S)"

private fun to_est where
  "to_est [] = []"
| "to_est (x#S) = Step x#to_est S"

private abbreviation "ik\<^sub>e\<^sub>s\<^sub>t A \<equiv> ik\<^sub>s\<^sub>t (to_st A)"
private abbreviation "wf\<^sub>e\<^sub>s\<^sub>t V A \<equiv> wf\<^sub>s\<^sub>t V (to_st A)"
private abbreviation "assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<equiv> assignment_rhs\<^sub>s\<^sub>t (to_st A)"
private abbreviation "vars\<^sub>e\<^sub>s\<^sub>t A \<equiv> vars\<^sub>s\<^sub>t (to_st A)"
private abbreviation "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A \<equiv> wfrestrictedvars\<^sub>s\<^sub>t (to_st A)"
private abbreviation "bvars\<^sub>e\<^sub>s\<^sub>t A \<equiv> bvars\<^sub>s\<^sub>t (to_st A)"
private abbreviation "fv\<^sub>e\<^sub>s\<^sub>t A \<equiv> fv\<^sub>s\<^sub>t (to_st A)"
private abbreviation "funs\<^sub>e\<^sub>s\<^sub>t A \<equiv> funs\<^sub>s\<^sub>t (to_st A)"

private definition wf\<^sub>s\<^sub>t\<^sub>s'::"('fun,'var) strands \<Rightarrow> ('fun,'var) extstrand \<Rightarrow> bool" where
  "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A> \<equiv> (\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>) (dual\<^sub>s\<^sub>t S)) \<and>
                 (\<forall>S \<in> \<S>. \<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}) \<and>
                 (\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t \<A> = {}) \<and>
                 (\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t (to_st \<A>) \<inter> bvars\<^sub>s\<^sub>t S = {})"

private definition wf\<^sub>s\<^sub>t\<^sub>s::"('fun,'var) strands \<Rightarrow> bool" where
  "wf\<^sub>s\<^sub>t\<^sub>s \<S> \<equiv> (\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t {} (dual\<^sub>s\<^sub>t S)) \<and> (\<forall>S \<in> \<S>. \<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {})"

private inductive well_analyzed::"('fun,'var) extstrand \<Rightarrow> bool" where
  Nil[simp]: "well_analyzed []"
| Step: "well_analyzed A \<Longrightarrow> well_analyzed (A@[Step x])"
| Decomp: "\<lbrakk>well_analyzed A; t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) - (Var ` \<V>)\<rbrakk>
    \<Longrightarrow> well_analyzed (A@[Decomp t])"

private fun subst_apply_extstrandstep (infix "\<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p" 51) where
  "subst_apply_extstrandstep (Step x) \<theta> = Step (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>)"
| "subst_apply_extstrandstep (Decomp t) \<theta> = Decomp (t \<cdot> \<theta>)"

private lemma subst_apply_extstrandstep'_simps[simp]:
  "(Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta> = Step (send\<langle>t \<cdot> \<theta>\<rangle>\<^sub>s\<^sub>t)"
  "(Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta> = Step (receive\<langle>t \<cdot> \<theta>\<rangle>\<^sub>s\<^sub>t)"
  "(Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta> = Step (\<langle>a: (t \<cdot> \<theta>) \<doteq> (t' \<cdot> \<theta>)\<rangle>\<^sub>s\<^sub>t)"
  "(Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta> = Step (\<forall>X\<langle>\<or>\<noteq>: (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>)\<rangle>\<^sub>s\<^sub>t)"
by simp_all

private lemma vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p_subst_apply_simps[simp]:
  "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>)"
  "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>)"
  "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>) \<union> fv (t' \<cdot> \<theta>)"
  "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>) = set X \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>)"
by auto

private definition subst_apply_extstrand (infix "\<cdot>\<^sub>e\<^sub>s\<^sub>t" 51) where "S \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> \<equiv> map (\<lambda>x. x \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>) S"

private abbreviation update\<^sub>s\<^sub>t::"('fun,'var) strands \<Rightarrow> ('fun,'var) strand \<Rightarrow> ('fun,'var) strands"
where
  "update\<^sub>s\<^sub>t \<S> S \<equiv> (case S of Nil \<Rightarrow> \<S> - {S} | Cons _ S' \<Rightarrow> insert S' (\<S> - {S}))"

private inductive_set decomps\<^sub>e\<^sub>s\<^sub>t::
  "('fun,'var) terms \<Rightarrow> ('fun,'var) terms \<Rightarrow> ('fun,'var) subst \<Rightarrow> ('fun,'var) extstrands"
(* \<M>: intruder knowledge
   \<N>: additional messages
*)
for \<M> and \<N> and \<I> where
  Nil: "[] \<in> decomps\<^sub>e\<^sub>s\<^sub>t \<M> \<N> \<I>"
| Decomp: "\<lbrakk>\<D> \<in> decomps\<^sub>e\<^sub>s\<^sub>t \<M> \<N> \<I>; Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<M> \<union> \<N>);
            Ana (Fun f T) = (K,M); M \<noteq> [];
            (\<M> \<union> ik\<^sub>e\<^sub>s\<^sub>t \<D>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c Fun f T \<cdot> \<I>;
            \<And>k. k \<in> set K \<Longrightarrow> (\<M> \<union> ik\<^sub>e\<^sub>s\<^sub>t \<D>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>\<rbrakk>
            \<Longrightarrow> \<D>@[Decomp (Fun f T)] \<in> decomps\<^sub>e\<^sub>s\<^sub>t \<M> \<N> \<I>"

private fun decomp_rm\<^sub>e\<^sub>s\<^sub>t::"('fun,'var) extstrand \<Rightarrow> ('fun,'var) extstrand" where
  "decomp_rm\<^sub>e\<^sub>s\<^sub>t [] = []"
| "decomp_rm\<^sub>e\<^sub>s\<^sub>t (Decomp t#S) = decomp_rm\<^sub>e\<^sub>s\<^sub>t S"
| "decomp_rm\<^sub>e\<^sub>s\<^sub>t (Step x#S) = Step x#(decomp_rm\<^sub>e\<^sub>s\<^sub>t S)"

private inductive sem\<^sub>e\<^sub>s\<^sub>t_d::"('fun,'var) terms \<Rightarrow> ('fun,'var) subst \<Rightarrow> ('fun,'var) extstrand \<Rightarrow> bool"
where
  Nil[simp]: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> []"
| Send: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> S \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t S \<union> M\<^sub>0) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I> \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (S@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
| Receive: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> S \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (S@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
| Equality: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> S \<Longrightarrow> t \<cdot> \<I> = t' \<cdot> \<I> \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (S@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)])"
| Inequality: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> S
    \<Longrightarrow> ineq_model \<I> X F
    \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (S@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)])"
| Decompose: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> S \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t S \<union> M\<^sub>0) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I> \<Longrightarrow> Ana t = (K, M)
    \<Longrightarrow> (\<And>k. k \<in> set K \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t S \<union> M\<^sub>0) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> k \<cdot> \<I>) \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (S@[Decomp t])"

private inductive sem\<^sub>e\<^sub>s\<^sub>t_c::"('fun,'var) terms \<Rightarrow> ('fun,'var) subst \<Rightarrow> ('fun,'var) extstrand \<Rightarrow> bool"
where
  Nil[simp]: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> []"
| Send: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> S \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t S \<union> M\<^sub>0) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I> \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> (S@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
| Receive: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> S \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> (S@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
| Equality: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> S \<Longrightarrow> t \<cdot> \<I> = t' \<cdot> \<I> \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> (S@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)])"
| Inequality: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> S
    \<Longrightarrow> ineq_model \<I> X F
    \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> (S@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)])"
| Decompose: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> S \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t S \<union> M\<^sub>0) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I> \<Longrightarrow> Ana t = (K, M)
    \<Longrightarrow> (\<And>k. k \<in> set K \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t S \<union> M\<^sub>0) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>) \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> (S@[Decomp t])"


subsubsection \<open>Preliminary Lemmata\<close>
private lemma wf\<^sub>s\<^sub>t\<^sub>s_wf\<^sub>s\<^sub>t\<^sub>s':
  "wf\<^sub>s\<^sub>t\<^sub>s \<S> = wf\<^sub>s\<^sub>t\<^sub>s' \<S> []"
by (simp add: wf\<^sub>s\<^sub>t\<^sub>s_def wf\<^sub>s\<^sub>t\<^sub>s'_def)

private lemma decomp_ik:
  assumes "Ana t = (K,M)"
  shows "ik\<^sub>s\<^sub>t (decomp t) = set M"
using ik_rcv_map[of _ M] ik_rcv_map'[of _ M]
by (auto simp add: decomp_def inv_def assms)

private lemma decomp_assignment_rhs_empty:
  assumes "Ana t = (K,M)"
  shows "assignment_rhs\<^sub>s\<^sub>t (decomp t) = {}"
by (auto simp add: decomp_def inv_def assms)

private lemma decomp_tfr\<^sub>s\<^sub>t\<^sub>p:
  "list_all tfr\<^sub>s\<^sub>t\<^sub>p (decomp t)"
by (auto simp add: decomp_def list_all_def)

private lemma trms\<^sub>e\<^sub>s\<^sub>t_ikI:
  "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<Longrightarrow> t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t A)"
proof (induction A rule: to_st.induct)
  case (2 x S) thus ?case by (cases x) auto
next
  case (3 t' A)
  obtain K M where Ana: "Ana t' = (K,M)" by (metis surj_pair)
  show ?case using 3 decomp_ik[OF Ana] Ana_subterm[OF Ana] by auto
qed simp

private lemma trms\<^sub>e\<^sub>s\<^sub>t_ik_assignment_rhsI:
  "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<Longrightarrow> t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t A)"
proof (induction A rule: to_st.induct)
  case (2 x S) thus ?case
  proof (cases x)
    case (Equality ac t t') thus ?thesis using 2 by (cases ac) auto
  qed auto
next
  case (3 t' A)
  obtain K M where Ana: "Ana t' = (K,M)" by (metis surj_pair)
  show ?case
    using 3 decomp_ik[OF Ana] decomp_assignment_rhs_empty[OF Ana] Ana_subterm[OF Ana]
    by auto
qed simp

private lemma trms\<^sub>e\<^sub>s\<^sub>t_ik_subtermsI:
  assumes "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A)"
  shows "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t A)"
proof -
  obtain t' where "t' \<in> ik\<^sub>e\<^sub>s\<^sub>t A" "t \<sqsubseteq> t'" using trms\<^sub>e\<^sub>s\<^sub>t_ikI assms by auto
  thus ?thesis by (meson contra_subsetD in_subterms_subset_Union trms\<^sub>e\<^sub>s\<^sub>t_ikI)
qed

private lemma trms\<^sub>e\<^sub>s\<^sub>tD:
  assumes "t \<in> trms\<^sub>e\<^sub>s\<^sub>t A"
  shows "t \<in> trms\<^sub>s\<^sub>t (to_st A)"
using assms
proof (induction A)
  case (Cons a A)
  obtain K M where Ana: "Ana t = (K,M)" by (metis surj_pair)
  hence "t \<in> trms\<^sub>s\<^sub>t (decomp t)" unfolding decomp_def by force
  thus ?case using Cons.IH Cons.prems by (cases a) auto
qed simp

private lemma subst_apply_extstrand_nil[simp]:
  "[] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = []"
by (simp add: subst_apply_extstrand_def)

private lemma subst_apply_extstrand_singleton[simp]:
  "[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = [Step (Receive (t \<cdot> \<theta>))]"
  "[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = [Step (Send (t \<cdot> \<theta>))]"
  "[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = [Step (Equality a (t \<cdot> \<theta>) (t' \<cdot> \<theta>))]"
  "[Decomp t] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = [Decomp (t \<cdot> \<theta>)]"
unfolding subst_apply_extstrand_def by auto

private lemma extstrand_subst_hom:
  "(S@S') \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = (S \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>)@(S' \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>)" "(x#S) \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = (x \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>)#(S \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>)"
unfolding subst_apply_extstrand_def by auto

private lemma decomp_vars:
  "wfrestrictedvars\<^sub>s\<^sub>t (decomp t) = fv t" "vars\<^sub>s\<^sub>t (decomp t) = fv t" "bvars\<^sub>s\<^sub>t (decomp t) = {}"
  "fv\<^sub>s\<^sub>t (decomp t) = fv t"
proof -
  obtain K M where Ana: "Ana t = (K,M)" by (metis surj_pair)
  hence "decomp t = send\<langle>t\<rangle>\<^sub>s\<^sub>t#map Send K@map Receive M"
    unfolding decomp_def by simp
  moreover have "\<Union>(set (map fv K)) = fv\<^sub>s\<^sub>e\<^sub>t (set K)" "\<Union>(set (map fv M)) = fv\<^sub>s\<^sub>e\<^sub>t (set M)" by auto
  moreover have "fv\<^sub>s\<^sub>e\<^sub>t (set K) \<subseteq> fv t" "fv\<^sub>s\<^sub>e\<^sub>t (set M) \<subseteq> fv t"
    using Ana_subterm[OF Ana(1)] Ana_keys_fv[OF Ana(1)]
    by (simp_all add: UN_least psubsetD subtermeq_vars_subset)
  ultimately show
      "wfrestrictedvars\<^sub>s\<^sub>t (decomp t) = fv t" "vars\<^sub>s\<^sub>t (decomp t) = fv t" "bvars\<^sub>s\<^sub>t (decomp t) = {}"
      "fv\<^sub>s\<^sub>t (decomp t) = fv t"
    by auto
qed

private lemma bvars\<^sub>e\<^sub>s\<^sub>t_cons: "bvars\<^sub>e\<^sub>s\<^sub>t (x#X) = bvars\<^sub>e\<^sub>s\<^sub>t [x] \<union> bvars\<^sub>e\<^sub>s\<^sub>t X"
by (cases x) auto

private lemma bvars\<^sub>e\<^sub>s\<^sub>t_append: "bvars\<^sub>e\<^sub>s\<^sub>t (A@B) = bvars\<^sub>e\<^sub>s\<^sub>t A \<union> bvars\<^sub>e\<^sub>s\<^sub>t B"
proof (induction A)
  case (Cons x A) thus ?case using bvars\<^sub>e\<^sub>s\<^sub>t_cons[of x "A@B"] bvars\<^sub>e\<^sub>s\<^sub>t_cons[of x A] by force
qed simp

private lemma fv\<^sub>e\<^sub>s\<^sub>t_cons: "fv\<^sub>e\<^sub>s\<^sub>t (x#X) = fv\<^sub>e\<^sub>s\<^sub>t [x] \<union> fv\<^sub>e\<^sub>s\<^sub>t X"
by (cases x) auto

private lemma fv\<^sub>e\<^sub>s\<^sub>t_append: "fv\<^sub>e\<^sub>s\<^sub>t (A@B) = fv\<^sub>e\<^sub>s\<^sub>t A \<union> fv\<^sub>e\<^sub>s\<^sub>t B"
proof (induction A)
  case (Cons x A) thus ?case using fv\<^sub>e\<^sub>s\<^sub>t_cons[of x "A@B"] fv\<^sub>e\<^sub>s\<^sub>t_cons[of x A] by auto
qed simp

private lemma bvars_decomp: "bvars\<^sub>e\<^sub>s\<^sub>t (A@[Decomp t]) = bvars\<^sub>e\<^sub>s\<^sub>t A" "bvars\<^sub>e\<^sub>s\<^sub>t (Decomp t#A) = bvars\<^sub>e\<^sub>s\<^sub>t A"
using bvars\<^sub>e\<^sub>s\<^sub>t_append decomp_vars(3) by fastforce+

private lemma bvars_decomp_rm: "bvars\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) = bvars\<^sub>e\<^sub>s\<^sub>t A"
using bvars_decomp by (induct A rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) simp_all+

private lemma fv_decomp_rm: "fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<subseteq> fv\<^sub>e\<^sub>s\<^sub>t A"
by (induct A rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) auto

private lemma ik_assignment_rhs_decomp_fv:
  assumes "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
  shows "fv\<^sub>e\<^sub>s\<^sub>t (A@[Decomp t]) = fv\<^sub>e\<^sub>s\<^sub>t A"
proof -
  have "fv\<^sub>e\<^sub>s\<^sub>t (A@[Decomp t]) = fv\<^sub>e\<^sub>s\<^sub>t A \<union> fv t" using fv\<^sub>e\<^sub>s\<^sub>t_append decomp_vars by simp
  moreover have "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<subseteq> fv\<^sub>e\<^sub>s\<^sub>t A" by force
  moreover have "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
    using fv_subset_subterms[OF assms(1)] by simp
  ultimately show ?thesis by blast
qed

private lemma wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_decomp_rm\<^sub>e\<^sub>s\<^sub>t_subset:
  "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<subseteq> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A"
by (induct A rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) auto+

private lemma wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_eq_wfrestrictedvars\<^sub>s\<^sub>t:
  "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A = wfrestrictedvars\<^sub>s\<^sub>t (to_st A)"
by simp

private lemma decomp_set_unfold:
  assumes "Ana t = (K, M)"
  shows "set (decomp t) = {send\<langle>t\<rangle>\<^sub>s\<^sub>t} \<union> (Send ` set K) \<union> (Receive ` set M)"
using assms unfolding decomp_def by auto

private lemma ik\<^sub>e\<^sub>s\<^sub>t_finite: "finite (ik\<^sub>e\<^sub>s\<^sub>t A)"
by (rule finite_ik\<^sub>s\<^sub>t)

private lemma assignment_rhs\<^sub>e\<^sub>s\<^sub>t_finite: "finite (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
by (rule finite_assignment_rhs\<^sub>s\<^sub>t)

private lemma to_est_append: "to_est (A@B) = to_est A@to_est B"
by (induct A rule: to_est.induct) auto

private lemma to_st_to_est_inv: "to_st (to_est A) = A"
by (induct A rule: to_est.induct) auto

private lemma to_st_append: "to_st (A@B) = (to_st A)@(to_st B)"
by (induct A rule: to_st.induct) auto

private lemma to_st_cons: "to_st (a#B) = (to_st [a])@(to_st B)"
using to_st_append[of "[a]" B] by simp

private lemma wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split:
  "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t (x#S) = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t [x] \<union> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t S"
  "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t (S@S') = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t S \<union> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t S'"
using to_st_cons[of x S] to_st_append[of S S'] by auto

private lemma ik\<^sub>e\<^sub>s\<^sub>t_append: "ik\<^sub>e\<^sub>s\<^sub>t (A@B) = ik\<^sub>e\<^sub>s\<^sub>t A \<union> ik\<^sub>e\<^sub>s\<^sub>t B"
by (metis ik_append to_st_append)

private lemma assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append:
  "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B) = assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t B"
by (metis assignment_rhs_append to_st_append)

private lemma ik\<^sub>e\<^sub>s\<^sub>t_cons: "ik\<^sub>e\<^sub>s\<^sub>t (a#A) = ik\<^sub>e\<^sub>s\<^sub>t [a] \<union> ik\<^sub>e\<^sub>s\<^sub>t A"
by (metis ik_append to_st_cons)

private lemma ik\<^sub>e\<^sub>s\<^sub>t_append_subst:
  "ik\<^sub>e\<^sub>s\<^sub>t (A@B \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>) = ik\<^sub>e\<^sub>s\<^sub>t (A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>) \<union> ik\<^sub>e\<^sub>s\<^sub>t (B \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>)"
  "ik\<^sub>e\<^sub>s\<^sub>t (A@B) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
by (metis ik\<^sub>e\<^sub>s\<^sub>t_append extstrand_subst_hom(1), simp add: image_Un to_st_append)

private lemma assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append_subst:
  "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>) = assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>) \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t (B \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>)"
  "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
by (metis assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append extstrand_subst_hom(1), use assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append in blast)

private lemma ik\<^sub>e\<^sub>s\<^sub>t_cons_subst:
  "ik\<^sub>e\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>) = ik\<^sub>e\<^sub>s\<^sub>t ([a \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>]) \<union> ik\<^sub>e\<^sub>s\<^sub>t (A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>)"
  "ik\<^sub>e\<^sub>s\<^sub>t (a#A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = (ik\<^sub>e\<^sub>s\<^sub>t [a] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
by (metis ik\<^sub>e\<^sub>s\<^sub>t_cons extstrand_subst_hom(2), metis image_Un ik\<^sub>e\<^sub>s\<^sub>t_cons)

private lemma decomp_rm\<^sub>e\<^sub>s\<^sub>t_append: "decomp_rm\<^sub>e\<^sub>s\<^sub>t (S@S') = (decomp_rm\<^sub>e\<^sub>s\<^sub>t S)@(decomp_rm\<^sub>e\<^sub>s\<^sub>t S')"
by (induct S rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) auto

private lemma decomp_rm\<^sub>e\<^sub>s\<^sub>t_single[simp]:
  "decomp_rm\<^sub>e\<^sub>s\<^sub>t [Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)] = [Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
  "decomp_rm\<^sub>e\<^sub>s\<^sub>t [Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] = [Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
  "decomp_rm\<^sub>e\<^sub>s\<^sub>t [Decomp t] = []"
by auto

private lemma decomp_rm\<^sub>e\<^sub>s\<^sub>t_ik_subset: "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t S) \<subseteq> ik\<^sub>e\<^sub>s\<^sub>t S"
proof (induction S rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct)
  case (3 x S) thus ?case by (cases x) auto
qed auto

private lemma decomps\<^sub>e\<^sub>s\<^sub>t_ik_subset: "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I> \<Longrightarrow> ik\<^sub>e\<^sub>s\<^sub>t D \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (M \<union> N)"
proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
  case (Decomp D f T K M')
  have "ik\<^sub>s\<^sub>t (decomp (Fun f T)) \<subseteq> subterms (Fun f T)"
       "ik\<^sub>s\<^sub>t (decomp (Fun f T)) = ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f T)]"
    using decomp_ik[OF Decomp.hyps(3)] Ana_subterm[OF Decomp.hyps(3)]
    by auto
  hence "ik\<^sub>s\<^sub>t (to_st [Decomp (Fun f T)]) \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (M \<union> N)"
    using in_subterms_subset_Union[OF Decomp.hyps(2)]
    by blast
  thus ?case using ik\<^sub>e\<^sub>s\<^sub>t_append[of D "[Decomp (Fun f T)]"] using Decomp.IH by auto
qed simp

private lemma decomps\<^sub>e\<^sub>s\<^sub>t_decomp_rm\<^sub>e\<^sub>s\<^sub>t_empty: "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I> \<Longrightarrow> decomp_rm\<^sub>e\<^sub>s\<^sub>t D = []"
by (induct D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct) (auto simp add: decomp_rm\<^sub>e\<^sub>s\<^sub>t_append)

private lemma decomps\<^sub>e\<^sub>s\<^sub>t_append:
  assumes "A \<in> decomps\<^sub>e\<^sub>s\<^sub>t S N \<I>" "B \<in> decomps\<^sub>e\<^sub>s\<^sub>t S N \<I>"
  shows "A@B \<in> decomps\<^sub>e\<^sub>s\<^sub>t S N \<I>"
using assms(2)
proof (induction B rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
  case Nil show ?case using assms(1) by simp
next
  case (Decomp B f X K T)
  hence "S \<union> ik\<^sub>e\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> S \<union> ik\<^sub>e\<^sub>s\<^sub>t (A@B) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using ik\<^sub>e\<^sub>s\<^sub>t_append by auto
  thus ?case
    using decomps\<^sub>e\<^sub>s\<^sub>t.Decomp[OF Decomp.IH(1) Decomp.hyps(2,3,4)]
          ideduct_synth_mono[OF Decomp.hyps(5)]
          ideduct_synth_mono[OF Decomp.hyps(6)]
    by auto
qed

private lemma decomps\<^sub>e\<^sub>s\<^sub>t_subterms:
  assumes "A' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>"
  shows "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A') \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (M \<union> N)"
using assms
proof (induction A' rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
  case (Decomp D f X K T)
  hence "Fun f X \<in> subterms\<^sub>s\<^sub>e\<^sub>t (M \<union> N)" by auto
  hence "subterms\<^sub>s\<^sub>e\<^sub>t (set X) \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (M \<union> N)"
    using in_subterms_subset_Union[of "Fun f X" "M \<union> N"] params_subterms_Union[of X f]
    by blast
  moreover have "ik\<^sub>s\<^sub>t (to_st [Decomp (Fun f X)]) = set T" using Decomp.hyps(3) decomp_ik by simp
  hence "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t (to_st [Decomp (Fun f X)])) \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (set X)"
    using Ana_fun_subterm[OF Decomp.hyps(3)] by auto
  ultimately show ?case
    using ik\<^sub>e\<^sub>s\<^sub>t_append[of D "[Decomp (Fun f X)]"] Decomp.IH
    by auto
qed simp

private lemma decomps\<^sub>e\<^sub>s\<^sub>t_assignment_rhs_empty:
  assumes "A' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>"
  shows "assignment_rhs\<^sub>e\<^sub>s\<^sub>t A' = {}"
using assms
by (induction A' rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
   (simp_all add: decomp_assignment_rhs_empty assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append)

private lemma decomps\<^sub>e\<^sub>s\<^sub>t_finite_ik_append:
  assumes "finite M" "M \<subseteq> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>"
  shows "\<exists>D \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>. ik\<^sub>e\<^sub>s\<^sub>t D = (\<Union>m \<in> M. ik\<^sub>e\<^sub>s\<^sub>t m)"
using assms
proof (induction M rule: finite_induct)
  case empty
  moreover have "[] \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>" "ik\<^sub>s\<^sub>t (to_st []) = {}" using decomps\<^sub>e\<^sub>s\<^sub>t.Nil by auto
  ultimately show ?case by blast
next
  case (insert m M)
  then obtain D where "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>" "ik\<^sub>e\<^sub>s\<^sub>t D = (\<Union>m\<in>M. ik\<^sub>s\<^sub>t (to_st m))" by moura
  moreover have "m \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>" using insert.prems(1) by blast
  ultimately show ?case using decomps\<^sub>e\<^sub>s\<^sub>t_append[of D A N \<I> m] ik\<^sub>e\<^sub>s\<^sub>t_append[of D m] by blast
qed

private lemma decomp_snd_exists[simp]: "\<exists>D. decomp t = send\<langle>t\<rangle>\<^sub>s\<^sub>t#D"
by (metis (mono_tags, lifting) decomp_def prod.case surj_pair)

private lemma decomp_nonnil[simp]: "decomp t \<noteq> []"
using decomp_snd_exists[of t] by fastforce

private lemma to_st_nil_inv[dest]: "to_st A = [] \<Longrightarrow> A = []"
by (induct A rule: to_st.induct) auto

private lemma well_analyzedD:
  assumes "well_analyzed A" "Decomp t \<in> set A"
  shows "\<exists>f T. t = Fun f T"
using assms
proof (induction A rule: well_analyzed.induct)
  case (Decomp A t')
  hence "\<exists>f T. t' = Fun f T" by (cases t') auto
  moreover have "Decomp t \<in> set A \<or> t = t'" using Decomp by auto
  ultimately show ?case using Decomp.IH by auto
qed auto

private lemma well_analyzed_inv:
  assumes "well_analyzed (A@[Decomp t])"
  shows "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) - (Var ` \<V>)"
using assms well_analyzed.cases[of "A@[Decomp t]"] by fastforce

private lemma well_analyzed_split_left_single: "well_analyzed (A@[a]) \<Longrightarrow> well_analyzed A"
by (induction "A@[a]" rule: well_analyzed.induct) auto

private lemma well_analyzed_split_left: "well_analyzed (A@B) \<Longrightarrow> well_analyzed A"
proof (induction B rule: List.rev_induct)
  case (snoc b B) thus ?case using well_analyzed_split_left_single[of "A@B" b] by simp
qed simp

private lemma well_analyzed_append:
  assumes "well_analyzed A" "well_analyzed B"
  shows "well_analyzed (A@B)"
using assms(2,1)
proof (induction B rule: well_analyzed.induct)
  case (Step B x) show ?case using well_analyzed.Step[OF Step.IH[OF Step.prems]] by simp
next
  case (Decomp B t) thus ?case
    using well_analyzed.Decomp[OF Decomp.IH[OF Decomp.prems]] ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append
    by auto
qed simp_all

private lemma well_analyzed_singleton:
  "well_analyzed [Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]" "well_analyzed [Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
  "well_analyzed [Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]" "well_analyzed [Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"
  "\<not>well_analyzed [Decomp t]"
proof -
  show "well_analyzed [Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]" "well_analyzed [Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
       "well_analyzed [Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]" "well_analyzed [Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"
    using well_analyzed.Step[OF well_analyzed.Nil]
    by simp_all

  show "\<not>well_analyzed [Decomp t]" using well_analyzed.cases[of "[Decomp t]"] by auto
qed

private lemma well_analyzed_decomp_rm\<^sub>e\<^sub>s\<^sub>t_fv: "well_analyzed A \<Longrightarrow> fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) = fv\<^sub>e\<^sub>s\<^sub>t A"
proof
  assume "well_analyzed A" thus "fv\<^sub>e\<^sub>s\<^sub>t A \<subseteq> fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A)"
  proof (induction A rule: well_analyzed.induct)
    case Decomp thus ?case using ik_assignment_rhs_decomp_fv decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto
  next
    case (Step A x)
    have "fv\<^sub>e\<^sub>s\<^sub>t (A@[Step x]) = fv\<^sub>e\<^sub>s\<^sub>t A \<union> fv\<^sub>s\<^sub>t\<^sub>p x"
         "fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t (A@[Step x])) = fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> fv\<^sub>s\<^sub>t\<^sub>p x"
      using fv\<^sub>e\<^sub>s\<^sub>t_append decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto
    thus ?case using Step by auto
  qed simp
qed (rule fv_decomp_rm)

private lemma sem\<^sub>e\<^sub>s\<^sub>t_d_split_left: assumes "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (\<A>@\<A>')" shows "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> \<A>"
using assms sem\<^sub>e\<^sub>s\<^sub>t_d.cases by (induction \<A>' rule: List.rev_induct) fastforce+

private lemma sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> \<A> = \<lbrakk>M\<^sub>0; to_st \<A>\<rbrakk>\<^sub>d' \<I>"
proof
  show "\<lbrakk>M\<^sub>0; to_st \<A>\<rbrakk>\<^sub>d' \<I> \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> \<A>"
  proof (induction \<A> arbitrary: M\<^sub>0 rule: List.rev_induct)
    case Nil show ?case using to_st_nil_inv by simp
  next
    case (snoc a \<A>)
    hence IH: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> \<A>" and *: "\<lbrakk>ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0; to_st [a]\<rbrakk>\<^sub>d' \<I>"
      using to_st_append by (auto simp add: sup.commute)
    thus ?case using snoc
    proof (cases a)
      case (Step b) thus ?thesis
      proof (cases b)
        case (Send t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_d.Send[OF IH] * Step by auto
      next
        case (Receive t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_d.Receive[OF IH] Step by auto
      next
        case (Equality a t t') thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_d.Equality[OF IH] * Step by auto
      next
        case (Inequality X F) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_d.Inequality[OF IH] * Step by auto
      qed
    next
      case (Decomp t)
      obtain K M where Ana: "Ana t = (K,M)" by moura
      have "to_st [a] = decomp t" using Decomp by auto
      hence "to_st [a] = send\<langle>t\<rangle>\<^sub>s\<^sub>t#map Send K@map Receive M"
        using Ana unfolding decomp_def by auto
      hence **: "ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>" and "\<lbrakk>ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0; map Send K\<rbrakk>\<^sub>d' \<I>"
        using * by auto
      hence "\<And>k. k \<in> set K \<Longrightarrow> ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> k \<cdot> \<I>"
        using *
        by (metis (full_types) strand_sem_d.simps(2) strand_sem_eq_defs(2) strand_sem_Send_split(2))
      thus ?thesis using Decomp sem\<^sub>e\<^sub>s\<^sub>t_d.Decompose[OF IH ** Ana] by metis
    qed
  qed

  show "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> \<A> \<Longrightarrow> \<lbrakk>M\<^sub>0; to_st \<A>\<rbrakk>\<^sub>d' \<I>"
  proof (induction rule: sem\<^sub>e\<^sub>s\<^sub>t_d.induct)
    case Nil thus ?case by simp
  next
    case (Send M\<^sub>0 \<I> \<A> t) thus ?case
      using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[send\<langle>t\<rangle>\<^sub>s\<^sub>t]"]
            to_st_append[of \<A> "[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]"]
      by (simp add: sup.commute)
  next
    case (Receive M\<^sub>0 \<I> \<A> t) thus ?case
      using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[receive\<langle>t\<rangle>\<^sub>s\<^sub>t]"]
            to_st_append[of \<A> "[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"]
      by (simp add: sup.commute)
  next
    case (Equality M\<^sub>0 \<I> \<A> t t' a) thus ?case
      using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t]"]
            to_st_append[of \<A> "[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]"]
      by (simp add: sup.commute)
  next
    case (Inequality M\<^sub>0 \<I> \<A> X F) thus ?case
      using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t]"]
            to_st_append[of \<A> "[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"]
      by (simp add: sup.commute)
  next
    case (Decompose M\<^sub>0 \<I> \<A> t K M)
    have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); decomp t\<rbrakk>\<^sub>d' \<I>"
    proof -
      have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); [send\<langle>t\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>d' \<I>"
        using Decompose.hyps(2) by (auto simp add: sup.commute)
      moreover have "\<And>k. k \<in> set K \<Longrightarrow> M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> k \<cdot> \<I>"
        using Decompose by (metis sup.commute)
      hence "\<And>k. k \<in> set K \<Longrightarrow> \<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); [Send k]\<rbrakk>\<^sub>d' \<I>" by auto
      hence "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); map Send K\<rbrakk>\<^sub>d' \<I>"
        using strand_sem_Send_map(2)[of K, of "M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" \<I>] strand_sem_eq_defs(2)
        by auto
      moreover have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); map Receive M\<rbrakk>\<^sub>d' \<I>"
        by (metis strand_sem_Receive_map(2) strand_sem_eq_defs(2))
      ultimately have
          "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); send\<langle>t\<rangle>\<^sub>s\<^sub>t#map Send K@map Receive M\<rbrakk>\<^sub>d' \<I>"
        by auto
      thus ?thesis using Decompose.hyps(3) unfolding decomp_def by auto
    qed
    hence "\<lbrakk>M\<^sub>0; to_st \<A>@decomp t\<rbrakk>\<^sub>d' \<I>"
      using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "decomp t"] Decompose.IH
      by simp
    thus ?case using to_st_append[of \<A> "[Decomp t]"] by simp
  qed
qed

private lemma sem\<^sub>e\<^sub>s\<^sub>t_c_eq_sem_st: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> \<A> = \<lbrakk>M\<^sub>0; to_st \<A>\<rbrakk>\<^sub>c' \<I>"
proof
  show "\<lbrakk>M\<^sub>0; to_st \<A>\<rbrakk>\<^sub>c' \<I> \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> \<A>"
  proof (induction \<A> arbitrary: M\<^sub>0 rule: List.rev_induct)
    case Nil show ?case using to_st_nil_inv by simp
  next
    case (snoc a \<A>)
    hence IH: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> \<A>" and *: "\<lbrakk>ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0; to_st [a]\<rbrakk>\<^sub>c' \<I>"
      using to_st_append
      by (auto simp add: sup.commute)
    thus ?case using snoc
    proof (cases a)
      case (Step b) thus ?thesis
      proof (cases b)
        case (Send t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_c.Send[OF IH] * Step by auto
      next
        case (Receive t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_c.Receive[OF IH] Step by auto
      next
        case (Equality t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_c.Equality[OF IH] * Step by auto
      next
        case (Inequality t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_c.Inequality[OF IH] * Step by auto
      qed
    next
      case (Decomp t)
      obtain K M where Ana: "Ana t = (K,M)" by moura
      have "to_st [a] = decomp t" using Decomp by auto
      hence "to_st [a] = send\<langle>t\<rangle>\<^sub>s\<^sub>t#map Send K@map Receive M"
        using Ana unfolding decomp_def by auto
      hence **: "ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>" and "\<lbrakk>ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0; map Send K\<rbrakk>\<^sub>c' \<I>"
        using * by auto
      hence "\<And>k. k \<in> set K \<Longrightarrow> ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>"
        using * strand_sem_Send_split(1) strand_sem_eq_defs(1)
        by auto
      thus ?thesis using Decomp sem\<^sub>e\<^sub>s\<^sub>t_c.Decompose[OF IH ** Ana] by metis
    qed
  qed

  show "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> \<A> \<Longrightarrow> \<lbrakk>M\<^sub>0; to_st \<A>\<rbrakk>\<^sub>c' \<I>"
  proof (induction rule: sem\<^sub>e\<^sub>s\<^sub>t_c.induct)
    case Nil thus ?case by simp
  next
    case (Send M\<^sub>0 \<I> \<A> t) thus ?case
      using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[send\<langle>t\<rangle>\<^sub>s\<^sub>t]"]
            to_st_append[of \<A> "[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]"]
      by (simp add: sup.commute)
  next
    case (Receive M\<^sub>0 \<I> \<A> t) thus ?case
      using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[receive\<langle>t\<rangle>\<^sub>s\<^sub>t]"]
            to_st_append[of \<A> "[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"]
      by (simp add: sup.commute)
  next
    case (Equality M\<^sub>0 \<I> \<A> t t' a) thus ?case
      using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t]"]
            to_st_append[of \<A> "[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]"]
      by (simp add: sup.commute)
  next
    case (Inequality M\<^sub>0 \<I> \<A> X F) thus ?case
      using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t]"]
            to_st_append[of \<A> "[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"]
      by (auto simp add: sup.commute)
  next
    case (Decompose M\<^sub>0 \<I> \<A> t K M)
    have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); decomp t\<rbrakk>\<^sub>c' \<I>"
    proof -
      have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); [send\<langle>t\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>c' \<I>"
        using Decompose.hyps(2) by (auto simp add: sup.commute)
      moreover have "\<And>k. k \<in> set K \<Longrightarrow> M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>"
        using Decompose by (metis sup.commute)
      hence "\<And>k. k \<in> set K \<Longrightarrow> \<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); [Send k]\<rbrakk>\<^sub>c' \<I>" by auto
      hence "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); map Send K\<rbrakk>\<^sub>c' \<I>"
        using strand_sem_Send_map(1)[of K, of "M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" \<I>]
              strand_sem_eq_defs(1)
        by auto
      moreover have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); map Receive M\<rbrakk>\<^sub>c' \<I>"
        by (metis strand_sem_Receive_map(1) strand_sem_eq_defs(1))
      ultimately have
          "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); send\<langle>t\<rangle>\<^sub>s\<^sub>t#map Send K@map Receive M\<rbrakk>\<^sub>c' \<I>"
        by auto
      thus ?thesis using Decompose.hyps(3) unfolding decomp_def by auto
    qed
    hence "\<lbrakk>M\<^sub>0; to_st \<A>@decomp t\<rbrakk>\<^sub>c' \<I>"
      using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "decomp t"] Decompose.IH
      by simp
    thus ?case using to_st_append[of \<A> "[Decomp t]"] by simp
  qed
qed

private lemma sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct_aux:
  assumes "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> A" "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "t \<notin> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
  shows "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t"
using assms
proof (induction M\<^sub>0 \<I> A arbitrary: t rule: sem\<^sub>e\<^sub>s\<^sub>t_c.induct)
  case (Send M\<^sub>0 \<I> A t') thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto
next
  case (Receive M\<^sub>0 \<I> A t')
  hence "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "t \<notin> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
    using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto
  hence IH: "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t" using Receive.IH by auto
  show ?case using ideduct_mono[OF IH] decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto
next
  case (Equality M\<^sub>0 \<I> A t') thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto
next
  case (Inequality M\<^sub>0 \<I> A t') thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto
next
  case (Decompose M\<^sub>0 \<I> A t' K M t)
  have *: "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t' \<cdot> \<I>" using Decompose.hyps(2)
  proof (induction rule: intruder_synth_induct)
    case (AxiomC t'')
    moreover {
      assume "t'' \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "t'' \<notin> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
      hence ?case using Decompose.IH by auto
    }
    ultimately show ?case by force
  qed simp

  { fix k assume "k \<in> set K"
    hence "ik\<^sub>e\<^sub>s\<^sub>t A \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>" using Decompose.hyps by auto
    hence "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> k \<cdot> \<I>"
    proof (induction rule: intruder_synth_induct)
      case (AxiomC t'')
      moreover {
        assume "t'' \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "t'' \<notin> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
        hence ?case using Decompose.IH by auto
      }
      ultimately show ?case by force
    qed simp
  }
  hence **: "\<And>k. k \<in> set (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>) \<Longrightarrow> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> k" by auto

  show ?case
  proof (cases "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>")
    case True thus ?thesis using Decompose.IH Decompose.prems(2) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto
  next
    case False
    hence "t \<in> ik\<^sub>s\<^sub>t (decomp t') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using Decompose.prems(1) ik\<^sub>e\<^sub>s\<^sub>t_append by auto
    hence ***: "t \<in> set (M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>)" using Decompose.hyps(3) decomp_ik by auto
    hence "M \<noteq> []" by auto
    hence ****: "Ana (t' \<cdot> \<I>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>, M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>)" using Ana_subst[OF Decompose.hyps(3)] by auto

    have "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t" by (rule intruder_deduct.Decompose[OF * **** ** ***])
    thus ?thesis using ideduct_mono decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto
  qed
qed simp

private lemma sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct:
  assumes "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> A" "ik\<^sub>e\<^sub>s\<^sub>t A \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t"
  shows "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t"
using assms(2)
proof (induction t rule: intruder_synth_induct)
  case (AxiomC t)
  hence "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<or> t \<in> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by auto
  moreover {
    assume "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "t \<in> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
    hence ?case using ideduct_mono[OF intruder_deduct.Axiom] by auto
  }
  moreover {
    assume "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "t \<notin> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
    hence ?case using sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct_aux[OF assms(1)] by auto
  }
  ultimately show ?case by auto
qed simp

private lemma sem\<^sub>e\<^sub>s\<^sub>t_d_decomp_rm\<^sub>e\<^sub>s\<^sub>t_if_sem\<^sub>e\<^sub>s\<^sub>t_c: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> A \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (decomp_rm\<^sub>e\<^sub>s\<^sub>t A)"
proof (induction M\<^sub>0 \<I> A rule: sem\<^sub>e\<^sub>s\<^sub>t_c.induct)
  case (Send M\<^sub>0 \<I> A t)
  thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append sem\<^sub>e\<^sub>s\<^sub>t_d.Send[OF Send.IH] sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct by auto
next
  case (Receive t) thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append sem\<^sub>e\<^sub>s\<^sub>t_d.Receive by auto
next
  case (Equality M\<^sub>0 \<I> A t)
  thus ?case
    using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append sem\<^sub>e\<^sub>s\<^sub>t_d.Equality[OF Equality.IH] sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct
    by auto
next
  case (Inequality M\<^sub>0 \<I> A t)
  thus ?case
    using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append sem\<^sub>e\<^sub>s\<^sub>t_d.Inequality[OF Inequality.IH] sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct
    by auto
next
  case Decompose thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto
qed auto

private lemma sem\<^sub>e\<^sub>s\<^sub>t_c_decomps\<^sub>e\<^sub>s\<^sub>t_append:
  assumes "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> A" "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>) \<I>"
  shows "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> (A@D)"
using assms(2,1)
proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
  case (Decomp D f T K M)
  hence *: "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> (A @ D)" "ik\<^sub>e\<^sub>s\<^sub>t (A@D) \<union> {} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c Fun f T \<cdot> \<I>"
           "\<And>k. k \<in> set K \<Longrightarrow> ik\<^sub>e\<^sub>s\<^sub>t (A @ D) \<union> {} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>"
    using ik\<^sub>e\<^sub>s\<^sub>t_append by auto
  show ?case using sem\<^sub>e\<^sub>s\<^sub>t_c.Decompose[OF *(1,2) Decomp.hyps(3) *(3)] by simp
qed auto

private lemma decomps\<^sub>e\<^sub>s\<^sub>t_preserves_wf:
  assumes "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<I>" "wf\<^sub>e\<^sub>s\<^sub>t V A"
  shows "wf\<^sub>e\<^sub>s\<^sub>t V (A@D)"
using assms
proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
  case (Decomp D f T K M)
  have "wfrestrictedvars\<^sub>s\<^sub>t (decomp (Fun f T)) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
    using decomp_vars fv_subset_subterms[OF Decomp.hyps(2)] by fast
  hence "wfrestrictedvars\<^sub>s\<^sub>t (decomp (Fun f T)) \<subseteq> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A"
    using ik\<^sub>s\<^sub>t_assignment_rhs\<^sub>s\<^sub>t_wfrestrictedvars_subset[of "to_st A"] by blast
  hence "wfrestrictedvars\<^sub>s\<^sub>t (decomp (Fun f T)) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (to_st (A@D)) \<union> V"
    using to_st_append[of A D] strand_vars_split(2)[of "to_st A" "to_st D"]
    by (metis le_supI1)
  thus ?case
    using wf_append_suffix[OF Decomp.IH[OF Decomp.prems], of "decomp (Fun f T)"]
          to_st_append[of "A@D" "[Decomp (Fun f T)]"]
    by auto
qed auto

private lemma decomps\<^sub>e\<^sub>s\<^sub>t_preserves_model_c:
  assumes "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<I>" "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> A"
  shows "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> (A@D)"
using assms
proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
  case (Decomp D f T K M) show ?case
    using sem\<^sub>e\<^sub>s\<^sub>t_c.Decompose[OF Decomp.IH[OF Decomp.prems] _ Decomp.hyps(3)]
          Decomp.hyps(5,6) ideduct_synth_mono ik\<^sub>e\<^sub>s\<^sub>t_append
    by (metis (mono_tags, lifting) List.append_assoc image_Un sup_ge1)
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 wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_nil: assumes "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \<S> []) \<A>"
using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto

private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_snd:
  assumes "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" "send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
  shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S)) (\<A>@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
proof (intro conjI)
  let ?S = "send\<langle>t\<rangle>\<^sub>s\<^sub>t#S"
  let ?A = "\<A>@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"

  have \<S>: "\<And>S'. S' \<in> update\<^sub>s\<^sub>t \<S> ?S \<Longrightarrow> S' = S \<or> S' \<in> \<S>" by auto

  have 1: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>) (dual\<^sub>s\<^sub>t S)" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto
  moreover have 2: "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A> \<union> fv t"
    using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2) by (auto simp add: Un_assoc)
  ultimately have 3: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis wf_vars_mono)

  have 4: "\<forall>S \<in> \<S>. \<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by simp

  have "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" using 1 2 3 assms(2) by auto
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis 3 \<S>)

  have "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {}"
       "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}"
       "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t S = {}"
    using 4 assms(2) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by force+
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. \<forall>S' \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" by (metis 4 \<S>)

  have "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>s\<^sub>t S' = {}" "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t ?S = {}"
    using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by metis+
  hence 5: "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \<A> \<union> fv t" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = bvars\<^sub>e\<^sub>s\<^sub>t \<A>" "\<forall>S' \<in> \<S>. fv t \<inter> bvars\<^sub>s\<^sub>t S' = {}"
    using to_st_append by fastforce+

  have *: "\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}"
    using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
  hence "fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using assms(2) by metis
  hence "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by auto
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by (metis * \<S>)

  have **: "\<forall>S \<in> \<S>. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}"
    using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
  hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t ?S = {}" using assms(2) by metis
  hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by fastforce
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by (metis ** \<S>)
qed

private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_rcv:
  assumes "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" "receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
  shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S)) (\<A>@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
proof (intro conjI)
  let ?S = "receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S"
  let ?A = "\<A>@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]"

  have \<S>: "\<And>S'. S' \<in> update\<^sub>s\<^sub>t \<S> ?S \<Longrightarrow> S' = S \<or> S' \<in> \<S>" by auto

  have 1: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>) (dual\<^sub>s\<^sub>t S)" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto
  moreover have 2: "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A> \<union> fv t"
    using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2) by (auto simp add: Un_assoc)
  ultimately have 3: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis wf_vars_mono)

  have 4: "\<forall>S \<in> \<S>. \<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by simp

  have "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" using 1 2 3 assms(2) by auto
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis 3 \<S>)

  have "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {}"
       "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}"
       "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t S = {}"
    using 4 assms(2) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by force+
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. \<forall>S' \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" by (metis 4 \<S>)

  have "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>s\<^sub>t S' = {}" "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t ?S = {}"
    using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by metis+
  hence 5: "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \<A> \<union> fv t" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = bvars\<^sub>e\<^sub>s\<^sub>t \<A>" "\<forall>S' \<in> \<S>. fv t \<inter> bvars\<^sub>s\<^sub>t S' = {}"
    using to_st_append by fastforce+

  have *: "\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}"
    using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
  hence "fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using assms(2) by metis
  hence "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by auto
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by (metis * \<S>)

  have **: "\<forall>S \<in> \<S>. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}"
    using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
  hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t ?S = {}" using assms(2) by metis
  hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by fastforce
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by (metis ** \<S>)
qed

private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_eq:
  assumes "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" "\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
  shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S)) (\<A>@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)])"
unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
proof (intro conjI)
  let ?S = "\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S"
  let ?A = "\<A>@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]"

  have \<S>: "\<And>S'. S' \<in> update\<^sub>s\<^sub>t \<S> ?S \<Longrightarrow> S' = S \<or> S' \<in> \<S>" by auto

  have 1: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>) (dual\<^sub>s\<^sub>t S)" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto
  moreover have 2:
      "a = Assign \<Longrightarrow> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A> \<union> fv t \<union> fv t'"
      "a = Check \<Longrightarrow> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>"
    using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2) by (auto simp add: Un_assoc)
  ultimately have 3: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)"
    by (cases a) (metis wf_vars_mono, metis)

  have 4: "\<forall>S \<in> \<S>. \<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by simp

  have "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" using 1 2 3 assms(2) by (cases a) auto
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis 3 \<S>)

  have "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {}"
       "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}"
       "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t S = {}"
    using 4 assms(2) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by force+
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. \<forall>S' \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" by (metis 4 \<S>)

  have "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>s\<^sub>t S' = {}" "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t ?S = {}"
    using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by metis+
  hence 5: "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \<A> \<union> fv t \<union> fv t'" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = bvars\<^sub>e\<^sub>s\<^sub>t \<A>"
           "\<forall>S' \<in> \<S>. fv t \<inter> bvars\<^sub>s\<^sub>t S' = {}" "\<forall>S' \<in> \<S>. fv t' \<inter> bvars\<^sub>s\<^sub>t S' = {}"
    using to_st_append by fastforce+

  have *: "\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}"
    using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
  hence "fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using assms(2) by metis
  hence "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by auto
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by (metis * \<S>)

  have **: "\<forall>S \<in> \<S>. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}"
    using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
  hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t ?S = {}" using assms(2) by metis
  hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by fastforce
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by (metis ** \<S>)
qed

private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_ineq:
  assumes "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" "\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
  shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S)) (\<A>@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)])"
unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
proof (intro conjI)
  let ?S = "\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S"
  let ?A = "\<A>@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"

  have \<S>: "\<And>S'. S' \<in> update\<^sub>s\<^sub>t \<S> ?S \<Longrightarrow> S' = S \<or> S' \<in> \<S>" by auto

  have 1: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>) (dual\<^sub>s\<^sub>t S)" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto
  moreover have 2: "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>"
    using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2) by (auto simp add: Un_assoc)
  ultimately have 3: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by metis

  have 4: "\<forall>S \<in> \<S>. \<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by simp

  have "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" using 1 2 3 assms(2) by auto
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis 3 \<S>)

  have "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {}"
       "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}"
       "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t S = {}"
    using 4 assms(2) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by force+
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. \<forall>S' \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" by (metis 4 \<S>)

  have "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>s\<^sub>t S' = {}" "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t ?S = {}"
    using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by metis+
  moreover have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<subseteq> fv\<^sub>s\<^sub>t (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t # S)" by auto
  ultimately have 5:
      "\<forall>S' \<in> \<S>. (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X) \<inter> bvars\<^sub>s\<^sub>t S' = {}"
      "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \<A> \<union> (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X)" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = set X \<union> bvars\<^sub>e\<^sub>s\<^sub>t \<A>"
      "\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> set X = {}"
    using to_st_append
    by (blast, force, force, force)

  have *: "\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using 5(3,4) assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by blast
  hence "fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using assms(2) by metis
  hence "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by auto
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by (metis * \<S>)

  have **: "\<forall>S \<in> \<S>. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}"
    using 5(1,2) assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
  hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t ?S = {}" using assms(2) by metis
  hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by auto
  thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by (metis ** \<S>)
qed

private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq:
  assumes "x#S \<in> \<S>"
  shows "\<Union>(trms\<^sub>s\<^sub>t ` update\<^sub>s\<^sub>t \<S> (x#S)) \<union> trms\<^sub>s\<^sub>t\<^sub>p x = \<Union>(trms\<^sub>s\<^sub>t ` \<S>)" (is "?A = ?B")
proof
  show "?B \<subseteq> ?A"
  proof
    have "trms\<^sub>s\<^sub>t\<^sub>p x \<subseteq> trms\<^sub>s\<^sub>t (x#S)" by auto
    hence "\<And>t'. t' \<in> ?B \<Longrightarrow> t' \<in> trms\<^sub>s\<^sub>t\<^sub>p x \<Longrightarrow> t' \<in> ?A" by simp
    moreover {
      fix t' assume t': "t' \<in> ?B" "t' \<notin> trms\<^sub>s\<^sub>t\<^sub>p x"
      then obtain S' where S': "t' \<in> trms\<^sub>s\<^sub>t S'" "S' \<in> \<S>" by auto
      hence "S' = x#S \<or> S' \<in> update\<^sub>s\<^sub>t \<S> (x#S)" by auto
      moreover {
        assume "S' = x#S"
        hence "t' \<in> trms\<^sub>s\<^sub>t S" using S' t' by simp
        hence "t' \<in> ?A" by auto
      }
      ultimately have "t' \<in> ?A" using t' S' by auto
    }
    ultimately show "\<And>t'. t' \<in> ?B \<Longrightarrow> t' \<in> ?A" by metis
  qed

  show "?A \<subseteq> ?B"
  proof
    have "\<And>t'. t' \<in> ?A \<Longrightarrow> t' \<in> trms\<^sub>s\<^sub>t\<^sub>p x \<Longrightarrow> trms\<^sub>s\<^sub>t\<^sub>p x \<subseteq> ?B"
      using assms by force+
    moreover {
      fix t' assume t': "t' \<in> ?A" "t' \<notin> trms\<^sub>s\<^sub>t\<^sub>p x"
      then obtain S' where "t' \<in> trms\<^sub>s\<^sub>t S'" "S' \<in> update\<^sub>s\<^sub>t \<S> (x#S)" by auto
      hence "S' = S \<or> S' \<in> \<S>" by auto
      moreover have "trms\<^sub>s\<^sub>t S \<subseteq> ?B" using assms trms\<^sub>s\<^sub>t_cons[of x S] by blast
      ultimately have "t' \<in> ?B" using t' by fastforce
    }
    ultimately show "\<And>t'. t' \<in> ?A \<Longrightarrow> t' \<in> ?B" by blast
  qed
qed

private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_snd:
  assumes "send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>" "\<S>' = update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S)" "\<A>' = \<A>@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
  shows "(\<Union>(trms\<^sub>s\<^sub>t ` \<S>)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>) = (\<Union>(trms\<^sub>s\<^sub>t ` \<S>')) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>')"
proof -
  have "(trms\<^sub>e\<^sub>s\<^sub>t \<A>') = (trms\<^sub>e\<^sub>s\<^sub>t \<A>) \<union> {t}" "\<Union>(trms\<^sub>s\<^sub>t ` \<S>') \<union> {t} = \<Union>(trms\<^sub>s\<^sub>t ` \<S>)"
    using to_st_append trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq[OF assms(1)] assms(2,3) by auto
  thus ?thesis
    by (metis (no_types, lifting) Un_insert_left Un_insert_right sup_bot.right_neutral)
qed

private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_rcv:
  assumes "receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>" "\<S>' = update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S)" "\<A>' = \<A>@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
  shows "(\<Union>(trms\<^sub>s\<^sub>t ` \<S>)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>) = (\<Union>(trms\<^sub>s\<^sub>t ` \<S>')) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>')"
proof -
  have "(trms\<^sub>e\<^sub>s\<^sub>t \<A>') = (trms\<^sub>e\<^sub>s\<^sub>t \<A>) \<union> {t}" "\<Union>(trms\<^sub>s\<^sub>t ` \<S>') \<union> {t} = \<Union>(trms\<^sub>s\<^sub>t ` \<S>)"
    using to_st_append trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq[OF assms(1)] assms(2,3) by auto
  thus ?thesis
    by (metis (no_types, lifting) Un_insert_left Un_insert_right sup_bot.right_neutral)
qed

private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_eq:
  assumes "\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>" "\<S>' = update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S)" "\<A>' = \<A>@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]"
  shows "(\<Union>(trms\<^sub>s\<^sub>t ` \<S>)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>) = (\<Union>(trms\<^sub>s\<^sub>t ` \<S>')) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>')"
proof -
  have "(trms\<^sub>e\<^sub>s\<^sub>t \<A>') = (trms\<^sub>e\<^sub>s\<^sub>t \<A>) \<union> {t,t'}" "\<Union>(trms\<^sub>s\<^sub>t ` \<S>') \<union> {t,t'} = \<Union>(trms\<^sub>s\<^sub>t ` \<S>)"
    using to_st_append trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq[OF assms(1)] assms(2,3) by auto
  thus ?thesis
    by (metis (no_types, lifting) Un_insert_left Un_insert_right sup_bot.right_neutral)
qed

private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_ineq:
  assumes "\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>" "\<S>' = update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S)" "\<A>' = \<A>@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"
  shows "(\<Union>(trms\<^sub>s\<^sub>t ` \<S>)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>) = (\<Union>(trms\<^sub>s\<^sub>t ` \<S>')) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>')"
proof -
  have "(trms\<^sub>e\<^sub>s\<^sub>t \<A>') = (trms\<^sub>e\<^sub>s\<^sub>t \<A>) \<union> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" "\<Union>(trms\<^sub>s\<^sub>t ` \<S>') \<union> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = \<Union>(trms\<^sub>s\<^sub>t ` \<S>)"
    using to_st_append trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq[OF assms(1)] assms(2,3) by auto
  thus ?thesis by (simp add: Un_commute sup_left_commute)
qed

private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset:
  assumes "x#S \<in> \<S>"
  shows "\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` (update\<^sub>s\<^sub>t \<S> (x#S))) \<subseteq> \<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)" (is ?A)
        "\<Union>(assignment_rhs\<^sub>s\<^sub>t ` (update\<^sub>s\<^sub>t \<S> (x#S))) \<subseteq> \<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)" (is ?B)
proof -
  { fix t assume "t \<in> \<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` (update\<^sub>s\<^sub>t \<S> (x#S)))"
    then obtain S' where S': "S' \<in> update\<^sub>s\<^sub>t \<S> (x#S)" "t \<in> ik\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t S')" by auto

    have *: "ik\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t S) \<subseteq> ik\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t (x#S))"
      using ik_append[of "dual\<^sub>s\<^sub>t [x]" "dual\<^sub>s\<^sub>t S"] dual\<^sub>s\<^sub>t_append[of "[x]" S]
      by auto

    hence "t \<in> \<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)"
    proof (cases "S' = S")
      case True thus ?thesis using * assms S' by auto
    next
      case False thus ?thesis using S' by auto
    qed
  }
  moreover
  { fix t assume "t \<in> \<Union>(assignment_rhs\<^sub>s\<^sub>t ` (update\<^sub>s\<^sub>t \<S> (x#S)))"
    then obtain S' where S': "S' \<in> update\<^sub>s\<^sub>t \<S> (x#S)" "t \<in> assignment_rhs\<^sub>s\<^sub>t S'" by auto

    have "assignment_rhs\<^sub>s\<^sub>t S \<subseteq> assignment_rhs\<^sub>s\<^sub>t (x#S)"
      using assignment_rhs_append[of "[x]" S] by simp
    hence "t \<in> \<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)"
      using assms S' by (cases "S' = S") auto
  }
  ultimately show ?A ?B by (metis subsetI)+
qed

private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_snd:
  assumes "send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
          "\<S>' = update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S)"
          "\<A>' = \<A>@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
  shows "(\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
         (\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?A)
        "(\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
         (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?B)
proof -
  { fix t' assume t'_in: "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>')"
    hence "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>) \<union> {t}" using assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto
    moreover have "t \<in> \<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)" using assms(1) by force
    ultimately have "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)"
      using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
  }
  moreover
  { fix t' assume t'_in: "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>')"
    hence "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
      using assms assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append by auto
    hence "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
      using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
  }
  ultimately show ?A ?B by (metis subsetI)+
qed

private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_rcv:
  assumes "receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
          "\<S>' = update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S)"
          "\<A>' = \<A>@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
  shows "(\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
         (\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?A)
        "(\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
         (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?B)
proof -
  { fix t' assume t'_in: "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>')"
    hence "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" using assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto
    hence "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)"
      using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
  }
  moreover
  { fix t' assume t'_in: "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>')"
    hence "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
      using assms assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append by auto
    hence "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
      using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
  }
  ultimately show ?A ?B by (metis subsetI)+
qed

private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_eq:
  assumes "\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
          "\<S>' = update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S)"
          "\<A>' = \<A>@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]"
  shows "(\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
         (\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?A)
        "(\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
         (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?B)
proof -
  have 1: "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)"
    when "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>')"
    for t'
  proof -
    have "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" using that assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto
    thus ?thesis using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
  qed

  have 2: "t'' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
    when "t'' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>')" "a = Assign"
    for t''
  proof -
    have "t'' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>) \<union> {t'}"
      using that assms assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append by auto
    moreover have "t' \<in> \<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)" using assms(1) that by force
    ultimately show ?thesis using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) that by auto
  qed

  have 3: "assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>' = assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>" (is ?C)
          "(\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<subseteq> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>))" (is ?D)
    when "a = Check"
  proof -
    show ?C using that assms(2,3) by (simp add: assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append)
    show ?D using assms(1,2,3) ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset(2) by auto
  qed

  show ?A using 1 2 by (metis subsetI)
  show ?B using 1 2 3 by (cases a) blast+
qed

private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_ineq:
  assumes "\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
          "\<S>' = update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S)"
          "\<A>' = \<A>@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"
  shows "(\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
          (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?A)
        "(\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
         (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?B)
proof -
  { fix t' assume t'_in: "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>')"
    hence "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" using assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto
    hence "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)"
      using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
  }
  moreover
  { fix t' assume t'_in: "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>')"
    hence "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
      using assms assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append by auto
    hence "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
      using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
  }
  ultimately show ?A ?B by (metis subsetI)+
qed


subsubsection \<open>Transition Systems Definitions\<close>
inductive pts_symbolic::
  "(('fun,'var) strands \<times> ('fun,'var) strand) \<Rightarrow>
   (('fun,'var) strands \<times> ('fun,'var) strand) \<Rightarrow> bool"
(infix "\<Rightarrow>\<^sup>\<bullet>" 50) where
  Nil[simp]:        "[] \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet> (update\<^sub>s\<^sub>t \<S> [],\<A>)"
| Send[simp]:       "send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet> (update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S),\<A>@[receive\<langle>t\<rangle>\<^sub>s\<^sub>t])"
| Receive[simp]:    "receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet> (update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S),\<A>@[send\<langle>t\<rangle>\<^sub>s\<^sub>t])"
| Equality[simp]:   "\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet> (update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S),\<A>@[\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t])"
| Inequality[simp]: "\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet> (update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S),\<A>@[\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t])"

private inductive pts_symbolic_c::
  "(('fun,'var) strands \<times> ('fun,'var) extstrand) \<Rightarrow>
   (('fun,'var) strands \<times> ('fun,'var) extstrand) \<Rightarrow> bool"
(infix "\<Rightarrow>\<^sup>\<bullet>\<^sub>c" 50) where
  Nil[simp]:        "[] \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (update\<^sub>s\<^sub>t \<S> [],\<A>)"
| Send[simp]:       "send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S),\<A>@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
| Receive[simp]:    "receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S),\<A>@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
| Equality[simp]:   "\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S),\<A>@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)])"
| Inequality[simp]: "\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S),\<A>@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)])"
| Decompose[simp]:  "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)
                     \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (\<S>,\<A>@[Decomp (Fun f T)])"

abbreviation pts_symbolic_rtrancl (infix "\<Rightarrow>\<^sup>\<bullet>\<^sup>*" 50) where "a \<Rightarrow>\<^sup>\<bullet>\<^sup>* b \<equiv> pts_symbolic\<^sup>*\<^sup>* a b"
private abbreviation pts_symbolic_c_rtrancl (infix "\<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>*" 50) where "a \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* b \<equiv> pts_symbolic_c\<^sup>*\<^sup>* a b"

lemma pts_symbolic_induct[consumes 1, case_names Nil Send Receive Equality Inequality]:
  assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet> (\<S>',\<A>')"
  and "\<lbrakk>[] \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> []; \<A>' = \<A>\<rbrakk> \<Longrightarrow> P"
  and "\<And>t S. \<lbrakk>send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[receive\<langle>t\<rangle>\<^sub>s\<^sub>t]\<rbrakk> \<Longrightarrow> P"
  and "\<And>t S. \<lbrakk>receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[send\<langle>t\<rangle>\<^sub>s\<^sub>t]\<rbrakk> \<Longrightarrow> P"
  and "\<And>a t t' S. \<lbrakk>\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t]\<rbrakk> \<Longrightarrow> P"
  and "\<And>X F S. \<lbrakk>\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t]\<rbrakk> \<Longrightarrow> P"
  shows "P"
apply (rule pts_symbolic.cases[OF assms(1)])
using assms(2,3,4,5,6) by simp_all

private lemma pts_symbolic_c_induct[consumes 1, case_names Nil Send Receive Equality Inequality Decompose]:
  assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (\<S>',\<A>')"
  and "\<lbrakk>[] \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> []; \<A>' = \<A>\<rbrakk> \<Longrightarrow> P"
  and "\<And>t S. \<lbrakk>send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]\<rbrakk> \<Longrightarrow> P"
  and "\<And>t S. \<lbrakk>receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]\<rbrakk> \<Longrightarrow> P"
  and "\<And>a t t' S. \<lbrakk>\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]\<rbrakk> \<Longrightarrow> P"
  and "\<And>X F S. \<lbrakk>\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]\<rbrakk> \<Longrightarrow> P"
  and "\<And>f T. \<lbrakk>Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>); \<S>' = \<S>; \<A>' = \<A>@[Decomp (Fun f T)]\<rbrakk> \<Longrightarrow> P"
  shows "P"
apply (rule pts_symbolic_c.cases[OF assms(1)])
using assms(2,3,4,5,6,7) by simp_all

private lemma pts_symbolic_c_preserves_wf_prot:
  assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>')" "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>"
  shows "wf\<^sub>s\<^sub>t\<^sub>s' \<S>' \<A>'"
using assms
proof (induction rule: rtranclp_induct2)
  case (step \<S>1 \<A>1 \<S>2 \<A>2)
  from step.hyps(2) step.IH[OF step.prems] show ?case
  proof (induction rule: pts_symbolic_c_induct)
    case Decompose
    hence "fv\<^sub>e\<^sub>s\<^sub>t \<A>2 = fv\<^sub>e\<^sub>s\<^sub>t \<A>1" "bvars\<^sub>e\<^sub>s\<^sub>t \<A>2 = bvars\<^sub>e\<^sub>s\<^sub>t \<A>1"
      using bvars_decomp ik_assignment_rhs_decomp_fv by metis+
    thus ?case using Decompose unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
      by (metis wf_vars_mono wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2))
  qed (metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_nil, metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_snd,
       metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_rcv, metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_eq,
       metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_ineq)
qed metis

private lemma pts_symbolic_c_preserves_wf_is:
  assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>')" "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" "wf\<^sub>s\<^sub>t V (to_st \<A>)"
  shows "wf\<^sub>s\<^sub>t V (to_st \<A>')"
using assms
proof (induction rule: rtranclp_induct2)
  case (step \<S>1 \<A>1 \<S>2 \<A>2)
  hence "(\<S>, \<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>2, \<A>2)" by auto
  hence *: "wf\<^sub>s\<^sub>t\<^sub>s' \<S>1 \<A>1" "wf\<^sub>s\<^sub>t\<^sub>s' \<S>2 \<A>2"
    using pts_symbolic_c_preserves_wf_prot[OF _ step.prems(1)] step.hyps(1)
    by auto

  from step.hyps(2) step.IH[OF step.prems] show ?case
  proof (induction rule: pts_symbolic_c_induct)
    case Nil thus ?case by auto
  next
    case (Send t S)
    hence "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>1) (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#(dual\<^sub>s\<^sub>t S))"
      using *(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fastforce
    hence "fv t \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (to_st \<A>1) \<union> V"
      using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_eq_wfrestrictedvars\<^sub>s\<^sub>t by auto
    thus ?case using Send wf_rcv_append''' to_st_append by simp
  next
    case (Receive t) thus ?case using wf_snd_append to_st_append by simp
  next
    case (Equality a t t' S)
    hence "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>1) (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#(dual\<^sub>s\<^sub>t S))"
      using *(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fastforce
    hence "fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (to_st \<A>1) \<union> V" when "a = Assign"
      using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_eq_wfrestrictedvars\<^sub>s\<^sub>t that by auto
    thus ?case using Equality wf_eq_append''' to_st_append by (cases a) auto
  next
    case (Inequality t t' S) thus ?case using wf_ineq_append'' to_st_append by simp
  next
    case (Decompose f T)
    hence "fv (Fun f T) \<subseteq> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>1"
      by (metis fv_subterms_set fv_subset subset_trans
                ik\<^sub>s\<^sub>t_assignment_rhs\<^sub>s\<^sub>t_wfrestrictedvars_subset)
    hence "vars\<^sub>s\<^sub>t (decomp (Fun f T)) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (to_st \<A>1) \<union> V"
      using decomp_vars[of "Fun f T"] wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_eq_wfrestrictedvars\<^sub>s\<^sub>t[of \<A>1] by auto
    thus ?case
      using to_st_append[of \<A>1 "[Decomp (Fun f T)]"]
            wf_append_suffix[OF Decompose.prems] Decompose.hyps(3)
      by (metis append_Nil2 decomp_vars(1,2) to_st.simps(1,3))
  qed
qed metis

private lemma pts_symbolic_c_preserves_tfr\<^sub>s\<^sub>e\<^sub>t:
  assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>')"
    and "tfr\<^sub>s\<^sub>e\<^sub>t ((\<Union>(trms\<^sub>s\<^sub>t ` \<S>)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>))"
    and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s ((\<Union>(trms\<^sub>s\<^sub>t ` \<S>)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>))"
  shows "tfr\<^sub>s\<^sub>e\<^sub>t ((\<Union>(trms\<^sub>s\<^sub>t ` \<S>')) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>')) \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s ((\<Union>(trms\<^sub>s\<^sub>t ` \<S>')) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>'))"
using assms
proof (induction rule: rtranclp_induct2)
  case (step \<S>1 \<A>1 \<S>2 \<A>2)
  from step.hyps(2) step.IH[OF step.prems] show ?case
  proof (induction rule: pts_symbolic_c_induct)
    case Nil
    hence "\<Union>(trms\<^sub>s\<^sub>t ` \<S>1) = \<Union>(trms\<^sub>s\<^sub>t ` \<S>2)" by force
    thus ?case using Nil by metis
  next
    case (Decompose f T)
    obtain t where t: "t \<in> ik\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1" "Fun f T \<sqsubseteq> t"
      using Decompose.hyps(1) by auto
    have t_wf: "wf\<^sub>t\<^sub>r\<^sub>m t"
      using Decompose.prems wf_trm_subterm[of _ t]
            trms\<^sub>e\<^sub>s\<^sub>t_ik_assignment_rhsI[OF t(1)]
      unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def
      by (metis UN_E Un_iff)
    have "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t \<A>1)" using trms\<^sub>e\<^sub>s\<^sub>t_ik_assignment_rhsI t by auto
    hence "Fun f T \<in> SMP (trms\<^sub>e\<^sub>s\<^sub>t \<A>1)"
      by (metis (no_types) SMP.MP SMP.Subterm UN_E t(2))
    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 t S)
    hence "fv\<^sub>e\<^sub>s\<^sub>t \<A>2 = fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> fv t" "bvars\<^sub>e\<^sub>s\<^sub>t \<A>2 = bvars\<^sub>e\<^sub>s\<^sub>t \<A>1"
          "fv\<^sub>s\<^sub>t (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S) = fv t \<union> fv\<^sub>s\<^sub>t S"
      using fv\<^sub>e\<^sub>s\<^sub>t_append bvars\<^sub>e\<^sub>s\<^sub>t_append by simp+
    thus ?case using *(1)[OF Send(1)] Send(4) by auto
  next
    case (Receive t S)
    hence "fv\<^sub>e\<^sub>s\<^sub>t \<A>2 = fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> fv t" "bvars\<^sub>e\<^sub>s\<^sub>t \<A>2 = bvars\<^sub>e\<^sub>s\<^sub>t \<A>1"
          "fv\<^sub>s\<^sub>t (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S) = fv t \<union> fv\<^sub>s\<^sub>t S"
      using fv\<^sub>e\<^sub>s\<^sub>t_append bvars\<^sub>e\<^sub>s\<^sub>t_append by simp+
    thus ?case using *(1)[OF Receive(1)] Receive(4) by auto
  next
    case (Equality a t t' S)
    hence "fv\<^sub>e\<^sub>s\<^sub>t \<A>2 = fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> fv t \<union> fv t'" "bvars\<^sub>e\<^sub>s\<^sub>t \<A>2 = bvars\<^sub>e\<^sub>s\<^sub>t \<A>1"
          "fv\<^sub>s\<^sub>t (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S) = fv t \<union> fv t' \<union> fv\<^sub>s\<^sub>t S"
      using fv\<^sub>e\<^sub>s\<^sub>t_append bvars\<^sub>e\<^sub>s\<^sub>t_append by fastforce+
    thus ?case using *(1)[OF Equality(1)] Equality(4) by auto
  next
    case (Inequality X F S)
    hence "fv\<^sub>e\<^sub>s\<^sub>t \<A>2 = fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X)" "bvars\<^sub>e\<^sub>s\<^sub>t \<A>2 = bvars\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> set X"
          "fv\<^sub>s\<^sub>t (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S) = (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X) \<union> fv\<^sub>s\<^sub>t S"
      using fv\<^sub>e\<^sub>s\<^sub>t_append bvars\<^sub>e\<^sub>s\<^sub>t_append strand_vars_split(3)[of "[\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t]" S]
      by auto+
    moreover have "fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<inter> set X = {}" using *(2)[OF Inequality(1)] by auto
    ultimately show ?case using *(1)[OF Inequality(1)] Inequality(4) by auto
  next
    case (Decompose f T)
    thus ?case
      using Decompose(3,4) bvars_decomp ik_assignment_rhs_decomp_fv[OF Decompose(1)] by auto
  qed
qed


subsubsection \<open>Theorem: The Typing Result Lifted to the Transition System Level\<close>
private lemma wf\<^sub>s\<^sub>t\<^sub>s'_decomp_rm:
  assumes "well_analyzed A" "wf\<^sub>s\<^sub>t\<^sub>s' S (decomp_rm\<^sub>e\<^sub>s\<^sub>t A)" shows "wf\<^sub>s\<^sub>t\<^sub>s' S A"
unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
proof (intro conjI)
  show "\<forall>S\<in>S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A) (dual\<^sub>s\<^sub>t S)"
    by (metis (no_types) assms(2) wf\<^sub>s\<^sub>t\<^sub>s'_def wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_decomp_rm\<^sub>e\<^sub>s\<^sub>t_subset
                wf_vars_mono le_iff_sup)

  show "\<forall>Sa\<in>S. \<forall>S'\<in>S. fv\<^sub>s\<^sub>t Sa \<inter> bvars\<^sub>s\<^sub>t S' = {}" by (metis assms(2) wf\<^sub>s\<^sub>t\<^sub>s'_def)

  show "\<forall>S\<in>S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t A = {}" by (metis assms(2) wf\<^sub>s\<^sub>t\<^sub>s'_def bvars_decomp_rm)

  show "\<forall>S\<in>S. fv\<^sub>e\<^sub>s\<^sub>t A \<inter> bvars\<^sub>s\<^sub>t S = {}" by (metis assms wf\<^sub>s\<^sub>t\<^sub>s'_def well_analyzed_decomp_rm\<^sub>e\<^sub>s\<^sub>t_fv)
qed

private lemma decomps\<^sub>e\<^sub>s\<^sub>t_pts_symbolic_c:
  assumes "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<I>"
  shows "(S,A) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (S,A@D)"
using assms(1)
proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
  case (Decomp B f X K T)
  have "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<subseteq>
        subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t (A@B) \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B))"
    using ik\<^sub>e\<^sub>s\<^sub>t_append[of A B] assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append[of A B]
    by auto
  hence "Fun f X \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t (A@B) \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B))" using Decomp.hyps by auto
  hence "(S,A@B) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (S,A@B@[Decomp (Fun f X)])"
    using pts_symbolic_c.Decompose[of f X "A@B"]
    by simp
  thus ?case
    using Decomp.IH rtrancl_into_rtrancl
          rtranclp_rtrancl_eq[of pts_symbolic_c "(S,A)" "(S,A@B)"]
    by auto
qed simp

private lemma pts_symbolic_to_pts_symbolic_c:
  assumes "(\<S>,to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d)) \<Rightarrow>\<^sup>\<bullet>\<^sup>* (\<S>',\<A>')" "sem\<^sub>e\<^sub>s\<^sub>t_d {} \<I> (to_est \<A>')" "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> \<A>\<^sub>d"
  and wf: "wf\<^sub>s\<^sub>t\<^sub>s' \<S> (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d)" "wf\<^sub>e\<^sub>s\<^sub>t {} \<A>\<^sub>d"
  and tar: "Ana_invar_subst ((\<Union>(ik\<^sub>s\<^sub>t` dual\<^sub>s\<^sub>t` \<S>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d))
                            \<union> (\<Union>(assignment_rhs\<^sub>s\<^sub>t` \<S>) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d)))"
  and wa: "well_analyzed \<A>\<^sub>d"
  and \<I>: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
  shows "\<exists>\<A>\<^sub>d'. \<A>' = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d') \<and> (\<S>,\<A>\<^sub>d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>\<^sub>d') \<and> sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> \<A>\<^sub>d'"
using assms(1,2)
proof (induction rule: rtranclp_induct2)
  case refl thus ?case using assms by auto
next
  case (step \<S>1 \<A>1 \<S>2 \<A>2)
  have "sem\<^sub>e\<^sub>s\<^sub>t_d {} \<I> (to_est \<A>1)" using step.hyps(2) step.prems
    by (induct rule: pts_symbolic_induct, metis, (metis sem\<^sub>e\<^sub>s\<^sub>t_d_split_left to_est_append)+)
  then obtain \<A>1d where
      \<A>1d: "\<A>1 = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1d)" "(\<S>, \<A>\<^sub>d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>1, \<A>1d)" "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> \<A>1d"
    using step.IH by moura

  show ?case using step.hyps(2)
  proof (induction rule: pts_symbolic_induct)
    case Nil
    hence "(\<S>, \<A>\<^sub>d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>2, \<A>1d)" using \<A>1d pts_symbolic_c.Nil[OF Nil.hyps(1), of \<A>1d] by simp
    thus ?case using \<A>1d Nil by auto
  next
    case (Send t S)
    hence "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> (\<A>1d@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])" using sem\<^sub>e\<^sub>s\<^sub>t_c.Receive[OF \<A>1d(3)] by simp
    moreover have "(\<S>1, \<A>1d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (\<S>2, \<A>1d@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
      using Send.hyps(2) pts_symbolic_c.Send[OF Send.hyps(1), of \<A>1d] by simp
    moreover have "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t (\<A>1d@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])) = \<A>2"
      using Send.hyps(3) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append \<A>1d(1) by (simp add: to_st_append)
    ultimately show ?case using \<A>1d(2) by auto
  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 t S)
    hence "ik\<^sub>s\<^sub>t \<A>1 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>"
      using step.prems sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st[of "{}" \<I> "to_est \<A>2"]
            strand_sem_split(4)[of "{}" \<A>1 "[send\<langle>t\<rangle>\<^sub>s\<^sub>t]" \<I>]
            to_st_append to_est_append to_st_to_est_inv
      by auto
    moreover have "ik\<^sub>s\<^sub>t \<A>1 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> ik\<^sub>e\<^sub>s\<^sub>t \<A>1d \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using \<A>1d(1) decomp_rm\<^sub>e\<^sub>s\<^sub>t_ik_subset by auto
    ultimately have *: "ik\<^sub>e\<^sub>s\<^sub>t \<A>1d \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>" using ideduct_mono by auto

    have "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>\<^sub>d" by (rule wf\<^sub>s\<^sub>t\<^sub>s'_decomp_rm[OF wa assms(4)])
    hence **: "wf\<^sub>e\<^sub>s\<^sub>t {} \<A>1d" by (rule pts_symbolic_c_preserves_wf_is[OF \<A>1d(2) _ assms(5)])

    have "Ana_invar_subst (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t`\<S>1) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>1d) \<union>
                           (\<Union>(assignment_rhs\<^sub>s\<^sub>t`\<S>1) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1d)))"
      using tar \<A>1d(2) pts_symbolic_c_preserves_Ana_invar_subst by metis
    hence "Ana_invar_subst (ik\<^sub>e\<^sub>s\<^sub>t \<A>1d)" "Ana_invar_subst (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1d)"
      using Ana_invar_subst_subset by blast+
    moreover have "well_analyzed \<A>1d"
      using pts_symbolic_c_preserves_well_analyzed[OF \<A>1d(2) wa] by metis
    ultimately obtain D where D:
        "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \<A>1d) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1d) \<I>"
        "ik\<^sub>e\<^sub>s\<^sub>t (\<A>1d@D) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
      using decomps\<^sub>e\<^sub>s\<^sub>t_exist_subst[OF * \<A>1d(3) ** assms(8)] unfolding Ana_invar_subst_def by auto

    have "(\<S>, \<A>\<^sub>d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>1, \<A>1d@D)" using \<A>1d(2) decomps\<^sub>e\<^sub>s\<^sub>t_pts_symbolic_c[OF D(1), of \<S>1] by auto
    hence "(\<S>, \<A>\<^sub>d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>2, \<A>1d@D@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
      using Receive(2) pts_symbolic_c.Receive[OF Receive.hyps(1), of "\<A>1d@D"] by auto
    moreover have "\<A>2 = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t (\<A>1d@D@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]))"
      using Receive.hyps(3) \<A>1d(1) decomps\<^sub>e\<^sub>s\<^sub>t_decomp_rm\<^sub>e\<^sub>s\<^sub>t_empty[OF D(1)]
            decomp_rm\<^sub>e\<^sub>s\<^sub>t_append to_st_append
      by auto
    moreover have "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> (\<A>1d@D@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
      using D(2) sem\<^sub>e\<^sub>s\<^sub>t_c.Send[OF sem\<^sub>e\<^sub>s\<^sub>t_c_decomps\<^sub>e\<^sub>s\<^sub>t_append[OF \<A>1d(3) D(1)]] by simp
    ultimately show ?case by auto
  qed
qed

private lemma pts_symbolic_c_to_pts_symbolic:
  assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>')" "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> \<A>'"
  shows "(\<S>,to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>)) \<Rightarrow>\<^sup>\<bullet>\<^sup>* (\<S>',to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>'))"
        "sem\<^sub>e\<^sub>s\<^sub>t_d {} \<I> (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>')"
proof -
  show "(\<S>,to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>)) \<Rightarrow>\<^sup>\<bullet>\<^sup>* (\<S>',to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>'))" using assms(1)
  proof (induction rule: rtranclp_induct2)
    case (step \<S>1 \<A>1 \<S>2 \<A>2) show ?case using step.hyps(2,1) step.IH
    proof (induction rule: pts_symbolic_c_induct)
      case Nil thus ?case
        using pts_symbolic.Nil[OF Nil.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1)"] by simp
    next
      case (Send t S) thus ?case
        using pts_symbolic.Send[OF Send.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1)"]
        by (simp add: decomp_rm\<^sub>e\<^sub>s\<^sub>t_append to_st_append)
    next
      case (Receive t S) thus ?case
        using pts_symbolic.Receive[OF Receive.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1)"]
        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