(*  Title:      Lazy_Intruder.thy
    Author:     Andreas Viktor Hess, DTU
    SPDX-License-Identifier: BSD-3-Clause
*)

section \<open>The Lazy Intruder\<close>
theory Lazy_Intruder
imports Strands_and_Constraints Intruder_Deduction
begin

context intruder_model
begin

subsection \<open>Definition of the Lazy Intruder\<close>
text \<open>The lazy intruder constraint reduction system, defined as a relation on constraint states\<close>
inductive_set LI_rel::
    "((('fun,'var) strand \<times> (('fun,'var) subst)) \<times>
       ('fun,'var) strand \<times> (('fun,'var) subst)) set"
  and LI_rel' (infix "\<leadsto>" 50)
  and LI_rel_trancl (infix "\<leadsto>\<^sup>+" 50)
  and LI_rel_rtrancl (infix "\<leadsto>\<^sup>*" 50)
where
  "A \<leadsto> B \<equiv> (A,B) \<in> LI_rel"
| "A \<leadsto>\<^sup>+ B \<equiv> (A,B) \<in> LI_rel\<^sup>+"
| "A \<leadsto>\<^sup>* B \<equiv> (A,B) \<in> LI_rel\<^sup>*"

| Compose: "\<lbrakk>simple S; length T = arity f; public f\<rbrakk>
            \<Longrightarrow> (S@Send [Fun f T]#S',\<theta>) \<leadsto> (S@(map Send1 T)@S',\<theta>)"
| Unify: "\<lbrakk>simple S; Fun f T' \<in> ik\<^sub>s\<^sub>t S; Some \<delta> = mgu (Fun f T) (Fun f T')\<rbrakk>
          \<Longrightarrow> (S@Send [Fun f T]#S',\<theta>) \<leadsto> ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta> \<circ>\<^sub>s \<delta>)"
| Equality: "\<lbrakk>simple S; Some \<delta> = mgu t t'\<rbrakk>
          \<Longrightarrow> (S@Equality _ t t'#S',\<theta>) \<leadsto> ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta> \<circ>\<^sub>s \<delta>)"

text \<open>A "pre-processing step" to be applied before constraint reduction. It transforms constraints
such that exactly one message is transmitted in each message transmission step. It is sound and
complete and preserves the various well-formedness properties required by the lazy intruder.\<close>
fun LI_preproc where
  "LI_preproc [] = []"
| "LI_preproc (Send ts#S) = map Send1 ts@LI_preproc S"
| "LI_preproc (Receive ts#S) = map Receive1 ts@LI_preproc S"
| "LI_preproc (x#S) = x#LI_preproc S"

definition LI_preproc_prop where
  "LI_preproc_prop S \<equiv> \<forall>ts. Send ts \<in> set S \<or> Receive ts \<in> set S \<longrightarrow> (\<exists>t. ts = [t])"

subsection \<open>Lemmata: Preprocessing \<close>
lemma LI_preproc_preproc_prop:
  "LI_preproc_prop (LI_preproc S)"
by (induct S rule: LI_preproc.induct) (auto simp add: LI_preproc_prop_def)

lemma LI_preproc_sem_eq:
  "\<lbrakk>M; S\<rbrakk>\<^sub>c \<I> \<longleftrightarrow> \<lbrakk>M; LI_preproc S\<rbrakk>\<^sub>c \<I>" (is "?A \<longleftrightarrow> ?B")
proof
  show "?A \<Longrightarrow> ?B"
  proof (induction S rule: strand_sem_induct)
    case (ConsSnd M ts S)
    hence "\<lbrakk>M; LI_preproc S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; map Send1 ts\<rbrakk>\<^sub>c \<I>" using strand_sem_Send_map(5) by auto
    moreover have "ik\<^sub>s\<^sub>t (map Send1 ts) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = {}" unfolding ik\<^sub>s\<^sub>t_is_rcv_set by fastforce
    ultimately show ?case using strand_sem_append(1) by simp
  next
    case (ConsRcv M ts S)
    hence "\<lbrakk>(set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> M; LI_preproc S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; map Receive1 ts\<rbrakk>\<^sub>c \<I>"
      using strand_sem_Receive_map(3) by auto
    moreover have "ik\<^sub>s\<^sub>t (map Receive1 ts) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" unfolding ik\<^sub>s\<^sub>t_is_rcv_set by force
    ultimately show ?case using strand_sem_append(1) by (simp add: Un_commute)
  qed simp_all

  show "?B \<Longrightarrow> ?A"
  proof (induction S arbitrary: M rule: LI_preproc.induct)
    case (2 ts S)
    have "ik\<^sub>s\<^sub>t (map Send1 ts) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = {}" unfolding ik\<^sub>s\<^sub>t_is_rcv_set by fastforce
    hence "\<lbrakk>M; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; map Send1 ts\<rbrakk>\<^sub>c \<I>" using 2 strand_sem_append(1) by auto
    thus ?case using strand_sem_Send_map(5) by simp
  next
    case (3 ts S)
    have "ik\<^sub>s\<^sub>t (map Receive1 ts) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" unfolding ik\<^sub>s\<^sub>t_is_rcv_set by force
    hence "\<lbrakk>M \<union> (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>); S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>M; map Receive1 ts\<rbrakk>\<^sub>c \<I>"
      using 3 strand_sem_append(1) by auto
    thus ?case using strand_sem_Receive_map(3) by (simp add: Un_commute)
  qed simp_all
qed

lemma LI_preproc_sem_eq':
  "(\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>) \<longleftrightarrow> (\<I> \<Turnstile>\<^sub>c \<langle>LI_preproc S, \<theta>\<rangle>)"
using LI_preproc_sem_eq unfolding constr_sem_c_def by simp

lemma LI_preproc_vars_eq:
  "fv\<^sub>s\<^sub>t (LI_preproc S) = fv\<^sub>s\<^sub>t S"
  "bvars\<^sub>s\<^sub>t (LI_preproc S) = bvars\<^sub>s\<^sub>t S"
  "vars\<^sub>s\<^sub>t (LI_preproc S) = vars\<^sub>s\<^sub>t S"
by (induct S rule: LI_preproc.induct) auto

lemma LI_preproc_trms_eq:
  "trms\<^sub>s\<^sub>t (LI_preproc S) = trms\<^sub>s\<^sub>t S"
by (induct S rule: LI_preproc.induct) auto

lemma LI_preproc_wf\<^sub>s\<^sub>t:
  assumes "wf\<^sub>s\<^sub>t X S"
  shows "wf\<^sub>s\<^sub>t X (LI_preproc S)"
  using assms
proof (induction S arbitrary: X rule: wf\<^sub>s\<^sub>t_induct)
  case (ConsRcv X ts S)
  hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> X" "wf\<^sub>s\<^sub>t X (LI_preproc S)" by auto
  thus ?case using wf_Receive1_prefix by simp
next
  case (ConsSnd X ts S)
  hence "wf\<^sub>s\<^sub>t (X \<union> fv\<^sub>s\<^sub>e\<^sub>t (set ts)) (LI_preproc S)" by simp
  thus ?case using wf_Send1_prefix by simp
qed simp_all

lemma LI_preproc_preserves_wellformedness:
  assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>"
  shows "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r (LI_preproc S) \<theta>"
using assms LI_preproc_vars_eq[of S] LI_preproc_wf\<^sub>s\<^sub>t[of "{}" S] unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by argo

lemma LI_preproc_prop_SendE:
  assumes "LI_preproc_prop S"
    and "Send ts \<in> set S"
  shows "(\<exists>x. ts = [Var x]) \<or> (\<exists>f T. ts = [Fun f T])"
proof -
  obtain t where "ts = [t]" using assms unfolding LI_preproc_prop_def by auto
  thus ?thesis by (cases t) auto
qed

lemma LI_preproc_prop_split:
  "LI_preproc_prop (S@S') \<longleftrightarrow> LI_preproc_prop S \<and> LI_preproc_prop S'" (is "?A \<longleftrightarrow> ?B")
proof
  show "?A \<Longrightarrow> ?B"
  proof (induction S)
    case (Cons x S) thus ?case unfolding LI_preproc_prop_def by (cases x) auto
  qed (simp add: LI_preproc_prop_def)

  show "?B \<Longrightarrow> ?A"
  proof (induction S)
    case (Cons x S) thus ?case unfolding LI_preproc_prop_def by (cases x) auto
  qed (simp add: LI_preproc_prop_def)
qed

subsection \<open>Lemma: The Lazy Intruder is Well-founded\<close>
context
begin
private lemma LI_compose_measure_lt:
  "((S@(map Send1 T)@S',\<theta>\<^sub>1), (S@Send [Fun f T]#S',\<theta>\<^sub>2)) \<in> measure\<^sub>s\<^sub>t"
using strand_fv_card_map_fun_eq[of S f T S'] strand_size_map_fun_lt[of T f]
by (simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)

private lemma LI_unify_measure_lt:
  assumes "Some \<delta> = mgu (Fun f T) t" "fv t \<subseteq> fv\<^sub>s\<^sub>t S"
  shows "(((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta>\<^sub>1), (S@Send [Fun f T]#S',\<theta>\<^sub>2)) \<in> measure\<^sub>s\<^sub>t"
proof (cases "\<delta> = Var")
  assume "\<delta> = Var"
  hence "(S@S') \<cdot>\<^sub>s\<^sub>t \<delta> = S@S'" by blast
  thus ?thesis
    using strand_fv_card_rm_fun_le[of S S' f T]
    by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)
next
  assume "\<delta> \<noteq> Var"
  then obtain v where "v \<in> fv (Fun f T) \<union> fv t" "subst_elim \<delta> v"
    using mgu_eliminates[OF assms(1)[symmetric]] by metis
  hence v_in: "v \<in> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
    using assms(2) by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)

  have "range_vars \<delta> \<subseteq> fv (Fun f T) \<union> fv\<^sub>s\<^sub>t S"
    using assms(2) mgu_vars_bounded[OF assms(1)[symmetric]] by auto
  hence img_bound: "range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')" by auto

  have finite_fv: "finite (fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S'))" by auto

  have "v \<notin> fv\<^sub>s\<^sub>t ((S@Send [Fun f T]#S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
    using strand_fv_subst_subset_if_subst_elim[OF \<open>subst_elim \<delta> v\<close>] v_in by metis
  hence v_not_in: "v \<notin> fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)" by auto

  have "fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
    using strand_subst_fv_bounded_if_img_bounded[OF img_bound] by simp
  hence "fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subset> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')" using v_in v_not_in by blast
  hence "card (fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)) < card (fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S'))"
    using psubset_card_mono[OF finite_fv] by simp
  thus ?thesis by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)
qed

private lemma LI_equality_measure_lt:
  assumes "Some \<delta> = mgu t t'"
  shows "(((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta>\<^sub>1), (S@Equality a t t'#S',\<theta>\<^sub>2)) \<in> measure\<^sub>s\<^sub>t"
proof (cases "\<delta> = Var")
  assume "\<delta> = Var"
  hence "(S@S') \<cdot>\<^sub>s\<^sub>t \<delta> = S@S'" by blast
  thus ?thesis
    using strand_fv_card_rm_eq_le[of S S' a t t']
    by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)
next
  assume "\<delta> \<noteq> Var"
  then obtain v where "v \<in> fv t \<union> fv t'" "subst_elim \<delta> v"
    using mgu_eliminates[OF assms(1)[symmetric]] by metis
  hence v_in: "v \<in> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" using assms by auto

  have "range_vars \<delta> \<subseteq> fv t \<union> fv t' \<union> fv\<^sub>s\<^sub>t S"
    using assms mgu_vars_bounded[OF assms(1)[symmetric]] by auto
  hence img_bound: "range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" by auto

  have finite_fv: "finite (fv\<^sub>s\<^sub>t (S@Equality a t t'#S'))" by auto

  have "v \<notin> fv\<^sub>s\<^sub>t ((S@Equality a t t'#S') \<cdot>\<^sub>s\<^sub>t \<delta>)"
    using strand_fv_subst_subset_if_subst_elim[OF \<open>subst_elim \<delta> v\<close>] v_in by metis
  hence v_not_in: "v \<notin> fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)" by auto

  have "fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')"
    using strand_subst_fv_bounded_if_img_bounded[OF img_bound] by simp
  hence "fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subset> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" using v_in v_not_in by blast
  hence "card (fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)) < card (fv\<^sub>s\<^sub>t (S@Equality a t t'#S'))"
    using psubset_card_mono[OF finite_fv] by simp
  thus ?thesis by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def)
qed

private lemma LI_in_measure: "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto> (S\<^sub>2,\<theta>\<^sub>2) \<Longrightarrow> ((S\<^sub>2,\<theta>\<^sub>2),(S\<^sub>1,\<theta>\<^sub>1)) \<in> measure\<^sub>s\<^sub>t"
proof (induction rule: LI_rel.induct)
  case (Compose S T f S' \<theta>) thus ?case using LI_compose_measure_lt[of S T S'] by metis
next
  case (Unify S f U \<delta> T S' \<theta>)
  hence "fv (Fun f U) \<subseteq> fv\<^sub>s\<^sub>t S"
    using fv_snd_rcv_strand_subset(2)[of S] by force
  thus ?case using LI_unify_measure_lt[OF Unify.hyps(3), of S S'] by metis
qed (metis LI_equality_measure_lt)

private lemma LI_in_measure_trans: "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>+ (S\<^sub>2,\<theta>\<^sub>2) \<Longrightarrow> ((S\<^sub>2,\<theta>\<^sub>2),(S\<^sub>1,\<theta>\<^sub>1)) \<in> measure\<^sub>s\<^sub>t"
by (induction rule: trancl.induct, metis surjective_pairing LI_in_measure)
   (metis (no_types, lifting) surjective_pairing LI_in_measure measure\<^sub>s\<^sub>t_trans trans_def)

private lemma LI_converse_wellfounded_trans: "wf ((LI_rel\<^sup>+)\<inverse>)"
proof -
  have "(LI_rel\<^sup>+)\<inverse> \<subseteq> measure\<^sub>s\<^sub>t" using LI_in_measure_trans by auto
  thus ?thesis using measure\<^sub>s\<^sub>t_wellfounded wf_subset by metis
qed

private lemma LI_acyclic_trans: "acyclic (LI_rel\<^sup>+)"
using wf_acyclic[OF LI_converse_wellfounded_trans] acyclic_converse by metis

private lemma LI_acyclic: "acyclic LI_rel"
using LI_acyclic_trans acyclic_subset by (simp add: acyclic_def)

lemma LI_no_infinite_chain: "\<not>(\<exists>f. \<forall>i. f i \<leadsto>\<^sup>+ f (Suc i))"
proof -
  have "\<not>(\<exists>f. \<forall>i. (f (Suc i), f i) \<in> (LI_rel\<^sup>+)\<inverse>)"
    using wf_iff_no_infinite_down_chain LI_converse_wellfounded_trans by metis
  thus ?thesis by simp
qed

private lemma LI_unify_finite:
  assumes "finite M"
  shows "finite {((S@Send [Fun f T]#S',\<theta>), ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta> \<circ>\<^sub>s \<delta>)) | \<delta> T'.
                   simple S \<and> Fun f T' \<in> M \<and> Some \<delta> = mgu (Fun f T) (Fun f T')}"
using assms
proof (induction M rule: finite_induct)
  case (insert m M) thus ?case
  proof (cases m)
    case (Fun g U)
    let ?a = "\<lambda>\<delta>. ((S@Send [Fun f T]#S',\<theta>), ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta> \<circ>\<^sub>s \<delta>))"
    let ?A = "\<lambda>B. {?a \<delta> | \<delta> T'. simple S \<and> Fun f T' \<in> B \<and> Some \<delta> = mgu (Fun f T) (Fun f T')}"

    have "?A (insert m M) = (?A M) \<union> (?A {m})" by auto
    moreover have "finite (?A {m})"
    proof (cases "\<exists>\<delta>. Some \<delta> = mgu (Fun f T) (Fun g U)")
      case True
      then obtain \<delta> where \<delta>: "Some \<delta> = mgu (Fun f T) (Fun g U)" by blast

      have A_m_eq: "\<And>\<delta>'. ?a \<delta>' \<in> ?A {m} \<Longrightarrow> ?a \<delta> = ?a \<delta>'"
      proof -
        fix \<delta>' assume "?a \<delta>' \<in> ?A {m}"
        hence "\<exists>\<sigma>. Some \<sigma> = mgu (Fun f T) (Fun g U) \<and> ?a \<sigma> = ?a \<delta>'"
          using \<open>m = Fun g U\<close> by auto
        thus "?a \<delta> = ?a \<delta>'" by (metis \<delta> option.inject)
      qed

      have "?A {m} = {} \<or> ?A {m} = {?a \<delta>}"
      proof (cases "simple S \<and> ?A {m} \<noteq> {}")
        case True
        hence "simple S" "?A {m} \<noteq> {}" by meson+
        hence "?A {m} = {?a \<delta> | \<delta>. Some \<delta> = mgu (Fun f T) (Fun g U)}" using \<open>m = Fun g U\<close> by auto
        hence "?a \<delta> \<in> ?A {m}" using \<delta> by auto
       show ?thesis
        proof (rule ccontr)
          assume "\<not>(?A {m} = {} \<or> ?A {m} = {?a \<delta>})"
          then obtain B where B: "?A {m} = insert (?a \<delta>) B" "?a \<delta> \<notin> B" "B \<noteq> {}"
            using \<open>?A {m} \<noteq> {}\<close> \<open>?a \<delta> \<in> ?A {m}\<close> by (metis (no_types, lifting) Set.set_insert)
          then obtain b where b: "?a \<delta> \<noteq> b" "b \<in> B" by (metis (no_types, lifting) ex_in_conv)
          then obtain \<delta>' where \<delta>': "b = ?a \<delta>'" using B(1) by blast
          moreover have "?a \<delta>' \<in> ?A {m}" using B(1) b(2) \<delta>' by auto
          hence "?a \<delta> = ?a \<delta>'" by (blast dest!: A_m_eq)
          ultimately show False using b(1) by simp
        qed
      qed auto
      thus ?thesis by (metis (no_types, lifting) finite.emptyI finite_insert)
    next
      case False
      hence "?A {m} = {}" using \<open>m = Fun g U\<close> by blast
      thus ?thesis by (metis finite.emptyI)
    qed
    ultimately show ?thesis using insert.IH by auto
  qed simp
qed fastforce
end

subsection \<open>Lemma: The Lazy Intruder Preserves Well-formedness\<close>
context
begin
private lemma LI_preserves_subst_wf_single:
  assumes "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto> (S\<^sub>2,\<theta>\<^sub>2)" "fv\<^sub>s\<^sub>t S\<^sub>1 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>1 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<^sub>1"
  and "subst_domain \<theta>\<^sub>1 \<inter> vars\<^sub>s\<^sub>t S\<^sub>1 = {}" "range_vars \<theta>\<^sub>1 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>1 = {}"
  shows "fv\<^sub>s\<^sub>t S\<^sub>2 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>2 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<^sub>2"
  and "subst_domain \<theta>\<^sub>2 \<inter> vars\<^sub>s\<^sub>t S\<^sub>2 = {}" "range_vars \<theta>\<^sub>2 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>2 = {}"
using assms
proof (induction rule: LI_rel.induct)
  case (Compose S X f S' \<theta>)
  { case 1 thus ?case using vars_st_snd_map by auto }
  { case 2 thus ?case using vars_st_snd_map by auto }
  { case 3 thus ?case using vars_st_snd_map by force }
  { case 4 thus ?case using vars_st_snd_map by auto }
next
  case (Unify S f U \<delta> T S' \<theta>)
  hence "fv (Fun f U) \<subseteq> fv\<^sub>s\<^sub>t S" using fv_subset_if_in_strand_ik' by blast
  hence *: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
    using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]]
    unfolding range_vars_alt_def by (fastforce simp del: subst_range.simps)

  have "fv\<^sub>s\<^sub>t (S@S') \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')" "vars\<^sub>s\<^sub>t (S@S') \<subseteq> vars\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
    by auto
  hence **: "fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
            "vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> vars\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
    using subst_sends_strand_fv_to_img[of "S@S'" \<delta>]
          strand_subst_vars_union_bound[of "S@S'" \<delta>] *
    by blast+

  have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" by (fact mgu_gives_wellformed_subst[OF Unify.hyps(3)[symmetric]])

  { case 1
    have "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
      using bvars_subst_ident[of "S@S'" \<delta>] by auto
    thus ?case using 1 ** by blast
  }
  { case 2
    hence "subst_domain \<theta> \<inter> subst_domain \<delta> = {}" "subst_domain \<theta> \<inter> range_vars \<delta> = {}"
      using * by blast+
    thus ?case by (metis wf_subst_compose[OF \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>\<close>])
  }
  { case 3
    hence "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using ** by blast
    moreover have "v \<in> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')" when "v \<in> subst_domain \<delta>" for v
      using * that by blast
    hence "subst_domain \<delta> \<inter> fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}"
      using mgu_eliminates_dom[OF Unify.hyps(3)[symmetric],
                THEN strand_fv_subst_subset_if_subst_elim, of _ "S@Send [Fun f T]#S'"]
      unfolding subst_elim_def by auto
    moreover have "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
      using bvars_subst_ident[of "S@S'" \<delta>] by auto
    hence "subst_domain \<delta> \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using 3(1) * by blast
    ultimately show ?case
      using ** * subst_domain_compose[of \<theta> \<delta>] vars\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>t[of "S@S' \<cdot>\<^sub>s\<^sub>t \<delta>"]
      by blast
  }
  { case 4
    have ***: "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
      using bvars_subst_ident[of "S@S'" \<delta>] by auto
    hence "range_vars \<delta> \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using 4(1) * by blast
    thus ?case using subst_img_comp_subset[of \<theta> \<delta>] 4(4) *** by blast
  }
next
  case (Equality S \<delta> t t' a S' \<theta>)
  hence *: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')"
    using mgu_vars_bounded[OF Equality.hyps(2)[symmetric]]
    unfolding range_vars_alt_def by fastforce

  have "fv\<^sub>s\<^sub>t (S@S') \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" "vars\<^sub>s\<^sub>t (S@S') \<subseteq> vars\<^sub>s\<^sub>t (S@Equality a t t'#S')"
    by auto
  hence **: "fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')"
            "vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> vars\<^sub>s\<^sub>t (S@Equality a t t'#S')"
    using subst_sends_strand_fv_to_img[of "S@S'" \<delta>]
          strand_subst_vars_union_bound[of "S@S'" \<delta>] *
    by blast+

  have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" by (fact mgu_gives_wellformed_subst[OF Equality.hyps(2)[symmetric]])

  { case 1
    have "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Equality a t t'#S')"
      using bvars_subst_ident[of "S@S'" \<delta>] by auto
    thus ?case using 1 ** by blast
  }
  { case 2
    hence "subst_domain \<theta> \<inter> subst_domain \<delta> = {}" "subst_domain \<theta> \<inter> range_vars \<delta> = {}"
      using * by blast+
    thus ?case by (metis wf_subst_compose[OF \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>\<close>])
  }
  { case 3
    hence "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using ** by blast
    moreover have "v \<in> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" when "v \<in> subst_domain \<delta>" for v
      using * that by blast
    hence "subst_domain \<delta> \<inter> fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}"
      using mgu_eliminates_dom[OF Equality.hyps(2)[symmetric],
                THEN strand_fv_subst_subset_if_subst_elim, of _ "S@Equality a t t'#S'"]
      unfolding subst_elim_def by auto
    moreover have "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Equality a t t'#S')"
      using bvars_subst_ident[of "S@S'" \<delta>] by auto
    hence "subst_domain \<delta> \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using 3(1) * by blast
    ultimately show ?case
      using ** * subst_domain_compose[of \<theta> \<delta>] vars\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>t[of "S@S' \<cdot>\<^sub>s\<^sub>t \<delta>"]
      by blast
  }
  { case 4
    have ***: "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Equality a t t'#S')"
      using bvars_subst_ident[of "S@S'" \<delta>] by auto
    hence "range_vars \<delta> \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using 4(1) * by blast
    thus ?case using subst_img_comp_subset[of \<theta> \<delta>] 4(4) *** by blast
  }
qed

private lemma LI_preserves_subst_wf:
  assumes "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2)" "fv\<^sub>s\<^sub>t S\<^sub>1 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>1 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<^sub>1"
  and "subst_domain \<theta>\<^sub>1 \<inter> vars\<^sub>s\<^sub>t S\<^sub>1 = {}" "range_vars \<theta>\<^sub>1 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>1 = {}"
  shows "fv\<^sub>s\<^sub>t S\<^sub>2 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>2 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<^sub>2"
  and "subst_domain \<theta>\<^sub>2 \<inter> vars\<^sub>s\<^sub>t S\<^sub>2 = {}" "range_vars \<theta>\<^sub>2 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>2 = {}"
using assms
proof (induction S\<^sub>2 \<theta>\<^sub>2 rule: rtrancl_induct2)
  case (step S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j)
  { case 1 thus ?case using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] step.IH by metis }
  { case 2 thus ?case using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] step.IH by metis }
  { case 3 thus ?case using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] step.IH by metis }
  { case 4 thus ?case using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] step.IH by metis }
qed metis

lemma LI_preserves_wellformedness:
  assumes "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2)" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1"
  shows "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>2 \<theta>\<^sub>2"
proof -
  have *: "wf\<^sub>s\<^sub>t {} S\<^sub>j"
    when "(S\<^sub>i, \<theta>\<^sub>i) \<leadsto> (S\<^sub>j, \<theta>\<^sub>j)" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>i \<theta>\<^sub>i" for S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j
    using that
  proof (induction rule: LI_rel.induct)
    case (Compose S T f S' \<theta>) thus ?case by (metis wf_send_compose wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
  next
    case (Unify S f U \<delta> T S' \<theta>)
    have "fv (Fun f T) \<union> fv (Fun f U) \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')" using Unify.hyps(2) by force
    hence "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
      using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] by (metis subset_trans)
    hence "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t (S@Send [Fun f T]#S') = {}"
      using Unify.prems unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by blast
    thus ?case
      using wf_unify[OF _ Unify.hyps(2) MGU_is_Unifier[OF mgu_gives_MGU], of "{}",
                     OF _ Unify.hyps(3)[symmetric], of S'] Unify.prems(1)
      by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
  next
    case (Equality S \<delta> t t' a S' \<theta>)
    have "fv t \<union> fv t' \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" using Equality.hyps(2) by force
    hence "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')"
      using mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] by (metis subset_trans)
    hence "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t (S@Equality a t t'#S') = {}"
      using Equality.prems unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by blast
    thus ?case
      using wf_equality[OF _ Equality.hyps(2)[symmetric], of "{}" S a S'] Equality.prems(1)
      by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
  qed

  show ?thesis using assms
  proof (induction rule: rtrancl_induct2)
    case (step S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j) thus ?case
      using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] *[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>]
      by (metis wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
  qed simp
qed

      { fix s assume "s \<in> set (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)"
        hence "\<exists>s' \<in> set (S@S'). s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')"
          using Unify.prems(1) by (auto simp add: subst_apply_strand_def)
        moreover {
          fix s' assume s': "s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')" "s' \<in> set (S@S')"
          from s'(2) have "trms\<^sub>s\<^sub>t\<^sub>p (s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = trms\<^sub>s\<^sub>t\<^sub>p s' \<cdot>\<^sub>s\<^sub>e\<^sub>t (rm_vars (set (bvars\<^sub>s\<^sub>t\<^sub>p s')) \<delta>)"
          proof (induction s')
            case (Inequality X F) thus ?case by (induct F) (auto simp add: subst_apply_pairs_def)
          qed auto
          hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)"
            using wf_trm_subst[OF wf_trms_subst_rm_vars'[OF range_wf]] \<open>wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')\<close> s'(1)
            by simp
        }
        ultimately have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)" by auto
      }
      thus ?case by auto
    next
      case (Equality S \<delta> t t' a S' \<theta>)
      hence "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" by simp_all
      hence range_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
        using mgu_wf_trm[OF Equality.hyps(2)[symmetric]] by simp

      { fix s assume "s \<in> set (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)"
        hence "\<exists>s' \<in> set (S@S'). s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')"
          using Equality.prems(1) by (auto simp add: subst_apply_strand_def)
        moreover {
          fix s' assume s': "s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')" "s' \<in> set (S@S')"
          from s'(2) have "trms\<^sub>s\<^sub>t\<^sub>p (s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = trms\<^sub>s\<^sub>t\<^sub>p s' \<cdot>\<^sub>s\<^sub>e\<^sub>t (rm_vars (set (bvars\<^sub>s\<^sub>t\<^sub>p s')) \<delta>)"
          proof (induction s')
            case (Inequality X F) thus ?case by (induct F) (auto simp add: subst_apply_pairs_def)
          qed auto
          hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)"
            using wf_trm_subst[OF wf_trms_subst_rm_vars'[OF range_wf]] \<open>wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')\<close> s'(1)
            by simp
        }
        ultimately have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)" by auto
      }
      thus ?case by auto
    qed
  }
  with assms show ?thesis by (induction rule: rtrancl_induct2) metis+
qed

lemma LI_preproc_prop_subst:
  "LI_preproc_prop S \<longleftrightarrow> LI_preproc_prop (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
proof (induction S)
  case (Cons x S) thus ?case unfolding LI_preproc_prop_def by (cases x) auto
qed (simp add: LI_preproc_prop_def)

lemma LI_preserves_LI_preproc_prop:
  assumes "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2)" "LI_preproc_prop S\<^sub>1"
  shows "LI_preproc_prop S\<^sub>2"
using assms
proof (induction rule: rtrancl_induct2)
  case (step S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j)
  hence "LI_preproc_prop S\<^sub>i" by metis
  with step.hyps(2) show ?case
  proof (induction rule: LI_rel.induct)
    case (Unify S f T' \<delta> T S' \<theta>) thus ?case
      using LI_preproc_prop_subst LI_preproc_prop_split
      by (metis append.left_neutral append_Cons)
  next
    case (Equality S \<delta> t t' uu S' \<theta>) thus ?case
      using LI_preproc_prop_subst LI_preproc_prop_split
      by (metis append.left_neutral append_Cons)
  qed (auto simp add: LI_preproc_prop_def)
qed simp

end

subsection \<open>Theorem: Soundness of the Lazy Intruder\<close>
context
begin
private lemma LI_soundness_single:
  assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1" "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto> (S\<^sub>2,\<theta>\<^sub>2)" "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2,\<theta>\<^sub>2\<rangle>"
  shows "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1,\<theta>\<^sub>1\<rangle>"
using assms(2,1,3)
proof (induction rule: LI_rel.induct)
  case (Compose S T f S' \<theta>)
  have "ik\<^sub>s\<^sub>t (map Send1 T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = {}" by fastforce
  hence *: "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; map Send1 T\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>"
    using Compose unfolding constr_sem_c_def
    by (force, force, fastforce)

  have "ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c Fun f T \<cdot> \<I>"
    using *(2) Compose.hyps(2) ComposeC[OF _ Compose.hyps(3), of "map (\<lambda>x. x \<cdot> \<I>) T"]
    unfolding subst_compose_def by force
  thus "\<I> \<Turnstile>\<^sub>c \<langle>S@Send [Fun f T]#S',\<theta>\<rangle>"
    using *(1,3) \<open>\<I> \<Turnstile>\<^sub>c \<langle>S@map Send1 T@S',\<theta>\<rangle>\<close>
    by (auto simp add: constr_sem_c_def)
next
  case (Unify S f U \<delta> T S' \<theta>)
  have "(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>" "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>"
    using Unify.prems(2) unfolding constr_sem_c_def by metis+
  then obtain \<sigma> where \<sigma>: "\<theta> \<circ>\<^sub>s \<delta> \<circ>\<^sub>s \<sigma> = \<I>" unfolding subst_compose_def by auto

  have \<theta>fun_id: "Fun f U \<cdot> \<theta> = Fun f U" "Fun f T \<cdot> \<theta> = Fun f T"
    using Unify.prems(1) trm_subst_ident[of "Fun f U" \<theta>]
          fv_subset_if_in_strand_ik[of "Fun f U" S] Unify.hyps(2)
          fv_snd_rcv_strand_subset(2)[of S]
          strand_vars_split(1)[of S "Send [Fun f T]#S'"]
    unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def apply blast
    using Unify.prems(1) trm_subst_ident[of "Fun f T" \<theta>]
    unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by fastforce
  hence \<theta>\<delta>_disj:
      "subst_domain \<theta> \<inter> subst_domain \<delta> = {}"
      "subst_domain \<theta> \<inter> range_vars \<delta> = {}"
      "subst_domain \<theta> \<inter> range_vars \<theta> = {}"
    using trm_subst_disj mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] apply (blast,blast)
    using Unify.prems(1) unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by blast
  hence \<theta>\<delta>_support: "\<theta> supports \<I>" "\<delta> supports \<I>"
    by (simp_all add: subst_support_comp_split[OF \<open>(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>\<close>])

  have "fv (Fun f T) \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')" "fv (Fun f U) \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
    using Unify.hyps(2) by force+
  hence \<delta>_vars_bound: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Send [Fun f T]#S')"
    using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] by blast

  have "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; [Send [Fun f T]]\<rbrakk>\<^sub>c \<I>"
  proof -
    from Unify.hyps(2) have "Fun f U \<cdot> \<I> \<in> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by blast
    hence "Fun f U \<cdot> \<I> \<in> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by blast
    moreover have "Unifier \<delta> (Fun f T) (Fun f U)"
      by (fact MGU_is_Unifier[OF mgu_gives_MGU[OF Unify.hyps(3)[symmetric]]])
    ultimately have "Fun f T \<cdot> \<I> \<in> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
      using \<sigma> by (metis \<theta>fun_id subst_subst_compose)
    thus ?thesis by simp
  qed

  have "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>"
  proof -
    have "(S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta> = S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "(S@S') \<cdot>\<^sub>s\<^sub>t \<theta> = S@S'"
    proof -
      have "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S') = {}"
        using Unify.prems(1) by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
      hence "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}"
        using \<theta>\<delta>_disj(2) strand_subst_vars_union_bound[of "S@S'" \<delta>] by blast
      thus "(S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta> = S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "(S@S') \<cdot>\<^sub>s\<^sub>t \<theta> = S@S'"
        using strand_subst_comp \<open>subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S') = {}\<close> by (blast,blast)
    qed
    moreover have "subst_idem \<delta>" by (fact mgu_gives_subst_idem[OF Unify.hyps(3)[symmetric]])
    moreover have
        "(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t (S@S') = {}"
        "(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}"
        "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t (S@S') = {}"
      using wf_constr_bvars_disj[OF Unify.prems(1)]
            wf_constr_bvars_disj'[OF Unify.prems(1) \<delta>_vars_bound]
      by auto
    ultimately have "\<lbrakk>{}; S@S'\<rbrakk>\<^sub>c \<I>"
      using \<open>\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>\<close> \<sigma>
            strand_sem_subst(1)[of \<theta> "S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "{}" "\<delta> \<circ>\<^sub>s \<sigma>"]
            strand_sem_subst(2)[of \<theta> "S@S'" "{}" "\<delta> \<circ>\<^sub>s \<sigma>"]
            strand_sem_subst_subst_idem[of \<delta> "S@S'" "{}" \<sigma>]
      unfolding constr_sem_c_def
      by (metis subst_compose_assoc)
    thus "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>" by auto
  qed

  show "\<I> \<Turnstile>\<^sub>c \<langle>S@Send [Fun f T]#S',\<theta>\<rangle>"
    using \<theta>\<delta>_support(1) \<open>\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; [Send [Fun f T]]\<rbrakk>\<^sub>c \<I>\<close> \<open>\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>\<close> \<open>\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>\<close>
    by (auto simp add: constr_sem_c_def)
next
  case (Equality S \<delta> t t' a S' \<theta>)
  have "(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>" "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>"
    using Equality.prems(2) unfolding constr_sem_c_def by metis+
  then obtain \<sigma> where \<sigma>: "\<theta> \<circ>\<^sub>s \<delta> \<circ>\<^sub>s \<sigma> = \<I>" unfolding subst_compose_def by auto

  have "fv t \<subseteq> vars\<^sub>s\<^sub>t (S@Equality a t t'#S')" "fv t' \<subseteq> vars\<^sub>s\<^sub>t (S@Equality a t t'#S')"
    by auto
  moreover have "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@Equality a t t'#S') = {}"
    using Equality.prems(1) unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by auto
  ultimately have \<theta>fun_id: "t \<cdot> \<theta> = t" "t' \<cdot> \<theta> = t'"
    using trm_subst_ident[of t \<theta>] trm_subst_ident[of t' \<theta>]
    by auto
  hence \<theta>\<delta>_disj:
      "subst_domain \<theta> \<inter> subst_domain \<delta> = {}"
      "subst_domain \<theta> \<inter> range_vars \<delta> = {}"
      "subst_domain \<theta> \<inter> range_vars \<theta> = {}"
    using trm_subst_disj mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] apply (blast,blast)
    using Equality.prems(1) unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by blast
  hence \<theta>\<delta>_support: "\<theta> supports \<I>" "\<delta> supports \<I>"
    by (simp_all add: subst_support_comp_split[OF \<open>(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>\<close>])

  have "fv t \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" "fv t' \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" by auto
  hence \<delta>_vars_bound: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')"
    using mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] by blast

  have "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; [Equality a t t']\<rbrakk>\<^sub>c \<I>"
  proof -
    have "t \<cdot> \<delta> = t' \<cdot> \<delta>"
      using MGU_is_Unifier[OF mgu_gives_MGU[OF Equality.hyps(2)[symmetric]]]
      by metis
    hence "t \<cdot> (\<theta> \<circ>\<^sub>s \<delta>) = t' \<cdot> (\<theta> \<circ>\<^sub>s \<delta>)" by (metis \<theta>fun_id subst_subst_compose)
    hence "t \<cdot> \<I> = t' \<cdot> \<I>" by (metis \<sigma> subst_subst_compose)
    thus ?thesis by simp
  qed

  have "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>"
  proof -
    have "(S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta> = S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "(S@S') \<cdot>\<^sub>s\<^sub>t \<theta> = S@S'"
    proof -
      have "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S') = {}"
        using Equality.prems(1)
        by (fastforce simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def simp del: subst_range.simps)
      hence "subst_domain \<theta> \<inter> fv\<^sub>s\<^sub>t (S@S') = {}" by blast
      hence "subst_domain \<theta> \<inter> fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}"
        using \<theta>\<delta>_disj(2) subst_sends_strand_fv_to_img[of "S@S'" \<delta>] by blast
      thus "(S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta> = S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "(S@S') \<cdot>\<^sub>s\<^sub>t \<theta> = S@S'"
        using strand_subst_comp \<open>subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S') = {}\<close> by (blast,blast)
    qed
    moreover have
        "(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t (S@S') = {}"
        "(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}"
        "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t (S@S') = {}"
      using wf_constr_bvars_disj[OF Equality.prems(1)]
            wf_constr_bvars_disj'[OF Equality.prems(1) \<delta>_vars_bound]
      by auto
    ultimately have "\<lbrakk>{}; S@S'\<rbrakk>\<^sub>c \<I>"
      using \<open>\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>\<close> \<sigma>
            strand_sem_subst(1)[of \<theta> "S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "{}" "\<delta> \<circ>\<^sub>s \<sigma>"]
            strand_sem_subst(2)[of \<theta> "S@S'" "{}" "\<delta> \<circ>\<^sub>s \<sigma>"]
            strand_sem_subst_subst_idem[of \<delta> "S@S'" "{}" \<sigma>]
            mgu_gives_subst_idem[OF Equality.hyps(2)[symmetric]]
      unfolding constr_sem_c_def
      by (metis subst_compose_assoc)
    thus "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>" by auto
  qed

  show "\<I> \<Turnstile>\<^sub>c \<langle>S@Equality a t t'#S',\<theta>\<rangle>"
    using \<theta>\<delta>_support(1) \<open>\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; [Equality a t t']\<rbrakk>\<^sub>c \<I>\<close> \<open>\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>\<close> \<open>\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>\<close>
    by (auto simp add: constr_sem_c_def)
qed

theorem LI_soundness:
  assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1" "(LI_preproc S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2)" "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2, \<theta>\<^sub>2\<rangle>"
  shows "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>"
using assms(2,1,3)
proof (induction S\<^sub>2 \<theta>\<^sub>2 rule: rtrancl_induct2)
  case (step S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j) thus ?case
    using LI_preproc_preserves_wellformedness[OF \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1\<close>]
          LI_preserves_wellformedness[OF \<open>(LI_preproc S\<^sub>1, \<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>i, \<theta>\<^sub>i)\<close>]
          LI_soundness_single[OF _ \<open>(S\<^sub>i, \<theta>\<^sub>i) \<leadsto> (S\<^sub>j, \<theta>\<^sub>j)\<close> \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>j, \<theta>\<^sub>j\<rangle>\<close>]
    by metis
qed (metis LI_preproc_sem_eq')
end

subsection \<open>Theorem: Completeness of the Lazy Intruder\<close>
context
begin
private lemma LI_completeness_single:
  assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1" "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>" "\<not>simple S\<^sub>1" "LI_preproc_prop S\<^sub>1"
  shows "\<exists>S\<^sub>2 \<theta>\<^sub>2. (S\<^sub>1,\<theta>\<^sub>1) \<leadsto> (S\<^sub>2,\<theta>\<^sub>2) \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2, \<theta>\<^sub>2\<rangle>)"
using not_simple_elim[OF \<open>\<not>simple S\<^sub>1\<close>]
proof -
  { \<comment> \<open>In this case \<open>S\<^sub>1\<close> isn't simple because it contains an equality constraint,
        so we can simply proceed with the reduction by computing the MGU for the equation\<close>
    assume "\<exists>S' S'' a t t'. S\<^sub>1 = S'@Equality a t t'#S'' \<and> simple S'"
    then obtain S a t t' S' where S\<^sub>1: "S\<^sub>1 = S@Equality a t t'#S'" "simple S" by moura
    hence *: "wf\<^sub>s\<^sub>t {} S" "\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<^sub>1\<rangle>" "\<theta>\<^sub>1 supports \<I>" "t \<cdot> \<I> = t' \<cdot> \<I>"
      using \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1\<close> wf_eq_fv[of "{}" S t t' S']
            fv_snd_rcv_strand_subset(5)[of S]
      by (auto simp add: constr_sem_c_def wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)

    from * have "Unifier \<I> t t'" by simp
    then obtain \<delta> where \<delta>:
        "Some \<delta> = mgu t t'" "subst_idem \<delta>" "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv t \<union> fv t'"
      using mgu_always_unifies mgu_gives_subst_idem mgu_vars_bounded by metis+

    have "\<delta> \<preceq>\<^sub>\<circ> \<I>"
      using mgu_gives_MGU[OF \<delta>(1)[symmetric]]
      by (metis \<open>Unifier \<I> t t'\<close>)
    hence "\<delta> supports \<I>" using subst_support_if_mgt_subst_idem[OF _ \<delta>(2)] by metis
    hence "(\<theta>\<^sub>1 \<circ>\<^sub>s \<delta>) supports \<I>" using subst_support_comp \<open>\<theta>\<^sub>1 supports \<I>\<close> by metis

    have "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>"
    proof -
      have "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t S\<^sub>1" using \<delta>(3) S\<^sub>1(1) by auto
      hence "\<lbrakk>{}; S\<^sub>1 \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>"
        using \<open>subst_idem \<delta>\<close> \<open>\<delta> \<preceq>\<^sub>\<circ> \<I>\<close> \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> strand_sem_subst
              wf_constr_bvars_disj'(1)[OF assms(1)]
        unfolding subst_idem_def constr_sem_c_def
        by (metis (no_types) subst_compose_assoc)
      thus "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>" using S\<^sub>1(1) by force
    qed
    moreover have "(S@Equality a t t'#S', \<theta>\<^sub>1) \<leadsto> (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>, \<theta>\<^sub>1 \<circ>\<^sub>s \<delta>)"
      using LI_rel.Equality[OF \<open>simple S\<close> \<delta>(1)] S\<^sub>1 by metis
    ultimately have ?thesis
      using S\<^sub>1(1) \<open>(\<theta>\<^sub>1 \<circ>\<^sub>s \<delta>) supports \<I>\<close>
      by (auto simp add: constr_sem_c_def)
  } moreover {
    \<comment> \<open>In this case \<open>S\<^sub>1\<close> isn't simple because it contains a deduction constraint for a composed
        term, so we must look at how this composed term is derived under the interpretation \<open>\<I>\<close>\<close>
    assume "\<exists>S' S'' ts. S\<^sub>1 = S'@Send ts#S'' \<and> (\<nexists>x. ts = [Var x]) \<and> simple S'"
    hence "\<exists>S' S'' f T. S\<^sub>1 = S'@Send [Fun f T]#S'' \<and> simple S'"
      using LI_preproc_prop_SendE[OF \<open>LI_preproc_prop S\<^sub>1\<close>]
      by fastforce
    with assms obtain S f T S' where S\<^sub>1: "S\<^sub>1 = S@Send [Fun f T]#S'" "simple S" by moura
    hence "wf\<^sub>s\<^sub>t {} S" "\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<^sub>1\<rangle>" "\<theta>\<^sub>1 supports \<I>"
      using \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1\<close>
      by (auto simp add: constr_sem_c_def wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)

    \<comment> \<open>Lemma for a common subcase\<close>
    have fun_sat: "\<I> \<Turnstile>\<^sub>c \<langle>S@(map Send1 T)@S', \<theta>\<^sub>1\<rangle>"
      when T: "\<And>t. t \<in> set T \<Longrightarrow> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
    proof -
      have "\<And>t. t \<in> set T \<Longrightarrow> \<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; [Send1 t]\<rbrakk>\<^sub>c \<I>" using T by simp
      hence "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; map Send1 T\<rbrakk>\<^sub>c \<I>"
        using \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> strand_sem_Send_map by blast
      moreover have "ik\<^sub>s\<^sub>t (S@[Send1 (Fun f T)]) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = ik\<^sub>s\<^sub>t (S@(map Send1 T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by auto
      hence "\<lbrakk>ik\<^sub>s\<^sub>t (S@(map Send1 T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>"
        using \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> unfolding S\<^sub>1(1) constr_sem_c_def by force
      ultimately show ?thesis
        using \<open>\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<^sub>1\<rangle>\<close> strand_sem_append(1)[of "{}" S \<I> "map Send1 T"]
              strand_sem_append(1)[of "{}" "S@map Send1 T" \<I> S']
        unfolding constr_sem_c_def by simp
    qed

    from S\<^sub>1 \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> have "ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c Fun f T \<cdot> \<I>" by (auto simp add: constr_sem_c_def)
    hence ?thesis
    proof cases
      \<comment> \<open>Case 1: \<open>\<I>(f(T))\<close> has been derived using the \<open>AxiomC\<close> rule.\<close>
      case AxiomC
      hence ex_t: "\<exists>t. t \<in> ik\<^sub>s\<^sub>t S \<and> Fun f T \<cdot> \<I> = t \<cdot> \<I>" by auto
      show ?thesis
      proof (cases "\<forall>T'. Fun f T' \<in> ik\<^sub>s\<^sub>t S \<longrightarrow> Fun f T \<cdot> \<I> \<noteq> Fun f T' \<cdot> \<I>")
        \<comment> \<open>Case 1.1: \<open>f(T)\<close> is equal to a variable in the intruder knowledge under \<open>\<I>\<close>.
            Hence there must exists a deduction constraint in the simple prefix of the constraint
            in which this variable occurs/"is sent" for the first time. Since this variable itself
            cannot have been derived from the \<open>AxiomC\<close> rule (because it must be equal under the
            interpretation to \<open>f(T)\<close>, which is by assumption not in the intruder knowledge under
            \<open>\<I>\<close>) it must be the case that we can derive it using the \<open>ComposeC\<close> rule. Hence we can
            apply the \<open>Compose\<close> rule of the lazy intruder to \<open>f(T)\<close>.\<close>
        case True
        have "\<exists>v. Var v \<in> ik\<^sub>s\<^sub>t S \<and> Fun f T \<cdot> \<I> = \<I> v"
        proof -
          obtain t where "t \<in> ik\<^sub>s\<^sub>t S" "Fun f T \<cdot> \<I> = t \<cdot> \<I>" using ex_t by moura
          thus ?thesis
            using \<open>\<forall>T'. Fun f T' \<in> ik\<^sub>s\<^sub>t S \<longrightarrow> Fun f T \<cdot> \<I> \<noteq> Fun f T' \<cdot> \<I>\<close>
            by (cases t) auto
        qed
        hence "\<exists>v \<in> wfrestrictedvars\<^sub>s\<^sub>t S. Fun f T \<cdot> \<I> = \<I> v"
          using vars_subset_if_in_strand_ik2[of _ S] by fastforce
        then obtain v S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f
          where S: "S = S\<^sub>p\<^sub>r\<^sub>e@Send [Var v]#S\<^sub>s\<^sub>u\<^sub>f" "Fun f T \<cdot> \<I> = \<I> v"
                   "\<not>(\<exists>w \<in> wfrestrictedvars\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e. Fun f T \<cdot> \<I> = \<I> w)"
          using \<open>wf\<^sub>s\<^sub>t {} S\<close> wf_simple_strand_first_Send_var_split[OF _ \<open>simple S\<close>, of "Fun f T" \<I>]
          by auto
        hence "\<forall>w. Var w \<in> ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<longrightarrow> \<I> v \<noteq> Var w \<cdot> \<I>" by force
        moreover have "\<forall>T'. Fun f T' \<in> ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<longrightarrow> Fun f T \<cdot> \<I> \<noteq> Fun f T' \<cdot> \<I>"
          using \<open>\<forall>T'. Fun f T' \<in> ik\<^sub>s\<^sub>t S \<longrightarrow> Fun f T \<cdot> \<I> \<noteq> Fun f T' \<cdot> \<I>\<close> S(1)
          by (meson contra_subsetD ik_append_subset(1))
        hence "\<forall>g T'. Fun g T' \<in> ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<longrightarrow> \<I> v \<noteq> Fun g T' \<cdot> \<I>" using S(2) by simp
        ultimately have "\<forall>t \<in> ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e. \<I> v \<noteq> t \<cdot> \<I>" by (metis term.exhaust)
        hence "\<I> v \<notin> (ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by auto

        have "ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c \<I> v"
          using S\<^sub>1(1) S(1) \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close>
          by (auto simp add: constr_sem_c_def)
        hence "ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c Fun f T \<cdot> \<I>" using \<open>Fun f T \<cdot> \<I> = \<I> v\<close> by metis
        hence "length T = arity f" "public f" "\<And>t. t \<in> set T \<Longrightarrow> ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
          using \<open>Fun f T \<cdot> \<I> = \<I> v\<close> \<open>\<I> v \<notin> ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>\<close>
                intruder_synth.simps[of "ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "\<I> v"]
          by auto
        hence *: "\<And>t. t \<in> set T \<Longrightarrow> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
          using S(1) by (auto intro: ideduct_synth_mono)
        hence "\<I> \<Turnstile>\<^sub>c \<langle>S@(map Send1 T)@S', \<theta>\<^sub>1\<rangle>" by (metis fun_sat)
        moreover have "(S@Send [Fun f T]#S', \<theta>\<^sub>1) \<leadsto> (S@map Send1 T@S', \<theta>\<^sub>1)"
          by (metis LI_rel.Compose[OF \<open>simple S\<close> \<open>length T = arity f\<close> \<open>public f\<close>])
        ultimately show ?thesis using S\<^sub>1 by auto
      next
        \<comment> \<open>Case 1.2: \<open>\<I>(f(T))\<close> can be derived from an interpreted composed term in the intruder
            knowledge. Use the \<open>Unify\<close> rule on this composed term to further reduce the constraint.\<close>
        case False
        then obtain T' where t: "Fun f T' \<in> ik\<^sub>s\<^sub>t S" "Fun f T \<cdot> \<I> = Fun f T' \<cdot> \<I>"
          by auto
        hence "fv (Fun f T') \<subseteq> fv\<^sub>s\<^sub>t S\<^sub>1"
          using S\<^sub>1(1) fv_subset_if_in_strand_ik'[OF t(1)]
                fv_snd_rcv_strand_subset(2)[of S]
          by auto
        from t have "Unifier \<I> (Fun f T) (Fun f T')" by simp
        then obtain \<delta> where \<delta>:
            "Some \<delta> = mgu (Fun f T) (Fun f T')" "subst_idem \<delta>"
            "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv (Fun f T) \<union> fv (Fun f T')"
          using mgu_always_unifies mgu_gives_subst_idem mgu_vars_bounded by metis+

        have "\<delta> \<preceq>\<^sub>\<circ> \<I>"
          using mgu_gives_MGU[OF \<delta>(1)[symmetric]]
          by (metis \<open>Unifier \<I> (Fun f T) (Fun f T')\<close>)
        hence "\<delta> supports \<I>" using subst_support_if_mgt_subst_idem[OF _ \<delta>(2)] by metis
        hence "(\<theta>\<^sub>1 \<circ>\<^sub>s \<delta>) supports \<I>" using subst_support_comp \<open>\<theta>\<^sub>1 supports \<I>\<close> by metis

        have "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>"
        proof -
          have "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t S\<^sub>1"
            using \<delta>(3) S\<^sub>1(1) \<open>fv (Fun f T') \<subseteq> fv\<^sub>s\<^sub>t S\<^sub>1\<close>
            unfolding range_vars_alt_def by (fastforce simp del: subst_range.simps)
          hence "\<lbrakk>{}; S\<^sub>1 \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>"
            using \<open>subst_idem \<delta>\<close> \<open>\<delta> \<preceq>\<^sub>\<circ> \<I>\<close> \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> strand_sem_subst
                  wf_constr_bvars_disj'(1)[OF assms(1)]
            unfolding subst_idem_def constr_sem_c_def
            by (metis (no_types) subst_compose_assoc)
          thus "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>" using S\<^sub>1(1) by force
        qed
        moreover have "(S@Send [Fun f T]#S', \<theta>\<^sub>1) \<leadsto> (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>, \<theta>\<^sub>1 \<circ>\<^sub>s \<delta>)"
          using LI_rel.Unify[OF \<open>simple S\<close> t(1) \<delta>(1)] S\<^sub>1 by metis
        ultimately show ?thesis
          using S\<^sub>1(1) \<open>(\<theta>\<^sub>1 \<circ>\<^sub>s \<delta>) supports \<I>\<close>
          by (auto simp add: constr_sem_c_def)
      qed
    next
      \<comment> \<open>Case 2: \<open>\<I>(f(T))\<close> has been derived using the \<open>ComposeC\<close> rule.
          Simply use the \<open>Compose\<close> rule of the lazy intruder to proceed with the reduction.\<close>
      case (ComposeC T' g)
      hence "f = g" "length T = arity f" "public f"
        and "\<And>x. x \<in> set T \<Longrightarrow> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c x \<cdot> \<I>"
        by auto
      hence "\<I> \<Turnstile>\<^sub>c \<langle>S@(map Send1 T)@S', \<theta>\<^sub>1\<rangle>" using fun_sat by metis
      moreover have "(S\<^sub>1, \<theta>\<^sub>1) \<leadsto> (S@(map Send1 T)@S', \<theta>\<^sub>1)"
        using S\<^sub>1 LI_rel.Compose[OF \<open>simple S\<close> \<open>length T = arity f\<close> \<open>public f\<close>]
        by metis
      ultimately show ?thesis by metis
    qed
  } moreover have "\<And>A B X F. S\<^sub>1 = A@Inequality X F#B \<Longrightarrow> ineq_model \<I> X F"
    using assms(2) by (auto simp add: constr_sem_c_def)
  ultimately show ?thesis using not_simple_elim[OF \<open>\<not>simple S\<^sub>1\<close>] by metis
qed

theorem LI_completeness:
  assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1" "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>"
  shows "\<exists>S\<^sub>2 \<theta>\<^sub>2. (LI_preproc S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2) \<and> simple S\<^sub>2 \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2, \<theta>\<^sub>2\<rangle>)"
proof (cases "simple (LI_preproc S\<^sub>1)")
  case False
  let ?Stuck = "\<lambda>S\<^sub>2 \<theta>\<^sub>2. \<not>(\<exists>S\<^sub>3 \<theta>\<^sub>3. (S\<^sub>2,\<theta>\<^sub>2) \<leadsto> (S\<^sub>3,\<theta>\<^sub>3) \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>3, \<theta>\<^sub>3\<rangle>))"
  let ?Sats = "{((S,\<theta>),(S',\<theta>')). (S,\<theta>) \<leadsto> (S',\<theta>') \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>) \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S', \<theta>'\<rangle>)}"

  have simple_if_stuck:
      "\<And>S\<^sub>2 \<theta>\<^sub>2. \<lbrakk>(LI_preproc S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>+ (S\<^sub>2,\<theta>\<^sub>2); \<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2, \<theta>\<^sub>2\<rangle>; ?Stuck S\<^sub>2 \<theta>\<^sub>2\<rbrakk> \<Longrightarrow> simple S\<^sub>2"
    using LI_preproc_preserves_wellformedness[OF \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1\<close>]
          LI_preserves_LI_preproc_prop[OF _ LI_preproc_preproc_prop]
          LI_completeness_single[OF LI_preserves_wellformedness]
          trancl_into_rtrancl
    by metis

  have base: "\<exists>b. ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),b) \<in> ?Sats"
    using LI_preproc_preserves_wellformedness[OF \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1\<close>]
          LI_completeness_single[OF _ _ False LI_preproc_preproc_prop]
          LI_preproc_sem_eq' \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close>
    by auto

  have *: "\<And>S \<theta> S' \<theta>'. ((S,\<theta>),(S',\<theta>')) \<in> ?Sats\<^sup>+ \<Longrightarrow> (S,\<theta>) \<leadsto>\<^sup>+ (S',\<theta>') \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S', \<theta>'\<rangle>)"
  proof -
    fix S \<theta> S' \<theta>'
    assume "((S,\<theta>),(S',\<theta>')) \<in> ?Sats\<^sup>+"
    thus "(S,\<theta>) \<leadsto>\<^sup>+ (S',\<theta>') \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S', \<theta>'\<rangle>)"
      by (induct rule: trancl_induct2) auto
  qed

  have "\<exists>S\<^sub>2 \<theta>\<^sub>2. ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S\<^sub>2,\<theta>\<^sub>2)) \<in> ?Sats\<^sup>+ \<and> ?Stuck S\<^sub>2 \<theta>\<^sub>2"
  proof (rule ccontr)
    assume "\<not>(\<exists>S\<^sub>2 \<theta>\<^sub>2. ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S\<^sub>2,\<theta>\<^sub>2)) \<in> ?Sats\<^sup>+ \<and> ?Stuck S\<^sub>2 \<theta>\<^sub>2)"
    hence sat_not_stuck: "\<And>S\<^sub>2 \<theta>\<^sub>2. ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S\<^sub>2,\<theta>\<^sub>2)) \<in> ?Sats\<^sup>+ \<Longrightarrow> \<not>?Stuck S\<^sub>2 \<theta>\<^sub>2" by blast

    have "\<forall>S \<theta>. ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S,\<theta>)) \<in> ?Sats\<^sup>+ \<longrightarrow> (\<exists>b. ((S,\<theta>),b) \<in> ?Sats)"
    proof (intro allI impI)
      fix S \<theta> assume a: "((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S,\<theta>)) \<in> ?Sats\<^sup>+"
      have "\<And>b. ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),b) \<in> ?Sats\<^sup>+ \<Longrightarrow> \<exists>c. b \<leadsto> c \<and> ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),c) \<in> ?Sats\<^sup>+"
      proof -
        fix b assume in_sat: "((LI_preproc S\<^sub>1,\<theta>\<^sub>1),b) \<in> ?Sats\<^sup>+"
        hence "\<exists>c. (b,c) \<in> ?Sats" using * sat_not_stuck by (cases b) blast
        thus "\<exists>c. b \<leadsto> c \<and> ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),c) \<in> ?Sats\<^sup>+"
          using trancl_into_trancl[OF in_sat] by blast
      qed
      hence "\<exists>S' \<theta>'. (S,\<theta>) \<leadsto> (S',\<theta>') \<and> ((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S',\<theta>')) \<in> ?Sats\<^sup>+" using a by auto
      then obtain S' \<theta>' where S'\<theta>': "(S,\<theta>) \<leadsto> (S',\<theta>')" "((LI_preproc S\<^sub>1,\<theta>\<^sub>1),(S',\<theta>')) \<in> ?Sats\<^sup>+" by auto
      hence "\<I> \<Turnstile>\<^sub>c \<langle>S', \<theta>'\<rangle>" using * by blast
      moreover have "(LI_preproc S\<^sub>1, \<theta>\<^sub>1) \<leadsto>\<^sup>+ (S,\<theta>)" using a trancl_mono by blast
      ultimately have "((S,\<theta>),(S',\<theta>')) \<in> ?Sats" using S'\<theta>'(1) * a by blast
      thus "\<exists>b. ((S,\<theta>),b) \<in> ?Sats" using S'\<theta>'(2) by blast
    qed
    hence "\<exists>f. \<forall>i::nat. (f i, f (Suc i)) \<in> ?Sats"
      using infinite_chain_intro'[OF base] by blast
    moreover have "?Sats \<subseteq> LI_rel\<^sup>+" by auto
    hence "\<not>(\<exists>f. \<forall>i::nat. (f i, f (Suc i)) \<in> ?Sats)"
      using LI_no_infinite_chain infinite_chain_mono by blast
    ultimately show False by auto
  qed
  hence "\<exists>S\<^sub>2 \<theta>\<^sub>2. (LI_preproc S\<^sub>1, \<theta>\<^sub>1) \<leadsto>\<^sup>+ (S\<^sub>2, \<theta>\<^sub>2) \<and> simple S\<^sub>2 \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2, \<theta>\<^sub>2\<rangle>)"
    using simple_if_stuck * by blast
  thus ?thesis by (meson trancl_into_rtrancl)
qed (use LI_preproc_sem_eq' \<open>\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle>\<close> in blast)
end

subsection \<open>Corollary: Soundness and Completeness as a Single Theorem\<close>
corollary LI_soundness_and_completeness:
  assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1"
  shows "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1, \<theta>\<^sub>1\<rangle> \<longleftrightarrow> (\<exists>S\<^sub>2 \<theta>\<^sub>2. (LI_preproc S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2) \<and> simple S\<^sub>2 \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2, \<theta>\<^sub>2\<rangle>))"
by (metis LI_soundness[OF assms] LI_completeness[OF assms])

end

end


(* AUTHOR: Qiyuan Xu, 2022 *)

theory VDT_Example
  imports "Virtual_Datatype.Virtual_Datatype" "Phi_Document.Base"
begin

section \<open>Introduction\<close>

text \<open>Virtual Datatype (VDT) provides a locale approach for inheritance of datatypes
  and any proof elements including theorems, definitions, and notations about these datatypes.
  In essence, it is a locale that constrains and assumes partially some constructors of
  a concrete type parameter, and the inheritance is merging the assumptions, i.e., combination
  of locales.
  As a set of assumptions and constraints, it is not a concrete type but more like an abstract
  interface.
  Theories and proofs above it are therefore abstract and available for any concrete types
  that match the interface, via interpreting the locale by @{command interpretation}.

Recursive datatype is supported.
For each constructor, a corresponding destructor is provided.
Case-split is not supported right now but is planned, for case-splitting only assumed constructors
and leaving future constructors in underscore, e.g. \<open>case x of Known_Constructor v \<Rightarrow> f v | _ \<Rightarrow>
the_case_for_future_constructors.\<close>

A typical usage of the virtual datatype is formalizing program semantics partially and modularly.
For example, it is suitable to model the deep representation of program values.
A minimal common set of the semantics can be provided, including maybe only integer values.
Then for a language having enumeration values, corresponding formalization can extend the previous
virtual datatype of integers.

Virtual datatype is implemented by locales.
Actually, it is the dual of the Statespace by Norbert Schirmer~\cite{Statespace}.
Maintained by locales, a Statespace is essentially a function \<open>Name \<Rightarrow> Value\<close> from a set of
distinct \<open>Names\<close> to a deep embedding of \<open>Values\<close>.
By contrast, Virtual Datatype is a production \<open>Constructor \<times> Value\<close> where the \<open>Value\<close> is
still the deep embedding of that \<open>Value\<close> in Statespace, and \<open>Constructor\<close> is the counterpart of
the \<open>Name\<close> in Statespace. Indeed, the \<open>Constructor\<close> and the \<open>Name\<close> are only different in
how we name them. \<close>

section \<open>Syntax\<close>

text \<open>
A virtual datatype is declared by command @{command virtual_datatype}.

  \begin{matharray}{rcl}
    @{command_def virtual_datatype} & : & \<open>theory \<rightarrow> theory\<close>\\
  \end{matharray}

  \<^rail>\<open>
    @@{command virtual_datatype} @{syntax environ}? @{syntax vdt_name} ('=' @{syntax vdt_descr})?
    ;
    @{syntax_def environ}: '(' 'in' @{syntax name} ')'
    ;
    @{syntax_def vdt_name}: @{syntax tyargs}? @{syntax name} ('::' @{syntax sort})?
    ;
    @{syntax_def tyargs}: (@{syntax typefree} | '(' (@{syntax typefree} + @{syntax typefree}) ')')
    ;
    @{syntax_def vdt_descr}: (@{syntax parents} | @{syntax constructors} | @{syntax parents} '+' @{syntax constructors})
    ;
    @{syntax_def constructors}: (@{syntax name} '::' @{syntax type} + @{syntax constructors})
    ;
    @{syntax_def parents}: (@{syntax parent} + @{syntax parent})
    ;
    @{syntax_def parent}: (@{syntax qualifier} ':')? (@{syntax tyinsts})?
          @{syntax name} (@{syntax renames})?
    ;
    @{syntax_def tyinsts}: (@{syntax type} | '(' (@{syntax type} + @{syntax type}) ')')
    ;
    @{syntax_def renames}: '[' ((@{syntax name} '=' @{syntax name}) + @{syntax renames}) ']'
  \<close>

\<^descr> Optional @{syntax environ} indicates the locale of virtual datatype to extend the @{syntax environ}
  locale. Constructors of the virtual datatype are able to use types fixed or defined in the
  @{syntax environ}.
  If not given, no @{syntax environ} locale is used.

\<^descr> @{syntax vdt_name} indicates the name of the VDT,
  together with type arguments and the sort of the VDT.
  @{syntax tyargs} is a sequence of type variables parameterize the VDT, which resembles that in
  @{command datatype}.
  The actual sort of the VDT is the meet (intersection) of the given sort and the sorts of all
  parents.

\<^descr> @{syntax vdt_descr} describes the parents and new constructors of the VDT.
  If it is not given, the command defines an empty VDT that contains no constructors.

  In @{syntax vdt_descr}, a special type variable \<^typ>\<open>'self\<close> denotes the type of the VDT itself,
  allowing to define recursive VDT. Examples are given in the next section.

\<^descr> @{syntax constructors} are a sequence of name-type pairs for each constructor.
  A constructor should has exactly one argument.
  Multiple arguments can be aggregated into a tuple.
  None argument can be a unit.

\<^descr> @{syntax parents} give the parent VDTs to be inherit.
  The syntax resembles locale expression as in \cite{Isar}.
  @{syntax qualifier} is exactly that in locale expression, cf. \cite{Isar}.
  @{syntax tyinsts} are optional type instantiations for type parameters of the parent.
  @{syntax renames} can optionally rename constructors in the parent.
  \<^verbatim>\<open>[A=A',B=B']\<close> renames constructors \<^verbatim>\<open>A,B\<close> in the parent to \<^verbatim>\<open>A',B'\<close> in the child VDT.
  By this, it enables to inherit the same parent twice with different names of constructors.
\<close>

text \<open>\<^emph>\<open>Remark\<close>: different with inheriting a parent, it is unfeasible to rename constructors in
  a \<open>environ\<close> locale. A \<open>environ\<close> locale is opened using @{command context} during the parse
  phase.\<close>

section \<open>Usage through Examples\<close>

subsection \<open>Declare a VDT\<close>

text \<open>The following example defines a VDT named \<open>T1\<close> in sort \<open>plus\<close>, having two constructors
  \<open>C1\<close> and \<open>C2\<close> for \<^typ>\<open>nat\<close> and \<^typ>\<open>bool\<close> respectively.\<close>

virtual_datatype T1 :: plus =
  C1 :: nat
  C2 :: bool

text \<open>The essence of a VDT is a locale.\<close>

locale T1_demo =
  fixes CONS_OF :: "'rep::plus \<Rightarrow> 'CONS_NAME"
    and C1 :: "('CONS_NAME, 'rep, nat)  Virtual_Datatype.Field"
    and C2 :: "('CONS_NAME, 'rep, bool) Virtual_Datatype.Field"
  assumes "Field.project C1 (Field.inject C1 n) = n"
    and   "Field.project C2 (Field.inject C2 b) = b"
    and  \<open>Field.name C1 \<noteq> Field.name C2\<close>

datatype ('CONS_NAME,'rep,'T) Field_demo =
  Field_demo (name: 'CONS_NAME) (project: "'rep \<Rightarrow> 'T") (inject: "'T \<Rightarrow> 'rep")

text \<open>\<^typ>\<open>'CONS_NAME\<close> can be any type that identifies constructors, e.g. \<^typ>\<open>string\<close> or \<^typ>\<open>nat\<close>.
\<^typ>\<open>'rep\<close> is the representation type of instances in the VDT.
A constructor of argument type \<open>'T\<close> is an injector from \<open>'T\<close> to \<open>'rep\<close> and reversely
a destructor is a projector from \<open>'rep\<close> to \<open>'T\<close>.
Type \<open>Field\<close> describes a constructor-destructor pair, together with the name of the constructor.
\<^term>\<open>CONS_OF\<close> gives the constructor of a given instance.

Assumptions constrain the injectors are injective and the projectors are their inverse functions.
The last assumption constrains the names of constructors are distinct.
\<close>

subsection \<open>Operations in VDT\<close>

text \<open>Operations are available inside the locale \<open>T1\<close> of the VDT.\<close>

context T1 begin

subsubsection \<open>Representation Type\<close>

text \<open>\<^typ>\<open>'rep\<close> is a sort plus!\<close>
typ \<open>'rep :: plus\<close>

subsubsection \<open>Constructor\<close>

term \<open>C1.mk 42 :: 'rep\<close> \<comment> \<open>Make an instance by constructor \<^term>\<open>\<f>\<i>\<e>\<l>\<d>_C1\<close>\<close>

lemma \<open>C1.mk = Virtual_Datatype.Field.inject \<f>\<i>\<e>\<l>\<d>_C1\<close>
  \<comment> \<open>\<open>C1.mk\<close> is merely a syntax sugar of \<open>Virtual_Datatype.Field.inject C1\<close>\<close>
  by simp

ML \<open>@{term C1.mk} = @{term \<open>Virtual_Datatype.Field.inject \<f>\<i>\<e>\<l>\<d>_C1\<close>}\<close> \<comment> \<open>is True!\<close>

subsubsection \<open>Destructor\<close>

term \<open>C1.dest :: 'rep \<Rightarrow> nat\<close> \<comment> \<open>Destructor corresponding to \<^term>\<open>\<f>\<i>\<e>\<l>\<d>_C1\<close>\<close>

lemma \<open>C1.dest = Virtual_Datatype.Field.project \<f>\<i>\<e>\<l>\<d>_C1\<close>
  \<comment> \<open>Yet another syntax sugar\<close>
  by simp

lemma \<open>C1.dest (C1.mk x) = x\<close>
  \<comment> \<open>Automation for destruction is prepared.\<close>
  by simp

subsubsection \<open>Constructor Name\<close>

term \<open>C1.name :: 'CONS_NAME\<close> \<comment> \<open>The name of the constructor \<open>\<f>\<i>\<e>\<l>\<d>_C1\<close>\<close>

lemma \<open>C1.name = Virtual_Datatype.Field.name \<f>\<i>\<e>\<l>\<d>_C1\<close>
  \<comment> \<open>Yet another syntax sugar\<close>
  by simp

lemma "C1.name \<noteq> C2.name"
  \<comment> \<open>Names are distinct.\<close>
  by simp

subsubsection \<open>Equality\<close>

lemma "C1.mk x \<noteq> C2.mk y"
  \<comment> \<open>Representations under different constructor are different\<close>
  by simp

lemma "C1.mk x = C1.mk y \<longleftrightarrow> x = y"
  \<comment> \<open>Representations under the same constructor are injective w.r.t the constructor.\<close>
  by simp

subsubsection \<open>Misc\<close>

lemma "CONS_OF (C1.mk x) = C1.name"
  \<comment> \<open>You can use \<open>CONS_OF\<close> to get the constructor from a representation.\<close>
  by simp

lemma \<open>C1.is_instance (C1.mk x)\<close>
      \<open>\<not> C2.is_instance (C1.mk x)\<close>
      \<open>C1.is_instance v \<longleftrightarrow> (\<exists>x. v = C1.mk x)\<close>
  \<comment> \<open>\<open>C.is_instance\<close> asserts whether a representation is an instance of the constructor.\<close>
  unfolding C1.is_instance_def by simp+
end

subsection \<open>Inheritance\<close>

text \<open>It is feasible to declare a new VDT inheriting the previous VDTs.\<close>

virtual_datatype T2 = T1 +
  C3 :: int

text \<open>The locale of @{locale T2} extends all locales of its parents.\<close>

locale T2_demo =
  fixes CONS_OF :: "'rep::plus \<Rightarrow> 'CONS_NAME"
    and C1 :: "('CONS_NAME, 'rep, nat)  Virtual_Datatype.Field"
    and C2 :: "('CONS_NAME, 'rep, bool) Virtual_Datatype.Field"
    and C3 :: "('CONS_NAME, 'rep, int) Virtual_Datatype.Field"
  assumes "Field.project C1 (Field.inject C1 n) = n"
    and   "Field.project C2 (Field.inject C2 b) = b"
    and   "Field.project C3 (Field.inject C3 i) = i"
    and \<open>distinct [Field.name C1, Field.name C2, Field.name C3]\<close>

text \<open>Proof elements defined on the parent VDT locales, are feasible on the children VDTs.\<close>

definition (in T1) "trn vx = C1.mk (if C2.dest vx then 1 else 0)"

lemma (in T1) trn: \<open>trn (C2.mk True) = C1.mk 1\<close>
  unfolding trn_def by simp

context T2 begin
thm trn  \<comment>  \<open>\<open>trn (C2.mk True) = C1.mk 1\<close>\<close>
end

text \<open>A parent may be inherited by multiple times in a child and
constructors in the parent are able to be renamed.

As an example, this \<open>T3\<close> inherits \<open>T1\<close> twice, by qualifying the second inheritance with name \<open>t1'\<close>
and renaming only the constructor \<open>C1\<close>.\<close>

virtual_datatype T3 = T1 + t1': T1[C1=C1']

text \<open>The resulting locale is like this. Note we only rename the \<open>C1\<close> so the constructor \<open>C2\<close>
is shared between two copies of \<open>T1\<close>.\<close>

print_locale T3

locale T3_demo =
  fixes CONS_OF :: "'rep::plus \<Rightarrow> 'CONS_NAME"
    and C1 :: "('CONS_NAME, 'rep, nat)  Virtual_Datatype.Field"
    and C2 :: "('CONS_NAME, 'rep, bool) Virtual_Datatype.Field"
    and C1' :: "('CONS_NAME, 'rep, nat) Virtual_Datatype.Field"
  assumes "Field.project C1 (Field.inject C1 n) = n"
    and   "Field.project C2 (Field.inject C2 b) = b"
    and   "Field.project C1' (Field.inject C1' n) = n"
    and \<open>distinct [Field.name C1, Field.name C2, Field.name C1']\<close>

text \<open>Proof elements of \<open>T1\<close> represent also two copies in \<open>T3\<close>\<close>

context T3 begin
thm trn     \<comment> \<open>@{thm trn}\<close>
thm t1'.trn \<comment> \<open>@{thm t1'.trn}\<close>
end

text \<open>Note there are two theorems \<open>trn\<close>, two constant \<open>trn\<close> and \<open>t1'.trn\<close>.
Two theorems share the same constructor \<open>C2\<close> but use their own different \<open>C1\<close> and \<open>C1'\<close>.\<close>

subsection \<open>Recursion\<close>

text \<open>Recursion is feasible by using \<^typ>\<open>'self\<close>.
For example, the following implements a list using VDT.\<close>

virtual_datatype TR =
  R_NIL :: "unit"
  R_CONS :: "nat \<times> 'self"

text \<open>A limitation is, lacking of case-split and Bounded Natural Functor (BNF)~\cite{datatypes},
it is unfeasible to define recursive functions over VDTs right now.
It is not a theoretical limitation and is planned in future.\<close>

context TR begin

definition "sth = R_CONS.mk (3, R_CONS.mk (2, R_NIL.mk ()))"
  \<comment> \<open>Instead, we use some trivial things to demonstrate the basic recursion.\<close>

end

text \<open>Recall VDT is by locale-based approach. It is a set of assumptions which can be inconsistent.\<close>

virtual_datatype Inconsistent =
  Inconsit :: "'self \<Rightarrow> bool"

text \<open>Therefore, any conclusion proven on VDTs is valid only until the VDTs are interpreted.\<close>

subsection \<open>Interpretation of VDT locale\<close>

datatype cons_names = MY_R_NIL | MY_R_CONS

interpretation interp1: TR
  "(\<lambda>l. case l of [] \<Rightarrow> MY_R_NIL | _ \<Rightarrow> MY_R_CONS)" _ _
  \<open>Virtual_Datatype.Field MY_R_NIL (\<lambda>_. ()) (\<lambda>_. [])\<close>
  \<open>Virtual_Datatype.Field MY_R_CONS (\<lambda>l. case l of (a#l') \<Rightarrow> (a,l')) (\<lambda>(a,l'). a#l')\<close>
  by unfold_locales (auto split: list.split unit.split)

thm interp1.sth_def[simplified] \<comment> \<open>@{thm interp1.sth_def[simplified]}\<close>

section \<open>Documentation of Inner Implementation for Developers\<close>

text \<open>The essence of a VDT is three locales.
@{locale T1_names} is for names of constructors, @{locale T1_prjs} describes the projectors
and injectors of each constructor, and @{locale T1} combines them two.\<close>

print_locale T1_names
print_locale T1_prjs
print_locale T1

end