Initial commit, based on AFP entry dated 2020-05-22.

CITATION

@@ -0,0 +1,38 @@
+To cite the use of this formal theory, please use
+
+  Andreas V. Hess, Sebastian Mödersheim, and Achim D. Brucker. Stateful
+  Protocol Composition and Typing. In Archive of Formal Proofs, 2020. 
+  http://www.isa-afp.org/entries/tateful_Protocol_Composition_and_Typing.html, 
+  Formal proof development
+
+A BibTeX entry for LaTeX users is
+@Article{ hess.ea:stateful:2020,
+	abstract= {We provide in this AFP entry several relative soundness 
+                   results for security protocols. In particular, we prove 
+                   typing and compositionality results for stateful protocols
+                   (i.e., protocols with mutable state that may span several
+                   sessions), and that focuses on reachability properties. Such
+                   results are useful to simplify protocol verification by 
+                   reducing it to a simpler problem: Typing results give 
+                   conditions under which it is safe to verify a protocol in a 
+                   typed model where only "well-typed" attacks can occur whereas 
+                   compositionality results allow us to verify a composed protocol
+                   by only verifying the component protocols in isolation. The 
+                   conditions on the protocols under which the results hold are 
+                   furthermore syntactic in nature allowing for full automation. 
+                   The foundation presented here is used in another entry to 
+                   provide fully automated and formalized security proofs of 
+                   stateful protocols.},
+	author	= {Andreas V. Hess and Sebastian M{\"o}dersheim and Achim D. Brucker},
+	date	= {2020-04-08},
+	file	= {https://www.brucker.ch/bibliography/download/2020/hess.ea-stateful-outline-2020.pdf},
+	filelabel= {Outline},
+	issn	= {2150-914x},
+	journal	= {Archive of Formal Proofs},
+	month	= {apr},
+	note	= {\url{http://www.isa-afp.org/entries/tateful_Protocol_Composition_and_Typing.html}, Formal proof development},
+	pdf	= {https://www.brucker.ch/bibliography/download/2020/hess.ea-stateful-2020.pdf},
+	title	= {Stateful Protocol Composition and Typing},
+	url	= {https://www.brucker.ch/bibliography/abstract/hess.ea-stateful-2020},
+	year	= {2020},
+} 

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2015-2020 Technical University Denmark, Denmark
+              2017-2019 The University of Sheffield, UK
+              2019-2020 University of Exeter, UK
+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 holders 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.

README.md

@@ -0,0 +1,44 @@
+# Stateful Protocol Composition and Typing (
+
+This git repository contains a local mirror of
+[Stateful Protocol Composition and Typing](https://www.isa-afp.org/entries/Stateful_Protocol_Composition_and_Typing.html)
+entry of the
+[Archive of Formal Proofs (AFP)](https://www.isa-afp.org).
+
+The official AFP releases are tagged. Additionally, this repository
+may contain extensions (i.e., a development version) that may be
+submitted (as an update of the Stateful Protocol Composition and Typing entry) at a later stage.
+
+## Installation
+
+```console
+achim@logicalhacking:~$ isabelle build -D Stateful_Protocol_Composition_and_Typing.html
+```
+
+## Authors
+
+* Andreas V. Hess
+* [Sebastian Mödersheim](https://people.compute.dtu.dk/samo/)
+* [Achim D. Brucker](http://www.brucker.ch/)
+
+## License
+
+This project is licensed under a 3-clause BSD-style license.
+
+SPDX-License-Identifier: BSD-3-Clause
+
+## Master Repository
+
+The master git repository for this project is hosted by the [Software
+Assurance & Security Research Team](https://logicalhacking.com) at
+<https://git.logicalhacking.com/afp-mirror/Stateful_Protocol_Composition_and_Typing.html>.
+
+## Publications
+
+* Andreas V. Hess, Sebastian Mödersheim, and Achim D. Brucker. Stateful
+  Protocol Composition and Typing. In Archive of Formal Proofs, 2020. 
+  http://www.isa-afp.org/entries/tateful_Protocol_Composition_and_Typing.html, 
+  Formal proof development
+* Andreas V. Hess, Sebastian A. Mödersheim, and Achim D. Brucker. Stateful 
+  Protocol Composition. In ESORICS. Lecture Notes in Computer Science (11098),
+  pages 427-446, Springer-Verlag, 2018. doi:[10.1007/978-3-319-99073-6](https://dx.doi.org/10.1007/978-3-319-99073-6) 

Stateful_Protocol_Composition_and_Typing/Examples.thy

@@ -0,0 +1,5 @@
+theory Examples
+  imports "examples/Example_Keyserver"
+          "examples/Example_TLS"
+begin
+end

Stateful_Protocol_Composition_and_Typing/Labeled_Stateful_Strands.thy

@@ -0,0 +1,906 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2018-2020
+
+All Rights Reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+- Redistributions of source code must retain the above copyright
+  notice, this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer in the
+  documentation and/or other materials provided with the distribution.
+
+- Neither the name of the copyright holder nor the names of its
+  contributors may be used to endorse or promote products
+  derived from this software without specific prior written
+  permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(*  Title:      Labeled_Stateful_Strands.thy
+    Author:     Andreas Viktor Hess, DTU
+*)
+
+section \<open>Labeled Stateful Strands\<close>
+theory Labeled_Stateful_Strands
+imports Stateful_Strands Labeled_Strands
+begin
+
+subsection \<open>Definitions\<close>
+text\<open>Syntax for stateful strand labels\<close>
+abbreviation Star_step ("\<langle>\<star>, _\<rangle>") where
+  "\<langle>\<star>, (s::('a,'b) stateful_strand_step)\<rangle> \<equiv> (\<star>, s)"
+
+abbreviation LabelN_step ("\<langle>_, _\<rangle>") where
+  "\<langle>(l::'a), (s::('b,'c) stateful_strand_step)\<rangle> \<equiv> (ln l, s)"
+
+
+text\<open>Database projection\<close>
+abbreviation dbproj where "dbproj l D \<equiv> filter (\<lambda>d. fst d = l) D"
+
+text\<open>The type of labeled stateful strands\<close>
+type_synonym ('a,'b,'c) labeled_stateful_strand_step = "'c strand_label \<times> ('a,'b) stateful_strand_step"
+type_synonym ('a,'b,'c) labeled_stateful_strand = "('a,'b,'c) labeled_stateful_strand_step list"
+
+text\<open>Dual strands\<close>
+fun dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p::"('a,'b,'c) labeled_stateful_strand_step \<Rightarrow> ('a,'b,'c) labeled_stateful_strand_step"
+where
+  "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,send\<langle>t\<rangle>) = (l,receive\<langle>t\<rangle>)"
+| "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,receive\<langle>t\<rangle>) = (l,send\<langle>t\<rangle>)"
+| "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = x"
+
+definition dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t::"('a,'b,'c) labeled_stateful_strand \<Rightarrow> ('a,'b,'c) labeled_stateful_strand"
+where
+  "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<equiv> map dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p"
+
+text\<open>Substitution application\<close>
+fun subst_apply_labeled_stateful_strand_step::
+  "('a,'b,'c) labeled_stateful_strand_step \<Rightarrow> ('a,'b) subst \<Rightarrow>
+   ('a,'b,'c) labeled_stateful_strand_step"
+  (infix "\<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p" 51) where
+  "(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>  = (l,s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
+
+definition subst_apply_labeled_stateful_strand::
+  "('a,'b,'c) labeled_stateful_strand \<Rightarrow> ('a,'b) subst \<Rightarrow> ('a,'b,'c) labeled_stateful_strand"
+  (infix "\<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t" 51) where
+  "S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta> \<equiv> map (\<lambda>x. x \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) S"
+
+text\<open>Definitions lifted from stateful strands\<close>
+abbreviation wfrestrictedvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "wfrestrictedvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t (unlabel S)"
+
+abbreviation ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> ik\<^sub>s\<^sub>s\<^sub>t (unlabel S)"
+
+abbreviation db\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> db\<^sub>s\<^sub>s\<^sub>t (unlabel S)"
+abbreviation db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> db'\<^sub>s\<^sub>s\<^sub>t (unlabel S)"
+
+abbreviation trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> trms\<^sub>s\<^sub>s\<^sub>t (unlabel S)"
+abbreviation trms_proj\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "trms_proj\<^sub>l\<^sub>s\<^sub>s\<^sub>t n S \<equiv> trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n S)"
+
+abbreviation vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> vars\<^sub>s\<^sub>s\<^sub>t (unlabel S)"
+abbreviation vars_proj\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "vars_proj\<^sub>l\<^sub>s\<^sub>s\<^sub>t n S \<equiv> vars\<^sub>s\<^sub>s\<^sub>t (proj_unl n S)"
+
+abbreviation bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel S)"
+abbreviation fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> fv\<^sub>s\<^sub>s\<^sub>t (unlabel S)"
+
+text\<open>Labeled set-operations\<close>
+fun setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p where
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,insert\<langle>t,s\<rangle>) = {(i,t,s)}"
+| "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,delete\<langle>t,s\<rangle>) = {(i,t,s)}"
+| "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,\<langle>_: t \<in> s\<rangle>) = {(i,t,s)}"
+| "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,\<forall>_\<langle>\<or>\<noteq>: _ \<or>\<notin>: F'\<rangle>) = ((\<lambda>(t,s). (i,t,s)) ` set F')"
+| "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p _ = {}"
+
+definition setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t where
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> \<Union>(setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ` set S)"
+
+
+subsection \<open>Minor Lemmata\<close>
+lemma subst_lsst_nil[simp]: "[] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = []"
+by (simp add: subst_apply_labeled_stateful_strand_def)
+
+lemma subst_lsst_cons: "a#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)#(A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
+by (simp add: subst_apply_labeled_stateful_strand_def)
+
+lemma subst_lsst_singleton: "[(l,s)] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = [(l,s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)]"
+by (simp add: subst_apply_labeled_stateful_strand_def)
+
+lemma subst_lsst_append: "A@B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)@(B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
+by (simp add: subst_apply_labeled_stateful_strand_def)
+
+lemma subst_lsst_append_inv:
+  assumes "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = B1@B2"
+  shows "\<exists>A1 A2. A = A1@A2 \<and> A1 \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = B1 \<and> A2 \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = B2"
+using assms
+proof (induction A arbitrary: B1 B2)
+  case (Cons a A)
+  note prems = Cons.prems
+  note IH = Cons.IH
+  show ?case
+  proof (cases B1)
+    case Nil
+    then obtain b B3 where "B2 = b#B3" "a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> = b" "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = B3"
+      using prems subst_lsst_cons by fastforce
+    thus ?thesis by (simp add: Nil subst_apply_labeled_stateful_strand_def)
+  next
+    case (Cons b B3)
+    hence "a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> = b" "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = B3@B2"
+      using prems by (simp_all add: subst_lsst_cons)
+    thus ?thesis by (metis Cons_eq_appendI Cons IH subst_lsst_cons) 
+  qed
+qed (metis append_is_Nil_conv subst_lsst_nil)
+
+lemma subst_lsst_member[intro]: "x \<in> set A \<Longrightarrow> x \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<in> set (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
+by (metis image_eqI set_map subst_apply_labeled_stateful_strand_def)
+
+lemma subst_lsst_unlabel_cons: "unlabel ((l,b)#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)#(unlabel (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+by (simp add: subst_apply_labeled_stateful_strand_def)
+
+lemma subst_lsst_unlabel: "unlabel (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = unlabel A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>"
+proof (induction A)
+  case (Cons a A)
+  then obtain l b where "a = (l,b)" by (metis surj_pair)
+  thus ?case
+    using Cons
+    by (simp add: subst_apply_labeled_stateful_strand_def subst_apply_stateful_strand_def)
+qed simp
+
+lemma subst_lsst_unlabel_member[intro]:
+  assumes "x \<in> set (unlabel A)"
+  shows "x \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<in> set (unlabel (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>))"
+proof -
+  obtain l where x: "(l,x) \<in> set A" using assms unfolding unlabel_def by moura
+  thus ?thesis
+    using subst_lsst_member
+    by (metis unlabel_def in_set_zipE subst_apply_labeled_stateful_strand_step.simps zip_map_fst_snd)
+qed
+
+lemma subst_lsst_prefix:
+  assumes "prefix B (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+  shows "\<exists>C. C \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta> = B \<and> prefix C A"
+using assms
+proof (induction A rule: List.rev_induct)
+  case (snoc a A) thus ?case
+  proof (cases "B = A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>")
+    case False thus ?thesis
+      using snoc by (auto simp add: subst_lsst_append[of A] subst_lsst_cons)
+  qed auto
+qed simp
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_nil[simp]: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] = []"
+by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_Cons[simp]:
+  "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,send\<langle>t\<rangle>)#A) = (l,receive\<langle>t\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,receive\<langle>t\<rangle>)#A) = (l,send\<langle>t\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,\<langle>a: t \<doteq> s\<rangle>)#A) = (l,\<langle>a: t \<doteq> s\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,insert\<langle>t,s\<rangle>)#A) = (l,insert\<langle>t,s\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,delete\<langle>t,s\<rangle>)#A) = (l,delete\<langle>t,s\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,\<langle>a: t \<in> s\<rangle>)#A) = (l,\<langle>a: t \<in> s\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>)#A) = (l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+by (simp_all add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append[simp]: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t B"
+by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>"
+proof -
+  obtain l x  where s: "s = (l,x)" by moura
+  thus ?thesis by (cases x) (auto simp add: subst_apply_labeled_stateful_strand_def)
+qed
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>"
+proof (induction S)
+  case (Cons s S) thus ?case
+    using Cons dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[of s \<delta>]
+    by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def)
+qed (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def)
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_unlabel: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>" 
+by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst subst_lsst_unlabel)
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_cons: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>))"
+by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst list.simps(9) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def)
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_append: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t B) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>"
+by (metis (no_types) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append)
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>)@[dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma>]"
+by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_cons list.map(1) map_append
+          subst_apply_labeled_stateful_strand_def)
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD:
+  assumes "(l,a) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  shows "\<exists>b. (l,b) \<in> set A \<and> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,b) = (l,a)"
+  using assms
+proof (induction A)
+  case (Cons c A)
+  hence "(l,a) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<or> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p c = (l,a)" unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by force
+  thus ?case
+  proof
+    assume "(l,a) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" thus ?case using Cons.IH by auto
+  next
+    assume a: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p c = (l,a)"
+    obtain i b where b: "c = (i,b)" by (metis surj_pair)
+    thus ?case using a by (cases b) auto
+  qed
+qed simp
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv:
+  assumes "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l, a) = (k, b)"
+  shows "l = k"
+    and "a = receive\<langle>t\<rangle> \<Longrightarrow> b = send\<langle>t\<rangle>"
+    and "a = send\<langle>t\<rangle> \<Longrightarrow> b = receive\<langle>t\<rangle>"
+    and "(\<nexists>t. a = receive\<langle>t\<rangle> \<or> a = send\<langle>t\<rangle>) \<Longrightarrow> b = a"
+proof -
+  show "l = k" using assms by (cases a) auto
+  show "a = receive\<langle>t\<rangle> \<Longrightarrow> b = send\<langle>t\<rangle>" using assms by (cases a) auto
+  show "a = send\<langle>t\<rangle> \<Longrightarrow> b = receive\<langle>t\<rangle>" using assms by (cases a) auto
+  show "(\<nexists>t. a = receive\<langle>t\<rangle> \<or> a = send\<langle>t\<rangle>) \<Longrightarrow> b = a" using assms by (cases a) auto
+qed
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_self_inverse: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = A"
+proof (induction A)
+  case (Cons a A)
+  obtain l b where "a = (l,b)" by (metis surj_pair)
+  thus ?case using Cons by (cases b) auto
+qed simp
+
+lemma vars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq: "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+proof (induction A)
+  case (Cons a A)
+  obtain l b where a: "a = (l,b)" by (metis surj_pair)
+  thus ?case using Cons.IH by (cases b) auto
+qed simp
+
+lemma fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+proof (induction A)
+  case (Cons a A)
+  obtain l b where a: "a = (l,b)" by (metis surj_pair)
+  thus ?case using Cons.IH by (cases b) auto
+qed simp
+
+lemma bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+proof (induction A)
+  case (Cons a A)
+  obtain l b where a: "a = (l,b)" by (metis surj_pair)
+  thus ?case using Cons.IH by (cases b) simp+
+qed simp
+
+lemma vars\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons: "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,b)#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+by (metis unlabel_Cons(1) vars\<^sub>s\<^sub>s\<^sub>t_Cons)
+
+lemma fv\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,b)#A) = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+by (metis unlabel_Cons(1) fv\<^sub>s\<^sub>s\<^sub>t_Cons)
+
+lemma bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,b)#A) = set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+by (metis unlabel_Cons(1) bvars\<^sub>s\<^sub>s\<^sub>t_Cons)
+
+lemma bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+by (metis subst_lsst_unlabel bvars\<^sub>s\<^sub>s\<^sub>t_subst)
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_member:
+  assumes "(l,x) \<in> set A"
+    and "\<not>is_Receive x" "\<not>is_Send x"
+  shows "(l,x) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+using assms
+proof (induction A)
+  case (Cons a A) thus ?case using assms(2,3) by (cases x) (auto simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
+qed simp
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_member:
+  assumes "x \<in> set (unlabel A)"
+    and "\<not>is_Receive x" "\<not>is_Send x"
+  shows "x \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+using assms dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_member[of _ _ A]
+  by (meson unlabel_in unlabel_mem_has_label)
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff:
+  "(l,send\<langle>t\<rangle>) \<in> set A \<longleftrightarrow> (l,receive\<langle>t\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  "(l,receive\<langle>t\<rangle>) \<in> set A \<longleftrightarrow> (l,send\<langle>t\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  "(l,\<langle>c: t \<doteq> s\<rangle>) \<in> set A \<longleftrightarrow> (l,\<langle>c: t \<doteq> s\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  "(l,insert\<langle>t,s\<rangle>) \<in> set A \<longleftrightarrow> (l,insert\<langle>t,s\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  "(l,delete\<langle>t,s\<rangle>) \<in> set A \<longleftrightarrow> (l,delete\<langle>t,s\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  "(l,\<langle>c: t \<in> s\<rangle>) \<in> set A \<longleftrightarrow> (l,\<langle>c: t \<in> s\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  "(l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) \<in> set A \<longleftrightarrow> (l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+proof (induction A)
+  case (Cons a A)
+  obtain j b where a: "a = (j,b)" by (metis surj_pair)
+  { case 1 thus ?case by (cases b) (simp_all add: Cons.IH(1) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) }
+  { case 2 thus ?case by (cases b) (simp_all add: Cons.IH(2) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) }
+  { case 3 thus ?case by (cases b) (simp_all add: Cons.IH(3) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) }
+  { case 4 thus ?case by (cases b) (simp_all add: Cons.IH(4) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) }
+  { case 5 thus ?case by (cases b) (simp_all add: Cons.IH(5) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) }
+  { case 6 thus ?case by (cases b) (simp_all add: Cons.IH(6) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) }
+  { case 7 thus ?case by (cases b) (simp_all add: Cons.IH(7) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) }
+qed (simp_all add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff:
+  "send\<langle>t\<rangle> \<in> set (unlabel A) \<longleftrightarrow> receive\<langle>t\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "receive\<langle>t\<rangle> \<in> set (unlabel A) \<longleftrightarrow> send\<langle>t\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "\<langle>c: t \<doteq> s\<rangle> \<in> set (unlabel A) \<longleftrightarrow> \<langle>c: t \<doteq> s\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "insert\<langle>t,s\<rangle> \<in> set (unlabel A) \<longleftrightarrow> insert\<langle>t,s\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "delete\<langle>t,s\<rangle> \<in> set (unlabel A) \<longleftrightarrow> delete\<langle>t,s\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "\<langle>c: t \<in> s\<rangle> \<in> set (unlabel A) \<longleftrightarrow> \<langle>c: t \<in> s\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set (unlabel A) \<longleftrightarrow> \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(1,2)[of _ t A]
+      dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(3,6)[of _ c t s A]
+      dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(4,5)[of _ t s A]
+      dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(7)[of _ X F G A]
+by (meson unlabel_in unlabel_mem_has_label)+
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all:
+  "list_all is_Receive (unlabel A) \<Longrightarrow> list_all is_Send (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "list_all is_Send (unlabel A) \<Longrightarrow> list_all is_Receive (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "list_all is_Equality (unlabel A) \<Longrightarrow> list_all is_Equality (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "list_all is_Insert (unlabel A) \<Longrightarrow> list_all is_Insert (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "list_all is_Delete (unlabel A) \<Longrightarrow> list_all is_Delete (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "list_all is_InSet (unlabel A) \<Longrightarrow> list_all is_InSet (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "list_all is_NegChecks (unlabel A) \<Longrightarrow> list_all is_NegChecks (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "list_all is_Assignment (unlabel A) \<Longrightarrow> list_all is_Assignment (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "list_all is_Check (unlabel A) \<Longrightarrow> list_all is_Check (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  "list_all is_Update (unlabel A) \<Longrightarrow> list_all is_Update (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+proof (induct A)
+  case (Cons a A)
+  obtain l b where a: "a = (l,b)" by (metis surj_pair)
+  { case 1 thus ?case using Cons.hyps(1) a by (cases b) auto }
+  { case 2 thus ?case using Cons.hyps(2) a by (cases b) auto }
+  { case 3 thus ?case using Cons.hyps(3) a by (cases b) auto }
+  { case 4 thus ?case using Cons.hyps(4) a by (cases b) auto }
+  { case 5 thus ?case using Cons.hyps(5) a by (cases b) auto }
+  { case 6 thus ?case using Cons.hyps(6) a by (cases b) auto }
+  { case 7 thus ?case using Cons.hyps(7) a by (cases b) auto }
+  { case 8 thus ?case using Cons.hyps(8) a by (cases b) auto }
+  { case 9 thus ?case using Cons.hyps(9) a by (cases b) auto }
+  { case 10 thus ?case using Cons.hyps(10) a by (cases b) auto }
+qed simp_all
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain:
+  assumes "s \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+  shows "\<exists>l B s'. (l,s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,s') \<and> prefix (B@[(l,s')]) A"
+  using assms
+proof (induction A rule: List.rev_induct)
+  case (snoc a A)
+  obtain i b where a: "a = (i,b)" by (metis surj_pair)
+  show ?case using snoc
+  proof (cases "s \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))")
+    case False thus ?thesis
+      using a snoc.prems unlabel_append[of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t [a]"] dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append[of A "[a]"]
+      by (cases b) (force simp add: unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)+
+  qed auto
+qed simp
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst:
+  assumes "s \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
+  shows "\<exists>l B s'. (l,s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s') \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) \<and> prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s') \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+proof -
+  obtain B l s' where B: "(l,s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,s')" "prefix (B@[(l,s')]) (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+    using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain[OF assms] by moura
+
+  obtain C where C: "C \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta> = B@[(l,s')]"
+    using subst_lsst_prefix[OF B(2)] by moura
+
+  obtain D u where D: "C = D@[(l,u)]" "D \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta> = B" "[(l,u)] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta> = [(l, s')]"
+    using subst_lsst_prefix[OF B(2)] subst_lsst_append_inv[OF C(1)]
+    by (auto simp add: subst_apply_labeled_stateful_strand_def)
+
+  show ?thesis 
+    using B D subst_lsst_cons subst_lsst_singleton
+    by (metis (no_types, lifting) nth_append_length)
+qed
+
+lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq: "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+proof (induction A)
+  case (Cons a A)
+  obtain l b where a: "a = (l,b)" by (metis surj_pair)
+  thus ?case using Cons.IH by (cases b) auto
+qed simp
+
+lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst_cons:
+  "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,b)#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
+by (metis subst_lsst_unlabel trms\<^sub>s\<^sub>s\<^sub>t_subst_cons unlabel_Cons(1))
+
+lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst:
+  assumes "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<theta> = {}"
+  shows "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
+by (metis trms\<^sub>s\<^sub>s\<^sub>t_subst[OF assms] subst_lsst_unlabel)
+
+lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst':
+  fixes t::"('a,'b) term" and \<delta>::"('a,'b) subst"
+  assumes "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
+  shows "\<exists>s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S. \<exists>X. set X \<subseteq> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<and> t = s \<cdot> rm_vars (set X) \<delta>"
+using assms
+proof (induction S)
+  case (Cons a S)
+  obtain l b where a: "a = (l,b)" by (metis surj_pair)
+  hence "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) \<or> t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)" 
+    using Cons.prems trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst_cons by fast
+  thus ?case
+  proof
+    assume *: "t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)"
+    show ?thesis using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst''[OF *] a by auto
+  next
+    assume *: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
+    show ?thesis using Cons.IH[OF *] a by auto
+  qed
+qed simp
+
+lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst'':
+  fixes t::"('a,'b) term" and \<delta> \<theta>::"('a,'b) subst"
+  assumes "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
+  shows "\<exists>s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S. \<exists>X. set X \<subseteq> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<and> t = s \<cdot> rm_vars (set X) \<delta> \<circ>\<^sub>s \<theta>"
+proof -
+  obtain s where s: "s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" "t = s \<cdot> \<theta>" using assms by moura
+  show ?thesis using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst'[OF s(1)] s(2) by auto
+qed
+
+lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual_subst_cons:
+  "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>)) = (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma>)) \<union> (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>)))"
+proof -
+  obtain l b where a: "a = (l,b)" by (metis surj_pair)
+  thus ?thesis using a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_cons[of a A \<sigma>] by (cases b) auto
+qed
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_funs_term:
+  "\<Union>(funs_term ` (trms\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S)))) = \<Union>(funs_term ` (trms\<^sub>s\<^sub>s\<^sub>t (unlabel S)))"
+using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq by fast
+
+lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_db\<^sub>l\<^sub>s\<^sub>s\<^sub>t:
+  "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+proof (induction A)
+  case (Cons a A)
+  obtain l b where a: "a = (l,b)" by (metis surj_pair)
+  thus ?case using Cons by (cases b) auto
+qed simp
+
+lemma db\<^sub>s\<^sub>s\<^sub>t_unlabel_append:
+  "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) I D = db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t B I (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I D)"
+by (metis db\<^sub>s\<^sub>s\<^sub>t_append unlabel_append)
+
+lemma db\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t:
+  "db'\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>))) \<I> D = db'\<^sub>s\<^sub>s\<^sub>t (unlabel (T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)) \<I> D"
+proof (induction T arbitrary: D)
+  case (Cons x T)
+  obtain l s where "x = (l,s)" by moura
+  thus ?case
+    using Cons
+    by (cases s) (simp_all add: unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def)  
+qed (simp add: unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def)
+
+lemma labeled_list_insert_eq_cases:
+  "d \<notin> set (unlabel D) \<Longrightarrow> List.insert d (unlabel D) = unlabel (List.insert (i,d) D)"
+  "(i,d) \<in> set D \<Longrightarrow> List.insert d (unlabel D) = unlabel (List.insert (i,d) D)"
+unfolding unlabel_def
+by (metis (no_types, hide_lams) List.insert_def image_eqI list.simps(9) set_map snd_conv,
+    metis in_set_insert set_zip_rightD zip_map_fst_snd)
+
+lemma labeled_list_insert_eq_ex_cases:
+  "List.insert d (unlabel D) = unlabel (List.insert (i,d) D) \<or>
+  (\<exists>j. (j,d) \<in> set D \<and> List.insert d (unlabel D) = unlabel (List.insert (j,d) D))"
+using labeled_list_insert_eq_cases unfolding unlabel_def
+by (metis in_set_impl_in_set_zip2 length_map zip_map_fst_snd)
+
+lemma proj_subst: "proj l (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = proj l A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>"
+proof (induction A)
+  case (Cons a A)
+  obtain l b where "a = (l,b)" by (metis surj_pair)
+  thus ?case using Cons unfolding proj_def subst_apply_labeled_stateful_strand_def by force
+qed simp 
+
+lemma proj_set_subset[simp]:
+  "set (proj n A) \<subseteq> set A"
+unfolding proj_def by auto
+
+lemma proj_proj_set_subset[simp]:
+  "set (proj n (proj m A)) \<subseteq> set (proj n A)"
+  "set (proj n (proj m A)) \<subseteq> set (proj m A)"
+  "set (proj_unl n (proj m A)) \<subseteq> set (proj_unl n A)"
+  "set (proj_unl n (proj m A)) \<subseteq> set (proj_unl m A)"
+unfolding unlabel_def proj_def by auto
+
+lemma proj_in_set_iff:
+  "(ln i, d) \<in> set (proj i D) \<longleftrightarrow> (ln i, d) \<in> set D"
+  "(\<star>, d) \<in> set (proj i D) \<longleftrightarrow> (\<star>, d) \<in> set D"
+unfolding proj_def by auto
+
+lemma proj_list_insert:
+  "proj i (List.insert (ln i,d) D) = List.insert (ln i,d) (proj i D)"
+  "proj i (List.insert (\<star>,d) D) = List.insert (\<star>,d) (proj i D)"
+  "i \<noteq> j \<Longrightarrow> proj i (List.insert (ln j,d) D) = proj i D"
+unfolding List.insert_def proj_def by auto
+
+lemma proj_filter: "proj i [d\<leftarrow>D. d \<notin> set Di] = [d\<leftarrow>proj i D. d \<notin> set Di]"
+by (simp_all add: proj_def conj_commute)
+
+lemma proj_list_Cons:
+  "proj i ((ln i,d)#D) = (ln i,d)#proj i D"
+  "proj i ((\<star>,d)#D) = (\<star>,d)#proj i D"
+  "i \<noteq> j \<Longrightarrow> proj i ((ln j,d)#D) = proj i D"
+unfolding List.insert_def proj_def by auto
+
+lemma proj_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t:
+  "proj l (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l A)"
+proof (induction A)
+  case (Cons a A)
+  obtain k b where "a = (k,b)" by (metis surj_pair)
+  thus ?case using Cons unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def proj_def by (cases b) auto
+qed simp
+
+lemma proj_instance_ex:
+  assumes B: "\<forall>b \<in> set B. \<exists>a \<in> set A. \<exists>\<delta>. b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> P \<delta>"
+    and b: "b \<in> set (proj l B)"
+  shows "\<exists>a \<in> set (proj l A). \<exists>\<delta>. b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> P \<delta>"
+proof -
+  obtain a \<delta> where a: "a \<in> set A" "b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>" "P \<delta>" using B b proj_set_subset by fast
+  obtain k b' where b': "b = (k, b')" "k = (ln l) \<or> k = \<star>" using b proj_in_setD by metis
+  obtain a' where a': "a = (k, a')" using b'(1) a(2) by (cases a) simp_all
+  show ?thesis using a a' b'(2) unfolding proj_def by auto
+qed
+
+lemma proj_dbproj:
+  "dbproj (ln i) (proj i D) = dbproj (ln i) D"
+  "dbproj \<star> (proj i D) = dbproj \<star> D"
+  "i \<noteq> j \<Longrightarrow> dbproj (ln j) (proj i D) = []"
+unfolding proj_def by (induct D) auto
+
+lemma dbproj_Cons:
+  "dbproj i ((i,d)#D) = (i,d)#dbproj i D"
+  "i \<noteq> j \<Longrightarrow> dbproj j ((i,d)#D) = dbproj j D"
+by auto
+
+lemma dbproj_subset[simp]:
+  "set (unlabel (dbproj i D)) \<subseteq> set (unlabel D)"
+unfolding unlabel_def by auto
+
+lemma dbproj_subseq: 
+  assumes "Di \<in> set (subseqs (dbproj k D))"
+  shows "dbproj k Di = Di" (is ?A)
+  and "i \<noteq> k \<Longrightarrow> dbproj i Di = []" (is "i \<noteq> k \<Longrightarrow> ?B")
+proof -
+  have *: "set Di \<subseteq> set (dbproj k D)" using subseqs_powset[of "dbproj k D"] assms by auto
+  thus ?A by (metis filter_True filter_set member_filter subsetCE)
+
+  have "\<And>j d. (j,d) \<in> set Di \<Longrightarrow> j = k" using * by auto
+  moreover have "\<And>j d. (j,d) \<in> set (dbproj i Di) \<Longrightarrow> j = i" by auto
+  moreover have "\<And>j d. (j,d) \<in> set (dbproj i Di) \<Longrightarrow> (j,d) \<in> set Di" by auto
+  ultimately show "i \<noteq> k \<Longrightarrow> ?B" by (metis set_empty subrelI subset_empty)
+qed
+
+lemma dbproj_subseq_subset:
+  assumes "Di \<in> set (subseqs (dbproj i D))"
+  shows "set Di \<subseteq> set D"
+by (metis Pow_iff assms filter_set image_eqI member_filter subseqs_powset subsetCE subsetI)
+
+lemma dbproj_subseq_in_subseqs:
+  assumes "Di \<in> set (subseqs (dbproj i D))"
+  shows "Di \<in> set (subseqs D)"
+using assms in_set_subseqs subseq_filter_left subseq_order.dual_order.trans by blast
+
+lemma proj_subseq:
+  assumes "Di \<in> set (subseqs (dbproj (ln j) D))" "j \<noteq> i"
+  shows "[d\<leftarrow>proj i D. d \<notin> set Di] = proj i D"
+proof -
+  have "set Di \<subseteq> set (dbproj (ln j) D)" using subseqs_powset[of "dbproj (ln j) D"] assms by auto
+  hence "\<And>k d. (k,d) \<in> set Di \<Longrightarrow> k = ln j" by auto
+  moreover have "\<And>k d. (k,d) \<in> set (proj i D) \<Longrightarrow> k \<noteq> ln j"
+    using assms(2) unfolding proj_def by auto
+  ultimately have "\<And>d. d \<in> set (proj i D) \<Longrightarrow> d \<notin> set Di" by auto
+  thus ?thesis by simp
+qed
+
+lemma unlabel_subseqsD:
+  assumes "A \<in> set (subseqs (unlabel B))"
+  shows "\<exists>C \<in> set (subseqs B). unlabel C = A"
+using assms map_subseqs unfolding unlabel_def by (metis imageE set_map) 
+
+lemma unlabel_filter_eq:
+  assumes "\<forall>(j, p) \<in> set A \<union> B. \<forall>(k, q) \<in> set A \<union> B. p = q \<longrightarrow> j = k" (is "?P (set A)")
+  shows "[d\<leftarrow>unlabel A. d \<notin> snd ` B] = unlabel [d\<leftarrow>A. d \<notin> B]"
+using assms unfolding unlabel_def
+proof (induction A)
+  case (Cons a A)
+  have "set A \<subseteq> set (a#A)" "{a} \<subseteq> set (a#A)" by auto
+  hence *: "?P (set A)" "?P {a}" using Cons.prems by fast+
+  hence IH: "[d\<leftarrow>map snd A . d \<notin> snd ` B] = map snd [d\<leftarrow>A . d \<notin> B]" using Cons.IH by auto
+
+  { assume "snd a \<in> snd ` B"
+    then obtain b where b: "b \<in> B" "snd a = snd b" by moura
+    hence "fst a = fst b" using *(2) by auto
+    hence "a \<in> B" using b by (metis surjective_pairing)  
+  } hence **: "a \<notin> B \<Longrightarrow> snd a \<notin> snd ` B" by metis
+
+  show ?case by (cases "a \<in> B") (simp add: ** IH)+ 
+qed simp
+
+lemma subseqs_mem_dbproj:
+  assumes "Di \<in> set (subseqs D)" "list_all (\<lambda>d. fst d = i) Di"
+  shows "Di \<in> set (subseqs (dbproj i D))"
+using assms
+proof (induction D arbitrary: Di)
+  case (Cons di D)
+  obtain d j where di: "di = (j,d)" by (metis surj_pair)
+  show ?case
+  proof (cases "Di \<in> set (subseqs D)")
+    case True
+    hence "Di \<in> set (subseqs (dbproj i D))" using Cons.IH Cons.prems by auto
+    thus ?thesis using subseqs_Cons by auto
+  next
+    case False
+    then obtain Di' where Di': "Di = di#Di'" using Cons.prems(1)
+      by (metis (mono_tags, lifting) Un_iff imageE set_append set_map subseqs.simps(2)) 
+    hence "Di' \<in> set (subseqs D)" using Cons.prems(1) False
+      by (metis (no_types, lifting) UnE imageE list.inject set_append set_map subseqs.simps(2)) 
+    hence "Di' \<in> set (subseqs (dbproj i D))" using Cons.IH Cons.prems Di' by auto
+    moreover have "i = j" using Di' di Cons.prems(2) by auto
+    hence "dbproj i (di#D) = di#dbproj i D" by (simp add: di)
+    ultimately show ?thesis using Di'
+      by (metis (no_types, lifting) UnCI image_eqI set_append set_map subseqs.simps(2)) 
+  qed
+qed simp
+
+lemma unlabel_subst: "unlabel S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta> = unlabel (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
+unfolding unlabel_def subst_apply_stateful_strand_def subst_apply_labeled_stateful_strand_def 
+by auto
+
+lemma subterms_subst_lsst:
+  assumes "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S). (\<exists>f. \<sigma> x = Fun f []) \<or> (\<exists>y. \<sigma> x = Var y)"
+    and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<sigma> = {}"
+  shows "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>)) = subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>"
+using subterms_subst''[OF assms(1)] trms\<^sub>s\<^sub>s\<^sub>t_subst[OF assms(2)] unlabel_subst[of S \<sigma>]
+by simp
+
+lemma subterms_subst_lsst_ik:
+  assumes "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t S). (\<exists>f. \<sigma> x = Fun f []) \<or> (\<exists>y. \<sigma> x = Var y)"
+  shows "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>)) = subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>"
+using subterms_subst''[OF assms(1)] ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel S" \<sigma>] unlabel_subst[of S \<sigma>]
+by simp
+
+lemma labeled_stateful_strand_subst_comp:
+  assumes "range_vars \<delta> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S = {}"
+  shows "S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> \<circ>\<^sub>s \<theta> = (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"
+using assms
+proof (induction S)
+  case (Cons s S)
+  obtain l x where s: "s = (l,x)" by (metis surj_pair)
+  hence IH: "S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> \<circ>\<^sub>s \<theta> = (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>" using Cons by auto
+
+  have "x \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<circ>\<^sub>s \<theta> = (x \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>"
+    using s Cons.prems stateful_strand_step_subst_comp[of \<delta> x \<theta>] by auto
+  thus ?case using s IH by (simp add: subst_apply_labeled_stateful_strand_def)
+qed simp
+
+lemma sst_vars_proj_subset[simp]:
+  "fv\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
+  "bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
+  "vars\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> vars\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
+using vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel A"]
+      vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "proj_unl n A"]
+unfolding unlabel_def proj_def by auto
+
+lemma trms\<^sub>s\<^sub>s\<^sub>t_proj_subset[simp]:
+  "trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A)" (is ?A)
+  "trms\<^sub>s\<^sub>s\<^sub>t (proj_unl m (proj n A)) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n A)" (is ?B)
+  "trms\<^sub>s\<^sub>s\<^sub>t (proj_unl m (proj n A)) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (proj_unl m A)" (is ?C)
+proof -
+  show ?A unfolding unlabel_def proj_def by auto
+  show ?B using trms\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_proj_set_subset(4)] by metis
+  show ?C using trms\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_proj_set_subset(3)] by metis
+qed
+
+lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset:
+  "trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B))" (is ?A)
+  "trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n (A@B))" (is ?B)
+using trms\<^sub>s\<^sub>s\<^sub>t_mono[of "proj_unl n A" "proj_unl n (A@B)"]
+unfolding unlabel_def proj_def by auto
+
+lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_suffix_subset:
+  "trms\<^sub>s\<^sub>s\<^sub>t (unlabel B) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B))"
+  "trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n B) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n (A@B))"
+using trms\<^sub>s\<^sub>s\<^sub>t_mono[of "proj_unl n B" "proj_unl n (A@B)"]
+unfolding unlabel_def proj_def by auto
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>pD:
+  assumes p: "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a"
+  shows "fst p = fst a" (is ?P)
+    and "is_Update (snd a) \<or> is_InSet (snd a) \<or> is_NegChecks (snd a)" (is ?Q)
+proof -
+  obtain l k p' a' where a: "p = (l,p')" "a = (k,a')" by (metis surj_pair)
+  show ?P using p a by (cases a') auto
+  show ?Q using p a by (cases a') auto
+qed
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_nil[simp]:
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] = {}"
+by (simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_cons[simp]:
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (x#S) = setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \<union> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S"
+by (simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
+
+lemma setops\<^sub>s\<^sub>s\<^sub>t_proj_subset:
+  "setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
+  "setops\<^sub>s\<^sub>s\<^sub>t (proj_unl m (proj n A)) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n A)"
+  "setops\<^sub>s\<^sub>s\<^sub>t (proj_unl m (proj n A)) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (proj_unl m A)"
+unfolding unlabel_def proj_def
+proof (induction A)
+  case (Cons a A)
+  obtain l b where lb: "a = (l,b)" by moura
+  { case 1 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) }
+  { case 2 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) }
+  { case 3 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) }
+qed simp_all
+
+lemma setops\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset:
+  "setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B))"
+  "setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n (A@B))"
+unfolding unlabel_def proj_def
+proof (induction A)
+  case (Cons a A)
+  obtain l b where lb: "a = (l,b)" by moura
+  { case 1 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) }
+  { case 2 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) }
+qed (simp_all add: setops\<^sub>s\<^sub>s\<^sub>t_def)
+
+lemma setops\<^sub>s\<^sub>s\<^sub>t_unlabel_suffix_subset:
+  "setops\<^sub>s\<^sub>s\<^sub>t (unlabel B) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B))"
+  "setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n B) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n (A@B))"
+unfolding unlabel_def proj_def
+proof (induction A)
+  case (Cons a A)
+  obtain l b where lb: "a = (l,b)" by moura
+  { case 1 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) }
+  { case 2 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) }
+qed simp_all
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj_subset:
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj m (proj n A)) \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A)"
+unfolding proj_def setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_prefix_subset:
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B)"
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n (A@B))"
+unfolding proj_def setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_suffix_subset:
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B)"
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n B) \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n (A@B))"
+unfolding proj_def setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_mono:
+  "set M \<subseteq> set N \<Longrightarrow> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t M \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t N"
+by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
+
+lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subset_if_no_label:
+  "\<not>list_ex (is_LabelN l) A \<Longrightarrow> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l A) \<subseteq> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l' A)"
+by (rule trms\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_subset_if_no_label(2)[of l A l']])
+
+lemma setops\<^sub>s\<^sub>s\<^sub>t_unlabel_subset_if_no_label:
+  "\<not>list_ex (is_LabelN l) A \<Longrightarrow> setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l A) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l' A)"
+by (rule setops\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_subset_if_no_label(2)[of l A l']])
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj_subset_if_no_label:
+  "\<not>list_ex (is_LabelN l) A \<Longrightarrow> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l A) \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l' A)"
+by (rule setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_subset_if_no_label(1)[of l A l']])
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases[simp]:
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,send\<langle>t\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,receive\<langle>t\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,\<langle>ac: s \<doteq> t\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}"
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,insert\<langle>t,s\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = {(l,t \<cdot> \<delta>,s \<cdot> \<delta>)}"
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,delete\<langle>t,s\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = {(l,t \<cdot> \<delta>,s \<cdot> \<delta>)}"
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,\<langle>ac: t \<in> s\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = {(l,t \<cdot> \<delta>,s \<cdot> \<delta>)}"
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) =
+    ((\<lambda>(t,s). (l,t \<cdot> rm_vars (set X) \<delta>,s \<cdot> rm_vars (set X) \<delta>)) ` set F')" (is "?A = ?B")
+proof -
+  have "?A = (\<lambda>(t,s). (l,t,s)) ` set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<delta>)" by auto
+  thus "?A = ?B" unfolding subst_apply_pairs_def by auto
+qed simp_all
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst:
+  assumes "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a)) \<inter> subst_domain \<theta> = {}"
+  shows "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = (\<lambda>p. (fst a,snd p \<cdot>\<^sub>p \<theta>)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a"
+proof -
+  obtain l a' where a: "a = (l,a')" by (metis surj_pair)
+  show ?thesis
+  proof (cases a')
+    case (NegChecks X F G)
+    hence *: "rm_vars (set X) \<theta> = \<theta>" using a assms rm_vars_apply'[of \<theta> "set X"] by auto
+    have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = (\<lambda>p. (fst a, p)) ` set (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)"
+      using * NegChecks a  by auto
+    moreover have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = (\<lambda>p. (fst a, p)) ` set G" using NegChecks a by simp
+    hence "(\<lambda>p. (fst a,snd p \<cdot>\<^sub>p \<theta>)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = (\<lambda>p. (fst a, p \<cdot>\<^sub>p \<theta>)) ` set G"
+      by (metis (mono_tags, lifting) image_cong image_image snd_conv)
+    hence "(\<lambda>p. (fst a,snd p \<cdot>\<^sub>p \<theta>)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = (\<lambda>p. (fst a, p)) ` (set G \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>)"
+      unfolding case_prod_unfold by auto
+    ultimately show ?thesis by (simp add: subst_apply_pairs_def) 
+  qed (use a in simp_all)
+qed
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst':
+  assumes "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a)) \<inter> subst_domain \<theta> = {}"
+  shows "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = (\<lambda>(i,p). (i,p \<cdot>\<^sub>p \<theta>)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a"
+using setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[OF assms] setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>pD(1) unfolding case_prod_unfold
+by (metis (mono_tags, lifting) image_cong)
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst:
+  assumes "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<theta> = {}"
+  shows "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = (\<lambda>p. (fst p,snd p \<cdot>\<^sub>p \<theta>)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S"
+using assms
+proof (induction S)
+  case (Cons a S)
+  have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<theta> = {}" and *: "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a)) \<inter> subst_domain \<theta> = {}"
+    using Cons.prems by auto
+  hence IH: "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = (\<lambda>p. (fst p,snd p \<cdot>\<^sub>p \<theta>)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S"
+    using Cons.IH by auto
+  show ?case
+    using setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst'[OF *] IH
+    unfolding setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def case_prod_unfold subst_lsst_cons 
+    by auto
+qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_in_subst:
+  assumes p: "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)"
+  shows "\<exists>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. fst p = fst q \<and> snd p = snd q \<cdot>\<^sub>p rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a))) \<delta>"
+    (is "\<exists>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. ?P q")
+proof -
+  obtain l b where a: "a = (l,b)" by (metis surj_pair)
+
+  show ?thesis
+  proof (cases b)
+    case (NegChecks X F F')
+    hence "p \<in> (\<lambda>(t, s). (l, t \<cdot> rm_vars (set X) \<delta>, s \<cdot> rm_vars (set X) \<delta>)) ` set F'"
+      using p a setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(7)[of l X F F' \<delta>] by blast
+    then obtain s t where st:
+        "(t,s) \<in> set F'" "p = (l, t \<cdot> rm_vars (set X) \<delta>, s \<cdot> rm_vars (set X) \<delta>)"
+      by auto
+    hence "(l,t,s) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" "fst p = fst (l,t,s)"
+          "snd p = snd (l,t,s) \<cdot>\<^sub>p rm_vars (set X) \<delta>"
+      using a NegChecks by fastforce+
+    moreover have "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a) = X" using NegChecks a by auto
+    ultimately show ?thesis by blast
+  qed (use p a in auto)
+qed
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_subst:
+  assumes "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
+  shows "\<exists>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. fst p = fst q \<and> (\<exists>X \<subseteq> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. snd p = snd q \<cdot>\<^sub>p rm_vars X \<delta>)"
+    (is "\<exists>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. ?P A q")
+  using assms
+proof (induction A)
+  case (Cons a A)
+  note 0 = unlabel_Cons(2)[of a A] bvars\<^sub>s\<^sub>s\<^sub>t_Cons[of "snd a" "unlabel A"]
+  show ?case
+  proof (cases "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)")
+    case False
+    hence "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)"
+      using Cons.prems setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_cons[of "a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>" "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>"] subst_lsst_cons[of a A \<delta>] by auto
+    moreover have "(set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a))) \<subseteq> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A)" using 0 by simp
+    ultimately have "\<exists>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. ?P (a#A) q" using setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_in_subst[of p a \<delta>] by blast
+    thus ?thesis by auto
+  qed (use Cons.IH 0 in auto)
+qed simp
+
+lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq:
+  "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+proof (induction A)
+  case (Cons a A)
+  obtain l b where "a = (l,b)" by (metis surj_pair)
+  thus ?case using Cons unfolding setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by (cases b) auto
+qed simp
+
+end

Stateful_Protocol_Composition_and_Typing/Labeled_Strands.thy

@@ -0,0 +1,372 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2018-2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2018-2020
+(C) Copyright Achim D. Brucker, University of Sheffield, 2018-2020
+
+All Rights Reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+- Redistributions of source code must retain the above copyright
+  notice, this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer in the
+  documentation and/or other materials provided with the distribution.
+
+- Neither the name of the copyright holder nor the names of its
+  contributors may be used to endorse or promote products
+  derived from this software without specific prior written
+  permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(*  Title:      Labeled_Strands.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, The University of Sheffield
+*)
+
+section \<open>Labeled Strands\<close>
+theory Labeled_Strands
+imports Strands_and_Constraints
+begin
+
+subsection \<open>Definitions: Labeled Strands and Constraints\<close>
+datatype 'l strand_label =
+  LabelN (the_LabelN: "'l") ("ln _")
+| LabelS ("\<star>")
+
+text \<open>Labeled strands are strands whose steps are equipped with labels\<close>
+type_synonym ('a,'b,'c) labeled_strand_step = "'c strand_label \<times> ('a,'b) strand_step"
+type_synonym ('a,'b,'c) labeled_strand = "('a,'b,'c) labeled_strand_step list"
+
+abbreviation is_LabelN where "is_LabelN n x \<equiv> fst x = ln n"
+abbreviation is_LabelS where "is_LabelS x \<equiv> fst x = \<star>"
+
+definition unlabel where "unlabel S \<equiv> map snd S"
+definition proj where "proj n S \<equiv> filter (\<lambda>s. is_LabelN n s \<or> is_LabelS s) S"
+abbreviation proj_unl where "proj_unl n S \<equiv> unlabel (proj n S)"
+
+abbreviation wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t where "wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t S \<equiv> wfrestrictedvars\<^sub>s\<^sub>t (unlabel S)"
+
+abbreviation subst_apply_labeled_strand_step (infix "\<cdot>\<^sub>l\<^sub>s\<^sub>t\<^sub>p" 51) where
+  "x \<cdot>\<^sub>l\<^sub>s\<^sub>t\<^sub>p \<theta> \<equiv> (case x of (l, s) \<Rightarrow> (l, s \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>))"
+
+abbreviation subst_apply_labeled_strand (infix "\<cdot>\<^sub>l\<^sub>s\<^sub>t" 51) where
+  "S \<cdot>\<^sub>l\<^sub>s\<^sub>t \<theta> \<equiv> map (\<lambda>x. x \<cdot>\<^sub>l\<^sub>s\<^sub>t\<^sub>p \<theta>) S"
+
+abbreviation trms\<^sub>l\<^sub>s\<^sub>t where "trms\<^sub>l\<^sub>s\<^sub>t S \<equiv> trms\<^sub>s\<^sub>t (unlabel S)"
+abbreviation trms_proj\<^sub>l\<^sub>s\<^sub>t where "trms_proj\<^sub>l\<^sub>s\<^sub>t n S \<equiv> trms\<^sub>s\<^sub>t (proj_unl n S)"
+
+abbreviation vars\<^sub>l\<^sub>s\<^sub>t where "vars\<^sub>l\<^sub>s\<^sub>t S \<equiv> vars\<^sub>s\<^sub>t (unlabel S)"
+abbreviation vars_proj\<^sub>l\<^sub>s\<^sub>t where "vars_proj\<^sub>l\<^sub>s\<^sub>t n S \<equiv> vars\<^sub>s\<^sub>t (proj_unl n S)"
+
+abbreviation bvars\<^sub>l\<^sub>s\<^sub>t where "bvars\<^sub>l\<^sub>s\<^sub>t S \<equiv> bvars\<^sub>s\<^sub>t (unlabel S)"
+abbreviation fv\<^sub>l\<^sub>s\<^sub>t where "fv\<^sub>l\<^sub>s\<^sub>t S \<equiv> fv\<^sub>s\<^sub>t (unlabel S)"
+
+abbreviation wf\<^sub>l\<^sub>s\<^sub>t where "wf\<^sub>l\<^sub>s\<^sub>t V S \<equiv> wf\<^sub>s\<^sub>t V (unlabel S)"
+
+
+subsection \<open>Lemmata: Projections\<close>
+lemma is_LabelS_proj_iff_not_is_LabelN:
+  "list_all is_LabelS (proj l A) \<longleftrightarrow> \<not>list_ex (is_LabelN l) A"
+by (induct A) (auto simp add: proj_def)
+
+lemma proj_subset_if_no_label:
+  assumes "\<not>list_ex (is_LabelN l) A"
+  shows "set (proj l A) \<subseteq> set (proj l' A)"
+    and "set (proj_unl l A) \<subseteq> set (proj_unl l' A)"
+using assms by (induct A) (auto simp add: unlabel_def proj_def)
+
+lemma proj_in_setD:
+  assumes a: "a \<in> set (proj l A)"
+  obtains k b where "a = (k, b)" "k = (ln l) \<or> k = \<star>"
+using that a unfolding proj_def by (cases a) auto
+
+lemma proj_set_mono:
+  assumes "set A \<subseteq> set B"
+  shows "set (proj n A) \<subseteq> set (proj n B)"
+    and "set (proj_unl n A) \<subseteq> set (proj_unl n B)"
+using assms unfolding proj_def unlabel_def by auto
+
+lemma unlabel_nil[simp]: "unlabel [] = []"
+by (simp add: unlabel_def)
+
+lemma unlabel_mono: "set A \<subseteq> set B \<Longrightarrow> set (unlabel A) \<subseteq> set (unlabel B)"
+by (auto simp add: unlabel_def)
+
+lemma unlabel_in: "(l,x) \<in> set A \<Longrightarrow> x \<in> set (unlabel A)"
+unfolding unlabel_def by force
+
+lemma unlabel_mem_has_label: "x \<in> set (unlabel A) \<Longrightarrow> \<exists>l. (l,x) \<in> set A"
+unfolding unlabel_def by auto
+
+lemma proj_nil[simp]: "proj n [] = []" "proj_unl n [] = []"
+unfolding unlabel_def proj_def by auto
+
+lemma singleton_lst_proj[simp]:
+  "proj_unl l [(ln l, a)] = [a]"
+  "l \<noteq> l' \<Longrightarrow> proj_unl l' [(ln l, a)] = []"
+  "proj_unl l [(\<star>, a)] = [a]"
+  "unlabel [(l'', a)] = [a]"
+unfolding proj_def unlabel_def by simp_all
+
+lemma unlabel_nil_only_if_nil[simp]: "unlabel A = [] \<Longrightarrow> A = []"
+unfolding unlabel_def by auto
+
+lemma unlabel_Cons[simp]:
+  "unlabel ((l,a)#A) = a#unlabel A"
+  "unlabel (b#A) = snd b#unlabel A"
+unfolding unlabel_def by simp_all
+
+lemma unlabel_append[simp]: "unlabel (A@B) = unlabel A@unlabel B"
+unfolding unlabel_def by auto
+
+lemma proj_Cons[simp]:
+  "proj n ((ln n,a)#A) = (ln n,a)#proj n A"
+  "proj n ((\<star>,a)#A) = (\<star>,a)#proj n A"
+  "m \<noteq> n \<Longrightarrow> proj n ((ln m,a)#A) = proj n A"
+  "l = (ln n) \<Longrightarrow> proj n ((l,a)#A) = (l,a)#proj n A"
+  "l = \<star> \<Longrightarrow> proj n ((l,a)#A) = (l,a)#proj n A"
+  "fst b \<noteq> \<star> \<Longrightarrow> fst b \<noteq> (ln n) \<Longrightarrow> proj n (b#A) = proj n A"
+unfolding proj_def by auto
+
+lemma proj_append[simp]:
+  "proj l (A'@B') = proj l A'@proj l B'"
+  "proj_unl l (A@B) = proj_unl l A@proj_unl l B"
+unfolding proj_def unlabel_def by auto
+
+lemma proj_unl_cons[simp]:
+  "proj_unl l ((ln l, a)#A) = a#proj_unl l A"
+  "l \<noteq> l' \<Longrightarrow> proj_unl l' ((ln l, a)#A) = proj_unl l' A"
+  "proj_unl l ((\<star>, a)#A) = a#proj_unl l A"
+unfolding proj_def unlabel_def by simp_all
+
+lemma trms_unlabel_proj[simp]:
+  "trms\<^sub>s\<^sub>t\<^sub>p (snd (ln l, x)) \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t l [(ln l, x)]"
+by auto
+
+lemma trms_unlabel_star[simp]:
+  "trms\<^sub>s\<^sub>t\<^sub>p (snd (\<star>, x)) \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t l [(\<star>, x)]"
+by auto
+
+lemma trms\<^sub>l\<^sub>s\<^sub>t_union[simp]: "trms\<^sub>l\<^sub>s\<^sub>t A = (\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l A)"
+proof (induction A)
+  case (Cons a A)
+  obtain l s where ls: "a = (l,s)" by moura
+  have "trms\<^sub>l\<^sub>s\<^sub>t [a] = (\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l [a])"
+  proof -
+    have *: "trms\<^sub>l\<^sub>s\<^sub>t [a] = trms\<^sub>s\<^sub>t\<^sub>p s" using ls by simp
+    show ?thesis
+    proof (cases l)
+      case (LabelN n)
+      hence "trms_proj\<^sub>l\<^sub>s\<^sub>t n [a] = trms\<^sub>s\<^sub>t\<^sub>p s" using ls by simp
+      moreover have "\<forall>m. n \<noteq> m \<longrightarrow> trms_proj\<^sub>l\<^sub>s\<^sub>t m [a] = {}" using ls LabelN by auto
+      ultimately show ?thesis using * ls by fastforce
+    next
+      case LabelS
+      hence "\<forall>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l [a] = trms\<^sub>s\<^sub>t\<^sub>p s" using ls by auto
+      thus ?thesis using * ls by fastforce
+    qed
+  qed
+  moreover have "\<forall>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l (a#A) = trms_proj\<^sub>l\<^sub>s\<^sub>t l [a] \<union> trms_proj\<^sub>l\<^sub>s\<^sub>t l A"
+    unfolding unlabel_def proj_def by auto
+  hence "(\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l (a#A)) = (\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l [a]) \<union> (\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l A)" by auto
+  ultimately show ?case using Cons.IH ls by auto
+qed simp
+
+lemma trms\<^sub>l\<^sub>s\<^sub>t_append[simp]: "trms\<^sub>l\<^sub>s\<^sub>t (A@B) = trms\<^sub>l\<^sub>s\<^sub>t A \<union> trms\<^sub>l\<^sub>s\<^sub>t B"
+by (metis trms\<^sub>s\<^sub>t_append unlabel_append)
+
+lemma trms_proj\<^sub>l\<^sub>s\<^sub>t_append[simp]: "trms_proj\<^sub>l\<^sub>s\<^sub>t l (A@B) = trms_proj\<^sub>l\<^sub>s\<^sub>t l A \<union> trms_proj\<^sub>l\<^sub>s\<^sub>t l B"
+by (metis (no_types, lifting) filter_append proj_def trms\<^sub>l\<^sub>s\<^sub>t_append)
+
+lemma trms_proj\<^sub>l\<^sub>s\<^sub>t_subset[simp]:
+  "trms_proj\<^sub>l\<^sub>s\<^sub>t l A \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t l (A@B)"
+  "trms_proj\<^sub>l\<^sub>s\<^sub>t l B \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t l (A@B)"
+using trms_proj\<^sub>l\<^sub>s\<^sub>t_append[of l] by blast+
+
+lemma trms\<^sub>l\<^sub>s\<^sub>t_subset[simp]:
+  "trms\<^sub>l\<^sub>s\<^sub>t A \<subseteq> trms\<^sub>l\<^sub>s\<^sub>t (A@B)"
+  "trms\<^sub>l\<^sub>s\<^sub>t B \<subseteq> trms\<^sub>l\<^sub>s\<^sub>t (A@B)"
+proof (induction A)
+  case (Cons a A)
+  obtain l s where *: "a = (l,s)" by moura
+  { case 1 thus ?case using Cons * by auto }
+  { case 2 thus ?case using Cons * by auto }
+qed simp_all
+
+lemma vars\<^sub>l\<^sub>s\<^sub>t_union: "vars\<^sub>l\<^sub>s\<^sub>t A = (\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l A)"
+proof (induction A)
+  case (Cons a A)
+  obtain l s where ls: "a = (l,s)" by moura
+  have "vars\<^sub>l\<^sub>s\<^sub>t [a] = (\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l [a])"
+  proof -
+    have *: "vars\<^sub>l\<^sub>s\<^sub>t [a] = vars\<^sub>s\<^sub>t\<^sub>p s" using ls by auto
+    show ?thesis
+    proof (cases l)
+      case (LabelN n)
+      hence "vars_proj\<^sub>l\<^sub>s\<^sub>t n [a] = vars\<^sub>s\<^sub>t\<^sub>p s" using ls by simp
+      moreover have "\<forall>m. n \<noteq> m \<longrightarrow> vars_proj\<^sub>l\<^sub>s\<^sub>t m [a] = {}" using ls LabelN by auto
+      ultimately show ?thesis using * ls by fast
+    next
+      case LabelS
+      hence "\<forall>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l [a] = vars\<^sub>s\<^sub>t\<^sub>p s" using ls by auto
+      thus ?thesis using * ls by fast
+    qed
+  qed
+  moreover have "\<forall>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l (a#A) = vars_proj\<^sub>l\<^sub>s\<^sub>t l [a] \<union> vars_proj\<^sub>l\<^sub>s\<^sub>t l A"
+    unfolding unlabel_def proj_def by auto
+  hence "(\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l (a#A)) = (\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l [a]) \<union> (\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l A)"
+    using strand_vars_split(1) by auto
+  ultimately show ?case using Cons.IH ls strand_vars_split(1) by auto
+qed simp
+
+lemma unlabel_Cons_inv:
+  "unlabel A = b#B \<Longrightarrow> \<exists>A'. (\<exists>n. A = (ln n, b)#A') \<or> A = (\<star>, b)#A'"
+proof -
+  assume *: "unlabel A = b#B"
+  then obtain l A' where "A = (l,b)#A'" unfolding unlabel_def by moura
+  thus "\<exists>A'. (\<exists>l. A = (ln l, b)#A') \<or> A = (\<star>, b)#A'" by (metis strand_label.exhaust)
+qed
+
+lemma unlabel_snoc_inv:
+  "unlabel A = B@[b] \<Longrightarrow> \<exists>A'. (\<exists>n. A = A'@[(ln n, b)]) \<or> A = A'@[(\<star>, b)]"
+proof -
+  assume *: "unlabel A = B@[b]"
+  then obtain A' l where "A = A'@[(l,b)]"
+    unfolding unlabel_def by (induct A rule: List.rev_induct) auto
+  thus "\<exists>A'. (\<exists>n. A = A'@[(ln n, b)]) \<or> A = A'@[(\<star>, b)]" by (cases l) auto
+qed
+
+lemma proj_idem[simp]: "proj l (proj l A) = proj l A"
+unfolding proj_def by auto
+
+lemma proj_ik\<^sub>s\<^sub>t_is_proj_rcv_set:
+  "ik\<^sub>s\<^sub>t (proj_unl n A) = {t. (ln n, Receive t) \<in> set A \<or> (\<star>, Receive t) \<in> set A} "
+using ik\<^sub>s\<^sub>t_is_rcv_set unfolding unlabel_def proj_def by force
+
+lemma unlabel_ik\<^sub>s\<^sub>t_is_rcv_set:
+  "ik\<^sub>s\<^sub>t (unlabel A) = {t | l t. (l, Receive t) \<in> set A}"
+using ik\<^sub>s\<^sub>t_is_rcv_set unfolding unlabel_def by force
+
+lemma proj_ik_union_is_unlabel_ik:
+  "ik\<^sub>s\<^sub>t (unlabel A) = (\<Union>l. ik\<^sub>s\<^sub>t (proj_unl l A))"
+proof
+  show "(\<Union>l. ik\<^sub>s\<^sub>t (proj_unl l A)) \<subseteq> ik\<^sub>s\<^sub>t (unlabel A)"
+    using unlabel_ik\<^sub>s\<^sub>t_is_rcv_set[of A] proj_ik\<^sub>s\<^sub>t_is_proj_rcv_set[of _ A] by auto
+
+  show "ik\<^sub>s\<^sub>t (unlabel A) \<subseteq> (\<Union>l. ik\<^sub>s\<^sub>t (proj_unl l A))"
+  proof
+    fix t assume "t \<in> ik\<^sub>s\<^sub>t (unlabel A)"
+    then obtain l where "(l, Receive t) \<in> set A"
+      using ik\<^sub>s\<^sub>t_is_rcv_set unlabel_mem_has_label[of _ A]
+      by moura
+    thus "t \<in> (\<Union>l. ik\<^sub>s\<^sub>t (proj_unl l A))" using proj_ik\<^sub>s\<^sub>t_is_proj_rcv_set[of _ A] by (cases l) auto
+  qed
+qed
+
+lemma proj_ik_append[simp]:
+  "ik\<^sub>s\<^sub>t (proj_unl l (A@B)) = ik\<^sub>s\<^sub>t (proj_unl l A) \<union> ik\<^sub>s\<^sub>t (proj_unl l B)"
+using proj_append(2)[of l A B] ik_append by auto
+
+lemma proj_ik_append_subst_all:
+  "ik\<^sub>s\<^sub>t (proj_unl l (A@B)) \<cdot>\<^sub>s\<^sub>e\<^sub>t I = (ik\<^sub>s\<^sub>t (proj_unl l A) \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<union> (ik\<^sub>s\<^sub>t (proj_unl l B) \<cdot>\<^sub>s\<^sub>e\<^sub>t I)"
+using proj_ik_append[of l] by auto
+
+lemma ik_proj_subset[simp]: "ik\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t n A"
+by auto
+
+lemma prefix_proj:
+  "prefix A B \<Longrightarrow> prefix (unlabel A) (unlabel B)"
+  "prefix A B \<Longrightarrow> prefix (proj n A) (proj n B)"
+  "prefix A B \<Longrightarrow> prefix (proj_unl n A) (proj_unl n B)"
+unfolding prefix_def unlabel_def proj_def by auto
+
+
+subsection \<open>Lemmata: Well-formedness\<close>
+lemma wfvarsoccs\<^sub>s\<^sub>t_proj_union:
+  "wfvarsoccs\<^sub>s\<^sub>t (unlabel A) = (\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A))"
+proof (induction A)
+  case (Cons a A)
+  obtain l s where ls: "a = (l,s)" by moura
+  have "wfvarsoccs\<^sub>s\<^sub>t (unlabel [a]) = (\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a]))"
+  proof -
+    have *: "wfvarsoccs\<^sub>s\<^sub>t (unlabel [a]) = wfvarsoccs\<^sub>s\<^sub>t\<^sub>p s" using ls by auto
+    show ?thesis
+    proof (cases l)
+      case (LabelN n)
+      hence "wfvarsoccs\<^sub>s\<^sub>t (proj_unl n [a]) = wfvarsoccs\<^sub>s\<^sub>t\<^sub>p s" using ls by simp
+      moreover have "\<forall>m. n \<noteq> m \<longrightarrow> wfvarsoccs\<^sub>s\<^sub>t (proj_unl m [a]) = {}" using ls LabelN by auto
+      ultimately show ?thesis using * ls by fast
+    next
+      case LabelS
+      hence "\<forall>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a]) = wfvarsoccs\<^sub>s\<^sub>t\<^sub>p s" using ls by auto
+      thus ?thesis using * ls by fast
+    qed
+  qed
+  moreover have
+      "wfvarsoccs\<^sub>s\<^sub>t (proj_unl l (a#A)) =
+       wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a]) \<union> wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A)"
+    for l
+    unfolding unlabel_def proj_def by auto
+  hence "(\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l (a#A))) =
+         (\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a])) \<union> (\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A))"
+    using strand_vars_split(1) by auto
+  ultimately show ?case using Cons.IH ls strand_vars_split(1) by auto
+qed simp
+
+lemma wf_if_wf_proj:
+  assumes "\<forall>l. wf\<^sub>s\<^sub>t V (proj_unl l A)"
+  shows "wf\<^sub>s\<^sub>t V (unlabel A)"
+using assms
+proof (induction A arbitrary: V rule: List.rev_induct)
+  case (snoc a A)
+  hence IH: "wf\<^sub>s\<^sub>t V (unlabel A)" using proj_append(2)[of _ A] by auto
+  obtain b l where b: "a = (ln l, b) \<or> a = (\<star>, b)" by (cases a, metis strand_label.exhaust)
+  hence *: "wf\<^sub>s\<^sub>t V (proj_unl l A@[b])"
+    by (metis snoc.prems proj_append(2) singleton_lst_proj(1) proj_unl_cons(1,3))
+  thus ?case using IH b snoc.prems proj_append(2)[of l A "[a]"] unlabel_append[of A "[a]"]
+  proof (cases b)
+    case (Receive t)
+    have "fv t \<subseteq> wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \<union> V"
+    proof
+      fix x assume "x \<in> fv t"
+      hence "x \<in> V \<union> wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A)" using wf_append_exec[OF *] b Receive by auto
+      thus "x \<in> wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \<union> V" using wfvarsoccs\<^sub>s\<^sub>t_proj_union[of A] by auto
+    qed
+    hence "fv t \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (unlabel A) \<union> V"
+      using vars_snd_rcv_strand_subset2(4)[of "unlabel A"] by blast
+    hence "wf\<^sub>s\<^sub>t V (unlabel A@[Receive t])" by (rule wf_rcv_append'''[OF IH])
+    thus ?thesis using b Receive unlabel_append[of A "[a]"] by auto
+  next
+    case (Equality ac s t)
+    have "fv t \<subseteq> wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \<union> V" when "ac = Assign"
+    proof
+      fix x assume "x \<in> fv t"
+      hence "x \<in> V \<union> wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A)" using wf_append_exec[OF *] b Equality that by auto
+      thus "x \<in> wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \<union> V" using wfvarsoccs\<^sub>s\<^sub>t_proj_union[of A] by auto
+    qed
+    hence "fv t \<subseteq> wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t A \<union> V" when "ac = Assign"
+      using vars_snd_rcv_strand_subset2(4)[of "unlabel A"] that by blast
+    hence "wf\<^sub>s\<^sub>t V (unlabel A@[Equality ac s t])"
+      by (cases ac) (metis wf_eq_append'''[OF IH], metis wf_eq_check_append''[OF IH])
+    thus ?thesis using b Equality unlabel_append[of A "[a]"] by auto
+  qed auto
+qed simp
+
+end

Stateful_Protocol_Composition_and_Typing/Lazy_Intruder.thy

@@ -0,0 +1,884 @@
+(*
+(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:      Lazy_Intruder.thy
+    Author:     Andreas Viktor Hess, DTU
+*)
+
+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 Send 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>)"
+
+
+subsection \<open>Lemma: The Lazy Intruder is Well-founded\<close>
+context
+begin
+private lemma LI_compose_measure_lt: "((S@(map Send 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(2)[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 (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 (metis wf_send_compose wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
+
+  show ?thesis using assms
+  proof (induction rule: rtrancl_induct2)
+    case (step S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j) thus ?case
+      using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] *[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>]
+      by (metis wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
+  qed simp
+qed
+
+lemma LI_preserves_trm_wf:
+  assumes "(S,\<theta>) \<leadsto>\<^sup>* (S',\<theta>')" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
+  shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')"
+proof -
+  { fix S \<theta> S' \<theta>'
+    assume "(S,\<theta>) \<leadsto> (S',\<theta>')" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
+    hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')"
+    proof (induction rule: LI_rel.induct)
+      case (Compose S T f S' \<theta>)
+      hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)"
+        and *: "t \<in> set S \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p t)" "t \<in> set S' \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p t)" for t
+        by auto
+      hence "wf\<^sub>t\<^sub>r\<^sub>m t" when "t \<in> set T" for t using that unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
+      hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p t)" when "t \<in> set (map Send T)" for t
+        using that unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
+      thus ?case using * by force
+    next
+      case (Unify S f U \<delta> T S' \<theta>)
+      have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f U)"
+        using Unify.prems(1) Unify.hyps(2) wf_trm_subterm[of _ "Fun f U"]
+        by (simp, force)
+      hence range_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
+        using mgu_wf_trm[OF Unify.hyps(3)[symmetric]] by simp
+
+      { fix s assume "s \<in> set (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)"
+        hence "\<exists>s' \<in> set (S@S'). s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')"
+          using Unify.prems(1) by (auto simp add: subst_apply_strand_def)
+        moreover {
+          fix s' assume s': "s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')" "s' \<in> set (S@S')"
+          from s'(2) have "trms\<^sub>s\<^sub>t\<^sub>p (s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = trms\<^sub>s\<^sub>t\<^sub>p s' \<cdot>\<^sub>s\<^sub>e\<^sub>t (rm_vars (set (bvars\<^sub>s\<^sub>t\<^sub>p s')) \<delta>)"
+          proof (induction s')
+            case (Inequality X F) thus ?case by (induct F) (auto simp add: subst_apply_pairs_def)
+          qed auto
+          hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)"
+            using wf_trm_subst[OF wf_trms_subst_rm_vars'[OF range_wf]] \<open>wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')\<close> s'(1)
+            by simp
+        }
+        ultimately have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)" by auto
+      }
+      thus ?case by auto
+    next
+      case (Equality S \<delta> t t' a S' \<theta>)
+      hence "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" by simp_all
+      hence range_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
+        using mgu_wf_trm[OF Equality.hyps(2)[symmetric]] by simp
+
+      { fix s assume "s \<in> set (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)"
+        hence "\<exists>s' \<in> set (S@S'). s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')"
+          using Equality.prems(1) by (auto simp add: subst_apply_strand_def)
+        moreover {
+          fix s' assume s': "s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')" "s' \<in> set (S@S')"
+          from s'(2) have "trms\<^sub>s\<^sub>t\<^sub>p (s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = trms\<^sub>s\<^sub>t\<^sub>p s' \<cdot>\<^sub>s\<^sub>e\<^sub>t (rm_vars (set (bvars\<^sub>s\<^sub>t\<^sub>p s')) \<delta>)"
+          proof (induction s')
+            case (Inequality X F) thus ?case by (induct F) (auto simp add: subst_apply_pairs_def)
+          qed auto
+          hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)"
+            using wf_trm_subst[OF wf_trms_subst_rm_vars'[OF range_wf]] \<open>wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')\<close> s'(1)
+            by simp
+        }
+        ultimately have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)" by auto
+      }
+      thus ?case by auto
+    qed
+  }
+  with assms show ?thesis by (induction rule: rtrancl_induct2) metis+
+qed
+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>)
+  hence *: "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; map Send 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>"
+    unfolding constr_sem_c_def by force+
+
+  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 Send 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>
+