commit 216e3831c7b2d90984de66c57f266057c4a67db1
Author: Achim D. Brucker <adbrucker@0x5f.org>
Date:   Sat May 23 15:44:53 2020 +0100

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

diff --git a/Automated_Stateful_Protocol_Verification/Eisbach_Protocol_Verification.thy b/Automated_Stateful_Protocol_Verification/Eisbach_Protocol_Verification.thy
new file mode 100644
index 0000000..40957a9
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/Eisbach_Protocol_Verification.thy
@@ -0,0 +1,110 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      Eisbach_Protocol_Verification.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section \<open>Useful Eisbach Methods for Automating Protocol Verification\<close>
+theory Eisbach_Protocol_Verification
+  imports Main "HOL-Eisbach.Eisbach_Tools"
+begin
+
+named_theorems exhausts
+named_theorems type_class_instance_lemmata
+named_theorems protocol_checks
+named_theorems coverage_check_unfold_protocol_lemma
+named_theorems coverage_check_unfold_lemmata
+named_theorems coverage_check_intro_lemmata
+named_theorems transaction_coverage_lemmata
+
+method UNIV_lemma =
+  (rule UNIV_eq_I; (subst insert_iff)+; subst empty_iff; smt exhausts)+
+
+method type_class_instance =
+  (intro_classes; auto simp add: type_class_instance_lemmata)
+
+method protocol_model_subgoal =
+  (((rule allI, case_tac f); (erule forw_subst)+)?; simp_all)
+
+method protocol_model_interpretation =
+  (unfold_locales; protocol_model_subgoal+)
+
+method check_protocol_intro =
+  (unfold_locales, unfold protocol_checks[symmetric])
+
+method check_protocol_with methods meth =
+  (check_protocol_intro, meth)
+
+method check_protocol' =
+  (check_protocol_with \<open>code_simp+\<close>)
+
+method check_protocol_unsafe' =
+  (check_protocol_with \<open>eval+\<close>)
+
+method check_protocol =
+  (check_protocol_with \<open>
+    code_simp,
+    code_simp,
+    code_simp,
+    code_simp,
+    code_simp\<close>)
+
+method check_protocol_unsafe =
+  (check_protocol_with \<open>
+    eval,
+    eval,
+    eval,
+    eval,
+    eval\<close>)
+
+method coverage_check_intro =
+  (((unfold coverage_check_unfold_protocol_lemma)?;
+    intro coverage_check_intro_lemmata;
+    simp only: list_all_simps list_all_append list.map concat.simps map_append product_concat_map;
+    intro conjI TrueI);
+   (clarsimp+)?;
+   ((rule transaction_coverage_lemmata)+)?)
+
+method coverage_check_unfold =
+  (unfold coverage_check_unfold_protocol_lemma coverage_check_unfold_lemmata
+          list_all_iff Let_def case_prod_unfold Product_Type.fst_conv Product_Type.snd_conv)
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/Examples.thy b/Automated_Stateful_Protocol_Verification/Examples.thy
new file mode 100644
index 0000000..93d4914
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/Examples.thy
@@ -0,0 +1,54 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      Examples.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>Examples\<close>
+theory Examples
+  imports "examples/Keyserver"
+          "examples/Keyserver2"
+          "examples/Keyserver_Composition"
+          "examples/PKCS/PKCS_Model03"
+          "examples/PKCS/PKCS_Model07"
+          "examples/PKCS/PKCS_Model09"
+begin
+end
diff --git a/Automated_Stateful_Protocol_Verification/PSPSP.thy b/Automated_Stateful_Protocol_Verification/PSPSP.thy
new file mode 100644
index 0000000..9895408
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/PSPSP.thy
@@ -0,0 +1,53 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      PSPSP.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>PSPSP\<close>
+theory PSPSP
+  imports "Stateful_Protocol_Verification"
+          "Eisbach_Protocol_Verification"
+          "trac/trac"
+begin
+
+end
+
diff --git a/Automated_Stateful_Protocol_Verification/ROOT b/Automated_Stateful_Protocol_Verification/ROOT
new file mode 100644
index 0000000..2f63b38
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/ROOT
@@ -0,0 +1,16 @@
+chapter AFP
+
+session "Automated_Stateful_Protocol_Verification-devel" (AFP) = "Stateful_Protocol_Composition_and_Typing" +
+  options [timeout = 2400]
+  sessions
+    "HOL-Eisbach"
+  directories
+    "trac"
+    "examples"
+    "examples/PKCS"
+  theories
+    "PSPSP"
+    "Examples"
+  document_files
+    "root.tex"
+    "root.bib"
diff --git a/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy b/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy
new file mode 100644
index 0000000..239adef
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy
@@ -0,0 +1,4410 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 2020
+
+All Rights Reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+- Redistributions of source code must retain the above copyright
+  notice, this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer in the
+  documentation and/or other materials provided with the distribution.
+
+- Neither the name of the copyright holder nor the names of its
+  contributors may be used to endorse or promote products
+  derived from this software without specific prior written
+  permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(*  Title:      Stateful_Protocol_Model.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>Stateful Protocol Model\<close>
+theory Stateful_Protocol_Model
+  imports Stateful_Protocol_Composition_and_Typing.Stateful_Compositionality
+          Transactions Term_Abstraction
+begin
+
+subsection \<open>Locale Setup\<close>
+locale stateful_protocol_model =
+  fixes arity\<^sub>f::"'fun \<Rightarrow> nat"
+    and arity\<^sub>s::"'sets \<Rightarrow> nat"
+    and public\<^sub>f::"'fun \<Rightarrow> bool"
+    and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets) prot_fun, nat) term list \<times> nat list)"
+    and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
+    and label_witness1::"'lbl"
+    and label_witness2::"'lbl"
+  assumes Ana\<^sub>f_assm1: "\<forall>f. let (K, M) = Ana\<^sub>f f in (\<forall>k \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K).
+      is_Fun k \<longrightarrow> (is_Fu (the_Fun k)) \<and> length (args k) = arity\<^sub>f (the_Fu (the_Fun k)))"
+    and Ana\<^sub>f_assm2: "\<forall>f. let (K, M) = Ana\<^sub>f f in \<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K) \<union> set M. i < arity\<^sub>f f"
+    and public\<^sub>f_assm: "\<forall>f. arity\<^sub>f f > (0::nat) \<longrightarrow> public\<^sub>f f"
+    and \<Gamma>\<^sub>f_assm: "\<forall>f. arity\<^sub>f f = (0::nat) \<longrightarrow> \<Gamma>\<^sub>f f \<noteq> None"
+    and label_witness_assm: "label_witness1 \<noteq> label_witness2"
+begin
+
+lemma Ana\<^sub>f_assm1_alt: 
+  assumes "Ana\<^sub>f f = (K,M)" "k \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)"
+  shows "(\<exists>x. k = Var x) \<or> (\<exists>h T. k = Fun (Fu h) T \<and> length T = arity\<^sub>f h)"
+proof (cases k)
+  case (Fun g T)
+  let ?P = "\<lambda>k. is_Fun k \<longrightarrow> is_Fu (the_Fun k) \<and> length (args k) = arity\<^sub>f (the_Fu (the_Fun k))"
+  let ?Q = "\<lambda>K M. \<forall>k \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K). ?P k"
+
+  have "?Q (fst (Ana\<^sub>f f)) (snd (Ana\<^sub>f f))" using Ana\<^sub>f_assm1 split_beta[of ?Q "Ana\<^sub>f f"] by meson
+  hence "?Q K M" using assms(1) by simp
+  hence "?P k" using assms(2) by blast
+  thus ?thesis using Fun by (cases g) auto
+qed simp
+
+lemma Ana\<^sub>f_assm2_alt:
+  assumes "Ana\<^sub>f f = (K,M)" "i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K) \<union> set M"
+  shows "i < arity\<^sub>f f"
+using Ana\<^sub>f_assm2 assms by fastforce
+
+
+subsection \<open>Definitions\<close>
+fun arity where
+  "arity (Fu f) = arity\<^sub>f f"
+| "arity (Set s) = arity\<^sub>s s"
+| "arity (Val _) = 0"
+| "arity (Abs _) = 0"
+| "arity Pair = 2"
+| "arity (Attack _) = 0"
+| "arity OccursFact = 2"
+| "arity OccursSec = 0"
+| "arity (PubConstAtom _ _) = 0"
+| "arity (PubConstSetType _) = 0"
+| "arity (PubConstAttackType _) = 0"
+| "arity (PubConstBottom _) = 0"
+| "arity (PubConstOccursSecType _) = 0"
+
+fun public where
+  "public (Fu f) = public\<^sub>f f"
+| "public (Set s) = (arity\<^sub>s s > 0)"
+| "public (Val n) = snd n"
+| "public (Abs _) = False"
+| "public Pair = True"
+| "public (Attack _) = False"
+| "public OccursFact = True"
+| "public OccursSec = False"
+| "public (PubConstAtom _ _) = True"
+| "public (PubConstSetType _) = True"
+| "public (PubConstAttackType _) = True"
+| "public (PubConstBottom _) = True" 
+| "public (PubConstOccursSecType _) = True"
+
+fun Ana where
+  "Ana (Fun (Fu f) T) = (
+    if arity\<^sub>f f = length T \<and> arity\<^sub>f f > 0
+    then let (K,M) = Ana\<^sub>f f in (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M)
+    else ([], []))"
+| "Ana _ = ([], [])"
+
+definition \<Gamma>\<^sub>v where
+  "\<Gamma>\<^sub>v v \<equiv> (
+    if (\<forall>t \<in> subterms (fst v).
+          case t of (TComp f T) \<Rightarrow> arity f > 0 \<and> arity f = length T | _ \<Rightarrow> True)
+    then fst v
+    else TAtom Bottom)"
+
+fun \<Gamma> where
+  "\<Gamma> (Var v) = \<Gamma>\<^sub>v v"
+| "\<Gamma> (Fun f T) = (
+    if arity f = 0
+    then case f of
+      (Fu g) \<Rightarrow> TAtom (case \<Gamma>\<^sub>f g of Some a \<Rightarrow> Atom a | None \<Rightarrow> Bottom)
+    | (Val _) \<Rightarrow> TAtom Value
+    | (Abs _) \<Rightarrow> TAtom Value
+    | (Set _) \<Rightarrow> TAtom SetType
+    | (Attack _) \<Rightarrow> TAtom AttackType
+    | OccursSec \<Rightarrow> TAtom OccursSecType
+    | (PubConstAtom a _) \<Rightarrow> TAtom (Atom a)
+    | (PubConstSetType _) \<Rightarrow> TAtom SetType
+    | (PubConstAttackType _) \<Rightarrow> TAtom AttackType
+    | (PubConstBottom _) \<Rightarrow> TAtom Bottom
+    | (PubConstOccursSecType _) \<Rightarrow> TAtom OccursSecType
+    | _ \<Rightarrow> TAtom Bottom
+    else TComp f (map \<Gamma> T))"
+
+lemma \<Gamma>_consts_simps[simp]:
+  "arity\<^sub>f g = 0 \<Longrightarrow> \<Gamma> (Fun (Fu g) []) = TAtom (case \<Gamma>\<^sub>f g of Some a \<Rightarrow> Atom a | None \<Rightarrow> Bottom)"
+  "\<Gamma> (Fun (Val n) []) = TAtom Value"
+  "\<Gamma> (Fun (Abs b) []) = TAtom Value"
+  "arity\<^sub>s s = 0 \<Longrightarrow> \<Gamma> (Fun (Set s) []) = TAtom SetType"
+  "\<Gamma> (Fun (Attack x) []) = TAtom AttackType"
+  "\<Gamma> (Fun OccursSec []) = TAtom OccursSecType"
+  "\<Gamma> (Fun (PubConstAtom a t) []) = TAtom (Atom a)"
+  "\<Gamma> (Fun (PubConstSetType t) []) = TAtom SetType"
+  "\<Gamma> (Fun (PubConstAttackType t) []) = TAtom AttackType"
+  "\<Gamma> (Fun (PubConstBottom t) []) = TAtom Bottom"
+  "\<Gamma> (Fun (PubConstOccursSecType t) []) = TAtom OccursSecType"
+by simp+
+
+lemma \<Gamma>_Set_simps[simp]:
+  "arity\<^sub>s s \<noteq> 0 \<Longrightarrow> \<Gamma> (Fun (Set s) T) = TComp (Set s) (map \<Gamma> T)"
+  "\<Gamma> (Fun (Set s) T) = TAtom SetType \<or> \<Gamma> (Fun (Set s) T) = TComp (Set s) (map \<Gamma> T)"
+  "\<Gamma> (Fun (Set s) T) \<noteq> TAtom Value"
+  "\<Gamma> (Fun (Set s) T) \<noteq> TAtom (Atom a)"
+  "\<Gamma> (Fun (Set s) T) \<noteq> TAtom AttackType"
+  "\<Gamma> (Fun (Set s) T) \<noteq> TAtom OccursSecType"
+  "\<Gamma> (Fun (Set s) T) \<noteq> TAtom Bottom"
+by auto
+
+
+subsection \<open>Locale Interpretations\<close>
+lemma Ana_Fu_cases:
+  assumes "Ana (Fun f T) = (K,M)"
+    and "f = Fu g"
+    and "Ana\<^sub>f g = (K',M')"
+  shows "(K,M) = (if arity\<^sub>f g = length T \<and> arity\<^sub>f g > 0
+                  then (K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')
+                  else ([],[]))" (is ?A)
+    and "(K,M) = (K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M') \<or> (K,M) = ([],[])" (is ?B)
+proof -
+  show ?A using assms by (cases "arity\<^sub>f g = length T \<and> arity\<^sub>f g > 0") auto
+  thus ?B by metis
+qed
+
+lemma Ana_Fu_intro:
+  assumes "arity\<^sub>f f = length T" "arity\<^sub>f f > 0"
+    and "Ana\<^sub>f f = (K',M')"
+  shows "Ana (Fun (Fu f) T) = (K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')"
+using assms by simp
+
+lemma Ana_Fu_elim:
+  assumes "Ana (Fun f T) = (K,M)"
+    and "f = Fu g"
+    and "Ana\<^sub>f g = (K',M')"
+    and "(K,M) \<noteq> ([],[])"
+  shows "arity\<^sub>f g = length T" (is ?A)
+    and "(K,M) = (K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')" (is ?B)
+proof -
+  show ?A using assms by force
+  moreover have "arity\<^sub>f g > 0" using assms by force
+  ultimately show ?B using assms by auto
+qed
+
+lemma Ana_nonempty_inv:
+  assumes "Ana t \<noteq> ([],[])"
+  shows "\<exists>f T. t = Fun (Fu f) T \<and> arity\<^sub>f f = length T \<and> arity\<^sub>f f > 0 \<and>
+               (\<exists>K M. Ana\<^sub>f f = (K, M) \<and> Ana t = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M))"
+using assms
+proof (induction t rule: Ana.induct)
+  case (1 f T)
+  hence *: "arity\<^sub>f f = length T" "0 < arity\<^sub>f f"
+           "Ana (Fun (Fu f) T) = (case Ana\<^sub>f f of (K, M) \<Rightarrow> (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M))"
+    using Ana.simps(1)[of f T] unfolding Let_def by metis+
+
+  obtain K M where **: "Ana\<^sub>f f = (K, M)" by (metis surj_pair)
+  hence "Ana (Fun (Fu f) T) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M)" using *(3) by simp
+  thus ?case using ** *(1,2) by blast
+qed simp_all
+
+lemma assm1:
+  assumes "Ana t = (K,M)"
+  shows "fv\<^sub>s\<^sub>e\<^sub>t (set K) \<subseteq> fv t"
+using assms
+proof (induction t rule: term.induct)
+  case (Fun f T)
+  have aux: "fv\<^sub>s\<^sub>e\<^sub>t (set K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) T) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (set T)"
+    when K: "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K). i < length T"
+    for K::"(('fun,'atom,'sets) prot_fun, nat) term list"
+  proof
+    fix x assume "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) T)"
+    then obtain k where k: "k \<in> set K" "x \<in> fv (k \<cdot> (!) T)" by moura
+    have "\<forall>i \<in> fv k. i < length T" using K k(1) by simp
+    thus "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set T)"
+      by (metis (no_types, lifting) k(2) contra_subsetD fv_set_mono image_subsetI nth_mem
+                                    subst_apply_fv_unfold)
+  qed
+
+  { fix g assume f: "f = Fu g" and K: "K \<noteq> []"
+    obtain K' M' where *: "Ana\<^sub>f g = (K',M')" by moura
+    have "(K, M) \<noteq> ([], [])" using K by simp
+    hence "(K, M) = (K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')" "arity\<^sub>f g = length T"
+      using Ana_Fu_cases(1)[OF Fun.prems f *]
+      by presburger+
+    hence ?case using aux[of K'] Ana\<^sub>f_assm2_alt[OF *] by auto
+  } thus ?case using Fun by (cases f) fastforce+
+qed simp
+
+lemma assm2:
+  assumes "Ana t = (K,M)"
+  and "\<And>g S'. Fun g S' \<sqsubseteq> t \<Longrightarrow> length S' = arity g"
+  and "k \<in> set K"
+  and "Fun f T' \<sqsubseteq> k"
+  shows "length T' = arity f"
+using assms
+proof (induction t rule: term.induct)
+  case (Fun g T)
+  obtain h where 2: "g = Fu h"
+    using Fun.prems(1,3) by (cases g) auto
+  obtain K' M' where 1: "Ana\<^sub>f h = (K',M')" by moura
+  have "(K,M) \<noteq> ([],[])" using Fun.prems(3) by auto
+  hence "(K,M) = (K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')"
+        "\<And>i. i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K') \<union> set M' \<Longrightarrow> i < length T"
+    using Ana_Fu_cases(1)[OF Fun.prems(1) 2 1] Ana\<^sub>f_assm2_alt[OF 1]
+    by presburger+
+  hence "K = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T" and 3: "\<forall>i\<in>fv\<^sub>s\<^sub>e\<^sub>t (set K'). i < length T" by simp_all
+  then obtain k' where k': "k' \<in> set K'" "k = k' \<cdot> (!) T" using Fun.prems(3) by moura
+  hence 4: "Fun f T' \<in> subterms (k' \<cdot> (!) T)" "fv k' \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (set K')"
+    using Fun.prems(4) by auto
+  show ?case
+  proof (cases "\<exists>i \<in> fv k'. Fun f T' \<in> subterms (T ! i)")
+    case True
+    hence "Fun f T' \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set T)" using k' Fun.prems(4) 3 by auto
+    thus ?thesis using Fun.prems(2) by auto
+  next
+    case False
+    then obtain S where "Fun f S \<in> subterms k'" "Fun f T' = Fun f S \<cdot> (!) T"
+      using k'(2) Fun.prems(4) subterm_subst_not_img_subterm by force
+    thus ?thesis using Ana\<^sub>f_assm1_alt[OF 1, of "Fun f S"] k'(1) by (cases f) auto
+  qed
+qed simp
+
+lemma assm4:
+  assumes "Ana (Fun f T) = (K, M)"
+  shows "set M \<subseteq> set T"
+using assms
+proof (cases f)
+  case (Fu g)
+  obtain K' M' where *: "Ana\<^sub>f g = (K',M')" by moura
+  have "M = [] \<or> (arity\<^sub>f g = length T \<and> M = map ((!) T) M')"
+    using Ana_Fu_cases(1)[OF assms Fu *]
+    by (meson prod.inject)
+  thus ?thesis using Ana\<^sub>f_assm2_alt[OF *] by auto
+qed auto
+
+lemma assm5: "Ana t = (K,M) \<Longrightarrow> K \<noteq> [] \<or> M \<noteq> [] \<Longrightarrow> Ana (t \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>, M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)"
+proof (induction t rule: term.induct)
+  case (Fun f T) thus ?case
+  proof (cases f)
+    case (Fu g)
+    obtain K' M' where *: "Ana\<^sub>f g = (K',M')" by moura
+    have **: "K = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T" "M = map ((!) T) M'"
+             "arity\<^sub>f g = length T" "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K') \<union> set M'. i < arity\<^sub>f g" "0 < arity\<^sub>f g"
+      using Fun.prems(2) Ana_Fu_cases(1)[OF Fun.prems(1) Fu *] Ana\<^sub>f_assm2_alt[OF *]
+      by (meson prod.inject)+
+
+    have ***: "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K'). i < length T" "\<forall>i \<in> set M'. i < length T" using **(3,4) by auto
+    
+    have "K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta> = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) (map (\<lambda>t. t \<cdot> \<delta>) T)"
+         "M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta> = map ((!) (map (\<lambda>t. t \<cdot> \<delta>) T)) M'"
+      using subst_idx_map[OF ***(2), of \<delta>]
+            subst_idx_map'[OF ***(1), of \<delta>]
+            **(1,2)
+      by fast+
+    thus ?thesis using Fu * **(3,5) by auto
+  qed auto
+qed simp
+
+sublocale intruder_model arity public Ana
+apply unfold_locales
+by (metis assm1, metis assm2, rule Ana.simps, metis assm4, metis assm5)
+
+adhoc_overloading INTRUDER_SYNTH intruder_synth
+adhoc_overloading INTRUDER_DEDUCT intruder_deduct
+
+lemma assm6: "arity c = 0 \<Longrightarrow> \<exists>a. \<forall>X. \<Gamma> (Fun c X) = TAtom a" by (cases c) auto
+
+lemma assm7: "0 < arity f \<Longrightarrow> \<Gamma> (Fun f T) = TComp f (map \<Gamma> T)" by auto
+
+lemma assm8: "infinite {c. \<Gamma> (Fun c []::('fun,'atom,'sets) prot_term) = TAtom a \<and> public c}"
+  (is "?P a")
+proof -
+  let ?T = "\<lambda>f. (range f)::('fun,'atom,'sets) prot_fun set"
+  let ?A = "\<lambda>f. \<forall>x::nat \<in> UNIV. \<forall>y::nat \<in> UNIV. (f x = f y) = (x = y)"
+  let ?B = "\<lambda>f. \<forall>x::nat \<in> UNIV. f x \<in> ?T f"
+  let ?C = "\<lambda>f. \<forall>y::('fun,'atom,'sets) prot_fun \<in> ?T f. \<exists>x \<in> UNIV. y = f x"
+  let ?D = "\<lambda>f b. ?T f \<subseteq> {c. \<Gamma> (Fun c []::('fun,'atom,'sets) prot_term) = TAtom b \<and> public c}"
+
+  have sub_lmm: "?P b" when "?A f" "?C f" "?C f" "?D f b" for b f
+  proof -
+    have "\<exists>g::nat \<Rightarrow> ('fun,'atom,'sets) prot_fun. bij_betw g UNIV (?T f)"
+      using bij_betwI'[of UNIV f "?T f"] that(1,2,3) by blast
+    hence "infinite (?T f)" by (metis nat_not_finite bij_betw_finite)
+    thus ?thesis using infinite_super[OF that(4)] by blast
+  qed
+
+  show ?thesis
+  proof (cases a)
+    case (Atom b) thus ?thesis using sub_lmm[of "PubConstAtom b" a] by force
+  next
+    case Value thus ?thesis using sub_lmm[of "\<lambda>n. Val (n,True)" a] by force
+  next
+    case SetType thus ?thesis using sub_lmm[of PubConstSetType a] by fastforce
+  next
+    case AttackType thus ?thesis using sub_lmm[of PubConstAttackType a] by fastforce
+  next
+    case Bottom thus ?thesis using sub_lmm[of PubConstBottom a] by fastforce
+  next
+    case OccursSecType thus ?thesis using sub_lmm[of PubConstOccursSecType a] by fastforce
+  qed
+qed
+
+lemma assm9: "TComp f T \<sqsubseteq> \<Gamma> t \<Longrightarrow> arity f > 0"
+proof (induction t rule: term.induct)
+  case (Var x)
+  hence "\<Gamma> (Var x) \<noteq> TAtom Bottom" by force
+  hence "\<forall>t \<in> subterms (fst x). case t of
+            TComp f T \<Rightarrow> arity f > 0 \<and> arity f = length T
+          | _ \<Rightarrow> True"
+    using Var \<Gamma>.simps(1)[of x] unfolding \<Gamma>\<^sub>v_def by meson
+  thus ?case using Var by (fastforce simp add: \<Gamma>\<^sub>v_def)
+next
+  case (Fun g S)
+  have "arity g \<noteq> 0" using Fun.prems Var_subtermeq assm6 by force
+  thus ?case using Fun by (cases "TComp f T = TComp g (map \<Gamma> S)") auto
+qed
+
+lemma assm10: "wf\<^sub>t\<^sub>r\<^sub>m (\<Gamma> (Var x))"
+unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (auto simp add: \<Gamma>\<^sub>v_def)
+
+lemma assm11: "arity f > 0 \<Longrightarrow> public f" using public\<^sub>f_assm by (cases f) auto
+
+lemma assm12: "\<Gamma> (Var (\<tau>, n)) = \<Gamma> (Var (\<tau>, m))" by (simp add: \<Gamma>\<^sub>v_def)
+
+lemma assm13: "arity c = 0 \<Longrightarrow> Ana (Fun c T) = ([],[])" by (cases c) simp_all
+
+lemma assm14:
+  assumes "Ana (Fun f T) = (K,M)"
+  shows "Ana (Fun f T \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>, M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)"
+proof -
+  show ?thesis
+  proof (cases "(K, M) = ([],[])")
+    case True
+    { fix g assume f: "f = Fu g"
+      obtain K' M' where "Ana\<^sub>f g = (K',M')" by moura
+      hence ?thesis using assms f True by auto
+    } thus ?thesis using True assms by (cases f) auto
+  next
+    case False
+    then obtain g where **: "f = Fu g" using assms by (cases f) auto
+    obtain K' M' where *: "Ana\<^sub>f g = (K',M')" by moura
+    have ***: "K = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T" "M = map ((!) T) M'" "arity\<^sub>f g = length T"
+              "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K') \<union> set M'. i < arity\<^sub>f g"
+      using Ana_Fu_cases(1)[OF assms ** *] False Ana\<^sub>f_assm2_alt[OF *]
+      by (meson prod.inject)+
+    have ****: "\<forall>i\<in>fv\<^sub>s\<^sub>e\<^sub>t (set K'). i < length T" "\<forall>i\<in>set M'. i < length T" using ***(3,4) by auto
+    have "K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta> = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) (map (\<lambda>t. t \<cdot> \<delta>) T)"
+         "M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta> = map ((!) (map (\<lambda>t. t \<cdot> \<delta>) T)) M'"
+      using subst_idx_map[OF ****(2), of \<delta>]
+            subst_idx_map'[OF ****(1), of \<delta>]
+            ***(1,2)
+      by auto
+    thus ?thesis using assms * ** ***(3) by auto
+  qed
+qed
+
+sublocale labeled_stateful_typed_model' arity public Ana \<Gamma> Pair label_witness1 label_witness2
+by unfold_locales
+   (metis assm6, metis assm7, metis assm8, metis assm9,
+    rule assm10, metis assm11, rule arity.simps(5), metis assm14,
+    metis assm12, metis assm13, metis assm14, rule label_witness_assm)
+
+subsection \<open>Minor Lemmata\<close>
+lemma \<Gamma>\<^sub>v_TAtom[simp]: "\<Gamma>\<^sub>v (TAtom a, n) = TAtom a"
+unfolding \<Gamma>\<^sub>v_def by simp
+
+lemma \<Gamma>\<^sub>v_TAtom':
+  assumes "a \<noteq> Bottom"
+  shows "\<Gamma>\<^sub>v (\<tau>, n) = TAtom a \<longleftrightarrow> \<tau> = TAtom a"
+proof
+  assume "\<Gamma>\<^sub>v (\<tau>, n) = TAtom a"
+  thus "\<tau> = TAtom a" by (metis (no_types, lifting) assms \<Gamma>\<^sub>v_def fst_conv term.inject(1)) 
+qed simp
+
+lemma \<Gamma>\<^sub>v_TAtom_inv:
+  "\<Gamma>\<^sub>v x = TAtom (Atom a) \<Longrightarrow> \<exists>m. x = (TAtom (Atom a), m)"
+  "\<Gamma>\<^sub>v x = TAtom Value \<Longrightarrow> \<exists>m. x = (TAtom Value, m)"
+  "\<Gamma>\<^sub>v x = TAtom SetType \<Longrightarrow> \<exists>m. x = (TAtom SetType, m)"
+  "\<Gamma>\<^sub>v x = TAtom AttackType \<Longrightarrow> \<exists>m. x = (TAtom AttackType, m)"
+  "\<Gamma>\<^sub>v x = TAtom OccursSecType \<Longrightarrow> \<exists>m. x = (TAtom OccursSecType, m)"
+by (metis \<Gamma>\<^sub>v_TAtom' surj_pair prot_atom.distinct(7),
+    metis \<Gamma>\<^sub>v_TAtom' surj_pair prot_atom.distinct(15),
+    metis \<Gamma>\<^sub>v_TAtom' surj_pair prot_atom.distinct(21),
+    metis \<Gamma>\<^sub>v_TAtom' surj_pair prot_atom.distinct(25),
+    metis \<Gamma>\<^sub>v_TAtom' surj_pair prot_atom.distinct(30))
+
+lemma \<Gamma>\<^sub>v_TAtom'':
+  "(fst x = TAtom (Atom a)) = (\<Gamma>\<^sub>v x = TAtom (Atom a))" (is "?A = ?A'")
+  "(fst x = TAtom Value) = (\<Gamma>\<^sub>v x = TAtom Value)" (is "?B = ?B'")
+  "(fst x = TAtom SetType) = (\<Gamma>\<^sub>v x = TAtom SetType)" (is "?C = ?C'")
+  "(fst x = TAtom AttackType) = (\<Gamma>\<^sub>v x = TAtom AttackType)" (is "?D = ?D'")
+  "(fst x = TAtom OccursSecType) = (\<Gamma>\<^sub>v x = TAtom OccursSecType)" (is "?E = ?E'")
+proof -
+  have 1: "?A \<Longrightarrow> ?A'" "?B \<Longrightarrow> ?B'" "?C \<Longrightarrow> ?C'" "?D \<Longrightarrow> ?D'" "?E \<Longrightarrow> ?E'"
+    by (metis \<Gamma>\<^sub>v_TAtom prod.collapse)+
+
+  have 2: "?A' \<Longrightarrow> ?A" "?B' \<Longrightarrow> ?B" "?C' \<Longrightarrow> ?C" "?D' \<Longrightarrow> ?D" "?E' \<Longrightarrow> ?E"
+    using \<Gamma>\<^sub>v_TAtom \<Gamma>\<^sub>v_TAtom_inv(1) apply fastforce
+    using \<Gamma>\<^sub>v_TAtom \<Gamma>\<^sub>v_TAtom_inv(2) apply fastforce
+    using \<Gamma>\<^sub>v_TAtom \<Gamma>\<^sub>v_TAtom_inv(3) apply fastforce
+    using \<Gamma>\<^sub>v_TAtom \<Gamma>\<^sub>v_TAtom_inv(4) apply fastforce
+    using \<Gamma>\<^sub>v_TAtom \<Gamma>\<^sub>v_TAtom_inv(5) by fastforce
+
+  show "?A = ?A'" "?B = ?B'" "?C = ?C'" "?D = ?D'" "?E = ?E'"
+    using 1 2 by metis+
+qed
+
+lemma \<Gamma>\<^sub>v_Var_image:
+  "\<Gamma>\<^sub>v ` X = \<Gamma> ` Var ` X"
+by force
+
+lemma \<Gamma>_Fu_const:
+  assumes "arity\<^sub>f g = 0"
+  shows "\<exists>a. \<Gamma> (Fun (Fu g) T) = TAtom (Atom a)"
+proof -
+  have "\<Gamma>\<^sub>f g \<noteq> None" using assms \<Gamma>\<^sub>f_assm by blast
+  thus ?thesis using assms by force
+qed
+
+lemma Fun_Value_type_inv:
+  fixes T::"('fun,'atom,'sets) prot_term list"
+  assumes "\<Gamma> (Fun f T) = TAtom Value"
+  shows "(\<exists>n. f = Val n) \<or> (\<exists>bs. f = Abs bs)"
+proof -
+  have *: "arity f = 0" by (metis const_type_inv assms) 
+  show ?thesis  using assms
+  proof (cases f)
+    case (Fu g)
+    hence "arity\<^sub>f g = 0" using * by simp
+    hence False using Fu \<Gamma>_Fu_const[of g T] assms by auto
+    thus ?thesis by metis
+  next
+    case (Set s)
+    hence "arity\<^sub>s s = 0" using * by simp
+    hence False using Set assms by auto
+    thus ?thesis by metis
+  qed simp_all
+qed
+
+lemma abs_\<Gamma>: "\<Gamma> t = \<Gamma> (t \<cdot>\<^sub>\<alpha> \<alpha>)"
+by (induct t \<alpha> rule: abs_apply_term.induct) auto
+
+lemma Ana\<^sub>f_keys_not_pubval_terms:
+  assumes "Ana\<^sub>f f = (K, T)"
+    and "k \<in> set K"
+    and "g \<in> funs_term k"
+  shows "\<not>is_Val g"
+proof
+  assume "is_Val g"
+  then obtain n S where *: "Fun (Val n) S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)"
+    using assms(2) funs_term_Fun_subterm[OF assms(3)]
+    by (cases g) auto
+  show False using Ana\<^sub>f_assm1_alt[OF assms(1) *] by simp
+qed
+
+lemma Ana\<^sub>f_keys_not_abs_terms:
+  assumes "Ana\<^sub>f f = (K, T)"
+    and "k \<in> set K"
+    and "g \<in> funs_term k"
+  shows "\<not>is_Abs g"
+proof
+  assume "is_Abs g"
+  then obtain a S where *: "Fun (Abs a) S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)"
+    using assms(2) funs_term_Fun_subterm[OF assms(3)]
+    by (cases g) auto
+  show False using Ana\<^sub>f_assm1_alt[OF assms(1) *] by simp
+qed
+
+lemma Ana\<^sub>f_keys_not_pairs:
+  assumes "Ana\<^sub>f f = (K, T)"
+    and "k \<in> set K"
+    and "g \<in> funs_term k"
+  shows "g \<noteq> Pair"
+proof
+  assume "g = Pair"
+  then obtain S where *: "Fun Pair S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)"
+    using assms(2) funs_term_Fun_subterm[OF assms(3)]
+    by (cases g) auto
+  show False using Ana\<^sub>f_assm1_alt[OF assms(1) *] by simp
+qed
+
+lemma Ana_Fu_keys_funs_term_subset:
+  fixes K::"('fun,'atom,'sets) prot_term list"
+  assumes "Ana (Fun (Fu f) S) = (K, T)"
+    and "Ana\<^sub>f f = (K', T')"
+  shows "\<Union>(funs_term ` set K) \<subseteq> \<Union>(funs_term ` set K') \<union> funs_term (Fun (Fu f) S)"
+proof -
+  { fix k assume k: "k \<in> set K"
+    then obtain k' where k':
+        "k' \<in> set K'" "k = k' \<cdot> (!) S" "arity\<^sub>f f = length S"
+        "subterms k' \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (set K')"
+      using assms Ana_Fu_elim[OF assms(1) _ assms(2)] by fastforce
+
+    have 1: "funs_term k' \<subseteq> \<Union>(funs_term ` set K')" using k'(1) by auto
+
+    have "i < length S" when "i \<in> fv k'" for i
+      using that Ana\<^sub>f_assm2_alt[OF assms(2), of i] k'(1,3)
+      by auto
+    hence 2: "funs_term (S ! i) \<subseteq> funs_term (Fun (Fu f) S)" when "i \<in> fv k'" for i
+      using that by force
+  
+    have "funs_term k \<subseteq> \<Union>(funs_term ` set K') \<union> funs_term (Fun (Fu f) S)"
+      using funs_term_subst[of k' "(!) S"] k'(2) 1 2 by fast
+  } thus ?thesis by blast
+qed
+
+lemma Ana_Fu_keys_not_pubval_terms:
+  fixes k::"('fun,'atom,'sets) prot_term"
+  assumes "Ana (Fun (Fu f) S) = (K, T)"
+    and "Ana\<^sub>f f = (K', T')"
+    and "k \<in> set K"
+    and "\<forall>g \<in> funs_term (Fun (Fu f) S). is_Val g \<longrightarrow> \<not>public g"
+  shows "\<forall>g \<in> funs_term k. is_Val g \<longrightarrow> \<not>public g"
+using assms(3,4) Ana\<^sub>f_keys_not_pubval_terms[OF assms(2)]
+      Ana_Fu_keys_funs_term_subset[OF assms(1,2)]
+by blast
+
+lemma Ana_Fu_keys_not_abs_terms:
+  fixes k::"('fun,'atom,'sets) prot_term"
+  assumes "Ana (Fun (Fu f) S) = (K, T)"
+    and "Ana\<^sub>f f = (K', T')"
+    and "k \<in> set K"
+    and "\<forall>g \<in> funs_term (Fun (Fu f) S). \<not>is_Abs g"
+  shows "\<forall>g \<in> funs_term k. \<not>is_Abs g"
+using assms(3,4) Ana\<^sub>f_keys_not_abs_terms[OF assms(2)]
+      Ana_Fu_keys_funs_term_subset[OF assms(1,2)]
+by blast
+
+lemma Ana_Fu_keys_not_pairs:
+  fixes k::"('fun,'atom,'sets) prot_term"
+  assumes "Ana (Fun (Fu f) S) = (K, T)"
+    and "Ana\<^sub>f f = (K', T')"
+    and "k \<in> set K"
+    and "\<forall>g \<in> funs_term (Fun (Fu f) S). g \<noteq> Pair"
+  shows "\<forall>g \<in> funs_term k. g \<noteq> Pair"
+using assms(3,4) Ana\<^sub>f_keys_not_pairs[OF assms(2)]
+      Ana_Fu_keys_funs_term_subset[OF assms(1,2)]
+by blast
+
+lemma deduct_occurs_in_ik:
+  fixes t::"('fun,'atom,'sets) prot_term"
+  assumes t: "M \<turnstile> occurs t"
+    and M: "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t M. OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
+           "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t M. OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
+           "Fun OccursSec [] \<notin> M"
+  shows "occurs t \<in> M"
+using private_fun_deduct_in_ik''[of M OccursFact "[Fun OccursSec [], t]" OccursSec] t M 
+by fastforce
+
+lemma wellformed_transaction_sem_receives:
+  fixes T::"('fun,'atom,'sets,'lbl) prot_transaction"
+  assumes T_valid: "wellformed_transaction T"
+    and \<I>: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I>"
+    and s: "receive\<langle>t\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  shows "IK \<turnstile> t \<cdot> \<I>"
+proof -
+  let ?R = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  let ?S = "\<lambda>A. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  let ?S' = "?S (transaction_receive T)"
+
+  obtain l B s where B:
+      "(l,send\<langle>t\<rangle>) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
+      "prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+    using s dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2)[of t "transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
+          dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst[of "send\<langle>t\<rangle>" "transaction_receive T" \<theta>]
+    by blast
+
+  have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>])) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[send\<langle>t\<rangle>]"
+    using B(1) unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst singleton_lst_proj(4)
+          dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc subst_lsst_append subst_lsst_singleton
+    by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps )
+
+  have "strand_sem_stateful IK DB ?S' \<I>"
+    using \<I> strand_sem_append_stateful[of IK DB _ _ \<I>] transaction_dual_subst_unfold[of T \<theta>]
+    by fastforce
+  hence "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[send\<langle>t\<rangle>]) \<I>"
+    using B 1 unfolding prefix_def unlabel_def
+    by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def map_append strand_sem_append_stateful) 
+  hence t_deduct: "IK \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile> t \<cdot> \<I>"
+    using strand_sem_append_stateful[of IK DB "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" "[send\<langle>t\<rangle>]" \<I>]
+    by simp
+
+  have "\<forall>s \<in> set (unlabel (transaction_receive T)). \<exists>t. s = receive\<langle>t\<rangle>"
+    using T_valid wellformed_transaction_unlabel_cases(1)[OF T_valid] by auto
+  moreover { fix A::"('fun,'atom,'sets,'lbl) prot_strand" and \<theta>
+    assume "\<forall>s \<in> set (unlabel A). \<exists>t. s = receive\<langle>t\<rangle>"
+    hence "\<forall>s \<in> set (unlabel (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)). \<exists>t. s = receive\<langle>t\<rangle>"
+    proof (induction A)
+      case (Cons a A) thus ?case using subst_lsst_cons[of a A \<theta>] by (cases a) auto
+    qed simp
+    hence "\<forall>s \<in> set (unlabel (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)). \<exists>t. s = receive\<langle>t\<rangle>"
+      by (simp add: list.pred_set is_Receive_def)
+    hence "\<forall>s \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))). \<exists>t. s = send\<langle>t\<rangle>"
+      by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv(2) unlabel_in unlabel_mem_has_label)
+  }
+  ultimately have "\<forall>s \<in> set ?R. \<exists>t. s = send\<langle>t\<rangle>" by simp
+  hence "ik\<^sub>s\<^sub>s\<^sub>t ?R = {}" unfolding unlabel_def ik\<^sub>s\<^sub>s\<^sub>t_def by fast
+  hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) = {}"
+    using B(2) 1 ik\<^sub>s\<^sub>s\<^sub>t_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append
+    by (metis (no_types, lifting) Un_empty map_append prefix_def unlabel_def) 
+  thus ?thesis using t_deduct by simp
+qed
+
+lemma wellformed_transaction_sem_selects:
+  assumes T_valid: "wellformed_transaction T"
+    and \<I>: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I>"
+    and "select\<langle>t,u\<rangle> \<in> set (unlabel (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  shows "(t \<cdot> \<I>, u \<cdot> \<I>) \<in> DB"
+proof -
+  let ?s = "select\<langle>t,u\<rangle>"
+  let ?R = "transaction_receive T@transaction_selects T"
+  let ?R' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  let ?S = "\<lambda>A. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  let ?S' = "?S (transaction_receive T)@?S (transaction_selects T)"
+  let ?P = "\<lambda>a. is_Receive a \<or> is_Assignment a"
+  let ?Q = "\<lambda>a. is_Send a \<or> is_Assignment a"
+
+  have s: "?s \<in> set (unlabel (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+    using assms(3) subst_lsst_append[of "transaction_receive T"]
+          unlabel_append[of "transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
+    by auto
+
+  obtain l B s where B:
+      "(l,?s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
+      "prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+    using s dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(6)[of assign t u]
+          dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst[of ?s ?R \<theta>] 
+    by blast
+
+  have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>])) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[?s]"
+    using B(1) unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst singleton_lst_proj(4)
+          dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc subst_lsst_append subst_lsst_singleton
+    by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps)
+
+  have "strand_sem_stateful IK DB ?S' \<I>"
+    using \<I> strand_sem_append_stateful[of IK DB _ _ \<I>] transaction_dual_subst_unfold[of T \<theta>]
+    by fastforce
+  hence "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[?s]) \<I>"
+    using B 1 strand_sem_append_stateful subst_lsst_append
+    unfolding prefix_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def
+    by (metis (no_types) map_append)
+  hence in_db: "(t \<cdot> \<I>, u \<cdot> \<I>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I> DB"
+    using strand_sem_append_stateful[of IK DB "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" "[?s]" \<I>]
+    by simp
+  
+  have "\<forall>a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))). ?Q a"
+  proof
+    fix a assume a: "a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
+
+    have "\<forall>a \<in> set (unlabel ?R). ?P a"
+      using wellformed_transaction_unlabel_cases(1)[OF T_valid]
+            wellformed_transaction_unlabel_cases(2)[OF T_valid]
+      unfolding unlabel_def
+      by fastforce
+    hence "\<forall>a \<in> set (unlabel (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)). ?P a"
+      using stateful_strand_step_cases_subst(2,8)[of _ \<theta>] subst_lsst_unlabel[of ?R \<theta>]
+      by (simp add: subst_apply_stateful_strand_def del: unlabel_append)
+    hence B_P: "\<forall>a \<in> set (unlabel (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)). ?P a"
+      using unlabel_mono[OF set_mono_prefix[OF append_prefixD[OF B(2)]]]
+      by blast
+
+    obtain l where "(l,a) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+      using a by (meson unlabel_mem_has_label)
+    then obtain b where b: "(l,b) \<in> set (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,b) = (l,a)"
+      using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD by blast
+    hence "?P b" using B_P unfolding unlabel_def by fastforce
+    thus "?Q a" using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv[OF b(2)] by (cases b) auto
+  qed
+  hence "\<forall>a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))). \<not>is_Insert a \<and> \<not>is_Delete a" by fastforce
+  thus ?thesis using dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" \<I> DB] in_db by simp
+qed
+
+lemma wellformed_transaction_sem_pos_checks:
+  assumes T_valid: "wellformed_transaction T"
+    and \<I>: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I>"
+    and "\<langle>t in u\<rangle> \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  shows "(t \<cdot> \<I>, u \<cdot> \<I>) \<in> DB"
+proof -
+  let ?s = "\<langle>t in u\<rangle>"
+  let ?R = "transaction_receive T@transaction_selects T@transaction_checks T"
+  let ?R' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  let ?S = "\<lambda>A. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  let ?S' = "?S (transaction_receive T)@?S (transaction_selects T)@?S (transaction_checks T)"
+  let ?P = "\<lambda>a. is_Receive a \<or> is_Assignment a \<or> is_Check a"
+  let ?Q = "\<lambda>a. is_Send a \<or> is_Assignment a \<or> is_Check a"
+
+  have s: "?s \<in> set (unlabel (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+    using assms(3) subst_lsst_append[of "transaction_receive T@transaction_selects T"]
+          unlabel_append[of "transaction_receive T@transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
+    by auto
+
+  obtain l B s where B:
+      "(l,?s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
+      "prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+    using s dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(6)[of check t u]
+          dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst[of ?s ?R \<theta>] 
+    by blast
+
+  have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>])) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[?s]"
+    using B(1) unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst singleton_lst_proj(4)
+          dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc subst_lsst_append subst_lsst_singleton
+    by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps )
+
+  have "strand_sem_stateful IK DB ?S' \<I>"
+    using \<I> strand_sem_append_stateful[of IK DB _ _ \<I>] transaction_dual_subst_unfold[of T \<theta>]
+    by fastforce
+  hence "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[?s]) \<I>"
+    using B 1 strand_sem_append_stateful subst_lsst_append
+    unfolding prefix_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def
+    by (metis (no_types) map_append)
+  hence in_db: "(t \<cdot> \<I>, u \<cdot> \<I>) \<in> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I> DB"
+    using strand_sem_append_stateful[of IK DB "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" "[?s]" \<I>]
+    by simp
+  
+  have "\<forall>a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))). ?Q a"
+  proof
+    fix a assume a: "a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
+
+    have "\<forall>a \<in> set (unlabel ?R). ?P a"
+      using wellformed_transaction_unlabel_cases(1,2,3)[OF T_valid]
+      unfolding unlabel_def
+      by fastforce
+    hence "\<forall>a \<in> set (unlabel (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)). ?P a"
+      using stateful_strand_step_cases_subst(2,8,9)[of _ \<theta>] subst_lsst_unlabel[of ?R \<theta>]
+      by (simp add: subst_apply_stateful_strand_def del: unlabel_append)
+    hence B_P: "\<forall>a \<in> set (unlabel (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)). ?P a"
+      using unlabel_mono[OF set_mono_prefix[OF append_prefixD[OF B(2)]]]
+      by blast
+
+    obtain l where "(l,a) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+      using a by (meson unlabel_mem_has_label)
+    then obtain b where b: "(l,b) \<in> set (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,b) = (l,a)"
+      using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD by blast
+    hence "?P b" using B_P unfolding unlabel_def by fastforce
+    thus "?Q a" using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv[OF b(2)] by (cases b) auto
+  qed
+  hence "\<forall>a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))). \<not>is_Insert a \<and> \<not>is_Delete a" by fastforce
+  thus ?thesis using dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" \<I> DB] in_db by simp
+qed
+
+lemma wellformed_transaction_sem_neg_checks:
+  assumes T_valid: "wellformed_transaction T"
+    and \<I>: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I>"
+    and "NegChecks X [] [(t,u)] \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  shows "\<forall>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>) \<longrightarrow> (t \<cdot> \<delta> \<cdot> \<I>, u \<cdot> \<delta> \<cdot> \<I>) \<notin> DB" (is ?A)
+    and "X = [] \<Longrightarrow> (t \<cdot> \<I>, u \<cdot> \<I>) \<notin> DB" (is "?B \<Longrightarrow> ?B'")
+proof -
+  let ?s = "NegChecks X [] [(t,u)]"
+  let ?R = "transaction_receive T@transaction_selects T@transaction_checks T"
+  let ?R' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  let ?S = "\<lambda>A. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  let ?S' = "?S (transaction_receive T)@?S (transaction_selects T)@?S (transaction_checks T)"
+  let ?P = "\<lambda>a. is_Receive a \<or> is_Assignment a \<or> is_Check a"
+  let ?Q = "\<lambda>a. is_Send a \<or> is_Assignment a \<or> is_Check a"
+  let ?U = "\<lambda>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>)"
+
+  have s: "?s \<in> set (unlabel (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+    using assms(3) subst_lsst_append[of "transaction_receive T@transaction_selects T"]
+          unlabel_append[of "transaction_receive T@transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>"]
+    by auto
+
+  obtain l B s where B:
+      "(l,?s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)"
+      "prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+    using s dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(7)[of X "[]" "[(t,u)]"]
+          dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst[of ?s ?R \<theta>]
+    by blast
+
+  have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>])) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[?s]"
+    using B(1) unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst singleton_lst_proj(4)
+          dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc subst_lsst_append subst_lsst_singleton
+    by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps)
+
+  have "strand_sem_stateful IK DB ?S' \<I>"
+    using \<I> strand_sem_append_stateful[of IK DB _ _ \<I>] transaction_dual_subst_unfold[of T \<theta>]
+    by fastforce
+  hence "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@[?s]) \<I>"
+    using B 1 strand_sem_append_stateful subst_lsst_append
+    unfolding prefix_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def
+    by (metis (no_types) map_append)
+  hence "negchecks_model \<I> (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I> DB) X [] [(t,u)]"
+    using strand_sem_append_stateful[of IK DB "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" "[?s]" \<I>]
+    by fastforce
+  hence in_db: "\<forall>\<delta>. ?U \<delta> \<longrightarrow> (t \<cdot> \<delta> \<cdot> \<I>, u \<cdot> \<delta> \<cdot> \<I>) \<notin> dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I> DB"
+    unfolding negchecks_model_def
+    by simp
+
+  have "\<forall>a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))). ?Q a"
+  proof
+    fix a assume a: "a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
+
+    have "\<forall>a \<in> set (unlabel ?R). ?P a"
+      using wellformed_transaction_unlabel_cases(1,2,3)[OF T_valid]
+      unfolding unlabel_def
+      by fastforce
+    hence "\<forall>a \<in> set (unlabel (?R \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)). ?P a"
+      using stateful_strand_step_cases_subst(2,8,9)[of _ \<theta>] subst_lsst_unlabel[of ?R \<theta>]
+      by (simp add: subst_apply_stateful_strand_def del: unlabel_append)
+    hence B_P: "\<forall>a \<in> set (unlabel (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)). ?P a"
+      using unlabel_mono[OF set_mono_prefix[OF append_prefixD[OF B(2)]]]
+      by blast
+
+    obtain l where "(l,a) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+      using a by (meson unlabel_mem_has_label)
+    then obtain b where b: "(l,b) \<in> set (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,b) = (l,a)"
+      using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD by blast
+    hence "?P b" using B_P unfolding unlabel_def by fastforce
+    thus "?Q a" using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv[OF b(2)] by (cases b) auto
+  qed
+  hence "\<forall>a \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))). \<not>is_Insert a \<and> \<not>is_Delete a" by fastforce
+  thus ?A using dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" \<I> DB] in_db by simp
+  moreover have "\<delta> = Var" "t \<cdot> \<delta> = t"
+    when "subst_domain \<delta> = set []" for t and \<delta>::"('fun, 'atom, 'sets) prot_subst"
+    using that by auto
+  moreover have "subst_domain Var = set []" "range_vars Var = {}"
+    by simp_all
+  ultimately show "?B \<Longrightarrow> ?B'" unfolding range_vars_alt_def by metis
+qed
+
+lemma wellformed_transaction_fv_in_receives_or_selects:
+  assumes T: "wellformed_transaction T"
+    and x: "x \<in> fv_transaction T" "x \<notin> set (transaction_fresh T)"
+  shows "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+proof -
+  have "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<union>
+            fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union>
+            fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
+    using x(1) fv\<^sub>s\<^sub>s\<^sub>t_append unlabel_append 
+    by (metis transaction_strand_def append_assoc)
+  thus ?thesis using T x(2) unfolding wellformed_transaction_def by blast
+qed
+
+lemma dual_transaction_ik_is_transaction_send'':
+  fixes \<delta> \<I>::"('a,'b,'c) prot_subst"
+  assumes "wellformed_transaction T"
+  shows "(ik\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>))) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a =
+         (trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a" (is "?A = ?B")
+using dual_transaction_ik_is_transaction_send[OF assms]
+      subst_lsst_unlabel[of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" \<delta>]
+      ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))" \<delta>]
+      dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" \<delta>]
+by (auto simp add: abs_apply_terms_def)
+
+lemma while_prot_terms_fun_mono:
+  "mono (\<lambda>M'. M \<union> \<Union>(subterms ` M') \<union> \<Union>((set \<circ> fst \<circ> Ana) ` M'))"
+unfolding mono_def by fast
+
+lemma while_prot_terms_SMP_overapprox:
+  fixes M::"('fun,'atom,'sets) prot_terms"
+  assumes N_supset: "M \<union> \<Union>(subterms ` N) \<union> \<Union>((set \<circ> fst \<circ> Ana) ` N) \<subseteq> N"
+    and Value_vars_only: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t N. \<Gamma>\<^sub>v x = TAtom Value"
+  shows "SMP M \<subseteq> {a \<cdot> \<delta> | a \<delta>. a \<in> N \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)}"
+proof -
+  define f where "f \<equiv> \<lambda>M'. M \<union> \<Union>(subterms ` M') \<union> \<Union>((set \<circ> fst \<circ> Ana) ` M')"
+  define S where "S \<equiv> {a \<cdot> \<delta> | a \<delta>. a \<in> N \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)}"
+
+  note 0 = Value_vars_only
+  
+  have "t \<in> S" when "t \<in> SMP M" for t
+  using that
+  proof (induction t rule: SMP.induct)
+    case (MP t)
+    hence "t \<in> N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" using N_supset by auto
+    hence "t \<cdot> Var \<in> S" unfolding S_def by blast
+    thus ?case by simp
+  next
+    case (Subterm t t')
+    then obtain \<delta> a where a: "a \<cdot> \<delta> = t" "a \<in> N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
+      by (auto simp add: S_def)
+    hence "\<forall>x \<in> fv a. \<exists>\<tau>. \<Gamma> (Var x) = TAtom \<tau>" using 0 by auto
+    hence *: "\<forall>x \<in> fv a. (\<exists>f. \<delta> x = Fun f []) \<or> (\<exists>y. \<delta> x = Var y)"
+      using a(3) TAtom_term_cases[OF wf_trm_subst_rangeD[OF a(4)]]
+      by (metis wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
+    obtain b where b: "b \<cdot> \<delta> = t'" "b \<in> subterms a"
+      using subterms_subst_subterm[OF *, of t'] Subterm.hyps(2) a(1)
+      by fast
+    hence "b \<in> N" using N_supset a(2) by blast
+    thus ?case using a b(1) unfolding S_def by blast
+  next
+    case (Substitution t \<theta>)
+    then obtain \<delta> a where a: "a \<cdot> \<delta> = t" "a \<in> N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
+      by (auto simp add: S_def)
+    have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<delta> \<circ>\<^sub>s \<theta>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<delta> \<circ>\<^sub>s \<theta>))"
+      by (fact wt_subst_compose[OF a(3) Substitution.hyps(2)],
+          fact wf_trms_subst_compose[OF a(4) Substitution.hyps(3)])
+    moreover have "t \<cdot> \<theta> = a \<cdot> \<delta> \<circ>\<^sub>s \<theta>" using a(1) subst_subst_compose[of a \<delta> \<theta>] by simp
+    ultimately show ?case using a(2) unfolding S_def by blast
+  next
+    case (Ana t K T k)
+    then obtain \<delta> a where a: "a \<cdot> \<delta> = t" "a \<in> N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
+      by (auto simp add: S_def)
+    obtain Ka Ta where a': "Ana a = (Ka,Ta)" by moura
+    have *: "K = Ka \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>"
+    proof (cases a)
+      case (Var x)
+      then obtain g U where gU: "t = Fun g U"
+        using a(1) Ana.hyps(2,3) Ana_var
+        by (cases t) simp_all
+      have "\<Gamma> (Var x) = TAtom Value" using Var a(2) 0 by auto
+      hence "\<Gamma> (Fun g U) = TAtom Value"
+        using a(1,3) Var gU wt_subst_trm''[OF a(3), of a]
+        by argo
+      thus ?thesis using gU Fun_Value_type_inv Ana.hyps(2,3) by fastforce  
+    next
+      case (Fun g U) thus ?thesis using a(1) a' Ana.hyps(2) Ana_subst'[of g U] by simp
+    qed
+    then obtain ka where ka: "k = ka \<cdot> \<delta>" "ka \<in> set Ka" using Ana.hyps(3) by auto
+    have "ka \<in> set ((fst \<circ> Ana) a)" using ka(2) a' by simp
+    hence "ka \<in> N" using a(2) N_supset by auto
+    thus ?case using ka a(3,4) unfolding S_def by blast
+  qed
+  thus ?thesis unfolding S_def by blast
+qed
+
+
+subsection \<open>The Protocol Transition System, Defined in Terms of the Reachable Constraints\<close>
+definition transaction_fresh_subst where
+  "transaction_fresh_subst \<sigma> T \<A> \<equiv>
+    subst_domain \<sigma> = set (transaction_fresh T) \<and>
+    (\<forall>t \<in> subst_range \<sigma>. \<exists>n. t = Fun (Val (n,False)) []) \<and>
+    (\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<and>
+    (\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)) \<and>
+    inj_on \<sigma> (subst_domain \<sigma>)"
+
+(* NB: We need the protocol P as a parameter for this definition---even though we will only apply \<alpha>
+       to a single transaction T of P---because we have to ensure that \<alpha>(fv(T)) is disjoint from
+       the bound variables of P and \<A>. *)
+definition transaction_renaming_subst where
+  "transaction_renaming_subst \<alpha> P \<A> \<equiv>
+    \<exists>n \<ge> max_var_set (\<Union>(vars_transaction ` set P) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). \<alpha> = var_rename n"
+
+definition constraint_model where
+  "constraint_model \<I> \<A> \<equiv> 
+    constr_sem_stateful \<I> (unlabel \<A>) \<and>
+    interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I> \<and>
+    wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
+
+definition welltyped_constraint_model where
+  "welltyped_constraint_model \<I> \<A> \<equiv>  wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I> \<and> constraint_model \<I> \<A>"
+
+lemma constraint_model_prefix:
+  assumes "constraint_model I (A@B)"
+  shows "constraint_model I A"
+by (metis assms strand_sem_append_stateful unlabel_append constraint_model_def)
+
+lemma welltyped_constraint_model_prefix:
+  assumes "welltyped_constraint_model I (A@B)"
+  shows "welltyped_constraint_model I A"
+by (metis assms constraint_model_prefix welltyped_constraint_model_def)
+
+lemma constraint_model_Val_is_Value_term:
+  assumes "welltyped_constraint_model I A"
+    and "t \<cdot> I = Fun (Val n) []"
+  shows "t = Fun (Val n) [] \<or> (\<exists>m. t = Var (TAtom Value, m))"
+proof -
+  have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" using assms(1) unfolding welltyped_constraint_model_def by simp
+  moreover have "\<Gamma> (Fun (Val n) []) = TAtom Value" by auto
+  ultimately have *: "\<Gamma> t = TAtom Value" by (metis (no_types) assms(2) wt_subst_trm'')
+
+  show ?thesis
+  proof (cases t)
+    case (Var x)
+    obtain \<tau> m where x: "x = (\<tau>, m)" by (metis surj_pair)
+    have "\<Gamma>\<^sub>v x = TAtom Value" using * Var by auto
+    hence "\<tau> = TAtom Value" using x \<Gamma>\<^sub>v_TAtom'[of Value \<tau> m] by simp
+    thus ?thesis using x Var by metis
+  next
+    case (Fun f T) thus ?thesis using assms(2) by auto
+  qed
+qed
+
+text \<open>
+  The set of symbolic constraints reachable in any symbolic run of the protocol \<open>P\<close>.
+  
+  \<open>\<sigma>\<close> instantiates the fresh variables of transaction \<open>T\<close> with fresh terms.
+  \<open>\<alpha>\<close> is a variable-renaming whose range consists of fresh variables.
+\<close>
+inductive_set reachable_constraints::
+  "('fun,'atom,'sets,'lbl) prot \<Rightarrow> ('fun,'atom,'sets,'lbl) prot_constr set"
+  for P::"('fun,'atom,'sets,'lbl) prot"
+where
+  init:
+  "[] \<in> reachable_constraints P"
+| step:
+  "\<lbrakk>\<A> \<in> reachable_constraints P;
+    T \<in> set P;
+    transaction_fresh_subst \<sigma> T \<A>;
+    transaction_renaming_subst \<alpha> P \<A>
+   \<rbrakk> \<Longrightarrow> \<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>) \<in> reachable_constraints P"
+
+
+subsection \<open>Admissible Transactions\<close>
+definition admissible_transaction_checks where
+  "admissible_transaction_checks T \<equiv>
+    \<forall>x \<in> set (unlabel (transaction_checks T)).
+      is_Check x \<and>
+      (is_InSet x \<longrightarrow>
+          is_Var (the_elem_term x) \<and> is_Fun_Set (the_set_term x) \<and>
+          fst (the_Var (the_elem_term x)) = TAtom Value) \<and>
+      (is_NegChecks x \<longrightarrow>
+          bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = [] \<and>
+          ((the_eqs x = [] \<and> length (the_ins x) = 1) \<or>
+           (the_ins x = [] \<and> length (the_eqs x) = 1))) \<and>
+      (is_NegChecks x \<and> the_eqs x = [] \<longrightarrow> (let h = hd (the_ins x) in
+          is_Var (fst h) \<and> is_Fun_Set (snd h) \<and>
+          fst (the_Var (fst h)) = TAtom Value))"
+
+definition admissible_transaction_selects where
+  "admissible_transaction_selects T \<equiv>
+    \<forall>x \<in> set (unlabel (transaction_selects T)).
+      is_InSet x \<and> the_check x = Assign \<and> is_Var (the_elem_term x) \<and> is_Fun_Set (the_set_term x) \<and>
+      fst (the_Var (the_elem_term x)) = TAtom Value"
+
+definition admissible_transaction_updates where
+  "admissible_transaction_updates T \<equiv>
+    \<forall>x \<in> set (unlabel (transaction_updates T)).
+      is_Update x \<and> is_Var (the_elem_term x) \<and> is_Fun_Set (the_set_term x) \<and>
+      fst (the_Var (the_elem_term x)) = TAtom Value"
+
+definition admissible_transaction_terms where
+  "admissible_transaction_terms T \<equiv>
+    wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) \<and>
+    (\<forall>f \<in> \<Union>(funs_term ` trms_transaction T).
+      \<not>is_Val f \<and> \<not>is_Abs f \<and> \<not>is_PubConstSetType f \<and> f \<noteq> Pair \<and>
+      \<not>is_PubConstAttackType f \<and> \<not>is_PubConstBottom f \<and> \<not>is_PubConstOccursSecType f) \<and>
+    (\<forall>r \<in> set (unlabel (transaction_strand T)).
+      (\<exists>f \<in> \<Union>(funs_term ` (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r)). is_Attack f) \<longrightarrow>
+        (let t = the_msg r in is_Send r \<and> is_Fun t \<and> is_Attack (the_Fun t) \<and> args t = []))"
+
+definition admissible_transaction_occurs_checks where
+  "admissible_transaction_occurs_checks T \<equiv> (
+    (\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow>
+      receive\<langle>occurs (Var x)\<rangle> \<in> set (unlabel (transaction_receive T))) \<and>
+    (\<forall>x \<in> set (transaction_fresh T). fst x = TAtom Value \<longrightarrow>
+      send\<langle>occurs (Var x)\<rangle> \<in> set (unlabel (transaction_send T))) \<and>
+    (\<forall>r \<in> set (unlabel (transaction_receive T)). is_Receive r \<longrightarrow>
+      (OccursFact \<in> funs_term (the_msg r) \<or> OccursSec \<in> funs_term (the_msg r)) \<longrightarrow>
+        (\<exists>x \<in> fv_transaction T - set (transaction_fresh T).
+          fst x = TAtom Value \<and> the_msg r = occurs (Var x))) \<and>
+    (\<forall>r \<in> set (unlabel (transaction_send T)). is_Send r \<longrightarrow>
+      (OccursFact \<in> funs_term (the_msg r) \<or> OccursSec \<in> funs_term (the_msg r)) \<longrightarrow>
+        (\<exists>x \<in> set (transaction_fresh T).
+          fst x = TAtom Value \<and> the_msg r = occurs (Var x)))
+  )"
+
+definition admissible_transaction where
+  "admissible_transaction T \<equiv> (
+    wellformed_transaction T \<and>
+    distinct (transaction_fresh T) \<and>
+    list_all (\<lambda>x. fst x = TAtom Value) (transaction_fresh T) \<and>
+    (\<forall>x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T). is_Var (fst x) \<and> (the_Var (fst x) = Value)) \<and>
+    bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = {} \<and>
+    (\<forall>x \<in> fv_transaction T - set (transaction_fresh T).
+     \<forall>y \<in> fv_transaction T - set (transaction_fresh T).
+      x \<noteq> y \<longrightarrow> \<langle>Var x != Var y\<rangle> \<in> set (unlabel (transaction_checks T)) \<or>
+                \<langle>Var y != Var x\<rangle> \<in> set (unlabel (transaction_checks T))) \<and>
+    admissible_transaction_selects T \<and>
+    admissible_transaction_checks T \<and>
+    admissible_transaction_updates T \<and>
+    admissible_transaction_terms T \<and>
+    admissible_transaction_occurs_checks T
+)"
+
+lemma transaction_no_bvars:
+  assumes "admissible_transaction T"
+  shows "fv_transaction T = vars_transaction T"
+    and "bvars_transaction T = {}"
+proof -
+  have "wellformed_transaction T" "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = {}"
+    using assms unfolding admissible_transaction_def
+    by blast+
+  thus "bvars_transaction T = {}" "fv_transaction T = vars_transaction T"
+    using bvars_wellformed_transaction_unfold vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t
+    by fast+
+qed
+
+lemma transactions_fv_bvars_disj:
+  assumes "\<forall>T \<in> set P. admissible_transaction T"
+  shows "(\<Union>T \<in> set P. fv_transaction T) \<inter> (\<Union>T \<in> set P. bvars_transaction T) = {}"
+using assms transaction_no_bvars(2) by fast
+
+lemma transaction_bvars_no_Value_type:
+  assumes "admissible_transaction T"
+    and "x \<in> bvars_transaction T"
+  shows "\<not>TAtom Value \<sqsubseteq> \<Gamma>\<^sub>v x"
+using assms transaction_no_bvars(2) by blast
+
+lemma transaction_receive_deduct:
+  assumes T_adm: "admissible_transaction T"
+    and \<I>: "constraint_model \<I> (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T A"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P A"
+    and t: "receive\<langle>t\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+  shows "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>"
+proof -
+  define \<theta> where "\<theta> \<equiv> \<sigma> \<circ>\<^sub>s \<alpha>"
+
+  have t': "send\<langle>t\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
+    using t dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) unfolding \<theta>_def by blast
+  then obtain T1 T2 where T: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) = T1@send\<langle>t\<rangle>#T2"
+    using t' by (meson split_list)
+
+  have "constr_sem_stateful \<I> (unlabel A@unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
+    using \<I> unlabel_append[of A] unfolding constraint_model_def \<theta>_def by simp
+  hence "constr_sem_stateful \<I> (unlabel A@T1@[send\<langle>t\<rangle>])"
+    using strand_sem_append_stateful[of "{}" "{}" "unlabel A@T1@[send\<langle>t\<rangle>]" _ \<I>]
+          transaction_dual_subst_unfold[of T \<theta>] T
+    by (metis append.assoc append_Cons append_Nil)
+  hence "ik\<^sub>s\<^sub>s\<^sub>t (unlabel A@T1) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>"
+    using strand_sem_append_stateful[of "{}" "{}" "unlabel A@T1" "[send\<langle>t\<rangle>]" \<I>] T
+    by force
+  moreover have "\<not>is_Receive x"
+    when x: "x \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))" for x
+  proof -
+    have *: "is_Receive a" when "a \<in> set (unlabel (transaction_receive T))" for a
+      using T_adm Ball_set[of "unlabel (transaction_receive T)" is_Receive] that
+      unfolding admissible_transaction_def wellformed_transaction_def
+      by blast
+
+    obtain l where l: "(l,x) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+      using x unfolding unlabel_def by fastforce
+    then obtain ly where ly: "ly \<in> set (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" "(l,x) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ly"
+      unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
+
+    obtain j y where j: "ly = (j,y)" by (metis surj_pair)
+    hence "j = l" using ly(2) by (cases y) auto
+    hence y: "(l,y) \<in> set (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" "(l,x) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,y)"
+      by (metis j ly(1), metis j ly(2))
+
+    obtain z where z:
+        "z \<in> set (unlabel (transaction_receive T))"
+        "(l,z) \<in> set (transaction_receive T)"
+        "(l,y) = (l,z) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>"
+      using y(1) unfolding subst_apply_labeled_stateful_strand_def unlabel_def by force
+
+    have "is_Receive y" using *[OF z(1)] z(3) by (cases z) auto
+    thus "\<not>is_Receive x" using l y by (cases y) auto
+  qed
+  hence "\<not>is_Receive x" when "x \<in> set T1" for x using T that by simp
+  hence "ik\<^sub>s\<^sub>s\<^sub>t T1 = {}" unfolding ik\<^sub>s\<^sub>s\<^sub>t_def is_Receive_def by fast
+  hence "ik\<^sub>s\<^sub>s\<^sub>t (unlabel A@T1) = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" using ik\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" T1] by simp
+  ultimately show ?thesis by (simp add: \<theta>_def)
+qed
+
+lemma transaction_checks_db:
+  assumes T: "admissible_transaction T"
+    and \<I>: "constraint_model \<I> (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T A"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P A"
+  shows "\<langle>Var (TAtom Value, n) in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))
+          \<Longrightarrow> (\<alpha> (TAtom Value, n) \<cdot> \<I>, Fun (Set s) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<I>)"
+      (is "?A \<Longrightarrow> ?B")
+    and "\<langle>Var (TAtom Value, n) not in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))
+          \<Longrightarrow> (\<alpha> (TAtom Value, n) \<cdot> \<I>, Fun (Set s) []) \<notin> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<I>)"
+      (is "?C \<Longrightarrow> ?D")
+proof -
+  let ?x = "\<lambda>n. (TAtom Value, n)"
+  let ?s = "Fun (Set s) []"
+  let ?T = "transaction_receive T@transaction_selects T@transaction_checks T"
+  let ?T' = "?T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+  let ?S = "\<lambda>S. transaction_receive T@transaction_selects T@S"
+  let ?S' = "\<lambda>S. ?S S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+
+  have T_valid: "wellformed_transaction T" using T by (simp add: admissible_transaction_def)
+
+  have "constr_sem_stateful \<I> (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)))"
+    using \<I> unfolding constraint_model_def by simp
+  moreover have
+      "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
+       dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S (T1@[c]) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)@
+       dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T2@transaction_updates T@transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
+    when "transaction_checks T = T1@c#T2" for T1 T2 c \<delta>
+    using that dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append
+    unfolding transaction_strand_def
+    by (metis append.assoc append_Cons append_Nil)
+  ultimately have T'_model: "constr_sem_stateful \<I> (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,c)]))))"
+    when "transaction_checks T = T1@(l,c)#T2" for T1 T2 l c
+    using strand_sem_append_stateful[of _ _ _ _ \<I>]
+    by (simp add: that transaction_strand_def)
+
+  show "?A \<Longrightarrow> ?B"
+  proof -
+    assume a: ?A
+    hence *: "\<langle>Var (?x n) in ?s\<rangle> \<in> set (unlabel ?T)"
+      unfolding transaction_strand_def unlabel_def by simp
+    then obtain l T1 T2 where T1: "transaction_checks T = T1@(l,\<langle>Var (?x n) in ?s\<rangle>)#T2"
+      by (metis a split_list unlabel_mem_has_label)
+
+    have "?x n \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
+      using a by force
+    hence "?x n \<notin> set (transaction_fresh T)"
+      using a transaction_fresh_vars_notin[OF T_valid] by fast
+    hence "unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,\<langle>Var (?x n) in ?s\<rangle>)]))) =
+           unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1))@[\<langle>\<alpha> (?x n) in ?s\<rangle>]"
+      using T a \<sigma> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append unlabel_append
+      by (fastforce simp add: transaction_fresh_subst_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def
+                              subst_apply_labeled_stateful_strand_def)
+    moreover have "db\<^sub>s\<^sub>s\<^sub>t (unlabel A) = db\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1)))"
+      by (simp add: T1 db\<^sub>s\<^sub>s\<^sub>t_transaction_prefix_eq[OF T_valid] del: unlabel_append)
+    ultimately have "\<exists>M. strand_sem_stateful M (set (db\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<I>)) [\<langle>\<alpha> (?x n) in ?s\<rangle>] \<I>"
+      using T'_model[OF T1] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of _ \<I>] strand_sem_append_stateful[of _ _ _ _ \<I>]
+      by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def del: unlabel_append)
+    thus ?B by simp
+  qed
+
+  show "?C \<Longrightarrow> ?D"
+  proof -
+    assume a: ?C
+    hence *: "\<langle>Var (?x n) not in ?s\<rangle> \<in> set (unlabel ?T)"
+      unfolding transaction_strand_def unlabel_def by simp
+    then obtain l T1 T2 where T1: "transaction_checks T = T1@(l,\<langle>Var (?x n) not in ?s\<rangle>)#T2"
+      by (metis a split_list unlabel_mem_has_label)
+
+    have "?x n \<in> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<langle>Var (?x n) not in ?s\<rangle>"
+      using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_cases(9)[of "[]" "Var (?x n)" ?s] by auto
+    hence "?x n \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
+      using a unfolding vars\<^sub>s\<^sub>s\<^sub>t_def by force
+    hence "?x n \<notin> set (transaction_fresh T)"
+      using a transaction_fresh_vars_notin[OF T_valid] by fast
+    hence "unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,\<langle>Var (?x n) not in ?s\<rangle>)]))) =
+           unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1))@[\<langle>\<alpha> (?x n) not in ?s\<rangle>]"
+      using T a \<sigma> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append unlabel_append
+      by (fastforce simp add: transaction_fresh_subst_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def
+                              subst_apply_labeled_stateful_strand_def)
+    moreover have "db\<^sub>s\<^sub>s\<^sub>t (unlabel A) = db\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1)))"
+      by (simp add: T1 db\<^sub>s\<^sub>s\<^sub>t_transaction_prefix_eq[OF T_valid] del: unlabel_append)
+    ultimately have "\<exists>M. strand_sem_stateful M (set (db\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<I>)) [\<langle>\<alpha> (?x n) not in ?s\<rangle>] \<I>"
+      using T'_model[OF T1] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of _ \<I>] strand_sem_append_stateful[of _ _ _ _ \<I>]
+      by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def del: unlabel_append)
+    thus ?D using stateful_strand_sem_NegChecks_no_bvars(1)[of _ _ _ ?s \<I>] by simp
+  qed
+qed
+
+lemma transaction_selects_db:
+  assumes T: "admissible_transaction T"
+    and \<I>: "constraint_model \<I> (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T A"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P A"
+  shows "select\<langle>Var (TAtom Value, n), Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_selects T))
+          \<Longrightarrow> (\<alpha> (TAtom Value, n) \<cdot> \<I>, Fun (Set s) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<I>)"
+      (is "?A \<Longrightarrow> ?B")
+proof -
+  let ?x = "\<lambda>n. (TAtom Value, n)"
+  let ?s = "Fun (Set s) []"
+  let ?T = "transaction_receive T@transaction_selects T@transaction_checks T"
+  let ?T' = "?T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+  let ?S = "\<lambda>S. transaction_receive T@S"
+  let ?S' = "\<lambda>S. ?S S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+
+  have T_valid: "wellformed_transaction T" using T by (simp add: admissible_transaction_def)
+
+  have "constr_sem_stateful \<I> (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)))"
+    using \<I> unfolding constraint_model_def by simp
+  moreover have
+      "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
+       dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S (T1@[c]) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)@
+       dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T2@transaction_checks T @ transaction_updates T@transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
+    when "transaction_selects T = T1@c#T2" for T1 T2 c \<delta>
+    using that dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append
+    unfolding transaction_strand_def by (metis append.assoc append_Cons append_Nil)
+  ultimately have T'_model: "constr_sem_stateful \<I> (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,c)]))))"
+    when "transaction_selects T = T1@(l,c)#T2" for T1 T2 l c
+    using strand_sem_append_stateful[of _ _ _ _ \<I>]
+    by (simp add: that transaction_strand_def)
+
+  show "?A \<Longrightarrow> ?B"
+  proof -
+    assume a: ?A
+    hence *: "select\<langle>Var (?x n), ?s\<rangle> \<in> set (unlabel ?T)"
+      unfolding transaction_strand_def unlabel_def by simp
+    then obtain l T1 T2 where T1: "transaction_selects T = T1@(l,select\<langle>Var (?x n), ?s\<rangle>)#T2"
+      by (metis a split_list unlabel_mem_has_label)
+
+    have "?x n \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+      using a by force
+    hence "?x n \<notin> set (transaction_fresh T)"
+      using a transaction_fresh_vars_notin[OF T_valid] by fast
+    hence "unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,select\<langle>Var (?x n), ?s\<rangle>)]))) =
+           unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1))@[select\<langle>\<alpha> (?x n), ?s\<rangle>]"
+      using T a \<sigma> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append unlabel_append
+      by (fastforce simp add: transaction_fresh_subst_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def
+                              subst_apply_labeled_stateful_strand_def)
+    moreover have "db\<^sub>s\<^sub>s\<^sub>t (unlabel A) = db\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1)))"
+      by (simp add: T1 db\<^sub>s\<^sub>s\<^sub>t_transaction_prefix_eq[OF T_valid] del: unlabel_append)
+    ultimately have "\<exists>M. strand_sem_stateful M (set (db\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<I>)) [\<langle>\<alpha> (?x n) in ?s\<rangle>] \<I>"
+      using T'_model[OF T1] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of _ \<I>] strand_sem_append_stateful[of _ _ _ _ \<I>]
+      by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def del: unlabel_append)
+    thus ?B by simp
+  qed
+qed
+
+lemma transactions_have_no_Value_consts:
+  assumes "admissible_transaction T"
+    and "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"
+  shows "\<nexists>a T. t = Fun (Val a) T" (is ?A)
+    and "\<nexists>a T. t = Fun (Abs a) T" (is ?B)
+proof -
+  have "admissible_transaction_terms T" using assms(1) unfolding admissible_transaction_def by blast
+  hence "\<not>is_Val f" "\<not>is_Abs f"
+    when "f \<in> \<Union>(funs_term ` (trms_transaction T))" for f
+    using that unfolding admissible_transaction_terms_def by blast+
+  moreover have "f \<in> \<Union>(funs_term ` (trms_transaction T))"
+    when "f \<in> funs_term t" for f
+    using that assms(2) funs_term_subterms_eq(2)[of "trms_transaction T"] by blast+
+  ultimately have *: "\<not>is_Val f" "\<not>is_Abs f"
+    when "f \<in> funs_term t" for f
+    using that by presburger+
+
+  show ?A using *(1) by force
+  show ?B using *(2) by force
+qed
+
+lemma transactions_have_no_Value_consts':
+  assumes "admissible_transaction T"
+    and "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)"
+  shows "\<nexists>a T. Fun (Val a) T \<in> subterms t"
+    and "\<nexists>a T. Fun (Abs a) T \<in> subterms t"
+using transactions_have_no_Value_consts[OF assms(1)] assms(2) by fast+
+
+lemma transactions_have_no_PubConsts:
+  assumes "admissible_transaction T"
+    and "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"
+  shows "\<nexists>a T. t = Fun (PubConstSetType a) T" (is ?A)
+    and "\<nexists>a T. t = Fun (PubConstAttackType a) T" (is ?B)
+    and "\<nexists>a T. t = Fun (PubConstBottom a) T" (is ?C)
+    and "\<nexists>a T. t = Fun (PubConstOccursSecType a) T" (is ?D)
+proof -
+  have "admissible_transaction_terms T" using assms(1) unfolding admissible_transaction_def by blast
+  hence "\<not>is_PubConstSetType f" "\<not>is_PubConstAttackType f"
+        "\<not>is_PubConstBottom f" "\<not>is_PubConstOccursSecType f"
+    when "f \<in> \<Union>(funs_term ` (trms_transaction T))" for f
+    using that unfolding admissible_transaction_terms_def by blast+
+  moreover have "f \<in> \<Union>(funs_term ` (trms_transaction T))"
+    when "f \<in> funs_term t" for f
+    using that assms(2) funs_term_subterms_eq(2)[of "trms_transaction T"] by blast+
+  ultimately have *:
+      "\<not>is_PubConstSetType f" "\<not>is_PubConstAttackType f"
+      "\<not>is_PubConstBottom f" "\<not>is_PubConstOccursSecType f"
+    when "f \<in> funs_term t" for f
+    using that by presburger+
+
+  show ?A using *(1) by force
+  show ?B using *(2) by force
+  show ?C using *(3) by force
+  show ?D using *(4) by force
+qed
+
+lemma transactions_have_no_PubConsts':
+  assumes "admissible_transaction T"
+    and "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)"
+  shows "\<nexists>a T. Fun (PubConstSetType a) T \<in> subterms t"
+    and "\<nexists>a T. Fun (PubConstAttackType a) T \<in> subterms t"
+    and "\<nexists>a T. Fun (PubConstBottom a) T \<in> subterms t"
+    and "\<nexists>a T. Fun (PubConstOccursSecType a) T \<in> subterms t"
+using transactions_have_no_PubConsts[OF assms(1)] assms(2) by fast+
+
+lemma transaction_inserts_are_Value_vars:
+  assumes T_valid: "wellformed_transaction T"
+    and "admissible_transaction_updates T"
+    and "insert\<langle>t,s\<rangle> \<in> set (unlabel (transaction_strand T))"
+  shows "\<exists>n. t = Var (TAtom Value, n)"
+    and "\<exists>u. s = Fun (Set u) []"
+proof -
+  let ?x = "insert\<langle>t,s\<rangle>"
+
+  have "?x \<in> set (unlabel (transaction_updates T))"
+    using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x]    
+    by (auto simp add: transaction_strand_def unlabel_def)
+  hence *: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value"
+           "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []"
+           "is_Set (the_Fun (the_set_term ?x))"
+    using assms(2) unfolding admissible_transaction_updates_def is_Fun_Set_def by fastforce+
+  
+  show "\<exists>n. t = Var (TAtom Value, n)" using *(1,2) by (cases t) auto
+  show "\<exists>u. s = Fun (Set u) []" using *(3,4,5) unfolding is_Set_def by (cases s) auto
+qed
+
+lemma transaction_deletes_are_Value_vars:
+  assumes T_valid: "wellformed_transaction T"
+    and "admissible_transaction_updates T"
+    and "delete\<langle>t,s\<rangle> \<in> set (unlabel (transaction_strand T))"
+  shows "\<exists>n. t = Var (TAtom Value, n)"
+    and "\<exists>u. s = Fun (Set u) []"
+proof -
+  let ?x = "delete\<langle>t,s\<rangle>"
+
+  have "?x \<in> set (unlabel (transaction_updates T))"
+    using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x]    
+    by (auto simp add: transaction_strand_def unlabel_def)
+  hence *: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value"
+           "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []"
+           "is_Set (the_Fun (the_set_term ?x))"
+    using assms(2) unfolding admissible_transaction_updates_def is_Fun_Set_def by fastforce+
+  
+  show "\<exists>n. t = Var (TAtom Value, n)" using *(1,2) by (cases t) auto
+  show "\<exists>u. s = Fun (Set u) []" using *(3,4,5) unfolding is_Set_def by (cases s) auto
+qed
+
+lemma transaction_selects_are_Value_vars:
+  assumes T_valid: "wellformed_transaction T"
+    and "admissible_transaction_selects T"
+    and "select\<langle>t,s\<rangle> \<in> set (unlabel (transaction_strand T))"
+  shows "\<exists>n. t = Var (TAtom Value, n) \<and> (TAtom Value, n) \<notin> set (transaction_fresh T)" (is ?A)
+    and "\<exists>u. s = Fun (Set u) []" (is ?B)
+proof -
+  let ?x = "select\<langle>t,s\<rangle>"
+
+  have *: "?x \<in> set (unlabel (transaction_selects T))"
+    using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x]    
+    by (auto simp add: transaction_strand_def unlabel_def)
+  
+  have **: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value"
+           "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []"
+           "is_Set (the_Fun (the_set_term ?x))"
+    using * assms(2) unfolding admissible_transaction_selects_def is_Fun_Set_def by fastforce+
+
+  have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+    using * by force
+  hence ***: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \<inter> set (transaction_fresh T) = {}"
+    using T_valid unfolding wellformed_transaction_def by fast
+
+  show ?A using **(1,2) *** by (cases t) auto
+  show ?B using **(3,4,5) unfolding is_Set_def by (cases s) auto
+qed
+
+lemma transaction_inset_checks_are_Value_vars:
+  assumes T_valid: "wellformed_transaction T"
+    and "admissible_transaction_checks T"
+    and "\<langle>t in s\<rangle> \<in> set (unlabel (transaction_strand T))"
+  shows "\<exists>n. t = Var (TAtom Value, n) \<and> (TAtom Value, n) \<notin> set (transaction_fresh T)" (is ?A)
+    and "\<exists>u. s = Fun (Set u) []" (is ?B)
+proof -
+  let ?x = "\<langle>t in s\<rangle>"
+
+  have *: "?x \<in> set (unlabel (transaction_checks T))"
+    using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x]    
+    by (auto simp add: transaction_strand_def unlabel_def)
+  
+  have **: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value"
+           "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []"
+           "is_Set (the_Fun (the_set_term ?x))"
+    using * assms(2) unfolding admissible_transaction_checks_def is_Fun_Set_def by fastforce+
+
+  have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
+    using * by force
+  hence ***: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \<inter> set (transaction_fresh T) = {}"
+    using T_valid unfolding wellformed_transaction_def by fast
+
+  show ?A using **(1,2) *** by (cases t) auto
+  show ?B using **(3,4,5) unfolding is_Set_def by (cases s) auto
+qed
+
+lemma transaction_notinset_checks_are_Value_vars:
+  assumes T_valid: "wellformed_transaction T"
+    and "admissible_transaction_checks T"
+    and "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set (unlabel (transaction_strand T))"
+    and "(t,s) \<in> set G"
+  shows "\<exists>n. t = Var (TAtom Value, n) \<and> (TAtom Value, n) \<notin> set (transaction_fresh T)" (is ?A)
+    and "\<exists>u. s = Fun (Set u) []" (is ?B)
+proof -
+  let ?x = "\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>"
+
+  have 0: "?x \<in> set (unlabel (transaction_checks T))"
+    using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x]    
+    by (auto simp add: transaction_strand_def unlabel_def)
+  hence 1: "F = [] \<and> length G = 1"
+    using assms(2,4) unfolding admissible_transaction_checks_def by fastforce
+  hence "hd G = (t,s)" using assms(4) by (cases "the_ins ?x") auto
+  hence **: "is_Var t" "fst (the_Var t) = TAtom Value" "is_Fun s" "args s = []" "is_Set (the_Fun s)"
+    using 0 1 assms(2) unfolding admissible_transaction_checks_def Let_def is_Fun_Set_def
+    by fastforce+
+
+  have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
+       "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x) \<subseteq> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
+    using 0 by force+
+  moreover have 
+      "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+      "set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}"
+      "set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {}"
+    using T_valid unfolding wellformed_transaction_def by fast+
+  ultimately have
+      "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \<inter> set (transaction_fresh T) = {}"
+      "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x) \<inter> set (transaction_fresh T) = {}"
+    using wellformed_transaction_wf\<^sub>s\<^sub>s\<^sub>t(2,3)[OF T_valid]
+          fv_transaction_unfold[of T] bvars_transaction_unfold[of T]
+    by blast+
+  hence ***: "fv t \<inter> set (transaction_fresh T) = {}"
+    using assms(4) by auto
+
+  show ?A using **(1,2) *** by (cases t) auto
+  show ?B using **(3,4,5) unfolding is_Set_def by (cases s) auto
+qed
+
+lemma admissible_transaction_strand_step_cases:
+  assumes T_adm: "admissible_transaction T"
+  shows "r \<in> set (unlabel (transaction_receive T)) \<Longrightarrow> \<exists>t. r = receive\<langle>t\<rangle>"
+        (is "?A \<Longrightarrow> ?A'")
+    and "r \<in> set (unlabel (transaction_selects T)) \<Longrightarrow>
+            \<exists>x s. r = select\<langle>Var x, Fun (Set s) []\<rangle> \<and>
+                  fst x = TAtom Value \<and> x \<in> fv_transaction T - set (transaction_fresh T)"
+        (is "?B \<Longrightarrow> ?B'")
+    and "r \<in> set (unlabel (transaction_checks T)) \<Longrightarrow>
+            (\<exists>x s. (r = \<langle>Var x in Fun (Set s) []\<rangle> \<or> r = \<langle>Var x not in Fun (Set s) []\<rangle>) \<and>
+                   fst x = TAtom Value \<and> x \<in> fv_transaction T - set (transaction_fresh T)) \<or>
+            (\<exists>s t. r = \<langle>s == t\<rangle> \<or> r = \<langle>s != t\<rangle>)"
+        (is "?C \<Longrightarrow> ?C'")
+    and "r \<in> set (unlabel (transaction_updates T)) \<Longrightarrow>
+            \<exists>x s. (r = insert\<langle>Var x, Fun (Set s) []\<rangle> \<or> r = delete\<langle>Var x, Fun (Set s) []\<rangle>) \<and>
+                  fst x = TAtom Value"
+        (is "?D \<Longrightarrow> ?D'")
+    and "r \<in> set (unlabel (transaction_send T)) \<Longrightarrow> \<exists>t. r = send\<langle>t\<rangle>"
+        (is "?E \<Longrightarrow> ?E'")
+proof -
+  have T_valid: "wellformed_transaction T"
+    using T_adm unfolding admissible_transaction_def by metis
+
+  show "?A \<Longrightarrow> ?A'"
+    using T_valid Ball_set[of "unlabel (transaction_receive T)" is_Receive]
+    unfolding wellformed_transaction_def is_Receive_def
+    by blast
+
+  show "?E \<Longrightarrow> ?E'"
+    using T_valid Ball_set[of "unlabel (transaction_send T)" is_Send]
+    unfolding wellformed_transaction_def is_Send_def
+    by blast
+
+  show "?B \<Longrightarrow> ?B'"
+  proof -
+    assume r: ?B
+    have "admissible_transaction_selects T"
+      using T_adm unfolding admissible_transaction_def by simp
+    hence *: "is_InSet r" "the_check r = Assign" "is_Var (the_elem_term r)"
+             "is_Fun (the_set_term r)" "is_Set (the_Fun (the_set_term r))"
+             "args (the_set_term r) = []" "fst (the_Var (the_elem_term r)) = TAtom Value"
+      using r unfolding admissible_transaction_selects_def is_Fun_Set_def
+      by fast+
+    
+    obtain rt rs where r': "r = select\<langle>rt,rs\<rangle>" using *(1,2) by (cases r) auto
+    obtain x where x: "rt = Var x" "fst x = TAtom Value" using *(3,7) r' by auto
+    obtain f S where fS: "rs = Fun f S" using *(4) r' by auto
+    obtain s where s: "f = Set s" using *(5) fS r' by (cases f) auto
+    hence S: "S = []" using *(6) fS r' by (cases S) auto
+
+    have fv_r1: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p r \<subseteq> fv_transaction T"
+      using r fv_transaction_unfold[of T] by auto
+  
+    have fv_r2: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p r \<inter> set (transaction_fresh T) = {}"
+      using r T_valid unfolding wellformed_transaction_def by fastforce
+
+    show ?B' using r' x fS s S fv_r1 fv_r2 by simp
+  qed
+
+  show "?C \<Longrightarrow> ?C'"
+  proof -
+    assume r: ?C
+    have adm_checks: "admissible_transaction_checks T"
+      using assms unfolding admissible_transaction_def by simp
+
+    have fv_r1: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p r \<subseteq> fv_transaction T"
+      using r fv_transaction_unfold[of T] by auto
+  
+    have fv_r2: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p r \<inter> set (transaction_fresh T) = {}"
+      using r T_valid unfolding wellformed_transaction_def by fastforce
+
+    have "(is_InSet r \<and> the_check r = Check) \<or>
+          (is_Equality r \<and> the_check r = Check) \<or>
+          is_NegChecks r"
+      using r adm_checks unfolding admissible_transaction_checks_def by fast
+    thus ?C'
+    proof (elim disjE conjE)
+      assume *: "is_InSet r" "the_check r = Check"
+      hence **: "is_Var (the_elem_term r)" "is_Fun (the_set_term r)"
+                "is_Set (the_Fun (the_set_term r))" "args (the_set_term r) = []"
+                "fst (the_Var (the_elem_term r)) = TAtom Value"
+        using r adm_checks unfolding admissible_transaction_checks_def is_Fun_Set_def
+        by fast+
+      
+      obtain rt rs where r': "r = \<langle>rt in rs\<rangle>" using * by (cases r) auto
+      obtain x where x: "rt = Var x" "fst x = TAtom Value" using **(1,5) r' by auto
+      obtain f S where fS: "rs = Fun f S" using **(2) r' by auto
+      obtain s where s: "f = Set s" using **(3) fS r' by (cases f) auto
+      hence S: "S = []" using **(4) fS r' by auto
+  
+      show ?C' using r' x fS s S fv_r1 fv_r2 by simp
+    next
+      assume *: "is_NegChecks r"
+      hence **: "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p r = []"
+                "(the_eqs r = [] \<and> length (the_ins r) = 1) \<or>
+                 (the_ins r = [] \<and> length (the_eqs r) = 1)"
+        using r adm_checks unfolding admissible_transaction_checks_def by fast+
+      show ?C' using **(2)
+      proof (elim disjE conjE)
+        assume ***: "the_eqs r = []" "length (the_ins r) = 1"
+        then obtain t s where ts: "the_ins r = [(t,s)]" by (cases "the_ins r") auto
+        hence "hd (the_ins r) = (t,s)" by simp
+        hence ****: "is_Var (fst (t,s))" "is_Fun (snd (t,s))"
+                    "is_Set (the_Fun (snd (t,s)))" "args (snd (t,s)) = []"
+                    "fst (the_Var (fst (t,s))) = TAtom Value"
+          using r adm_checks * ***(1) unfolding admissible_transaction_checks_def is_Fun_Set_def
+          by metis+
+        obtain x where x: "t = Var x" "fst x = TAtom Value" using ts ****(1,5) by (cases t) simp_all
+        obtain f S where fS: "s = Fun f S" using ts ****(2) by (cases s) simp_all
+        obtain ss where ss: "f = Set ss" using fS ****(3) by (cases f) simp_all
+        have S: "S = []" using ts fS ss ****(4) by simp
+        
+        show ?C' using ts x fS ss S *** **(1) * fv_r1 fv_r2 by (cases r) auto
+      next
+        assume ***: "the_ins r = []" "length (the_eqs r) = 1"
+        then obtain t s where "the_eqs r = [(t,s)]" by (cases "the_eqs r") auto
+        thus ?C' using *** **(1) * by (cases r) auto
+      qed
+    qed (auto simp add: is_Equality_def the_check_def)
+  qed
+
+  show "?D \<Longrightarrow> ?D'"
+  proof -
+    assume r: ?D
+    have adm_upds: "admissible_transaction_updates T"
+      using assms unfolding admissible_transaction_def by simp
+
+    have *: "is_Update r" "is_Var (the_elem_term r)" "is_Fun (the_set_term r)"
+            "is_Set (the_Fun (the_set_term r))" "args (the_set_term r) = []"
+            "fst (the_Var (the_elem_term r)) = TAtom Value"
+      using r adm_upds unfolding admissible_transaction_updates_def is_Fun_Set_def by fast+
+
+    obtain t s where ts: "r = insert\<langle>t,s\<rangle> \<or> r = delete\<langle>t,s\<rangle>" using *(1) by (cases r) auto
+    obtain x where x: "t = Var x" "fst x = TAtom Value" using ts *(2,6) by (cases t) auto
+    obtain f T where fT: "s = Fun f T" using ts *(3) by (cases s) auto
+    obtain ss where ss: "f = Set ss" using ts fT *(4) by (cases f) fastforce+
+    have T: "T = []" using ts fT *(5) ss by (cases T) auto
+
+    show ?D'
+      using ts x fT ss T by blast
+  qed
+qed
+
+lemma transaction_Value_vars_are_fv:
+  assumes "admissible_transaction T"
+    and "x \<in> vars_transaction T"
+    and "\<Gamma>\<^sub>v x = TAtom Value"
+  shows "x \<in> fv_transaction T"
+using assms \<Gamma>\<^sub>v_TAtom''(2)[of x] vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
+unfolding admissible_transaction_def by fast
+
+lemma protocol_transaction_vars_TAtom_typed:
+  assumes P: "admissible_transaction T"
+  shows "\<forall>x \<in> vars_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
+    and "\<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
+    and "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+proof -
+  have P': "wellformed_transaction T"
+    using P unfolding admissible_transaction_def by fast
+
+  show "\<forall>x \<in> vars_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
+    using P \<Gamma>\<^sub>v_TAtom''
+    unfolding admissible_transaction_def is_Var_def prot_atom.is_Atom_def the_Var_def
+    by fastforce
+  thus "\<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
+    using vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t by fast
+
+  have "list_all (\<lambda>x. fst x = Var Value) (transaction_fresh T)"
+    using P \<Gamma>\<^sub>v_TAtom'' unfolding admissible_transaction_def by fast
+  thus "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+    using \<Gamma>\<^sub>v_TAtom''(2) unfolding list_all_iff by fast
+qed
+
+lemma protocol_transactions_no_pubconsts:
+  assumes "admissible_transaction T"
+  shows "Fun (Val (n,True)) S \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)"
+using assms transactions_have_no_Value_consts(1)
+by fast
+
+lemma protocol_transactions_no_abss:
+  assumes "admissible_transaction T"
+  shows "Fun (Abs n) S \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)"
+using assms transactions_have_no_Value_consts(2)
+by fast
+
+lemma admissible_transaction_strand_sem_fv_ineq:
+  assumes T_adm: "admissible_transaction T"
+    and \<I>: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<I>"
+    and x: "x \<in> fv_transaction T - set (transaction_fresh T)"
+    and y: "y \<in> fv_transaction T - set (transaction_fresh T)"
+    and x_not_y: "x \<noteq> y"
+  shows "\<theta> x \<cdot> \<I> \<noteq> \<theta> y \<cdot> \<I>"
+proof -
+  have "\<langle>Var x != Var y\<rangle> \<in> set (unlabel (transaction_checks T)) \<or>
+        \<langle>Var y != Var x\<rangle> \<in> set (unlabel (transaction_checks T))"
+    using x y x_not_y T_adm unfolding admissible_transaction_def by auto
+  hence "\<langle>Var x != Var y\<rangle> \<in> set (unlabel (transaction_strand T)) \<or>
+         \<langle>Var y != Var x\<rangle> \<in> set (unlabel (transaction_strand T))"
+    unfolding transaction_strand_def unlabel_def by auto
+  hence "\<langle>\<theta> x != \<theta> y\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<or>
+         \<langle>\<theta> y != \<theta> x\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
+    using stateful_strand_step_subst_inI(8)[of _ _ "unlabel (transaction_strand T)" \<theta>]
+          subst_lsst_unlabel[of "transaction_strand T" \<theta>]
+          dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(7)[of "[]" _ "[]"]
+    by force
+  then obtain B where B:
+      "prefix (B@[\<langle>\<theta> x != \<theta> y\<rangle>]) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) \<or>
+       prefix (B@[\<langle>\<theta> y != \<theta> x\<rangle>]) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
+    unfolding prefix_def
+    by (metis (no_types, hide_lams) append.assoc append_Cons append_Nil split_list)
+  thus ?thesis
+    using \<I> strand_sem_append_stateful[of IK DB _ _ \<I>]
+          stateful_strand_sem_NegChecks_no_bvars(2)
+    unfolding prefix_def
+    by metis 
+qed
+
+lemma admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s:
+  assumes "admissible_transaction T"
+  shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)"
+by (metis wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code assms admissible_transaction_def admissible_transaction_terms_def)
+
+lemma admissible_transaction_no_Ana_Attack:
+  assumes "admissible_transaction_terms T"
+    and "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)"
+  shows "attack\<langle>n\<rangle> \<notin> set (snd (Ana t))"
+proof -
+  obtain r where r: "r \<in> set (unlabel (transaction_strand T))" "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r)"
+    using assms(2) by force
+
+  obtain K M where t: "Ana t = (K, M)"
+    by (metis surj_pair)
+
+  show ?thesis
+  proof
+    assume n: "attack\<langle>n\<rangle> \<in> set (snd (Ana t))"
+    hence "attack\<langle>n\<rangle> \<in> set M" using t by simp
+    hence n': "attack\<langle>n\<rangle> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r)"
+      using Ana_subterm[OF t] r(2) subterms_subset by fast
+    hence "\<exists>f \<in> \<Union>(funs_term ` trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r). is_Attack f"
+      using funs_term_Fun_subterm' unfolding is_Attack_def by fast
+    hence "is_Send r" "is_Fun (the_msg r)" "is_Attack (the_Fun (the_msg r))" "args (the_msg r) = []"
+      using assms(1) r(1) unfolding admissible_transaction_terms_def by metis+
+    hence "t = attack\<langle>n\<rangle>"
+      using n' r(2) unfolding is_Send_def is_Attack_def by auto
+    thus False using n by fastforce
+  qed
+qed
+
+lemma admissible_transaction_occurs_fv_types:
+  assumes "admissible_transaction T"
+    and "x \<in> vars_transaction T"
+  shows "\<exists>a. \<Gamma> (Var x) = TAtom a \<and> \<Gamma> (Var x) \<noteq> TAtom OccursSecType"
+proof -
+  have "is_Var (fst x)" "the_Var (fst x) = Value"
+    using assms unfolding admissible_transaction_def by blast+
+  thus ?thesis using \<Gamma>\<^sub>v_TAtom''(2)[of x] by force
+qed
+
+lemma admissible_transaction_Value_vars:
+  assumes T: "admissible_transaction T"
+    and x: "x \<in> fv_transaction T"
+  shows "\<Gamma>\<^sub>v x = TAtom Value"
+proof -
+  have "x \<in> vars_transaction T"
+    using x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
+    by blast
+  hence "is_Var (fst x)" "the_Var (fst x) = Value"
+    using T assms unfolding admissible_transaction_def list_all_iff by fast+
+  thus "\<Gamma>\<^sub>v x = TAtom Value" using \<Gamma>\<^sub>v_TAtom''(2)[of x] by force
+qed
+
+
+subsection \<open>Lemmata: Renaming and Fresh Substitutions\<close>
+lemma transaction_renaming_subst_is_renaming:
+  fixes \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_renaming_subst \<alpha> P A"
+  shows "\<exists>m. \<alpha> (\<tau>,n) = Var (\<tau>,n+Suc m)"
+using assms by (auto simp add: transaction_renaming_subst_def var_rename_def)
+
+lemma transaction_renaming_subst_is_renaming':
+  fixes \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_renaming_subst \<alpha> P A"
+  shows "\<exists>y. \<alpha> x = Var y"
+using assms by (auto simp add: transaction_renaming_subst_def var_rename_def)
+
+lemma transaction_renaming_subst_vars_disj:
+  fixes \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_renaming_subst \<alpha> P A"
+  shows "fv\<^sub>s\<^sub>e\<^sub>t (\<alpha> ` (\<Union>(vars_transaction ` set P))) \<inter> (\<Union>(vars_transaction ` set P)) = {}" (is ?A)
+    and "fv\<^sub>s\<^sub>e\<^sub>t (\<alpha> ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<inter> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = {}" (is ?B)
+    and "T \<in> set P \<Longrightarrow> vars_transaction T \<inter> range_vars \<alpha> = {}" (is "T \<in> set P \<Longrightarrow> ?C1")
+    and "T \<in> set P \<Longrightarrow> bvars_transaction T \<inter> range_vars \<alpha> = {}" (is "T \<in> set P \<Longrightarrow> ?C2")
+    and "T \<in> set P \<Longrightarrow> fv_transaction T \<inter> range_vars \<alpha> = {}" (is "T \<in> set P \<Longrightarrow> ?C3")
+    and "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<inter> range_vars \<alpha> = {}" (is ?D1)
+    and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<inter> range_vars \<alpha> = {}" (is ?D2)
+    and "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<inter> range_vars \<alpha> = {}" (is ?D3)
+proof -
+  define X where "X \<equiv> \<Union>(vars_transaction ` set P) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+
+  have 1: "finite X" by (simp add: X_def)
+
+  obtain n where n: "n \<ge> max_var_set X" "\<alpha> = var_rename n"
+    using assms unfolding transaction_renaming_subst_def X_def by moura
+  hence 2: "\<forall>x \<in> X. snd x < Suc n"
+    using less_Suc_max_var_set[OF _ 1] unfolding var_rename_def by fastforce
+  
+  have 3: "x \<notin> fv\<^sub>s\<^sub>e\<^sub>t (\<alpha> ` X)" "fv (\<alpha> x) \<inter> X = {}" "x \<notin> range_vars \<alpha>" when x: "x \<in> X" for x
+    using 2 x n unfolding var_rename_def by force+
+
+  show ?A ?B using 3(1,2) unfolding X_def by auto
+
+  show ?C1 when T: "T \<in> set P" using T 3(3) unfolding X_def by blast
+  thus ?C2 ?C3 when T: "T \<in> set P"
+    using T by (simp_all add: disjoint_iff_not_equal vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t)
+
+  show ?D1 using 3(3) unfolding X_def by auto
+  thus ?D2 ?D3 by (simp_all add: disjoint_iff_not_equal vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t)
+qed
+
+lemma transaction_renaming_subst_wt:
+  fixes \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_renaming_subst \<alpha> P A"
+  shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<alpha>"
+proof -
+  { fix x::"('fun,'atom,'sets) prot_var"
+    obtain \<tau> n where x: "x = (\<tau>,n)" by moura
+    then obtain m where m: "\<alpha> x = Var (\<tau>,m)"
+      using assms transaction_renaming_subst_is_renaming by moura
+    hence "\<Gamma> (\<alpha> x) = \<Gamma>\<^sub>v x" using x by (simp add: \<Gamma>\<^sub>v_def)
+  } thus ?thesis by (simp add: wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
+qed
+
+lemma transaction_renaming_subst_is_wf_trm:
+  fixes \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_renaming_subst \<alpha> P A"
+  shows "wf\<^sub>t\<^sub>r\<^sub>m (\<alpha> v)"
+proof -
+  obtain \<tau> n where "v = (\<tau>, n)" by moura
+  then obtain m where "\<alpha> v = Var (\<tau>, n + Suc m)"
+    using transaction_renaming_subst_is_renaming[OF assms]
+    by moura
+  thus ?thesis by (metis wf_trm_Var)
+qed
+
+lemma transaction_renaming_subst_range_wf_trms:
+  fixes \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_renaming_subst \<alpha> P A"
+  shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<alpha>)"
+by (metis transaction_renaming_subst_is_wf_trm[OF assms] wf_trm_subst_range_iff)
+
+lemma transaction_renaming_subst_range_notin_vars:
+  fixes \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_renaming_subst \<alpha> P \<A>"
+  shows "\<exists>y. \<alpha> x = Var y \<and> y \<notin> \<Union>(vars_transaction ` set P) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
+proof -
+  obtain \<tau> n where x: "x = (\<tau>,n)" by (metis surj_pair)
+
+  define y where "y \<equiv> \<lambda>m. (\<tau>,n+Suc m)"
+
+  have "\<exists>m \<ge> max_var_set (\<Union>(vars_transaction ` set P) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). \<alpha> x = Var (y m)"
+    using assms x by (auto simp add: y_def transaction_renaming_subst_def var_rename_def)
+  moreover have "finite (\<Union>(vars_transaction ` set P) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" by auto
+  ultimately show ?thesis using x unfolding y_def by force
+qed
+
+lemma transaction_renaming_subst_var_obtain:
+  fixes \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes x: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>)"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+  shows "\<exists>y. \<alpha> y = Var x"
+proof -
+  obtain y where y: "y \<in> fv\<^sub>s\<^sub>s\<^sub>t S" "x \<in> fv (\<alpha> y)" using fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var[OF x] by moura
+  thus ?thesis using transaction_renaming_subst_is_renaming'[OF \<alpha>, of y] by fastforce
+qed
+
+lemma transaction_fresh_subst_is_wf_trm:
+  fixes \<sigma>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T A"
+  shows "wf\<^sub>t\<^sub>r\<^sub>m (\<sigma> v)"
+proof (cases "v \<in> subst_domain \<sigma>")
+  case True
+  then obtain n where "\<sigma> v = Fun (Val n) []"
+    using assms unfolding transaction_fresh_subst_def
+    by moura
+  thus ?thesis by auto
+qed auto
+
+lemma transaction_fresh_subst_wt:
+  fixes \<sigma>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T A"
+    and "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+  shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>"
+proof -
+  have 1: "subst_domain \<sigma> = set (transaction_fresh T)"
+      and 2: "\<forall>t \<in> subst_range \<sigma>. \<exists>n. t = Fun (Val n) []"
+    using assms(1) unfolding transaction_fresh_subst_def by metis+
+
+  { fix x::"('fun,'atom,'sets) prot_var"
+    have "\<Gamma> (Var x) = \<Gamma> (\<sigma> x)" using assms(2) 1 2 by (cases "x \<in> subst_domain \<sigma>") force+
+  } thus ?thesis by (simp add: wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
+qed
+
+lemma transaction_fresh_subst_domain:
+  fixes \<sigma>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T \<A>"
+  shows "subst_domain \<sigma> = set (transaction_fresh T)"
+using assms unfolding transaction_fresh_subst_def by fast
+
+lemma transaction_fresh_subst_range_wf_trms:
+  fixes \<sigma>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T \<A>"
+  shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
+by (metis transaction_fresh_subst_is_wf_trm[OF assms] wf_trm_subst_range_iff)
+
+lemma transaction_fresh_subst_range_fresh:
+  fixes \<sigma>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T \<A>"
+  shows "\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+    and "\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"
+using assms unfolding transaction_fresh_subst_def by meson+
+
+lemma transaction_fresh_subst_sends_to_val:
+  fixes \<sigma>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T \<A>"
+    and "y \<in> set (transaction_fresh T)"
+  obtains n where "\<sigma> y = Fun (Val n) []" "Fun (Val n) [] \<in> subst_range \<sigma>"
+proof -
+  have "\<sigma> y \<in> subst_range \<sigma>" using assms unfolding transaction_fresh_subst_def by simp
+  thus ?thesis
+    using assms that unfolding transaction_fresh_subst_def
+    by fastforce
+qed
+
+lemma transaction_fresh_subst_sends_to_val':
+  fixes \<sigma> \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T \<A>"
+    and "y \<in> set (transaction_fresh T)"
+  obtains n where "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = Fun (Val n) []" "Fun (Val n) [] \<in> subst_range \<sigma>" 
+proof -
+  obtain n where "\<sigma> y = Fun (Val n) []" "Fun (Val n) [] \<in> subst_range \<sigma>"
+    using transaction_fresh_subst_sends_to_val[OF assms] by moura
+  thus ?thesis using that by (fastforce simp add: subst_compose_def)
+qed
+
+lemma transaction_fresh_subst_grounds_domain:
+  fixes \<sigma>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T \<A>"
+    and "y \<in> set (transaction_fresh T)"
+  shows "fv (\<sigma> y) = {}"
+proof -
+  obtain n where "\<sigma> y = Fun (Val n) []"
+    using transaction_fresh_subst_sends_to_val[OF assms]
+    by moura
+  thus ?thesis by simp
+qed
+
+lemma transaction_fresh_subst_transaction_renaming_subst_range:
+  fixes \<sigma> \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T \<A>" "transaction_renaming_subst \<alpha> P \<A>"
+  shows "x \<in> set (transaction_fresh T) \<Longrightarrow> \<exists>n. (\<sigma> \<circ>\<^sub>s \<alpha>) x = Fun (Val (n,False)) []"
+    and "x \<notin> set (transaction_fresh T) \<Longrightarrow> \<exists>y. (\<sigma> \<circ>\<^sub>s \<alpha>) x = Var y"
+proof -
+  assume "x \<in> set (transaction_fresh T)"
+  then obtain n where "\<sigma> x = Fun (Val (n,False)) []"
+    using assms(1) unfolding transaction_fresh_subst_def by fastforce
+  thus "\<exists>n. (\<sigma> \<circ>\<^sub>s \<alpha>) x = Fun (Val (n,False)) []" using subst_compose[of \<sigma> \<alpha> x] by simp
+next
+  assume "x \<notin> set (transaction_fresh T)"
+  hence "\<sigma> x = Var x"
+    using assms(1) unfolding transaction_fresh_subst_def by fastforce
+  thus "\<exists>y. (\<sigma> \<circ>\<^sub>s \<alpha>) x = Var y"
+    using transaction_renaming_subst_is_renaming[OF assms(2)] subst_compose[of \<sigma> \<alpha> x]
+    by (cases x) force
+qed
+
+lemma transaction_fresh_subst_transaction_renaming_subst_range':
+  fixes \<sigma> \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T \<A>" "transaction_renaming_subst \<alpha> P \<A>"
+    and "t \<in> subst_range (\<sigma> \<circ>\<^sub>s \<alpha>)"
+  shows "(\<exists>n. t = Fun (Val (n,False)) []) \<or> (\<exists>x. t = Var x)"
+proof -
+  obtain x where "x \<in> subst_domain (\<sigma> \<circ>\<^sub>s \<alpha>)" "(\<sigma> \<circ>\<^sub>s \<alpha>) x = t"
+    using assms(3) by auto
+  thus ?thesis
+    using transaction_fresh_subst_transaction_renaming_subst_range[OF assms(1,2), of x]
+    by auto
+qed
+
+lemma transaction_fresh_subst_transaction_renaming_subst_range'':
+  fixes \<sigma> \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes s: "transaction_fresh_subst \<sigma> T \<A>" "transaction_renaming_subst \<alpha> P \<A>"
+    and y: "y \<in> fv ((\<sigma> \<circ>\<^sub>s \<alpha>) x)"
+  shows "\<sigma> x = Var x"
+    and "\<alpha> x = Var y"
+    and "(\<sigma> \<circ>\<^sub>s \<alpha>) x = Var y"
+proof -
+  have "\<exists>z. z \<in> fv (\<sigma> x)"
+    using y subst_compose_fv'
+    by fast
+  hence x: "x \<notin> subst_domain \<sigma>"
+    using y transaction_fresh_subst_domain[OF s(1)]
+          transaction_fresh_subst_grounds_domain[OF s(1), of x]
+    by blast
+  thus "\<sigma> x = Var x" by blast
+  thus "\<alpha> x = Var y" "(\<sigma> \<circ>\<^sub>s \<alpha>) x = Var y"
+    using y transaction_renaming_subst_is_renaming'[OF s(2), of x]
+    unfolding subst_compose_def by fastforce+
+qed
+
+lemma transaction_fresh_subst_transaction_renaming_subst_vars_subset:
+  fixes \<sigma> \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+  shows "\<Union>(fv_transaction ` set P) \<subseteq> subst_domain (\<sigma> \<circ>\<^sub>s \<alpha>)" (is ?A)
+    and "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> subst_domain (\<sigma> \<circ>\<^sub>s \<alpha>)" (is ?B)
+    and "T' \<in> set P \<Longrightarrow> fv_transaction T' \<subseteq> subst_domain (\<sigma> \<circ>\<^sub>s \<alpha>)" (is "T' \<in> set P \<Longrightarrow> ?C")
+    and "T' \<in> set P \<Longrightarrow> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)) \<subseteq> range_vars (\<sigma> \<circ>\<^sub>s \<alpha>)"
+      (is "T' \<in> set P \<Longrightarrow> ?D")
+proof -
+  have *: "x \<in> subst_domain (\<sigma> \<circ>\<^sub>s \<alpha>)" for x
+  proof (cases "x \<in> subst_domain \<sigma>")
+    case True
+    hence "x \<notin> {x. \<exists>y. \<sigma> x = Var y \<and> \<alpha> y = Var x}"
+      using transaction_fresh_subst_domain[OF \<sigma>]
+            transaction_fresh_subst_grounds_domain[OF \<sigma>, of x]
+      by auto
+    thus ?thesis using subst_domain_subst_compose[of \<sigma> \<alpha>] by blast
+  next
+    case False
+    hence "(\<sigma> \<circ>\<^sub>s \<alpha>) x = \<alpha> x" unfolding subst_compose_def by fastforce
+    moreover have "\<alpha> x \<noteq> Var x"
+      using transaction_renaming_subst_is_renaming[OF \<alpha>, of "fst x" "snd x"] by (cases x) auto
+    ultimately show ?thesis by fastforce
+  qed
+  
+  show ?A ?B using * by blast+
+
+  show ?C when T: "T' \<in> set P" using T * by blast
+  hence "fv\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T') \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>) \<subseteq> range_vars (\<sigma> \<circ>\<^sub>s \<alpha>)"
+    when T: "T' \<in> set P"
+    using T fv\<^sub>s\<^sub>s\<^sub>t_subst_subset_range_vars_if_subset_domain by blast
+  thus ?D when T: "T' \<in> set P" by (metis T unlabel_subst)
+qed
+
+lemma transaction_fresh_subst_transaction_renaming_subst_vars_disj:
+  fixes \<sigma> \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+  shows "fv\<^sub>s\<^sub>e\<^sub>t ((\<sigma> \<circ>\<^sub>s \<alpha>) ` (\<Union>(vars_transaction ` set P))) \<inter> (\<Union>(vars_transaction ` set P)) = {}"
+      (is ?A)
+    and "x \<in> \<Union>(vars_transaction ` set P) \<Longrightarrow> fv ((\<sigma> \<circ>\<^sub>s \<alpha>) x) \<inter> (\<Union>(vars_transaction ` set P)) = {}"
+      (is "?B' \<Longrightarrow> ?B")
+    and "T' \<in> set P \<Longrightarrow> vars_transaction T' \<inter> range_vars (\<sigma> \<circ>\<^sub>s \<alpha>) = {}" (is "T' \<in> set P \<Longrightarrow> ?C1")
+    and "T' \<in> set P \<Longrightarrow> bvars_transaction T' \<inter> range_vars (\<sigma> \<circ>\<^sub>s \<alpha>) = {}" (is "T' \<in> set P \<Longrightarrow> ?C2")
+    and "T' \<in> set P \<Longrightarrow> fv_transaction T' \<inter> range_vars (\<sigma> \<circ>\<^sub>s \<alpha>) = {}" (is "T' \<in> set P \<Longrightarrow> ?C3")
+    and "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> range_vars (\<sigma> \<circ>\<^sub>s \<alpha>) = {}" (is ?D1)
+    and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> range_vars (\<sigma> \<circ>\<^sub>s \<alpha>) = {}" (is ?D2)
+    and "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> range_vars (\<sigma> \<circ>\<^sub>s \<alpha>) = {}" (is ?D3)
+proof -
+  note 0 = transaction_renaming_subst_vars_disj[OF \<alpha>]
+
+  show ?A
+  proof (cases "fv\<^sub>s\<^sub>e\<^sub>t ((\<sigma> \<circ>\<^sub>s \<alpha>) ` (\<Union>(vars_transaction ` set P))) = {}")
+    case False
+    hence "\<forall>x \<in> (\<Union>(vars_transaction ` set P)). (\<sigma> \<circ>\<^sub>s \<alpha>) x = \<alpha> x \<or> fv ((\<sigma> \<circ>\<^sub>s \<alpha>) x) = {}"
+      using transaction_fresh_subst_transaction_renaming_subst_range''[OF \<sigma> \<alpha>] by auto
+    thus ?thesis using 0(1) by force
+  qed blast
+  thus "?B' \<Longrightarrow> ?B" by auto
+
+  have 1: "range_vars (\<sigma> \<circ>\<^sub>s \<alpha>) \<subseteq> range_vars \<alpha>"
+    using range_vars_subst_compose_subset[of \<sigma> \<alpha>]
+          transaction_fresh_subst_domain[OF \<sigma>]
+          transaction_fresh_subst_grounds_domain[OF \<sigma>]
+    by force
+  
+  show ?C1 ?C2 ?C3 when T: "T' \<in> set P" using T 1 0(3,4,5)[of T'] by blast+
+
+  show ?D1 ?D2 ?D3 using 1 0(6,7,8) by blast+
+qed
+
+lemma transaction_fresh_subst_transaction_renaming_subst_trms:
+  fixes \<sigma> \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T \<A>" "transaction_renaming_subst \<alpha> P \<A>"
+    and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<sigma> = {}"
+    and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<alpha> = {}"
+  shows "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>))) = subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+proof -
+  have 1: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S). (\<exists>f. (\<sigma> \<circ>\<^sub>s \<alpha>) x = Fun f []) \<or> (\<exists>y. (\<sigma> \<circ>\<^sub>s \<alpha>) x = Var y)"
+    using transaction_fresh_subst_transaction_renaming_subst_range[OF assms(1,2)] by blast
+
+  have 2: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain (\<sigma> \<circ>\<^sub>s \<alpha>) = {}"
+    using assms(3,4) subst_domain_compose[of \<sigma> \<alpha>] by blast
+
+  show ?thesis using subterms_subst_lsst[OF 1 2] by simp
+qed
+
+lemma transaction_fresh_subst_transaction_renaming_wt:
+  fixes \<sigma> \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T \<A>" "transaction_renaming_subst \<alpha> P \<A>"
+    and "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+  shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+using transaction_renaming_subst_wt[OF assms(2)]
+      transaction_fresh_subst_wt[OF assms(1,3)]
+by (metis wt_subst_compose)
+
+lemma transaction_fresh_subst_transaction_renaming_fv:
+  fixes \<sigma> \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes \<sigma>: "transaction_fresh_subst \<sigma> T A"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P A"
+    and x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+  shows "\<exists>y \<in> fv_transaction T - set (transaction_fresh T). (\<sigma> \<circ>\<^sub>s \<alpha>) y = Var x"
+proof -
+  have "x \<in> fv\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+    using x fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
+          unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+    by argo
+  then obtain y where "y \<in> fv_transaction T" "x \<in> fv ((\<sigma> \<circ>\<^sub>s \<alpha>) y)"
+    by (metis fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var)
+  thus ?thesis
+    using transaction_fresh_subst_transaction_renaming_subst_range[OF \<sigma> \<alpha>, of y]
+    by (cases "y \<in> set (transaction_fresh T)") force+
+qed
+
+lemma transaction_fresh_subst_transaction_renaming_subst_occurs_fact_send_receive:
+  fixes t::"('fun,'atom,'sets) prot_term"
+  assumes \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+    and T: "wellformed_transaction T"
+  shows "send\<langle>occurs t\<rangle> \<in> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))
+          \<Longrightarrow> \<exists>s. send\<langle>occurs s\<rangle> \<in> set (unlabel (transaction_send T)) \<and> t = s \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>"
+      (is "?A \<Longrightarrow> ?A'")
+    and "receive\<langle>occurs t\<rangle> \<in> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))
+          \<Longrightarrow> \<exists>s. receive\<langle>occurs s\<rangle> \<in> set (unlabel (transaction_receive T)) \<and> t = s \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>"
+      (is "?B \<Longrightarrow> ?B'")
+proof -
+  assume ?A
+  then obtain s where s: "send\<langle>s\<rangle> \<in> set (unlabel (transaction_strand T))" "occurs t = s \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>"
+    using stateful_strand_step_subst_inv_cases(1)[
+            of "occurs t" "unlabel (transaction_strand T)" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+          unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+    by auto
+
+  note 0 = s(2) transaction_fresh_subst_transaction_renaming_subst_range[OF \<sigma> \<alpha>]
+
+  have "\<exists>u. s = occurs u"
+  proof (cases s)
+    case (Var x) 
+    hence "(\<exists>n. s \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> = Fun (Val (n, False)) []) \<or> (\<exists>y. s \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> = Var y)"
+      using 0(2,3)[of x] by (auto simp del: subst_subst_compose)
+    thus ?thesis
+      using 0(1) by simp
+  next
+    case (Fun f T)
+    hence 1: "f = OccursFact" "length T = 2" "T ! 0 \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> = Fun OccursSec []" "T ! 1 \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> = t"
+      using 0(1) by auto
+    have "T ! 0 = Fun OccursSec []"
+    proof (cases "T ! 0")
+      case (Var x) thus ?thesis using 0(2,3)[of x] 1(3) by (auto simp del: subst_subst_compose)
+    qed (use 1(3) in simp)
+    thus ?thesis using Fun 1 0(1) by (auto simp del: subst_subst_compose)
+  qed
+  then obtain u where u: "s = occurs u" by moura
+  hence "t = u \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>" using s(2) by fastforce
+  thus ?A' using s u wellformed_transaction_strand_unlabel_memberD(8)[OF T] by metis
+next
+  assume ?B
+  then obtain s where s: "receive\<langle>s\<rangle> \<in> set (unlabel (transaction_strand T))" "occurs t = s \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>"
+    using stateful_strand_step_subst_inv_cases(2)[
+            of "occurs t" "unlabel (transaction_strand T)" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+          unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+    by auto
+
+  note 0 = s(2) transaction_fresh_subst_transaction_renaming_subst_range[OF \<sigma> \<alpha>]
+
+  have "\<exists>u. s = occurs u"
+  proof (cases s)
+    case (Var x) 
+    hence "(\<exists>n. s \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> = Fun (Val (n, False)) []) \<or> (\<exists>y. s \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> = Var y)"
+      using 0(2,3)[of x] by (auto simp del: subst_subst_compose)
+    thus ?thesis
+      using 0(1) by simp
+  next
+    case (Fun f T)
+    hence 1: "f = OccursFact" "length T = 2" "T ! 0 \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> = Fun OccursSec []" "T ! 1 \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> = t"
+      using 0(1) by auto
+    have "T ! 0 = Fun OccursSec []"
+    proof (cases "T ! 0")
+      case (Var x) thus ?thesis using 0(2,3)[of x] 1(3) by (auto simp del: subst_subst_compose)
+    qed (use 1(3) in simp)
+    thus ?thesis using Fun 1 0(1) by (auto simp del: subst_subst_compose)
+  qed
+  then obtain u where u: "s = occurs u" by moura
+  hence "t = u \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>" using s(2) by fastforce
+  thus ?B' using s u wellformed_transaction_strand_unlabel_memberD(1)[OF T] by metis
+qed
+
+lemma transaction_fresh_subst_proj:
+  assumes "transaction_fresh_subst \<sigma> T A"
+  shows "transaction_fresh_subst \<sigma> (transaction_proj n T) (proj n A)"
+using assms transaction_proj_fresh_eq[of n T]
+      contra_subsetD[OF subterms\<^sub>s\<^sub>e\<^sub>t_mono[OF transaction_proj_trms_subset[of n T]]]
+      contra_subsetD[OF subterms\<^sub>s\<^sub>e\<^sub>t_mono[OF trms\<^sub>s\<^sub>s\<^sub>t_proj_subset(1)[of n A]]]
+unfolding transaction_fresh_subst_def by metis
+  
+lemma transaction_renaming_subst_proj:
+  assumes "transaction_renaming_subst \<alpha> P A"
+  shows "transaction_renaming_subst \<alpha> (map (transaction_proj n) P) (proj n A)"
+proof -
+  let ?X = "\<lambda>P A. \<Union>(vars_transaction ` set P) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+  define Y where "Y \<equiv> ?X (map (transaction_proj n) P) (proj n A)"
+  define Z where "Z \<equiv> ?X P A"
+
+  have "Y \<subseteq> Z"
+    using sst_vars_proj_subset(3)[of n A] transaction_proj_vars_subset[of n]
+    unfolding Y_def Z_def by fastforce
+  hence "insert 0 (snd ` Y) \<subseteq> insert 0 (snd ` Z)" by blast
+  moreover have "finite (insert 0 (snd ` Z))" "finite (insert 0 (snd ` Y))"
+    unfolding Y_def Z_def by auto
+  ultimately have 0: "max_var_set Y \<le> max_var_set Z" using Max_mono by blast
+
+  have "\<exists>n\<ge>max_var_set Z. \<alpha> = var_rename n"
+    using assms unfolding transaction_renaming_subst_def Z_def by blast
+  hence "\<exists>n\<ge>max_var_set Y. \<alpha> = var_rename n" using 0 le_trans by fast
+  thus ?thesis unfolding transaction_renaming_subst_def Y_def by blast
+qed
+
+lemma protocol_transaction_wf_subst:
+  fixes \<sigma> \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes T: "wf'\<^sub>s\<^sub>s\<^sub>t (set (transaction_fresh T)) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+  shows "wf'\<^sub>s\<^sub>s\<^sub>t {} (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)))"
+proof -
+  have 0: "range_vars \<sigma> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) = {}"
+          "ground (\<sigma> ` set (transaction_fresh T))" "ground (\<alpha> ` {})"
+    using transaction_fresh_subst_domain[OF \<sigma>] transaction_fresh_subst_grounds_domain[OF \<sigma>]
+    by fastforce+
+  
+  have "wf'\<^sub>s\<^sub>s\<^sub>t {} ((unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>)"
+    by (metis wf\<^sub>s\<^sub>s\<^sub>t_subst_apply[OF wf\<^sub>s\<^sub>s\<^sub>t_subst_apply[OF T]] 0(2,3))
+  thus ?thesis
+    by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst labeled_stateful_strand_subst_comp[OF 0(1)])
+qed
+
+
+subsection \<open>Lemmata: Reachable Constraints\<close>
+lemma reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s:
+  assumes "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)"
+    and "\<A> \<in> reachable_constraints P"
+  shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+  using assms(2)
+proof (induction \<A> rule: reachable_constraints.induct)
+  case (step \<A> T \<sigma> \<alpha>)
+  have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)"
+    using assms(1) step.hyps(2) by blast
+  moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+    using wf_trms_subst_compose[of \<sigma> \<alpha>]
+          transaction_renaming_subst_range_wf_trms[OF step.hyps(4)]
+          transaction_fresh_subst_range_wf_trms[OF step.hyps(3)]
+    by fastforce
+  ultimately have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)" by (metis wf_trms_subst)
+  hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+    using wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_trms\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"] by metis
+  hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)))"
+    using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq by blast
+  thus ?case using step.IH unlabel_append[of \<A>] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] by auto
+qed simp
+
+lemma reachable_constraints_TAtom_types:
+  assumes "\<A> \<in> reachable_constraints P"
+    and "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+  shows "\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` fv_transaction T)" (is "?A \<A>")
+    and "\<Gamma>\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` bvars_transaction T)" (is "?B \<A>")
+    and "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` vars_transaction T)" (is "?C \<A>")
+using assms(1)
+proof (induction \<A> rule: reachable_constraints.induct)
+  case (step \<A> T \<sigma> \<alpha>)
+  define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+
+  have 2: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+    using transaction_renaming_subst_wt[OF step.hyps(4)]
+          transaction_fresh_subst_wt[OF step.hyps(3)]
+    by (metis step.hyps(2) assms(2) wt_subst_compose)
+
+  have 3: "\<forall>t \<in> subst_range (\<sigma> \<circ>\<^sub>s \<alpha>). fv t = {} \<or> (\<exists>x. t = Var x)"
+    using transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)]
+    by fastforce
+
+  have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+       "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+       "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+    unfolding T'_def
+    by (metis fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq,
+        metis bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq,
+        metis vars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq)
+  hence "\<Gamma> ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> \<Gamma> ` Var ` fv_transaction T"
+        "\<Gamma> ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = \<Gamma> ` Var ` bvars_transaction T"
+        "\<Gamma> ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> \<Gamma> ` Var ` vars_transaction T"
+    using wt_subst_lsst_vars_type_subset[OF 2 3, of "transaction_strand T"]
+    by argo+
+  hence "\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> \<Gamma>\<^sub>v ` fv_transaction T"
+        "\<Gamma>\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = \<Gamma>\<^sub>v ` bvars_transaction T"
+        "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> \<Gamma>\<^sub>v ` vars_transaction T"
+    by (metis \<Gamma>\<^sub>v_Var_image)+
+  hence 4: "\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` fv_transaction T)"
+           "\<Gamma>\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` bvars_transaction T)"
+           "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` vars_transaction T)"
+    using step.hyps(2) by fast+
+
+  have 5: "\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> @ T') = (\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<union> (\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
+          "\<Gamma>\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> @ T') = (\<Gamma>\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<union> (\<Gamma>\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
+          "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> @ T') = (\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<union> (\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
+    using unlabel_append[of \<A> T']
+          fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel T'"]
+          bvars\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel T'"]
+          vars\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel T'"]
+    by auto
+
+  { case 1 thus ?case
+      using step.IH(1) 4(1) 5(1)
+      unfolding T'_def by (simp del: subst_subst_compose fv\<^sub>s\<^sub>s\<^sub>t_def)
+  }
+
+  { case 2 thus ?case
+      using step.IH(2) 4(2) 5(2)
+      unfolding T'_def by (simp del: subst_subst_compose bvars\<^sub>s\<^sub>s\<^sub>t_def)
+  }
+
+  { case 3 thus ?case
+      using step.IH(3) 4(3) 5(3)
+      unfolding T'_def by (simp del: subst_subst_compose)
+  }
+qed simp_all
+
+lemma reachable_constraints_no_bvars:
+  assumes \<A>: "\<A> \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = {}"
+  shows "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
+using assms proof (induction)
+  case init
+  then show ?case 
+    unfolding unlabel_def by auto
+next
+  case (step \<A> T \<sigma> \<alpha>)
+  then have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
+    by metis
+  moreover
+  have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) = {}"
+    using step by (metis bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq)
+  ultimately 
+  show ?case
+    using bvars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append by (metis sup_bot.left_neutral)
+qed
+
+lemma reachable_constraints_fv_bvars_disj:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and P: "\<forall>S \<in> set P. admissible_transaction S"
+  shows "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
+proof -
+  let ?X = "\<Union>T \<in> set P. bvars_transaction T"
+
+  note 0 = transactions_fv_bvars_disj[OF P]
+
+  have 1: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> ?X" using \<A>_reach
+  proof (induction \<A> rule: reachable_constraints.induct)
+    case (step \<A> T \<sigma> \<alpha>)
+    have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) = bvars_transaction T"
+      using bvars\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel (transaction_strand T)" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+            bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
+            dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+            unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+      by argo
+    hence "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) \<subseteq> ?X"
+      using step.hyps(2)
+      by blast
+    thus ?case
+      using step.IH bvars\<^sub>s\<^sub>s\<^sub>t_append
+      by auto
+  qed (simp add: unlabel_def bvars\<^sub>s\<^sub>s\<^sub>t_def)
+
+  have 2: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> ?X = {}" using \<A>_reach
+  proof (induction \<A> rule: reachable_constraints.induct)
+    case (step \<A> T \<sigma> \<alpha>)
+    have "x \<noteq> y" when x: "x \<in> ?X" and y: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)" for x y
+    proof -
+      obtain y' where y': "y' \<in> fv_transaction T" "y \<in> fv ((\<sigma> \<circ>\<^sub>s \<alpha>) y')"
+        using y unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+        by (metis fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var)
+
+      have "y \<notin> \<Union>(vars_transaction ` set P)"
+        using transaction_fresh_subst_transaction_renaming_subst_range''[OF step.hyps(3,4) y'(2)]
+              transaction_renaming_subst_range_notin_vars[OF step.hyps(4), of y']
+        by auto
+      thus ?thesis using x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t by fast
+    qed
+    hence "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>) \<inter> ?X = {}"
+      by blast
+    thus ?case
+      using step.IH
+            fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
+            dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+            unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+            fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"]
+            unlabel_append[of \<A> "transaction_strand T"]
+      by force
+  qed (simp add: unlabel_def fv\<^sub>s\<^sub>s\<^sub>t_def)
+
+  show ?thesis using 0 1 2 by blast
+qed
+
+lemma reachable_constraints_vars_TAtom_typed:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and x: "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
+  shows "\<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
+proof -
+  have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+    by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P \<A>_reach)
+
+  have T_adm: "admissible_transaction T" when "T \<in> set P" for T
+    by (meson that Ball_set P)
+
+  have "\<forall>T\<in>set P. \<forall>x\<in>set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+    using protocol_transaction_vars_TAtom_typed(3) P by blast
+  hence *: "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> (\<Union>T\<in>set P. \<Gamma>\<^sub>v ` vars_transaction T)"
+    using reachable_constraints_TAtom_types[of \<A> P, OF \<A>_reach] by auto
+
+  have "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> TAtom ` insert Value (range Atom)"
+  proof -
+    have "\<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
+      when "T \<in> set P" "x \<in> vars_transaction T" for T x
+      using that protocol_transaction_vars_TAtom_typed(1)[of T] P
+      unfolding admissible_transaction_def
+      by blast
+    hence "(\<Union>T\<in>set P. \<Gamma>\<^sub>v ` vars_transaction T) \<subseteq> TAtom ` insert Value (range Atom)"
+      using P by blast
+    thus "\<Gamma>\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> TAtom ` insert Value (range Atom)"
+      using * by auto
+  qed
+  thus ?thesis using x by auto
+qed
+
+lemma reachable_constraints_Value_vars_are_fv:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and x: "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
+    and "\<Gamma>\<^sub>v x = TAtom Value"
+  shows "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
+proof -
+    have "\<forall>T\<in>set P. bvars_transaction T = {}"
+    using P unfolding list_all_iff admissible_transaction_def by metis
+  hence \<A>_no_bvars: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
+    using reachable_constraints_no_bvars[OF \<A>_reach] by metis
+  thus ?thesis using x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"] by blast
+qed
+
+lemma reachable_constraints_subterms_subst:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and \<I>: "welltyped_constraint_model \<I> \<A>"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+  shows "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>)) = (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
+proof -
+  have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+    by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P \<A>_reach)
+
+  from \<I> have \<I>': "welltyped_constraint_model \<I> \<A>"
+    using welltyped_constraint_model_prefix by auto
+
+  have 1: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). (\<exists>f. \<I> x = Fun f []) \<or> (\<exists>y. \<I> x = Var y)"
+  proof
+    fix x
+    assume xa: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+    have "\<exists>f T. \<I> x = Fun f T"
+      using \<I> interpretation_grounds[of \<I> "Var x"]
+      unfolding welltyped_constraint_model_def constraint_model_def
+      by (cases "\<I> x") auto
+    then obtain f T where fT_p: "\<I> x = Fun f T"
+      by auto
+    hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)"
+      using \<I>
+      unfolding welltyped_constraint_model_def constraint_model_def
+      using wf_trm_subst_rangeD
+      by metis
+    moreover
+    have "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
+      using xa var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t[of x "unlabel \<A>"] vars_iff_subtermeq[of x]
+      by auto
+    hence "\<exists>a. \<Gamma>\<^sub>v x = TAtom a"
+      using reachable_constraints_vars_TAtom_typed[OF \<A>_reach P] by blast
+    hence "\<exists>a. \<Gamma> (Var x) = TAtom a"
+      by simp
+    hence "\<exists>a. \<Gamma> (Fun f T) = TAtom a"
+      by (metis (no_types, hide_lams) \<I>' welltyped_constraint_model_def fT_p wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
+    ultimately show "(\<exists>f. \<I> x = Fun f []) \<or> (\<exists>y. \<I> x = Var y)"
+      using TAtom_term_cases fT_p by metis
+  qed
+
+  have "\<forall>T\<in>set P. bvars_transaction T = {}"
+    using assms unfolding list_all_iff admissible_transaction_def by metis
+  then have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
+    using reachable_constraints_no_bvars assms by metis
+  then have 2: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> subst_domain \<I> = {}"
+    by auto
+
+  show ?thesis
+    using subterms_subst_lsst[OF _ 2] 1
+    by simp
+qed
+
+lemma reachable_constraints_val_funs_private:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and f: "f \<in> \<Union>(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+  shows "is_Val f \<Longrightarrow> \<not>public f"
+    and "\<not>is_Abs f"
+proof -
+  have "(is_Val f \<longrightarrow> \<not>public f) \<and> \<not>is_Abs f" using \<A>_reach f
+  proof (induction \<A> rule: reachable_constraints.induct)
+    case (step \<A> T \<sigma> \<alpha>)
+    let ?T' = "unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+    let ?T'' = "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+
+    have T: "admissible_transaction_terms T"
+      using P step.hyps(2) unfolding admissible_transaction_def by metis
+
+    show ?thesis using step
+    proof (cases "f \<in> \<Union>(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)")
+      case False
+      then obtain t where t: "t \<in> trms\<^sub>s\<^sub>s\<^sub>t ?T'" "f \<in> funs_term t"
+        using step.prems trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of ?T'']
+              trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T'')"]
+              unlabel_append[of \<A> "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T''"] unlabel_subst[of "transaction_strand T"]
+        by fastforce
+      show ?thesis using trms\<^sub>s\<^sub>s\<^sub>t_funs_term_cases[OF t]
+      proof
+        assume "\<exists>u \<in> trms_transaction T. f \<in> funs_term u"
+        thus ?thesis using T unfolding admissible_transaction_terms_def by blast
+      next
+        assume "\<exists>x \<in> fv_transaction T. f \<in> funs_term ((\<sigma> \<circ>\<^sub>s \<alpha>) x)"
+        then obtain x where "x \<in> fv_transaction T" "f \<in> funs_term ((\<sigma> \<circ>\<^sub>s \<alpha>) x)" by moura
+        thus ?thesis
+          using transaction_fresh_subst_transaction_renaming_subst_range[OF step.hyps(3,4), of x]
+          by (force simp del: subst_subst_compose)
+      qed
+    qed simp
+  qed simp
+  thus "is_Val f \<Longrightarrow> \<not>public f" "\<not>is_Abs f" by simp_all
+qed
+
+lemma reachable_constraints_occurs_fact_ik_case:
+  assumes \<A>_reach: "A \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and occ: "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+  shows "\<exists>n. t = Fun (Val (n,False)) []"
+using \<A>_reach occ
+proof (induction A rule: reachable_constraints.induct)
+  case (step A T \<sigma> \<alpha>)
+  define \<theta> where "\<theta> \<equiv> \<sigma> \<circ>\<^sub>s \<alpha>"
+
+  have T: "wellformed_transaction T" "admissible_transaction_occurs_checks T"
+    using P step.hyps(2) unfolding list_all_iff admissible_transaction_def by blast+
+
+  show ?case
+  proof (cases "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A")
+    case False
+    hence "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+      using step.prems unfolding \<theta>_def by simp
+    hence "receive\<langle>occurs t\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
+      unfolding ik\<^sub>s\<^sub>s\<^sub>t_def by force
+    hence "send\<langle>occurs t\<rangle> \<in> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+      using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(1) by blast
+    then obtain s where s:
+        "send\<langle>s\<rangle> \<in> set (unlabel (transaction_strand T))" "s \<cdot> \<theta> = occurs t"
+      by (metis (no_types) stateful_strand_step_subst_inv_cases(1) unlabel_subst)
+
+    note 0 = transaction_fresh_subst_transaction_renaming_subst_range[OF step.hyps(3,4)]
+
+    have 1: "send\<langle>s\<rangle> \<in> set (unlabel (transaction_send T))"
+      using s(1) wellformed_transaction_strand_unlabel_memberD(8)[OF T(1)] by blast
+
+    have 2: "is_Send (send\<langle>s\<rangle>)"
+      unfolding is_Send_def by simp
+
+    have 3: "\<exists>u. s = occurs u"
+    proof -
+      { fix z
+        have "(\<exists>n. \<theta> z = Fun (Val (n, False)) []) \<or> (\<exists>y. \<theta> z = Var y)"
+          using 0
+          unfolding \<theta>_def
+          by blast
+        hence "\<nexists>u. \<theta> z = occurs u" "\<theta> z \<noteq> Fun OccursSec []" by auto
+      } note * = this
+
+      obtain u u' where T: "s = Fun OccursFact [u,u']"
+        using *(1) s(2) by (cases s) auto
+      thus ?thesis using *(2) s(2) by (cases u) auto
+    qed
+
+    obtain x where x: "x \<in> set (transaction_fresh T)" "s = occurs (Var x)"
+      using T(2) 1 2 3
+      unfolding admissible_transaction_occurs_checks_def 
+      by fastforce
+    
+    have "t = \<theta> x"
+      using s(2) x(2) by auto
+    thus ?thesis
+      using 0(1)[OF x(1)] unfolding \<theta>_def by fast
+  qed (simp add: step.IH)
+qed simp
+
+lemma reachable_constraints_occurs_fact_send_ex:
+  assumes \<A>_reach: "A \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and x: "\<Gamma>\<^sub>v x = TAtom Value" "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+  (* shows "\<exists>B. prefix B A \<and> x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> send\<langle>occurs (Var x)\<rangle> \<in> set (unlabel A)" *)
+  shows "send\<langle>occurs (Var x)\<rangle> \<in> set (unlabel A)"
+using \<A>_reach x(2)
+proof (induction A rule: reachable_constraints.induct)
+  case (step A T \<sigma> \<alpha>)
+  have T: "admissible_transaction_occurs_checks T"
+    using P step.hyps(2) unfolding list_all_iff admissible_transaction_def by blast
+  
+  show ?case
+  proof (cases "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A")
+    case True
+    show ?thesis
+      using step.IH[OF True] unlabel_append[of A]
+      by auto
+  next
+    case False
+    then obtain y where y: "y \<in> fv_transaction T - set (transaction_fresh T)" "(\<sigma> \<circ>\<^sub>s \<alpha>) y = Var x"
+      using transaction_fresh_subst_transaction_renaming_fv[OF step.hyps(3,4), of x]
+            step.prems(1) fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A"] unlabel_append[of A]
+      by auto
+    
+    have "\<sigma> y = Var y" using y(1) step.hyps(3) unfolding transaction_fresh_subst_def by auto
+    hence "\<alpha> y = Var x" using y(2) unfolding subst_compose_def by simp
+    hence y_val: "fst y = TAtom Value"
+      using x(1) \<Gamma>\<^sub>v_TAtom''[of x] \<Gamma>\<^sub>v_TAtom''[of y]
+            wt_subst_trm''[OF transaction_renaming_subst_wt[OF step.hyps(4)], of "Var y"]
+      by force
+    hence "receive\<langle>occurs (Var y)\<rangle> \<in> set (unlabel (transaction_receive T))"
+      using y(1) T unfolding admissible_transaction_occurs_checks_def  by fast
+    hence *: "receive\<langle>occurs (Var y)\<rangle> \<in> set (unlabel (transaction_strand T))" 
+      using transaction_strand_subsets(6) by blast
+
+    have "receive\<langle>occurs (Var x)\<rangle> \<in> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+      using y(2) unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+            stateful_strand_step_subst_inI(2)[OF *, of "\<sigma> \<circ>\<^sub>s \<alpha>"]
+      by (auto simp del: subst_subst_compose)
+    hence "send\<langle>occurs (Var x)\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)))"
+      using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) by blast
+    thus ?thesis using unlabel_append[of A] by fastforce
+  qed
+qed simp
+
+lemma reachable_constraints_db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_args_empty:
+  assumes \<A>: "\<A> \<in> reachable_constraints P"
+    and PP: "list_all wellformed_transaction P"
+    and admissible_transaction_updates:
+      "let f = (\<lambda>T. \<forall>x \<in> set (unlabel (transaction_updates T)).
+                      is_Update x \<and> is_Var (the_elem_term x) \<and> is_Fun_Set (the_set_term x) \<and>
+                      fst (the_Var (the_elem_term x)) = TAtom Value)
+      in list_all f P"
+    and d: "(t, s) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+  shows "\<exists>ss. s = Fun (Set ss) []"
+  using \<A> d
+proof (induction)
+  case (step \<A> TT \<sigma> \<alpha>)
+  let ?TT = "transaction_strand TT \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+  let ?TTu = "unlabel ?TT"
+  let ?TTd = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?TT"
+  let ?TTdu = "unlabel ?TTd"
+  from step(6) have "(t, s) \<in> set (db'\<^sub>s\<^sub>s\<^sub>t ?TTdu \<I> (db'\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> []))"
+    unfolding db\<^sub>s\<^sub>s\<^sub>t_def by (simp add: db\<^sub>s\<^sub>s\<^sub>t_append)
+  hence "(t, s) \<in> set (db'\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> []) \<or>
+    (\<exists>t' s'. insert\<langle>t',s'\<rangle> \<in> set ?TTdu \<and> t = t' \<cdot> \<I> \<and> s = s' \<cdot> \<I>)"
+    using db\<^sub>s\<^sub>s\<^sub>t_in_cases[of t "s" ?TTdu \<I>] by metis 
+  thus ?case
+  proof
+    assume "\<exists>t' s'. insert\<langle>t',s'\<rangle> \<in> set ?TTdu \<and> t = t' \<cdot> \<I> \<and> s = s' \<cdot> \<I>"
+    then obtain t' s' where t's'_p: "insert\<langle>t',s'\<rangle> \<in> set ?TTdu" "t = t' \<cdot> \<I>" "s = s' \<cdot> \<I>" by metis
+    then obtain lll where "(lll, insert\<langle>t',s'\<rangle>) \<in> set ?TTd" by (meson unlabel_mem_has_label)
+    hence "(lll, insert\<langle>t',s'\<rangle>) \<in> set (transaction_strand TT \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+      using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(4) by blast
+    hence "insert\<langle>t',s'\<rangle> \<in> set ?TTu" by (meson unlabel_in)
+    hence "insert\<langle>t',s'\<rangle> \<in> set ((unlabel (transaction_strand TT)) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+      by (simp add: subst_lsst_unlabel)
+    hence "insert\<langle>t',s'\<rangle> \<in> (\<lambda>x. x \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p  \<sigma> \<circ>\<^sub>s \<alpha>) ` set (unlabel (transaction_strand TT))"
+      unfolding subst_apply_stateful_strand_def by auto
+    then obtain u where "u \<in> set (unlabel (transaction_strand TT)) \<and> u \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p  \<sigma> \<circ>\<^sub>s \<alpha> = insert\<langle>t',s'\<rangle>"
+      by auto
+    hence "\<exists>t'' s''. insert\<langle>t'',s''\<rangle> \<in> set (unlabel (transaction_strand TT)) \<and>
+                   t' = t'' \<cdot> \<sigma>  \<circ>\<^sub>s \<alpha> \<and> s' = s'' \<cdot> \<sigma>  \<circ>\<^sub>s \<alpha>"
+      by  (cases u) auto
+    then obtain t'' s'' where t''s''_p:
+        "insert\<langle>t'',s''\<rangle> \<in> set (unlabel (transaction_strand TT)) \<and>
+          t' = t'' \<cdot> \<sigma>  \<circ>\<^sub>s \<alpha> \<and> s' = s'' \<cdot> \<sigma>  \<circ>\<^sub>s \<alpha>"
+      by auto
+    hence "insert\<langle>t'',s''\<rangle> \<in> set (unlabel (transaction_updates TT))"
+      using is_Update_in_transaction_updates[of "insert\<langle>t'',s''\<rangle>" TT]
+      using PP step(2) unfolding list_all_iff by auto
+    moreover have "\<forall>x\<in>set (unlabel (transaction_updates TT)). is_Fun_Set (the_set_term x)"
+      using step(2) admissible_transaction_updates unfolding is_Fun_Set_def list_all_iff by auto
+    ultimately have "is_Fun_Set (the_set_term (insert\<langle>t'',s''\<rangle>))" by auto
+    moreover have "s' = s'' \<cdot> \<sigma>  \<circ>\<^sub>s \<alpha>" using t''s''_p by blast
+    ultimately have "is_Fun_Set (the_set_term (insert\<langle>t',s'\<rangle>))" by (auto simp add: is_Fun_Set_subst)
+    hence "is_Fun_Set s" by (simp add: t's'_p(3) is_Fun_Set_subst)
+    thus ?case using is_Fun_Set_exi by auto
+  qed (auto simp add: step db\<^sub>s\<^sub>s\<^sub>t_def)
+qed auto
+
+lemma reachable_constraints_occurs_fact_ik_ground:
+  assumes \<A>_reach: "A \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and t: "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+  shows "fv (occurs t) = {}"
+proof -
+  have 0: "admissible_transaction T"
+    when "T \<in> set P" for T
+    using P that unfolding list_all_iff by simp
+
+  have 1: "wellformed_transaction T"
+    when "T \<in> set P" for T
+    using 0[OF that] unfolding admissible_transaction_def by simp
+
+  have 2: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) =
+           (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<union> (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
+    when "T \<in> set P" for T \<theta> and A::"('fun,'atom,'sets,'lbl) prot_constr"
+    using dual_transaction_ik_is_transaction_send'[OF 1[OF that]] by fastforce
+
+  have 3: "admissible_transaction_occurs_checks T"
+    when "T \<in> set P" for T
+    using 0[OF that] unfolding admissible_transaction_def by simp
+
+  show ?thesis using \<A>_reach t
+  proof (induction A rule: reachable_constraints.induct)
+    case (step A T \<sigma> \<alpha>) thus ?case
+    proof (cases "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A")
+      case False
+      hence "occurs t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+        using 2[OF step.hyps(2)] step.prems by blast
+      hence "send\<langle>occurs t\<rangle> \<in> set (unlabel (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+        using wellformed_transaction_send_receive_subst_trm_cases(2)[OF 1[OF step.hyps(2)]]
+        by blast
+      then obtain s where s:
+          "send\<langle>occurs s\<rangle> \<in> set (unlabel (transaction_send T))" "t = s \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>"
+        using transaction_fresh_subst_transaction_renaming_subst_occurs_fact_send_receive(1)[
+                OF step.hyps(3,4) 1[OF step.hyps(2)]]
+            transaction_strand_subst_subsets(10)
+        by blast
+
+      obtain x where x: "x \<in> set (transaction_fresh T)" "s = Var x"
+        using s(1) 3[OF step.hyps(2)]
+        unfolding admissible_transaction_occurs_checks_def 
+        by fastforce
+
+      have "fv t = {}"
+        using transaction_fresh_subst_transaction_renaming_subst_range(1)[OF step.hyps(3,4) x(1)]
+              s(2) x(2)
+        by (auto simp del: subst_subst_compose)
+      thus ?thesis by simp
+    qed simp
+  qed simp
+qed
+
+lemma reachable_constraints_occurs_fact_ik_funs_terms:
+  fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
+  assumes \<A>_reach: "A \<in> reachable_constraints P"
+    and \<I>: "welltyped_constraint_model I A"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+  shows "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I). OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana s)))" (is "?A A")
+    and "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I). OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana s)))" (is "?B A")
+    and "Fun OccursSec [] \<notin> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I" (is "?C A")
+    and "\<forall>x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. I x \<noteq> Fun OccursSec []" (is "?D A")
+proof -
+  have T_adm: "admissible_transaction T" when "T \<in> set P" for T
+    using P that unfolding list_all_iff by simp
+
+  have T_valid: "wellformed_transaction T" when "T \<in> set P" for T
+    using T_adm[OF that] unfolding admissible_transaction_def by blast
+
+  have T_occ: "admissible_transaction_occurs_checks T" when "T \<in> set P" for T
+    using T_adm[OF that] unfolding admissible_transaction_def by blast
+
+  have \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" by (metis \<I> welltyped_constraint_model_def)
+
+  have \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)"
+    by (metis \<I> welltyped_constraint_model_def constraint_model_def)
+
+  have \<I>_grounds: "fv (I x) = {}" "\<exists>f T. I x = Fun f T" for x
+    using \<I> interpretation_grounds[of I, of "Var x"] empty_fv_exists_fun[of "I x"]
+    unfolding welltyped_constraint_model_def constraint_model_def by auto
+
+  have 00: "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<subseteq> vars_transaction T"
+           "fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))) = fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))"
+    for T::"('fun,'atom,'sets,'lbl) prot_transaction"
+    using fv_trms\<^sub>s\<^sub>s\<^sub>t_subset(1)[of "unlabel (transaction_send T)"] vars_transaction_unfold
+          fv_subterms_set[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"]
+    by blast+
+
+  have 0: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). \<exists>a. \<Gamma> (Var x) = TAtom a"
+          "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). \<Gamma> (Var x) \<noteq> TAtom OccursSecType"
+          "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))). \<exists>a. \<Gamma> (Var x) = TAtom a"
+          "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))). \<Gamma> (Var x) \<noteq> TAtom OccursSecType"
+          "\<forall>x \<in> vars_transaction T. \<exists>a. \<Gamma> (Var x) = TAtom a"
+          "\<forall>x \<in> vars_transaction T. \<Gamma> (Var x) \<noteq> TAtom OccursSecType"
+    when "T \<in> set P" for T
+    using admissible_transaction_occurs_fv_types[OF T_adm[OF that]] 00
+    by blast+
+
+  have 1: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<cdot>\<^sub>s\<^sub>e\<^sub>t I =
+           (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<union> (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<cdot>\<^sub>s\<^sub>e\<^sub>t I)"
+    when "T \<in> set P" for T \<theta> and A::"('fun,'atom,'sets,'lbl) prot_constr"
+    using dual_transaction_ik_is_transaction_send'[OF T_valid[OF that]]
+    by fastforce
+
+  have 2: "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<cdot>\<^sub>s\<^sub>e\<^sub>t I) =
+           subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
+    when "T \<in> set P" and \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" for T \<theta>
+    using wt_subst_TAtom_subterms_set_subst[OF wt_subst_compose[OF \<theta>(1) \<I>_wt] 0(1)[OF that(1)]]
+          wf_trm_subst_rangeD[OF wf_trms_subst_compose[OF \<theta>(2) \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s]]
+    by auto
+
+  have 3: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+    when "T \<in> set P" "transaction_fresh_subst \<sigma> T A" "transaction_renaming_subst \<alpha> P A"
+    for \<sigma> \<alpha> and T::"('fun,'atom,'sets,'lbl) prot_transaction"
+      and A::"('fun,'atom,'sets,'lbl) prot_constr"
+    using protocol_transaction_vars_TAtom_typed(3)[of T] P that(1)
+          transaction_fresh_subst_transaction_renaming_wt[OF that(2,3)]
+          transaction_fresh_subst_range_wf_trms[OF that(2)]
+          transaction_renaming_subst_range_wf_trms[OF that(3)]
+          wf_trms_subst_compose
+    by simp_all
+
+  have 4: "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)).
+              OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana s))) \<and>
+              OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
+    when T: "T \<in> set P" for T
+  proof
+    fix t assume t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))"
+    then obtain s where s: "send\<langle>s\<rangle> \<in> set (unlabel (transaction_send T))" "t \<in> subterms s"
+      using wellformed_transaction_unlabel_cases(5)[OF T_valid[OF T]]
+      by fastforce
+
+    have s_occ: "\<exists>x. s = occurs (Var x)" when "OccursFact \<in> funs_term t \<or> OccursSec \<in> funs_term t"
+    proof -
+      have "OccursFact \<in> funs_term s \<or> OccursSec \<in> funs_term s"
+        using that subtermeq_imp_funs_term_subset[OF s(2)] 
+        by blast
+      thus ?thesis
+        using s T_occ[OF T]
+        unfolding admissible_transaction_occurs_checks_def
+        by fastforce
+    qed
+
+    obtain K T' where K: "Ana t = (K,T')" by moura
+
+    show "OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana t))) \<and>
+          OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana t)))"
+    proof (rule ccontr)
+      assume "\<not>(OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana t))) \<and>
+                OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana t))))"
+      hence a: "OccursFact \<in> \<Union>(funs_term ` set (snd (Ana t))) \<or>
+                OccursSec \<in> \<Union>(funs_term ` set (snd (Ana t)))"
+        by simp
+      hence "OccursFact \<in> \<Union>(funs_term ` set T') \<or> OccursSec \<in> \<Union>(funs_term ` set T')"
+        using K by simp
+      hence "OccursFact \<in> funs_term t \<or> OccursSec \<in> funs_term t"
+        using Ana_subterm[OF K] funs_term_subterms_eq(1)[of t] by blast
+      then obtain x where x: "t \<in> subterms (occurs (Var x))"
+        using s(2) s_occ by blast
+      thus False using a by fastforce
+    qed
+  qed
+
+  have 5: "OccursFact \<notin> \<Union>(funs_term ` subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+          "OccursSec \<notin> \<Union>(funs_term ` subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+    when \<sigma>\<alpha>: "transaction_fresh_subst \<sigma> T A" "transaction_renaming_subst \<alpha> P A"
+    for \<sigma> \<alpha> and T::"('fun,'atom,'sets,'lbl) prot_transaction"
+      and A::"('fun,'atom,'sets,'lbl) prot_constr"
+  proof -
+    have "OccursFact \<notin> funs_term t" "OccursSec \<notin> funs_term t"
+      when "t \<in> subst_range (\<sigma> \<circ>\<^sub>s \<alpha>)" for t 
+      using transaction_fresh_subst_transaction_renaming_subst_range'[OF \<sigma>\<alpha> that]
+      by auto
+    thus "OccursFact \<notin> \<Union>(funs_term ` subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+         "OccursSec \<notin> \<Union>(funs_term ` subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+      by blast+
+  qed
+
+  have 6: "I x \<noteq> Fun OccursSec []" "\<nexists>t. I x = occurs t" "\<exists>a. \<Gamma> (I x) = TAtom a \<and> a \<noteq> OccursSecType"
+    when T: "T \<in> set P"
+      and \<sigma>\<alpha>: "transaction_fresh_subst \<sigma> T A" "transaction_renaming_subst \<alpha> P A"
+      and x: "Var x \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+    for x \<sigma> \<alpha> and T::"('fun,'atom,'sets,'lbl) prot_transaction"
+      and A::"('fun,'atom,'sets,'lbl) prot_constr"
+  proof -
+    obtain t where t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "t \<cdot> (\<sigma> \<circ>\<^sub>s \<alpha>) = Var x"
+      using x by moura
+    then obtain y where y: "t = Var y" by (cases t) auto
+
+    have "\<exists>a. \<Gamma> t = TAtom a \<and> a \<noteq> OccursSecType"
+      using 0(1,2)[OF T] t(1) y
+      by force
+    thus "\<exists>a. \<Gamma> (I x) = TAtom a \<and> a \<noteq> OccursSecType"
+      using wt_subst_trm''[OF 3(1)[OF T \<sigma>\<alpha>]] wt_subst_trm''[OF \<I>_wt] t(2) 
+      by (metis subst_apply_term.simps(1))
+    thus "I x \<noteq> Fun OccursSec []" "\<nexists>t. I x = occurs t"
+      by auto
+  qed
+
+  have 7: "I x \<noteq> Fun OccursSec []" "\<nexists>t. I x = occurs t" "\<exists>a. \<Gamma> (I x) = TAtom a \<and> a \<noteq> OccursSecType"
+    when T: "T \<in> set P"
+      and \<sigma>\<alpha>: "transaction_fresh_subst \<sigma> T A" "transaction_renaming_subst \<alpha> P A"
+      and x: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t ((\<sigma> \<circ>\<^sub>s \<alpha>) ` vars_transaction T)"
+    for x \<sigma> \<alpha> and T::"('fun,'atom,'sets,'lbl) prot_transaction"
+      and A::"('fun,'atom,'sets,'lbl) prot_constr"
+  proof -
+    obtain y where y: "y \<in> vars_transaction T" "x \<in> fv ((\<sigma> \<circ>\<^sub>s \<alpha>) y)"
+      using x by auto
+    hence y': "(\<sigma> \<circ>\<^sub>s \<alpha>) y = Var x"
+      using transaction_fresh_subst_transaction_renaming_subst_range'[OF \<sigma>\<alpha>]
+      by (cases "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<in> subst_range (\<sigma> \<circ>\<^sub>s \<alpha>)") force+
+
+    have "\<exists>a. \<Gamma> (Var y) = TAtom a \<and> a \<noteq> OccursSecType"
+      using 0(5,6)[OF T] y
+      by force
+    thus "\<exists>a. \<Gamma> (I x) = TAtom a \<and> a \<noteq> OccursSecType"
+      using wt_subst_trm''[OF 3(1)[OF T \<sigma>\<alpha>]] wt_subst_trm''[OF \<I>_wt] y'
+      by (metis subst_apply_term.simps(1))
+    thus "I x \<noteq> Fun OccursSec []" "\<nexists>t. I x = occurs t"
+      by auto
+  qed
+
+  have 8: "I x \<noteq> Fun OccursSec []" "\<nexists>t. I x = occurs t" "\<exists>a. \<Gamma> (I x) = TAtom a \<and> a \<noteq> OccursSecType"
+    when T: "T \<in> set P"
+      and \<sigma>\<alpha>: "transaction_fresh_subst \<sigma> T A" "transaction_renaming_subst \<alpha> P A"
+      and x: "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+    for x \<sigma> \<alpha> and T::"('fun,'atom,'sets,'lbl) prot_transaction"
+      and A::"('fun,'atom,'sets,'lbl) prot_constr"
+  proof -
+    obtain t where t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" "t \<cdot> (\<sigma> \<circ>\<^sub>s \<alpha>) = Var x"
+      using x by moura
+    then obtain y where y: "t = Var y" by (cases t) auto
+
+    have "\<exists>a. \<Gamma> t = TAtom a \<and> a \<noteq> OccursSecType"
+      using 0(3,4)[OF T] t(1) y
+      by force
+    thus "\<exists>a. \<Gamma> (I x) = TAtom a \<and> a \<noteq> OccursSecType"
+      using wt_subst_trm''[OF 3(1)[OF T \<sigma>\<alpha>]] wt_subst_trm''[OF \<I>_wt] t(2) 
+      by (metis subst_apply_term.simps(1))
+    thus "I x \<noteq> Fun OccursSec []" "\<nexists>t. I x = occurs t"
+      by auto
+  qed
+
+  have s_fv: "fv s \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t ((\<sigma> \<circ>\<^sub>s \<alpha>) ` vars_transaction T)"
+    when s: "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+      and T: "T \<in> set P"
+    for s and \<sigma> \<alpha>::"('fun,'atom,'sets) prot_subst" and T::"('fun,'atom,'sets,'lbl) prot_transaction"
+  proof
+    fix x assume "x \<in> fv s"
+    hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+      using s by auto
+    hence *: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+      using fv_subterms_set_subst' by fast
+    have **: "list_all is_Send (unlabel (transaction_send T))"
+      using T_valid[OF T] unfolding wellformed_transaction_def by blast
+    have "x \<in> fv\<^sub>s\<^sub>e\<^sub>t ((\<sigma> \<circ>\<^sub>s \<alpha>) ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))"
+    proof -
+      obtain t where t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "x \<in> fv (t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>)"
+        using * by fastforce
+      hence "fv t \<subseteq> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
+        using fv_trms\<^sub>s\<^sub>s\<^sub>t_subset(1)[of "unlabel (transaction_send T)"]
+        by auto
+      thus ?thesis using t(2) subst_apply_fv_subset by fast
+    qed
+    thus "x \<in> fv\<^sub>s\<^sub>e\<^sub>t ((\<sigma> \<circ>\<^sub>s \<alpha>) ` vars_transaction T)"
+      using vars_transaction_unfold[of T] by fastforce
+  qed
+
+  show "?A A" using \<A>_reach
+  proof (induction A rule: reachable_constraints.induct)
+    case (step A T \<sigma> \<alpha>)
+    have *: "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)).
+              OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
+      using 4[OF step.hyps(2)] by blast
+
+    have "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha> \<cdot>\<^sub>s\<^sub>e\<^sub>t I.
+            OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
+    proof
+      fix t assume t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha> \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
+      then obtain s u where su:
+          "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>" "s \<cdot> I = t"
+          "u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" "u \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> = s"
+        by force
+
+      obtain Ku Tu where KTu: "Ana u = (Ku,Tu)" by moura
+      
+      have *: "OccursFact \<notin> \<Union>(funs_term ` set Tu)"
+              "OccursFact \<notin> \<Union>(funs_term ` subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+              "OccursFact \<notin> \<Union>(funs_term ` \<Union>(((set \<circ> snd \<circ> Ana) ` subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))))"
+        using transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)]
+              4[OF step.hyps(2)] su(3) KTu
+        by fastforce+
+
+      have "OccursFact \<notin> \<Union>(funs_term ` set (Tu \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+      proof -
+        { fix f assume f: "f \<in> \<Union>(funs_term ` set (Tu \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+          then obtain tf where tf: "tf \<in> set Tu" "f \<in> funs_term (tf \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>)" by moura
+          hence "f \<in> funs_term tf \<or> f \<in> \<Union>(funs_term ` subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+            using funs_term_subst[of tf "\<sigma> \<circ>\<^sub>s \<alpha>"] by force
+          hence "f \<noteq> OccursFact" using *(1,2) tf(1) by blast
+        } thus ?thesis by metis
+      qed
+      hence **: "OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
+      proof (cases u)
+        case (Var xu)
+        hence "s = (\<sigma> \<circ>\<^sub>s \<alpha>) xu" using su(4) by (metis subst_apply_term.simps(1))
+        thus ?thesis using *(3) by fastforce
+      qed (use su(4) KTu Ana_subst'[of _ _ Ku Tu "\<sigma> \<circ>\<^sub>s \<alpha>"] in simp)
+      
+      show "OccursFact \<notin> \<Union>(funs_term ` set (snd (Ana t)))"
+      proof (cases s)
+        case (Var sx)
+        then obtain a where a: "\<Gamma> (I sx) = Var a"
+          using su(1) 8(3)[OF step.hyps(2,3,4), of sx] by fast
+        hence "Ana (I sx) = ([],[])" by (metis \<I>_grounds(2) const_type_inv[THEN Ana_const])
+        thus ?thesis using Var su(2) by simp
+      next
+        case (Fun f S)
+        hence snd_Ana_t: "snd (Ana t) = snd (Ana s) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t I"
+          using su(2) Ana_subst'[of f S _ "snd (Ana s)" I] by (cases "Ana s") simp_all
+
+        { fix g assume "g \<in> \<Union>(funs_term ` set (snd (Ana t)))"
+          hence "g \<in> \<Union>(funs_term ` set (snd (Ana s))) \<or>
+                 (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s))). g \<in> funs_term (I x))"
+            using snd_Ana_t funs_term_subst[of _ I] by auto
+          hence "g \<noteq> OccursFact"
+          proof
+            assume "\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s))). g \<in> funs_term (I x)"
+            then obtain x where x: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s)))" "g \<in> funs_term (I x)" by moura
+            have "x \<in> fv s" using x(1) Ana_vars(2)[of s] by (cases "Ana s") auto
+            hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t ((\<sigma> \<circ>\<^sub>s \<alpha>) ` vars_transaction T)"
+              using s_fv[OF su(1) step.hyps(2)] by blast
+            then obtain a h U where h:
+                "I x = Fun h U" "\<Gamma> (I x) = Var a" "a \<noteq> OccursSecType" "arity h = 0"
+              using \<I>_grounds(2) 7(3)[OF step.hyps(2,3,4)] const_type_inv
+              by metis
+            hence "h \<noteq> OccursFact" by auto
+            moreover have "U = []" using h(1,2,4) const_type_inv_wf[of h U a] \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s by fastforce
+            ultimately show ?thesis using h(1) x(2) by auto
+          qed (use ** in blast)
+        } thus ?thesis by blast
+      qed
+    qed
+    thus ?case
+      using step.IH step.prems 1[OF step.hyps(2), of A "\<sigma> \<circ>\<^sub>s \<alpha>"]
+            2[OF step.hyps(2) 3[OF step.hyps(2,3,4)]]
+      by auto
+  qed simp
+
+  show "?B A" using \<A>_reach
+  proof (induction A rule: reachable_constraints.induct)
+    case (step A T \<sigma> \<alpha>)
+    have "\<forall>s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha> \<cdot>\<^sub>s\<^sub>e\<^sub>t I.
+            OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
+    proof
+      fix t assume t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha> \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
+      then obtain s u where su:
+          "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>" "s \<cdot> I = t"
+          "u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" "u \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> = s"
+        by force
+
+      obtain Ku Tu where KTu: "Ana u = (Ku,Tu)" by moura
+      
+      have *: "OccursSec \<notin> \<Union>(funs_term ` set Tu)"
+              "OccursSec \<notin> \<Union>(funs_term ` subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+              "OccursSec \<notin> \<Union>(funs_term ` \<Union>(((set \<circ> snd \<circ> Ana) ` subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))))"
+        using transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)] 
+              4[OF step.hyps(2)] su(3) KTu
+        by fastforce+
+
+      have "OccursSec \<notin> \<Union>(funs_term ` set (Tu \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+      proof -
+        { fix f assume f: "f \<in> \<Union>(funs_term ` set (Tu \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+          then obtain tf where tf: "tf \<in> set Tu" "f \<in> funs_term (tf \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>)" by moura
+          hence "f \<in> funs_term tf \<or> f \<in> \<Union>(funs_term ` subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+            using funs_term_subst[of tf "\<sigma> \<circ>\<^sub>s \<alpha>"] by force
+          hence "f \<noteq> OccursSec" using *(1,2) tf(1) by blast
+        } thus ?thesis by metis
+      qed
+      hence **: "OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana s)))"
+      proof (cases u)
+        case (Var xu)
+        hence "s = (\<sigma> \<circ>\<^sub>s \<alpha>) xu" using su(4) by (metis subst_apply_term.simps(1))
+        thus ?thesis using *(3) by fastforce
+      qed (use su(4) KTu Ana_subst'[of _ _ Ku Tu "\<sigma> \<circ>\<^sub>s \<alpha>"] in simp)
+      
+      show "OccursSec \<notin> \<Union>(funs_term ` set (snd (Ana t)))"
+      proof (cases s)
+        case (Var sx)
+        then obtain a where a: "\<Gamma> (I sx) = Var a"
+          using su(1) 8(3)[OF step.hyps(2,3,4), of sx] by fast
+        hence "Ana (I sx) = ([],[])" by (metis \<I>_grounds(2) const_type_inv[THEN Ana_const])
+        thus ?thesis using Var su(2) by simp
+      next
+        case (Fun f S)
+        hence snd_Ana_t: "snd (Ana t) = snd (Ana s) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t I"
+          using su(2) Ana_subst'[of f S _ "snd (Ana s)" I] by (cases "Ana s") simp_all
+
+        { fix g assume "g \<in> \<Union>(funs_term ` set (snd (Ana t)))"
+          hence "g \<in> \<Union>(funs_term ` set (snd (Ana s))) \<or>
+                 (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s))). g \<in> funs_term (I x))"
+            using snd_Ana_t funs_term_subst[of _ I] by auto
+          hence "g \<noteq> OccursSec"
+          proof
+            assume "\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s))). g \<in> funs_term (I x)"
+            then obtain x where x: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s)))" "g \<in> funs_term (I x)" by moura
+            have "x \<in> fv s" using x(1) Ana_vars(2)[of s] by (cases "Ana s") auto
+            hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t ((\<sigma> \<circ>\<^sub>s \<alpha>) ` vars_transaction T)"
+              using s_fv[OF su(1) step.hyps(2)] by blast
+            then obtain a h U where h:
+                "I x = Fun h U" "\<Gamma> (I x) = Var a" "a \<noteq> OccursSecType" "arity h = 0"
+              using \<I>_grounds(2) 7(3)[OF step.hyps(2,3,4)] const_type_inv
+              by metis
+            hence "h \<noteq> OccursSec" by auto
+            moreover have "U = []" using h(1,2,4) const_type_inv_wf[of h U a] \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s by fastforce
+            ultimately show ?thesis using h(1) x(2) by auto
+          qed (use ** in blast)
+        } thus ?thesis by blast
+      qed
+    qed
+    thus ?case
+      using step.IH step.prems 1[OF step.hyps(2), of A "\<sigma> \<circ>\<^sub>s \<alpha>"]
+            2[OF step.hyps(2) 3[OF step.hyps(2,3,4)]]
+      by auto
+  qed simp
+
+  show "?C A" using \<A>_reach
+  proof (induction A rule: reachable_constraints.induct)
+    case (step A T \<sigma> \<alpha>)
+    have *: "Fun OccursSec [] \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
+      using wellformed_transaction_unlabel_cases(5)[OF T_valid[OF step.hyps(2)]]
+            T_occ[OF step.hyps(2)]
+      unfolding admissible_transaction_occurs_checks_def 
+      by fastforce
+
+    have **: "Fun OccursSec [] \<notin> subst_range (\<sigma> \<circ>\<^sub>s \<alpha>)"
+      using transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)]
+      by auto
+
+    have "Fun OccursSec [] \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha> \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
+    proof
+      assume "Fun OccursSec [] \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha> \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
+      then obtain s where "s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>" "s \<cdot> I = Fun OccursSec []"
+        by moura
+      moreover have "Fun OccursSec [] \<notin> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+      proof
+        assume "Fun OccursSec [] \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+        then obtain u where "u \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "u \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> = Fun OccursSec []"
+          by moura
+        thus False using * ** by (cases u) (force simp del: subst_subst_compose)+
+      qed
+      ultimately show False using 6[OF step.hyps(2,3,4)] by (cases s) auto
+    qed
+    thus ?case using step.IH step.prems 1[OF step.hyps(2), of A "\<sigma> \<circ>\<^sub>s \<alpha>"] by fast
+  qed simp
+
+  show "?D A" using \<A>_reach
+  proof (induction A rule: reachable_constraints.induct)
+    case (step A T \<sigma> \<alpha>)
+    { fix x assume x: "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+      hence x': "x \<in> vars\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+        by (metis vars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unlabel_subst)
+      hence "x \<in> vars_transaction T \<or> x \<in> fv\<^sub>s\<^sub>e\<^sub>t ((\<sigma> \<circ>\<^sub>s \<alpha>) ` vars_transaction T)"
+        using vars\<^sub>s\<^sub>s\<^sub>t_subst_cases[OF x'] by metis
+      moreover have "I x \<noteq> Fun OccursSec []" when "x \<in> vars_transaction T"
+        using that 0(5,6)[OF step.hyps(2)] wt_subst_trm''[OF \<I>_wt, of "Var x"]
+        by fastforce
+      ultimately have "I x \<noteq> Fun OccursSec []"
+        using 7(1)[OF step.hyps(2,3,4), of x]
+        by blast
+    } thus ?case using step.IH by auto
+  qed simp
+qed
+
+lemma reachable_constraints_occurs_fact_ik_subst_aux:
+  assumes \<A>_reach: "A \<in> reachable_constraints P"
+    and \<I>: "welltyped_constraint_model I A"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and t: "t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "t \<cdot> I = occurs s"
+  shows "\<exists>u. t = occurs u"
+proof -
+  have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I"
+    using \<I> unfolding welltyped_constraint_model_def constraint_model_def by metis
+  hence 0: "\<Gamma> t = \<Gamma> (occurs s)"
+    using t(2) wt_subst_trm'' by metis
+
+  have 1: "\<Gamma>\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<subseteq> (\<Union>T \<in> set P. \<Gamma>\<^sub>v ` fv_transaction T)"
+          "\<forall>T \<in> set P. \<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
+    using reachable_constraints_TAtom_types(1)[OF \<A>_reach]
+          protocol_transaction_vars_TAtom_typed(2,3) P
+    by fast+
+
+  show ?thesis
+  proof (cases t)
+    case (Var x)
+    thus ?thesis
+      using 0 1 t(1) var_subterm_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of x "unlabel A"]
+      by fastforce
+  next
+    case (Fun f T)
+    hence 2: "f = OccursFact" "length T = Suc (Suc 0)" "T ! 0 \<cdot> I = Fun OccursSec []"
+      using t(2) by auto
+
+    have "T ! 0 = Fun OccursSec []"
+    proof (cases "T ! 0")
+      case (Var y)
+      hence "I y = Fun OccursSec []" using Fun 2(3) by simp
+      moreover have "Var y \<in> set T" using Var 2(2) length_Suc_conv[of T 1] by auto
+      hence "y \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" using Fun t(1) by force
+      hence "y \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+        using fv_ik_subset_fv_sst'[of "unlabel A"] vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel A"]
+        by blast
+      ultimately have False
+        using reachable_constraints_occurs_fact_ik_funs_terms(4)[OF \<A>_reach \<I> P]
+        by blast
+      thus ?thesis by simp
+    qed (use 2(3) in simp)
+    moreover have "\<exists>u u'. T = [u,u']"
+      using 2(2) by (metis (no_types) length_0_conv length_Suc_conv)
+    ultimately show ?thesis using Fun 2(1,2) by force
+  qed
+qed
+
+lemma reachable_constraints_occurs_fact_ik_subst:
+  assumes \<A>_reach: "A \<in> reachable_constraints P"
+    and \<I>: "welltyped_constraint_model I A"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and t: "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I"
+  shows "occurs t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+proof -
+  have \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I"
+    using \<I> unfolding welltyped_constraint_model_def constraint_model_def by metis
+
+  obtain s where s: "s \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "s \<cdot> I = occurs t"
+    using t by auto
+  hence u: "\<exists>u. s = occurs u"
+    using \<I>_wt reachable_constraints_occurs_fact_ik_subst_aux[OF \<A>_reach \<I> P]
+    by blast
+  hence "fv s = {}"
+    using reachable_constraints_occurs_fact_ik_ground[OF \<A>_reach P] s
+    by fast
+  thus ?thesis
+    using s u subst_ground_ident[of s I] 
+    by argo
+qed
+
+lemma reachable_constraints_occurs_fact_send_in_ik:
+  assumes \<A>_reach: "A \<in> reachable_constraints P"
+    and \<I>: "welltyped_constraint_model I A"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and x: "send\<langle>occurs (Var x)\<rangle> \<in> set (unlabel A)"
+  shows "occurs (I x) \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+using \<A>_reach \<I> x
+proof (induction A rule: reachable_constraints.induct)
+  case (step A T \<sigma> \<alpha>)
+  define \<theta> where "\<theta> \<equiv> \<sigma> \<circ>\<^sub>s \<alpha>"
+  define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+
+  have T_adm: "admissible_transaction T"
+    using P step.hyps(2) unfolding list_all_iff by blast
+
+  have T_valid: "wellformed_transaction T"
+    using T_adm unfolding admissible_transaction_def by blast
+
+  have T_adm_occ: "admissible_transaction_occurs_checks T"
+    using T_adm unfolding admissible_transaction_def by blast
+
+  have \<I>_is_T_model: "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) (set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I)) (unlabel T') I"
+    using step.prems unlabel_append[of A T'] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel A" I "[]"]
+          strand_sem_append_stateful[of "{}" "{}" "unlabel A" "unlabel T'" I]
+    by (simp add: T'_def \<theta>_def welltyped_constraint_model_def constraint_model_def db\<^sub>s\<^sub>s\<^sub>t_def)
+
+  show ?case
+  proof (cases "send\<langle>occurs (Var x)\<rangle> \<in> set (unlabel A)")
+    case False
+    hence "send\<langle>occurs (Var x)\<rangle> \<in> set (unlabel T')"
+      using step.prems(2) unfolding T'_def \<theta>_def by simp
+    hence "receive\<langle>occurs (Var x)\<rangle> \<in> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+      using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) unfolding T'_def by blast
+    then obtain y where y:
+        "receive\<langle>occurs (Var y)\<rangle> \<in> set (unlabel (transaction_receive T))"
+        "\<theta> y = Var x"
+      using transaction_fresh_subst_transaction_renaming_subst_occurs_fact_send_receive(2)[
+              OF step.hyps(3,4) T_valid]
+            subst_to_var_is_var[of _ \<theta> x]
+      unfolding \<theta>_def by (force simp del: subst_subst_compose)
+    hence "receive\<langle>occurs (Var y) \<cdot> \<theta>\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+      using subst_lsst_unlabel_member[of "receive\<langle>occurs (Var y)\<rangle>" "transaction_receive T" \<theta>]
+      by fastforce
+    hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> occurs (Var y) \<cdot> \<theta> \<cdot> I"
+      using wellformed_transaction_sem_receives[
+              OF T_valid, of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I" "set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I)" \<theta> I "occurs (Var y) \<cdot> \<theta>"]
+            \<I>_is_T_model
+      by (metis T'_def)
+    hence *: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> occurs (\<theta> y \<cdot> I)"
+      by auto
+
+    have "occurs (\<theta> y \<cdot> I) \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+      using deduct_occurs_in_ik[OF *]
+            reachable_constraints_occurs_fact_ik_subst[
+              OF step.hyps(1) welltyped_constraint_model_prefix[OF step.prems(1)] P, of "\<theta> y \<cdot> I"]
+            reachable_constraints_occurs_fact_ik_funs_terms[
+              OF step.hyps(1) welltyped_constraint_model_prefix[OF step.prems(1)] P]
+      by blast
+    thus ?thesis using y(2) by simp
+  qed (simp add: step.IH[OF welltyped_constraint_model_prefix[OF step.prems(1)]])
+qed simp
+
+lemma reachable_contraints_fv_bvars_subset:
+  assumes A: "A \<in> reachable_constraints P"
+  shows "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<subseteq> (\<Union>T \<in> set P. bvars_transaction T)"
+using assms
+proof (induction A rule: reachable_constraints.induct)
+  case (step \<A> T \<sigma> \<alpha>)
+  let ?T' = "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+
+  show ?case
+    using step.IH step.hyps(2)
+          bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of ?T']
+          bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+          bvars\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T')"]
+          unlabel_append[of \<A> "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T'"]
+    by (metis (no_types, lifting) SUP_upper Un_subset_iff)
+qed simp
+
+lemma reachable_contraints_fv_disj:
+  assumes A: "A \<in> reachable_constraints P"
+  shows "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<inter> (\<Union>T \<in> set P. bvars_transaction T) = {}"
+using A
+proof (induction A rule: reachable_constraints.induct)
+  case (step \<A> T \<sigma> \<alpha>)
+  define T' where "T' \<equiv> transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>" 
+  define X where "X \<equiv> \<Union>T \<in> set P. bvars_transaction T"
+  have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<inter> X = {}"
+    using transaction_fresh_subst_transaction_renaming_subst_vars_disj(4)[OF step.hyps(3,4)]
+          transaction_fresh_subst_transaction_renaming_subst_vars_subset(4)[OF step.hyps(3,4,2)]
+    unfolding T'_def X_def by blast
+  hence "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<inter> X = {}"
+    using step.IH[unfolded X_def[symmetric]] fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of T'] by auto
+  thus ?case unfolding T'_def X_def by blast
+qed simp
+
+lemma reachable_contraints_fv_bvars_disj:
+  assumes P: "\<forall>T \<in> set P. wellformed_transaction T"
+    and A: "A \<in> reachable_constraints P"
+  shows "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = {}"
+using A
+proof (induction A rule: reachable_constraints.induct)
+  case (step \<A> T \<sigma> \<alpha>)
+  define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+
+  note 0 = transaction_fresh_subst_transaction_renaming_subst_vars_disj[OF step.hyps(3,4)]
+  note 1 = transaction_fresh_subst_transaction_renaming_subst_vars_subset[OF step.hyps(3,4)]
+
+  have 2: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = {}" 
+    using 0(7) 1(4)[OF step.hyps(2)] fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq
+    unfolding T'_def by (metis (no_types) disjoint_iff_not_equal subset_iff)
+
+  have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> \<Union>(bvars_transaction ` set P)"
+       "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> \<Union>(bvars_transaction ` set P) = {}"
+    using reachable_contraints_fv_bvars_subset[OF reachable_constraints.step[OF step.hyps]]
+          reachable_contraints_fv_disj[OF reachable_constraints.step[OF step.hyps]]
+    unfolding T'_def by auto
+  hence 3: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = {}" by blast
+  
+  have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>) \<inter> bvars_transaction T = {}"
+    using 0(4)[OF step.hyps(2)] 1(4)[OF step.hyps(2)] by blast
+  hence 4: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = {}"
+    by (metis (no_types) T'_def fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq
+              unlabel_subst bvars\<^sub>s\<^sub>s\<^sub>t_subst)
+
+  have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') = {}"
+    using 2 3 4 step.IH
+    unfolding unlabel_append[of \<A> T']
+              fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel T'"]
+              bvars\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel T'"]
+    by fast
+  thus ?case unfolding T'_def by blast
+qed simp
+
+lemma reachable_constraints_wf:
+  assumes P:
+      "\<forall>T \<in> set P. wellformed_transaction T"
+      "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
+    and A: "A \<in> reachable_constraints P"
+  shows "wf\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
+    and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+proof -
+  have "wellformed_transaction T"
+    when "T \<in> set P" for T
+    using P(1) that by fast+
+  hence 0: "wf'\<^sub>s\<^sub>s\<^sub>t (set (transaction_fresh T)) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))"
+           "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) = {}"
+           "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)"
+    when T: "T \<in> set P" for T
+    unfolding admissible_transaction_terms_def
+    by (metis T wellformed_transaction_wf\<^sub>s\<^sub>s\<^sub>t(1),
+        metis T wellformed_transaction_wf\<^sub>s\<^sub>s\<^sub>t(2) fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq,
+        metis T wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code P(2))
+
+  from A have "wf\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+  proof (induction A rule: reachable_constraints.induct)
+    case (step A T \<sigma> \<alpha>)
+    let ?T' = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+
+    have IH: "wf'\<^sub>s\<^sub>s\<^sub>t {} (unlabel A)" "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = {}" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+      using step.IH by metis+
+
+    have 1: "wf'\<^sub>s\<^sub>s\<^sub>t {} (unlabel (A@?T'))"
+      using protocol_transaction_wf_subst[OF 0(1)[OF step.hyps(2)] step.hyps(3,4)]
+            wf\<^sub>s\<^sub>s\<^sub>t_vars_mono[of "{}"] wf\<^sub>s\<^sub>s\<^sub>t_append[OF IH(1)]
+      by simp
+
+    have 2: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@?T') \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@?T') = {}"
+      using reachable_contraints_fv_bvars_disj[OF P(1)]
+            reachable_constraints.step[OF step.hyps]
+      by blast
+
+    have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T')"
+      using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unlabel_subst
+            wf_trms_subst[
+              OF wf_trms_subst_compose[
+                OF transaction_fresh_subst_range_wf_trms[OF step.hyps(3)]
+                   transaction_renaming_subst_range_wf_trms[OF step.hyps(4)]],
+              THEN wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_trms\<^sub>s\<^sub>s\<^sub>t_subst,
+              OF 0(3)[OF step.hyps(2)]]
+      by metis
+    hence 3: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@?T'))"
+      using IH(3) by auto
+
+    show ?case using 1 2 3 by force
+  qed simp
+  thus "wf\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" by metis+
+qed
+
+lemma reachable_constraints_no_Ana_Attack:
+  assumes \<A>: "\<A> \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+  shows "attack\<langle>n\<rangle> \<notin> set (snd (Ana t))"
+proof -
+  have T_adm: "admissible_transaction T" when "T \<in> set P" for T
+    using P that by blast
+
+  have T_adm_term: "admissible_transaction_terms T" when "T \<in> set P" for T
+    using T_adm[OF that] unfolding admissible_transaction_def by blast
+
+  have T_valid: "wellformed_transaction T" when "T \<in> set P" for T
+    using T_adm[OF that] unfolding admissible_transaction_def by blast
+
+  show ?thesis
+  using \<A> t
+  proof (induction \<A> rule: reachable_constraints.induct)
+    case (step A T \<sigma> \<alpha>) thus ?case
+    proof (cases "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)")
+      case False
+      hence "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)))"
+        using step.prems by simp
+      hence "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+        using dual_transaction_ik_is_transaction_send'[OF T_valid[OF step.hyps(2)]]
+        by metis
+      hence "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+        using transaction_fresh_subst_transaction_renaming_subst_trms[
+                OF step.hyps(3,4), of "transaction_send T"]
+              wellformed_transaction_unlabel_cases(5)[OF T_valid[OF step.hyps(2)]]
+        by fastforce
+      then obtain s where s: "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" "t = s \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>"
+        by moura
+      hence s': "attack\<langle>n\<rangle> \<notin> set (snd (Ana s))"
+        using admissible_transaction_no_Ana_Attack[OF T_adm_term[OF step.hyps(2)]]
+              trms_transaction_unfold[of T]
+        by blast
+
+      note * = transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)]
+
+      show ?thesis
+      proof
+        assume n: "attack\<langle>n\<rangle> \<in> set (snd (Ana t))"
+        thus False
+        proof (cases s)
+          case (Var x) thus ?thesis using Var * n s(2) by (force simp del: subst_subst_compose)
+        next
+          case (Fun f T)
+          hence "attack\<langle>n\<rangle> \<in> set (snd (Ana s)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+            using Ana_subst'[of f T _ "snd (Ana s)" "\<sigma> \<circ>\<^sub>s \<alpha>"] s(2) s' n
+            by (cases "Ana s") auto
+          hence "attack\<langle>n\<rangle> \<in> set (snd (Ana s)) \<or> attack\<langle>n\<rangle> \<in> subst_range (\<sigma> \<circ>\<^sub>s \<alpha>)"
+            using const_mem_subst_cases' by fast
+          thus ?thesis using * s' by blast
+        qed
+      qed
+    qed simp
+  qed simp
+qed
+
+lemma constraint_model_Value_term_is_Val:
+  assumes \<A>_reach: "A \<in> reachable_constraints P"
+    and \<I>: "welltyped_constraint_model I A"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and x: "\<Gamma>\<^sub>v x = TAtom Value" "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+  shows "\<exists>n. I x = Fun (Val (n,False)) []"
+using reachable_constraints_occurs_fact_send_ex[OF \<A>_reach P x]
+      reachable_constraints_occurs_fact_send_in_ik[OF \<A>_reach \<I> P]
+      reachable_constraints_occurs_fact_ik_case[OF \<A>_reach P]
+by fast
+
+lemma constraint_model_Value_term_is_Val':
+  assumes \<A>_reach: "A \<in> reachable_constraints P"
+    and \<I>: "welltyped_constraint_model I A"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and x: "(TAtom Value, m) \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+  shows "\<exists>n. I (TAtom Value, m) = Fun (Val (n,False)) []"
+using constraint_model_Value_term_is_Val[OF \<A>_reach \<I> P _ x] by simp
+
+(* We use this lemma to show that fresh constants first occur in \<I>(\<A>) at the point where they were generated *)
+lemma constraint_model_Value_var_in_constr_prefix:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and \<I>: "welltyped_constraint_model \<I> \<A>"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+  shows "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<Gamma>\<^sub>v x = TAtom Value
+          \<longrightarrow> (\<exists>B. prefix B \<A> \<and> x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> \<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B))" (is "?P \<A>")
+using \<A>_reach \<I>
+proof (induction \<A> rule: reachable_constraints.induct)
+  case (step \<A> T \<sigma> \<alpha>)
+  have IH: "?P \<A>" using step welltyped_constraint_model_prefix by fast
+
+  define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+
+  have T_adm: "admissible_transaction T"
+    by (metis P step.hyps(2))
+
+  have T_valid: "wellformed_transaction T"
+    by (metis T_adm admissible_transaction_def)
+
+  have \<I>_is_T_model: "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) (set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)) (unlabel T') \<I>"
+    using step.prems unlabel_append[of \<A> T'] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>" \<I> "[]"]
+          strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" "unlabel T'" \<I>]
+    by (simp add: T'_def welltyped_constraint_model_def constraint_model_def db\<^sub>s\<^sub>s\<^sub>t_def)
+
+  have \<I>_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
+    and \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
+    and \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
+    by (metis \<I> welltyped_constraint_model_def constraint_model_def,
+        metis \<I> welltyped_constraint_model_def,
+        metis \<I> welltyped_constraint_model_def constraint_model_def)
+
+  have 1: "\<exists>B. prefix B \<A> \<and> x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> \<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
+    when x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "\<Gamma>\<^sub>v x = TAtom Value" for x
+  proof -
+    obtain n where n: "\<I> x = Fun n []" "is_Val n \<or> is_Abs n" "\<not>public n"
+      using constraint_model_Value_term_is_Val[
+              OF reachable_constraints.step[OF step.hyps] step.prems P x(2)]
+            x(1) fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel T'"] unlabel_append[of \<A> T']
+      unfolding T'_def by moura
+
+    have "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+      using x(1) fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unfolding T'_def by fastforce
+    then obtain y where y: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" "x \<in> fv ((\<sigma> \<circ>\<^sub>s \<alpha>) y)"
+      using fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var[of x "unlabel (transaction_strand T)" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+            unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+      by auto
+
+    have y_x: "(\<sigma> \<circ>\<^sub>s \<alpha>) y = Var x"
+      using y(2) transaction_fresh_subst_transaction_renaming_subst_range[OF step.hyps(3,4), of y]
+      by force
+
+    have "\<Gamma> ((\<sigma> \<circ>\<^sub>s \<alpha>) y) = TAtom Value" using x(2) y_x by simp
+    moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+      using protocol_transaction_vars_TAtom_typed(3) P(1) step.hyps(2)
+            transaction_fresh_subst_transaction_renaming_wt[OF step.hyps(3,4)]
+      by fast
+    ultimately have y_val: "\<Gamma>\<^sub>v y = TAtom Value"
+      by (metis wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def \<Gamma>.simps(1))
+
+    have y_not_fresh: "y \<notin> set (transaction_fresh T)"
+      using y(2) transaction_fresh_subst_transaction_renaming_subst_range(1)[OF step.hyps(3,4)]
+      by fastforce
+
+    have y_n: "Fun n [] = (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>" using n y_x by simp
+    hence y_n': "Fun n [] = (\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>) y"
+      by (metis subst_subst_compose[of "Var y" "\<sigma> \<circ>\<^sub>s \<alpha>" \<I>] subst_apply_term.simps(1))
+
+    have "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<or> y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+      using wellformed_transaction_fv_in_receives_or_selects[OF T_valid] y(1) y_not_fresh by blast
+    hence n_cases:
+      "Fun n [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<or>
+       (\<exists>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<Gamma>\<^sub>v z = TAtom Value \<and> \<I> z = Fun n [])"
+    proof
+      assume y_in: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
+      then obtain t where t: "receive\<langle>t\<rangle> \<in> set (unlabel (transaction_receive T))" "y \<in> fv t"
+        using admissible_transaction_strand_step_cases(1)[OF T_adm]
+        by force
+      hence "receive\<langle>t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+        using subst_lsst_unlabel_member[of "receive\<langle>t\<rangle>" "transaction_receive T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+        by fastforce
+      hence *: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I>"
+        using wellformed_transaction_sem_receives[
+                OF T_valid, of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)" "\<sigma> \<circ>\<^sub>s \<alpha>" \<I> "t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>"]
+              \<I>_is_T_model
+        by (metis T'_def)
+
+      have "\<exists>a. \<Gamma> (\<I> x) = Var a" when "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" for x
+        using that reachable_constraints_vars_TAtom_typed[OF step.hyps(1) P, of x]
+              vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"] wt_subst_trm''[OF \<I>_wt, of "Var x"]
+        by force
+      hence "\<exists>f. \<I> x = Fun f []" when "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" for x
+        using that wf_trm_subst[OF \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s, of "Var x"] wf_trm_Var[of x] const_type_inv_wf
+              empty_fv_exists_fun[OF interpretation_grounds[OF \<I>_interp], of "Var x"] 
+        by (metis subst_apply_term.simps(1)[of x \<I>])
+      hence \<A>_ik_\<I>_vals: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). \<exists>f. \<I> x = Fun f []"
+        using fv_ik_subset_fv_sst'[of "unlabel \<A>"] vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"]
+        by blast
+      hence "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) = subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
+        using ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel \<A>" \<I>] unlabel_subst[of \<A> \<I>]
+              subterms_subst_lsst_ik[of \<A> \<I>] 
+        by metis
+      moreover have "v \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" when "v \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" for v
+        by (meson contra_subsetD fv_ik_subset_fv_sst' that) 
+      moreover have "Fun n [] \<in> subterms (t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I>)"
+        using imageI[of "Var y" "subterms t" "\<lambda>x. x \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>"]
+              var_is_subterm[OF t(2)] subterms_subst_subset[of "\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>" t]
+              subst_subst_compose[of t "\<sigma> \<circ>\<^sub>s \<alpha>" \<I>] y_n'
+        by (auto simp del: subst_subst_compose)
+      hence "Fun n [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)"
+        using private_fun_deduct_in_ik[OF *, of n "[]"] n(2,3)
+        unfolding is_Val_def is_Abs_def
+        by auto
+      hence "Fun n [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<or>
+              (\<exists>z \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). Fun n [] \<in> subterms (\<I> z))"
+        using const_subterm_subst_cases[of n _ \<I>]
+        by auto
+      hence "Fun n [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<or> (\<exists>z \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). \<I> z = Fun n [])"
+        using \<A>_ik_\<I>_vals by fastforce
+      hence "Fun n [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<or>
+              (\<exists>z \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). \<Gamma>\<^sub>v z = TAtom Value \<and> \<I> z = Fun n [])"
+        using \<I>_wt n(2) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def is_Val_def is_Abs_def by force
+      ultimately show ?thesis using ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel \<A>"] by fast
+    next
+      assume y_in: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+      then obtain s where s: "select\<langle>Var y,Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_selects T))"
+        using admissible_transaction_strand_step_cases(2)[OF T_adm]
+        by force
+      hence "select\<langle>(\<sigma> \<circ>\<^sub>s \<alpha>) y, Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+        using subst_lsst_unlabel_member
+        by fastforce
+      hence n_in_db: "(Fun n [], Fun (Set s) []) \<in> set (db'\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<I> [])"
+        using wellformed_transaction_sem_selects[
+                OF T_valid, of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)" "\<sigma> \<circ>\<^sub>s \<alpha>" \<I>
+                               "(\<sigma> \<circ>\<^sub>s \<alpha>) y" "Fun (Set s) []"]
+              \<I>_is_T_model n y_x
+        unfolding T'_def db\<^sub>s\<^sub>s\<^sub>t_def
+        by fastforce
+
+      obtain tn sn where tsn: "insert\<langle>tn,sn\<rangle> \<in> set (unlabel \<A>)" "Fun n [] = tn \<cdot> \<I>"
+        using db\<^sub>s\<^sub>s\<^sub>t_in_cases[OF n_in_db] by force
+
+      have "Fun n [] = tn \<or> (\<exists>z. \<Gamma>\<^sub>v z = TAtom Value \<and> tn = Var z)"
+        using \<I>_wt tsn(2) n(2) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def is_Val_def is_Abs_def by (cases tn) auto
+      moreover have "tn \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" "fv tn \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
+        using tsn(1) in_subterms_Union by force+
+      ultimately show ?thesis using tsn(2) by auto
+    qed
+
+    have x_nin_\<A>: "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
+    proof -
+      have "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+        using x(1) fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq
+        unfolding T'_def
+        by fast
+      hence "x \<in> fv\<^sub>s\<^sub>s\<^sub>t ((unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma>) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<alpha>)"
+        using transaction_fresh_subst_grounds_domain[OF step.hyps(3)] step.hyps(3)
+              labeled_stateful_strand_subst_comp[of \<sigma> "transaction_strand T" \<alpha>]
+              unlabel_subst[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>" \<alpha>]
+              unlabel_subst[of "transaction_strand T" \<sigma>]
+        by (simp add: transaction_fresh_subst_def range_vars_alt_def)
+      then obtain y where y: "\<alpha> y = Var x"
+        using transaction_renaming_subst_var_obtain[OF _ step.hyps(4)]
+        by blast
+      thus ?thesis
+        using transaction_renaming_subst_range_notin_vars[OF step.hyps(4), of y]
+              vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"]
+        by auto
+    qed
+
+    from n_cases show ?thesis
+    proof
+      assume "\<exists>z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<Gamma>\<^sub>v z = TAtom Value \<and> \<I> z = Fun n []"
+      then obtain B where B: "prefix B \<A>" "Fun n [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
+        by (metis IH n(1))
+      thus ?thesis
+        using n x_nin_\<A> trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)[of B]
+        by (metis (no_types, hide_lams) self_append_conv subset_iff subterms\<^sub>s\<^sub>e\<^sub>t_mono prefix_def)
+    qed (use n x_nin_\<A> in fastforce)
+  qed
+
+  have "?P (\<A>@T')"
+  proof (intro ballI impI)
+    fix x assume x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T')" "\<Gamma>\<^sub>v x = TAtom Value"
+    show "\<exists>B. prefix B (\<A>@T') \<and> x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> \<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
+    proof (cases "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>")
+      case False
+      hence x': "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" using x(1) unlabel_append[of \<A>] fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] by simp
+      then obtain B where B: "prefix B \<A>" "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B" "\<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
+        using x(2) 1 by moura
+      thus ?thesis using prefix_prefix by fast
+    qed (use x(2) IH prefix_prefix in fast)
+  qed
+  thus ?case unfolding T'_def by blast
+qed simp
+
+lemma admissible_transaction_occurs_checks_prop:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and \<I>: "welltyped_constraint_model \<I> \<A>"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and f: "f \<in> \<Union>(funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
+  shows "is_Val f \<Longrightarrow> \<not>public f"
+    and "\<not>is_Abs f"
+proof -
+  obtain x where x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" "f \<in> funs_term (\<I> x)" using f by moura
+  obtain T where T: "Fun f T \<sqsubseteq> \<I> x" using funs_term_Fun_subterm[OF x(2)] by moura
+
+  have \<I>_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
+    and \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
+    and \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
+    by (metis \<I> welltyped_constraint_model_def constraint_model_def,
+        metis \<I> welltyped_constraint_model_def,
+        metis \<I> welltyped_constraint_model_def constraint_model_def)
+
+  have 1: "\<Gamma> (Var x) = \<Gamma> (\<I> x)" using wt_subst_trm''[OF \<I>_wt, of "Var x"] by simp
+  hence "\<exists>a. \<Gamma> (\<I> x) = Var a"
+    using x(1) reachable_constraints_vars_TAtom_typed[OF \<A>_reach P, of x] 
+          vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"]
+    by force
+  hence "\<exists>f. \<I> x = Fun f []"
+    using x(1) wf_trm_subst[OF \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s, of "Var x"] wf_trm_Var[of x] const_type_inv_wf
+          empty_fv_exists_fun[OF interpretation_grounds[OF \<I>_interp], of "Var x"] 
+    by (metis subst_apply_term.simps(1)[of x \<I>])
+  hence 2: "\<I> x = Fun f []" using x(2) by force
+
+  have "(is_Val f \<longrightarrow> \<not>public f) \<and> \<not>is_Abs f"
+  proof (cases "\<Gamma>\<^sub>v x = TAtom Value")
+    case True
+    then obtain B where B: "prefix B \<A>" "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B" "\<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
+      using constraint_model_Value_var_in_constr_prefix[OF \<A>_reach \<I> P] x(1)
+      by fast
+  
+    have "\<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+      using B(1,3) trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel B"] unlabel_append[of B]
+      unfolding prefix_def by auto
+    hence "f \<in> \<Union>(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+      using x(2) funs_term_subterms_eq(2)[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"] by blast
+    thus ?thesis
+      using reachable_constraints_val_funs_private[OF \<A>_reach P]
+      by blast+
+  next
+    case False thus ?thesis using x 1 2 by (cases f) auto
+  qed
+  thus "is_Val f \<Longrightarrow> \<not>public f" "\<not>is_Abs f" by metis+
+qed
+
+lemma admissible_transaction_occurs_checks_prop':
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and \<I>: "welltyped_constraint_model \<I> \<A>"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and f: "f \<in> \<Union>(funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
+  shows "\<nexists>n. f = Val (n,True)"
+    and "\<nexists>n. f = Abs n"
+using admissible_transaction_occurs_checks_prop[OF \<A>_reach \<I> P f] by auto
+
+lemma transaction_var_becomes_Val:
+  assumes \<A>_reach: "\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>) \<in> reachable_constraints P"
+    and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and T: "T \<in> set P"
+    and x: "x \<in> fv_transaction T" "fst x = TAtom Value"
+  shows "\<exists>n. Fun (Val (n,False)) [] = (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I>"
+proof -
+  obtain m where m: "x = (TAtom Value, m)" by (metis x(2) eq_fst_iff)
+
+  have x_not_bvar: "x \<notin> bvars_transaction T" "fv ((\<sigma> \<circ>\<^sub>s \<alpha>) x) \<inter> bvars_transaction T = {}"
+    using x(1) transactions_fv_bvars_disj[OF P] T
+          transaction_fresh_subst_transaction_renaming_subst_vars_disj(2)[OF \<sigma> \<alpha>, of x]
+          vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
+    by blast+
+
+  show ?thesis
+  proof (cases "x \<in> subst_domain \<sigma>")
+    case True
+    then obtain n where "\<sigma> x = Fun (Val (n, False)) []"
+      using \<sigma> unfolding transaction_fresh_subst_def by fastforce
+    thus ?thesis using subst_compose[of \<sigma> \<alpha> x] by simp
+  next
+    case False
+    hence "\<sigma> x = Var x" by auto
+    then obtain n where n: "(\<sigma> \<circ>\<^sub>s \<alpha>) x = Var (TAtom Value, n)"
+      using m transaction_renaming_subst_is_renaming[OF \<alpha>] subst_compose[of \<sigma> \<alpha> x]
+      by force
+    hence "(TAtom Value, n) \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+      using x_not_bvar fv\<^sub>s\<^sub>s\<^sub>t_subst_fv_subset[OF x(1), of "\<sigma> \<circ>\<^sub>s \<alpha>"]
+            unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+      by force
+    hence "\<exists>n'. \<I> (TAtom Value, n) = Fun (Val (n',False)) []"
+      using constraint_model_Value_term_is_Val'[OF \<A>_reach \<I> P, of n] x
+            fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
+            fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] unlabel_append[of \<A>]
+      by fastforce
+    thus ?thesis using n by simp
+  qed
+qed
+
+lemma reachable_constraints_SMP_subset:
+  assumes \<A>: "\<A> \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+  shows "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<subseteq> SMP (\<Union>T \<in> set P. trms_transaction T)" (is "?A \<A>")
+    and "SMP (pair`setops\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)) \<subseteq> SMP (\<Union>T\<in>set P. pair`setops_transaction T)" (is "?B \<A>")
+proof -
+  have "?A \<A> \<and> ?B \<A>" using \<A>
+  proof (induction \<A> rule: reachable_constraints.induct)
+    case (step A T \<sigma> \<alpha>)
+    define T' where "T' \<equiv> transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+    define M where "M \<equiv> \<Union>T \<in> set P. trms_transaction T"
+    define N where "N \<equiv> \<Union>T \<in> set P. pair ` setops_transaction T"
+  
+    let ?P = "\<lambda>t. \<exists>s \<delta>. s \<in> M \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t = s \<cdot> \<delta>"
+    let ?Q = "\<lambda>t. \<exists>s \<delta>. s \<in> N \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t = s \<cdot> \<delta>"
+  
+    have IH: "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<subseteq> SMP M" "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)) \<subseteq> SMP N"
+      using step.IH by (metis M_def, metis N_def)
+  
+    have \<sigma>\<alpha>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+      using P(1) step.hyps(2)
+            transaction_fresh_subst_transaction_renaming_wt[OF step.hyps(3,4)]
+      by fast
+  
+    have \<sigma>\<alpha>_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+      using transaction_fresh_subst_range_wf_trms[OF step.hyps(3)]
+            transaction_renaming_subst_range_wf_trms[OF step.hyps(4)]
+      by (metis wf_trms_subst_compose)
+
+    have 0: "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')) = SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<union> SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
+            "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'))) =
+              SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)) \<union> SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel T'))"
+      using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of T']
+            setops\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of T']
+            trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"]
+            setops\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"]
+            unlabel_append[of A "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"]
+            image_Un[of pair "setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "setops\<^sub>s\<^sub>s\<^sub>t (unlabel T')"]
+            SMP_union[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"]
+            SMP_union[of "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel T')"]
+      by argo+
+  
+    have 1: "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<subseteq> SMP M"
+    proof (intro SMP_subset_I ballI)
+      fix t show "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<Longrightarrow> ?P t"
+        using trms\<^sub>s\<^sub>s\<^sub>t_wt_subst_ex[OF \<sigma>\<alpha>_wt \<sigma>\<alpha>_wf, of t "unlabel (transaction_strand T)"]
+              unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"] step.hyps(2)
+        unfolding T'_def M_def by auto
+    qed
+  
+    have 2: "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel T')) \<subseteq> SMP N"
+    proof (intro SMP_subset_I ballI)
+      fix t show "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel T') \<Longrightarrow> ?Q t"
+        using setops\<^sub>s\<^sub>s\<^sub>t_wt_subst_ex[OF \<sigma>\<alpha>_wt \<sigma>\<alpha>_wf, of t "unlabel (transaction_strand T)"]
+              unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"] step.hyps(2)
+        unfolding T'_def N_def by auto
+    qed
+  
+    have "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')) \<subseteq> SMP M"
+         "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'))) \<subseteq> SMP N"
+      using 0 1 2 IH by blast+
+    thus ?case unfolding T'_def M_def N_def by blast
+  qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
+  thus "?A \<A>" "?B \<A>" by metis+
+qed
+
+lemma reachable_constraints_no_Pair_fun:
+  assumes A: "A \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+  shows "Pair \<notin> \<Union>(funs_term ` SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))"
+using A
+proof (induction A rule: reachable_constraints.induct)
+  case (step A T \<sigma> \<alpha>)
+  define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+
+  have T_adm: "admissible_transaction T" using step.hyps(2) P unfolding list_all_iff by blast
+
+  have \<sigma>\<alpha>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+    using protocol_transaction_vars_TAtom_typed(3) P(1) step.hyps(2)
+          transaction_fresh_subst_transaction_renaming_wt[OF step.hyps(3,4)]
+    by fast
+
+  have \<sigma>\<alpha>_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+    using transaction_fresh_subst_range_wf_trms[OF step.hyps(3)]
+          transaction_renaming_subst_range_wf_trms[OF step.hyps(4)]
+    by (metis wf_trms_subst_compose)
+
+  have 0: "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T')) = SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<union> SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
+    using SMP_union[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"]
+          unlabel_append[of A T'] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" "unlabel T'"]
+    by simp
+
+  have 1: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
+    using reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s[OF _ reachable_constraints.step[OF step.hyps]]
+          admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P
+          trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A"] unlabel_append[of A]
+    unfolding T'_def by force
+
+  have 2: "Pair \<notin> \<Union>(funs_term ` (subst_range (\<sigma> \<circ>\<^sub>s \<alpha>)))"
+    using transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)] by force
+
+  have "Pair \<notin> \<Union>(funs_term ` (trms_transaction T))"
+    using T_adm
+    unfolding admissible_transaction_def admissible_transaction_terms_def
+    by blast
+  hence "Pair \<notin> funs_term t"
+    when t: "t \<in> trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)" for t
+    using 2 trms\<^sub>s\<^sub>s\<^sub>t_funs_term_cases[OF t]
+    by force
+  hence 3: "Pair \<notin> funs_term t" when t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for t
+    using t unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+          trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
+    unfolding T'_def by metis
+
+  have "\<exists>a. \<Gamma>\<^sub>v x = TAtom a" when "x \<in> vars_transaction T" for x
+    using that protocol_transaction_vars_TAtom_typed(1) P step.hyps(2)
+    by fast
+  hence "\<exists>a. \<Gamma>\<^sub>v x = TAtom a" when "x \<in> vars\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)" for x
+    using wt_subst_fv\<^sub>s\<^sub>e\<^sub>t_termtype_subterm[OF _ \<sigma>\<alpha>_wt \<sigma>\<alpha>_wf, of x "vars_transaction T"]
+          vars\<^sub>s\<^sub>s\<^sub>t_subst_cases[OF that]
+    by fastforce
+  hence "\<exists>a. \<Gamma>\<^sub>v x = TAtom a" when "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for x
+    using that unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+          vars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
+    unfolding T'_def
+    by simp
+  hence "\<exists>a. \<Gamma>\<^sub>v x = TAtom a" when "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" for x
+    using that fv_trms\<^sub>s\<^sub>s\<^sub>t_subset(1) by fast
+  hence "Pair \<notin> funs_term (\<Gamma> (Var x))" when "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" for x
+    using that by fastforce
+  moreover have "Pair \<in> funs_term s"
+    when s: "Ana s = (K, M)" "Pair \<in> \<Union>(funs_term ` set K)"
+    for s::"('fun,'atom,'sets) prot_term" and K M
+  proof (cases s)
+    case (Fun f S) thus ?thesis using s Ana_Fu_keys_not_pairs[of _ S K M] by (cases f) force+
+  qed (use s in simp)
+  ultimately have "Pair \<notin> funs_term t" when t: "t \<in> SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" for t
+    using t 3 SMP_funs_term[OF t _ _ 1, of Pair] funs_term_type_iff by fastforce
+  thus ?case using 0 step.IH(1) unfolding T'_def by blast
+qed simp
+
+lemma reachable_constraints_setops_form:
+  assumes A: "A \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and t: "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
+  shows "\<exists>c s. t = pair (c, Fun (Set s) []) \<and> \<Gamma> c = TAtom Value"
+using A t
+proof (induction A rule: reachable_constraints.induct)
+  case (step A T \<sigma> \<alpha>) 
+
+  have T_adm: "admissible_transaction T" when "T \<in> set P" for T
+    using P that unfolding list_all_iff by simp
+
+  have T_adm':
+      "admissible_transaction_selects T"
+      "admissible_transaction_checks T"
+      "admissible_transaction_updates T"
+    when "T \<in> set P" for T
+    using T_adm[OF that] unfolding admissible_transaction_def by simp_all
+
+  have T_valid: "wellformed_transaction T" when "T \<in> set P" for T
+    using T_adm[OF that] unfolding admissible_transaction_def by blast
+
+  have \<sigma>\<alpha>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+    using protocol_transaction_vars_TAtom_typed(3) P(1) step.hyps(2)
+          transaction_fresh_subst_transaction_renaming_wt[OF step.hyps(3,4)]
+    by fast
+
+  have \<sigma>\<alpha>_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+    using transaction_fresh_subst_range_wf_trms[OF step.hyps(3)]
+          transaction_renaming_subst_range_wf_trms[OF step.hyps(4)]
+    by (metis wf_trms_subst_compose)
+  
+  show ?case using step.IH
+  proof (cases "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)")
+    case False
+    hence "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+      using step.prems setops\<^sub>s\<^sub>s\<^sub>t_append unlabel_append
+            setops\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
+            unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+      by fastforce
+    then obtain t' \<delta> where t':
+        "t' \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))"
+        "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "t = t' \<cdot> \<delta>"
+      using setops\<^sub>s\<^sub>s\<^sub>t_wt_subst_ex[OF \<sigma>\<alpha>_wt \<sigma>\<alpha>_wf] by blast
+    then obtain s s' where s: "t' = pair (s,s')"
+      using setops\<^sub>s\<^sub>s\<^sub>t_are_pairs by fastforce
+    moreover have "InSet ac s s' = InSet Assign s s' \<or> InSet ac s s' = InSet Check s s'" for ac
+      by (cases ac) simp_all
+    ultimately have "\<exists>n. s = Var (Var Value, n)" "\<exists>u. s' = Fun (Set u) []"
+      using t'(1) setops\<^sub>s\<^sub>s\<^sub>t_member_iff[of s s' "unlabel (transaction_strand T)"]
+            pair_in_pair_image_iff[of s s']
+            transaction_inserts_are_Value_vars[
+              OF T_valid[OF step.hyps(2)] T_adm'(3)[OF step.hyps(2)], of s s']
+            transaction_deletes_are_Value_vars[
+              OF T_valid[OF step.hyps(2)] T_adm'(3)[OF step.hyps(2)], of s s']
+            transaction_selects_are_Value_vars[
+              OF T_valid[OF step.hyps(2)] T_adm'(1)[OF step.hyps(2)], of s s']
+            transaction_inset_checks_are_Value_vars[
+              OF T_valid[OF step.hyps(2)] T_adm'(2)[OF step.hyps(2)], of s s']
+            transaction_notinset_checks_are_Value_vars[
+              OF T_valid[OF step.hyps(2)] T_adm'(2)[OF step.hyps(2)], of _ _ _ s s']
+      by metis+
+    then obtain ss n where ss: "t = pair (\<delta> (Var Value, n), Fun (Set ss) [])"
+      using t'(4) s unfolding pair_def by force
+
+    have "\<Gamma> (\<delta> (Var Value, n)) = TAtom Value" "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> (Var Value, n))"
+      using t'(2) wt_subst_trm''[OF t'(2), of "Var (Var Value, n)"] apply simp
+      using t'(3) by (cases "(Var Value, n) \<in> subst_domain \<delta>") auto
+    thus ?thesis using ss by blast
+  qed simp
+qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
+
+lemma reachable_constraints_setops_type:
+  fixes t::"('fun,'atom,'sets) prot_term"
+  assumes A: "A \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and t: "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
+  shows "\<Gamma> t = TComp Pair [TAtom Value, TAtom SetType]"
+proof -
+  obtain s c where s: "t = pair (c, Fun (Set s) [])" "\<Gamma> c = TAtom Value"
+    using reachable_constraints_setops_form[OF A P t] by moura
+  hence "(Fun (Set s) []::('fun,'atom,'sets) prot_term) \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
+    using t setops\<^sub>s\<^sub>s\<^sub>t_member_iff[of c "Fun (Set s) []" "unlabel A"]
+    by force
+  hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun (Set s) []::('fun,'atom,'sets) prot_term)"
+    using reachable_constraints_wf(2) P A
+    unfolding admissible_transaction_def admissible_transaction_terms_def by blast
+  hence "arity (Set s) = 0" unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by simp
+  thus ?thesis using s unfolding pair_def by fastforce
+qed
+
+lemma reachable_constraints_setops_same_type_if_unifiable:
+  assumes A: "A \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+  shows "\<forall>s \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A). \<forall>t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A).
+          (\<exists>\<delta>. Unifier \<delta> s t) \<longrightarrow> \<Gamma> s = \<Gamma> t"
+    (is "?P A")
+using reachable_constraints_setops_type[OF A P] by simp
+
+lemma reachable_constraints_setops_unfiable_if_wt_instance_unifiable:
+  assumes A: "A \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+  shows "\<forall>s \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A). \<forall>t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A).
+          (\<exists>\<sigma> \<theta> \<rho>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>) \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>) \<and>
+                   Unifier \<rho> (s \<cdot> \<sigma>) (t \<cdot> \<theta>))
+          \<longrightarrow> (\<exists>\<delta>. Unifier \<delta> s t)"
+proof (intro ballI impI)
+  fix s t assume st: "s \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" and
+    "\<exists>\<sigma> \<theta> \<rho>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>) \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>) \<and>
+             Unifier \<rho> (s \<cdot> \<sigma>) (t \<cdot> \<theta>)"
+  then obtain \<sigma> \<theta> \<rho> where \<sigma>:
+      "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
+      "Unifier \<rho> (s \<cdot> \<sigma>) (t \<cdot> \<theta>)"
+    by moura
+
+  obtain fs ft cs ct where c:
+      "s = pair (cs, Fun (Set fs) [])" "t = pair (ct, Fun (Set ft) [])"
+      "\<Gamma> cs = TAtom Value" "\<Gamma> ct = TAtom Value" 
+    using reachable_constraints_setops_form[OF A P st(1)]
+          reachable_constraints_setops_form[OF A P st(2)]
+    by moura
+
+  have "cs \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" "ct \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
+    using c(1,2) setops_subterm_trms[OF st(1), of cs] setops_subterm_trms[OF st(2), of ct]
+          Fun_param_is_subterm[of cs "args s"] Fun_param_is_subterm[of ct "args t"]
+    unfolding pair_def by simp_all
+  moreover have
+      "\<forall>T \<in> set P. wellformed_transaction T"
+      "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
+    using P unfolding admissible_transaction_def admissible_transaction_terms_def by fast+
+  ultimately have *: "wf\<^sub>t\<^sub>r\<^sub>m cs" "wf\<^sub>t\<^sub>r\<^sub>m ct"
+    using reachable_constraints_wf(2)[OF _ _ A] wf_trms_subterms by blast+
+
+  have "(\<exists>x. cs = Var x) \<or> (\<exists>c d. cs = Fun c [])"
+    using const_type_inv_wf c(3) *(1) by (cases cs) auto
+  moreover have "(\<exists>x. ct = Var x) \<or> (\<exists>c d. ct = Fun c [])"
+    using const_type_inv_wf c(4) *(2) by (cases ct) auto
+  ultimately show "\<exists>\<delta>. Unifier \<delta> s t"
+    using reachable_constraints_setops_form[OF A P] reachable_constraints_setops_type[OF A P] st \<sigma> c
+    unfolding pair_def by auto
+qed
+
+lemma reachable_constraints_tfr:
+  assumes M:
+      "M \<equiv> \<Union>T \<in> set P. trms_transaction T"
+      "has_all_wt_instances_of \<Gamma> M N"
+      "finite N"
+      "tfr\<^sub>s\<^sub>e\<^sub>t N"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
+    and P:
+      "\<forall>T \<in> set P. admissible_transaction T"
+      "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
+    and \<A>: "\<A> \<in> reachable_constraints P"
+  shows "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
+using \<A>
+proof (induction \<A> rule: reachable_constraints.induct)
+  case (step A T \<sigma> \<alpha>)
+  define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+
+  have P':
+      "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+      "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)"
+    using P(1) protocol_transaction_vars_TAtom_typed(3) admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s
+    by blast+
+
+  have AT'_reach: "A@T' \<in> reachable_constraints P"
+    using reachable_constraints.step[OF step.hyps] unfolding T'_def by metis
+
+  have \<sigma>\<alpha>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+    using P'(1) step.hyps(2) transaction_fresh_subst_transaction_renaming_wt[OF step.hyps(3,4)]
+    by fast
+
+  have \<sigma>\<alpha>_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+    using transaction_fresh_subst_range_wf_trms[OF step.hyps(3)]
+          transaction_renaming_subst_range_wf_trms[OF step.hyps(4)]
+    by (metis wf_trms_subst_compose)
+
+  have \<sigma>\<alpha>_bvars_disj: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<inter> range_vars (\<sigma> \<circ>\<^sub>s \<alpha>) = {}"
+    by (rule transaction_fresh_subst_transaction_renaming_subst_vars_disj(4)[OF step.hyps(3,4,2)])
+
+  have wf_trms_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
+    using admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1)
+    unfolding M(1) by blast
+
+  have "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T'))"
+    using reachable_constraints_SMP_subset(1)[OF AT'_reach P'(1)]
+          tfr_subset(3)[OF M(4), of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T')"]
+          SMP_SMP_subset[of M N] SMP_I'[OF wf_trms_M M(5,2)]
+    unfolding M(1) by blast
+  moreover have "\<forall>p. Ana (pair p) = ([],[])" unfolding pair_def by auto
+  ultimately have 1: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T') \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T')))"
+    using tfr_setops_if_tfr_trms[of "unlabel (A@T')"]
+          reachable_constraints_no_Pair_fun[OF AT'_reach P(1)]
+          reachable_constraints_setops_same_type_if_unifiable[OF AT'_reach P(1)]
+          reachable_constraints_setops_unfiable_if_wt_instance_unifiable[OF AT'_reach P(1)]
+    by blast
+
+  have "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
+    using step.hyps(2) P(2) tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p
+    unfolding comp_tfr\<^sub>s\<^sub>s\<^sub>t_def tfr\<^sub>s\<^sub>s\<^sub>t_def by fastforce
+  hence "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel T')"
+    using tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_all_wt_subst_apply[OF _ \<sigma>\<alpha>_wt \<sigma>\<alpha>_wf \<sigma>\<alpha>_bvars_disj]
+          dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
+          unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+    unfolding T'_def by argo
+  hence 2: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (A@T'))"
+    using step.IH unlabel_append
+    unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by auto
+
+  have "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))" using 1 2 by (metis tfr\<^sub>s\<^sub>s\<^sub>t_def)
+  thus ?case by (metis T'_def)
+qed simp
+
+lemma reachable_constraints_tfr':
+  assumes M:
+      "M \<equiv> \<Union>T \<in> set P. trms_transaction T \<union> pair' Pair ` setops_transaction T"
+      "has_all_wt_instances_of \<Gamma> M N"
+      "finite N"
+      "tfr\<^sub>s\<^sub>e\<^sub>t N"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
+    and P:
+      "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+      "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
+      "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
+    and \<A>: "\<A> \<in> reachable_constraints P"
+  shows "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
+using \<A>
+proof (induction \<A> rule: reachable_constraints.induct)
+  case (step A T \<sigma> \<alpha>)
+  define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+
+  have AT'_reach: "A@T' \<in> reachable_constraints P"
+    using reachable_constraints.step[OF step.hyps] unfolding T'_def by metis
+
+  have \<sigma>\<alpha>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+    using P(1) step.hyps(2) transaction_fresh_subst_transaction_renaming_wt[OF step.hyps(3,4)]
+    by fast
+
+  have \<sigma>\<alpha>_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+    using transaction_fresh_subst_range_wf_trms[OF step.hyps(3)]
+          transaction_renaming_subst_range_wf_trms[OF step.hyps(4)]
+    by (metis wf_trms_subst_compose)
+
+  have \<sigma>\<alpha>_bvars_disj: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<inter> range_vars (\<sigma> \<circ>\<^sub>s \<alpha>) = {}"
+    by (rule transaction_fresh_subst_transaction_renaming_subst_vars_disj(4)[OF step.hyps(3,4,2)])
+
+  have wf_trms_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
+    using P(2) setops\<^sub>s\<^sub>s\<^sub>t_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s(2) unfolding M(1) pair_code wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric] by fast
+
+  have "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T')) \<subseteq> SMP M" "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))) \<subseteq> SMP M"
+    using reachable_constraints_SMP_subset[OF AT'_reach P(1)]
+          SMP_mono[of "\<Union>T \<in> set P. trms_transaction T" M]
+          SMP_mono[of "\<Union>T \<in> set P. pair ` setops_transaction T" M]
+    unfolding M(1) pair_code[symmetric] by blast+
+  hence 1: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T') \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T')))"
+    using tfr_subset(3)[OF M(4), of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T') \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))"]
+          SMP_union[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T')" "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))"]
+          SMP_SMP_subset[of M N] SMP_I'[OF wf_trms_M M(5,2)]
+    by blast
+
+  have "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
+    using step.hyps(2) P(3) tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p
+    unfolding comp_tfr\<^sub>s\<^sub>s\<^sub>t_def tfr\<^sub>s\<^sub>s\<^sub>t_def by fastforce
+  hence "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel T')"
+    using tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_all_wt_subst_apply[OF _ \<sigma>\<alpha>_wt \<sigma>\<alpha>_wf \<sigma>\<alpha>_bvars_disj]
+          dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
+          unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+    unfolding T'_def by argo
+  hence 2: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (A@T'))"
+    using step.IH unlabel_append
+    unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by auto
+
+  have "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))" using 1 2 by (metis tfr\<^sub>s\<^sub>s\<^sub>t_def)
+  thus ?case by (metis T'_def)
+qed simp
+
+lemma reachable_constraints_typing_cond\<^sub>s\<^sub>s\<^sub>t:
+  assumes M:
+      "M \<equiv> \<Union>T \<in> set P. trms_transaction T \<union> pair' Pair ` setops_transaction T"
+      "has_all_wt_instances_of \<Gamma> M N"
+      "finite N"
+      "tfr\<^sub>s\<^sub>e\<^sub>t N"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
+    and P:
+      "\<forall>T \<in> set P. wellformed_transaction T"
+      "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
+      "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+      "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
+    and \<A>: "\<A> \<in> reachable_constraints P"
+  shows "typing_cond\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
+using reachable_constraints_wf[OF P(1,2) \<A>] reachable_constraints_tfr'[OF M P(3,2,4) \<A>]
+unfolding typing_cond\<^sub>s\<^sub>s\<^sub>t_def by blast
+
+context
+begin
+private lemma reachable_constraints_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_aux:
+  fixes P
+  defines "Ts \<equiv> concat (map transaction_strand P)"
+  assumes P_fresh_wf: "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+    (is "\<forall>T \<in> set P. ?fresh_wf T")
+    and A: "A \<in> reachable_constraints P"
+  shows "\<forall>b \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A). \<exists>a \<in> set Ts. \<exists>\<delta>. b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<and>
+      wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and>
+      (\<forall>t \<in> subst_range \<delta>. (\<exists>x. t = Var x) \<or> (\<exists>c. t = Fun c []))"
+    (is "\<forall>b \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A). \<exists>a \<in> set Ts. ?P b a")
+using A
+proof (induction A rule: reachable_constraints.induct)
+  case (step \<A> T \<sigma> \<alpha>)
+  define Q where "Q \<equiv> ?P"
+  define \<theta> where "\<theta> \<equiv> \<sigma> \<circ>\<^sub>s \<alpha>"
+
+  let ?R = "\<lambda>A Ts. \<forall>b \<in> set A. \<exists>a \<in> set Ts. Q b a"
+
+  have T_fresh_wf: "?fresh_wf T" using step.hyps(2) P_fresh_wf by blast
+
+  have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
+       "\<forall>t \<in> subst_range \<theta>. (\<exists>x. t = Var x) \<or> (\<exists>c. t = Fun c [])"
+    using wt_subst_compose[
+            OF transaction_fresh_subst_wt[OF step.hyps(3) T_fresh_wf]
+               transaction_renaming_subst_wt[OF step.hyps(4)]]
+          wf_trms_subst_compose[
+            OF transaction_fresh_subst_range_wf_trms[OF step.hyps(3)]
+               transaction_renaming_subst_range_wf_trms[OF step.hyps(4)]]
+          transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)]
+    unfolding \<theta>_def by metis+
+  hence "?R (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) (transaction_strand T)"
+    using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_self_inverse[of "transaction_strand T"]
+    by (auto simp add: Q_def subst_apply_labeled_stateful_strand_def)
+  hence "?R (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) (transaction_strand T)"
+    by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst)
+  hence "?R (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) Ts"
+    using step.hyps(2) unfolding Ts_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by fastforce
+  thus ?case using step.IH unfolding Q_def \<theta>_def by auto
+qed simp
+
+lemma reachable_constraints_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t:
+  fixes P
+  defines "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. t \<in> M \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> fv (t \<cdot> \<delta>) = {}}"
+    and "Ts \<equiv> concat (map transaction_strand P)"
+  assumes P_pc: "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> Pair Ts M S"
+    and P_wf: "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+    and A: "A \<in> reachable_constraints P"
+  shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A ((f (set S)) - {m. intruder_synth {} m})"
+using par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_if_comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t'[OF P_pc, of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A", THEN par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t]
+      reachable_constraints_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_aux[OF P_wf A, unfolded Ts_def[symmetric]]
+unfolding f_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_self_inverse by fast
+end
+
+lemma reachable_constraints_par_comp_constr:
+  fixes P f S
+  defines "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. t \<in> M \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> fv (t \<cdot> \<delta>) = {}}"
+    and "Ts \<equiv> concat (map transaction_strand P)"
+    and "Sec \<equiv> (f (set S)) - {m. intruder_synth {} m}"
+    and "M \<equiv> \<Union>T \<in> set P. trms_transaction T \<union> pair' Pair ` setops_transaction T"
+  assumes M:
+      "has_all_wt_instances_of \<Gamma> M N"
+      "finite N"
+      "tfr\<^sub>s\<^sub>e\<^sub>t N"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
+    and P:
+      "\<forall>T \<in> set P. wellformed_transaction T"
+      "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
+      "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+      "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
+      "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> Pair Ts M_fun S"   
+    and \<A>: "\<A> \<in> reachable_constraints P"
+    and \<I>: "constraint_model \<I> \<A>"
+  shows "\<exists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> \<A> \<and>
+              ((\<forall>n. welltyped_constraint_model \<I>\<^sub>\<tau> (proj n \<A>)) \<or>
+               (\<exists>\<A>'. prefix \<A>' \<A> \<and> strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' Sec \<I>\<^sub>\<tau>))"
+proof -
+  have \<I>': "constr_sem_stateful \<I> (unlabel \<A>)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
+    using \<I> unfolding constraint_model_def by blast+
+
+  show ?thesis
+    using reachable_constraints_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t[OF P(5,3)[unfolded Ts_def] \<A>]
+          reachable_constraints_typing_cond\<^sub>s\<^sub>s\<^sub>t[OF M_def M P(1,2,3,4) \<A>]
+          par_comp_constr_stateful[OF _ _ \<I>', of Sec]
+    unfolding f_def Sec_def welltyped_constraint_model_def constraint_model_def by blast
+qed
+
+end
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy b/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy
new file mode 100644
index 0000000..6a9d519
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy
@@ -0,0 +1,3681 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 2020
+
+All Rights Reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+- Redistributions of source code must retain the above copyright
+  notice, this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer in the
+  documentation and/or other materials provided with the distribution.
+
+- Neither the name of the copyright holder nor the names of its
+  contributors may be used to endorse or promote products
+  derived from this software without specific prior written
+  permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(*  Title:      Stateful_Protocol_Verification.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>Stateful Protocol Verification\<close>
+theory Stateful_Protocol_Verification
+imports Stateful_Protocol_Model Term_Implication
+begin
+
+subsection \<open>Fixed-Point Intruder Deduction Lemma\<close>
+context stateful_protocol_model
+begin
+
+abbreviation pubval_terms::"('fun,'atom,'sets) prot_terms" where
+  "pubval_terms \<equiv> {t. \<exists>f \<in> funs_term t. is_Val f \<and> public f}"
+
+abbreviation abs_terms::"('fun,'atom,'sets) prot_terms" where
+  "abs_terms \<equiv> {t. \<exists>f \<in> funs_term t. is_Abs f}"
+
+definition intruder_deduct_GSMP::
+  "[('fun,'atom,'sets) prot_terms,
+    ('fun,'atom,'sets) prot_terms,
+    ('fun,'atom,'sets) prot_term]
+    \<Rightarrow> bool" ("\<langle>_;_\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P _" 50)
+where
+  "\<langle>M; T\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P t \<equiv> intruder_deduct_restricted M (\<lambda>t. t \<in> GSMP T - (pubval_terms \<union> abs_terms)) t"
+
+lemma intruder_deduct_GSMP_induct[consumes 1, case_names AxiomH ComposeH DecomposeH]:
+  assumes "\<langle>M; T\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P t" "\<And>t. t \<in> M \<Longrightarrow> P M t"
+          "\<And>S f. \<lbrakk>length S = arity f; public f;
+                  \<And>s. s \<in> set S \<Longrightarrow> \<langle>M; T\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P s;
+                  \<And>s. s \<in> set S \<Longrightarrow> P M s;
+                  Fun f S \<in> GSMP T - (pubval_terms \<union> abs_terms)
+                  \<rbrakk> \<Longrightarrow> P M (Fun f S)"
+          "\<And>t K T' t\<^sub>i. \<lbrakk>\<langle>M; T\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P t; P M t; Ana t = (K, T'); \<And>k. k \<in> set K \<Longrightarrow> \<langle>M; T\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P k;
+                        \<And>k. k \<in> set K \<Longrightarrow> P M k; t\<^sub>i \<in> set T'\<rbrakk> \<Longrightarrow> P M t\<^sub>i"
+  shows "P M t"
+proof -
+  let ?Q = "\<lambda>t. t \<in> GSMP T - (pubval_terms \<union> abs_terms)"
+  show ?thesis
+    using intruder_deduct_restricted_induct[of M ?Q t "\<lambda>M Q t. P M t"] assms
+    unfolding intruder_deduct_GSMP_def
+    by blast
+qed
+
+lemma pubval_terms_subst:
+  assumes "t \<cdot> \<theta> \<in> pubval_terms" "\<theta> ` fv t \<inter> pubval_terms = {}"
+  shows "t \<in> pubval_terms"
+using assms(1,2)
+proof (induction t)
+  case (Fun f T)
+  let ?P = "\<lambda>f. is_Val f \<and> public f"
+  from Fun show ?case
+  proof (cases "?P f")
+    case False
+    then obtain t where t: "t \<in> set T" "t \<cdot> \<theta> \<in> pubval_terms"
+      using Fun.prems by auto
+    hence "\<theta> ` fv t \<inter> pubval_terms = {}" using Fun.prems(2) by auto
+    thus ?thesis using Fun.IH[OF t] t(1) by auto
+  qed force
+qed simp
+
+lemma abs_terms_subst:
+  assumes "t \<cdot> \<theta> \<in> abs_terms" "\<theta> ` fv t \<inter> abs_terms = {}"
+  shows "t \<in> abs_terms"
+using assms(1,2)
+proof (induction t)
+  case (Fun f T)
+  let ?P = "\<lambda>f. is_Abs f"
+  from Fun show ?case
+  proof (cases "?P f")
+    case False
+    then obtain t where t: "t \<in> set T" "t \<cdot> \<theta> \<in> abs_terms"
+      using Fun.prems by auto
+    hence "\<theta> ` fv t \<inter> abs_terms = {}" using Fun.prems(2) by auto
+    thus ?thesis using Fun.IH[OF t] t(1) by auto
+  qed force
+qed simp
+
+lemma pubval_terms_subst':
+  assumes "t \<cdot> \<theta> \<in> pubval_terms" "\<forall>n. Val (n,True) \<notin> \<Union>(funs_term ` (\<theta> ` fv t))"
+  shows "t \<in> pubval_terms"
+proof -
+  have "\<not>public f"
+    when fs: "f \<in> funs_term s" "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv t)" "is_Val f"
+    for f s
+  proof -
+    obtain T where T: "Fun f T \<in> subterms s" using funs_term_Fun_subterm[OF fs(1)] by moura
+    hence "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv t)" using fs(2) in_subterms_subset_Union by blast
+    thus ?thesis using assms(2) funs_term_Fun_subterm'[of f T] fs(3) by (cases f) force+
+  qed
+  thus ?thesis using pubval_terms_subst[OF assms(1)] by force
+qed
+
+lemma abs_terms_subst':
+  assumes "t \<cdot> \<theta> \<in> abs_terms" "\<forall>n. Abs n \<notin> \<Union>(funs_term ` (\<theta> ` fv t))"
+  shows "t \<in> abs_terms"
+proof -
+  have "\<not>is_Abs f" when fs: "f \<in> funs_term s" "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv t)" for f s
+  proof -
+    obtain T where T: "Fun f T \<in> subterms s" using funs_term_Fun_subterm[OF fs(1)] by moura  
+    hence "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<theta> ` fv t)" using fs(2) in_subterms_subset_Union by blast
+    thus ?thesis using assms(2) funs_term_Fun_subterm'[of f T] by (cases f) auto
+  qed
+  thus ?thesis using abs_terms_subst[OF assms(1)] by force
+qed
+
+lemma pubval_terms_subst_range_disj:
+  "subst_range \<theta> \<inter> pubval_terms = {} \<Longrightarrow> \<theta> ` fv t \<inter> pubval_terms = {}"
+proof (induction t)
+  case (Var x) thus ?case by (cases "x \<in> subst_domain \<theta>") auto
+qed auto
+
+lemma abs_terms_subst_range_disj:
+  "subst_range \<theta> \<inter> abs_terms = {} \<Longrightarrow> \<theta> ` fv t \<inter> abs_terms = {}"
+proof (induction t)
+  case (Var x) thus ?case by (cases "x \<in> subst_domain \<theta>") auto
+qed auto
+
+lemma pubval_terms_subst_range_comp:
+  assumes "subst_range \<theta> \<inter> pubval_terms = {}" "subst_range \<delta> \<inter> pubval_terms = {}"
+  shows "subst_range (\<theta> \<circ>\<^sub>s \<delta>) \<inter> pubval_terms = {}"
+proof -
+  { fix t f assume t:
+      "t \<in> subst_range (\<theta> \<circ>\<^sub>s \<delta>)" "f \<in> funs_term t" "is_Val f" "public f"
+    then obtain x where x: "(\<theta> \<circ>\<^sub>s \<delta>) x = t" by auto
+    have "\<theta> x \<notin> pubval_terms" using assms(1) by (cases "\<theta> x \<in> subst_range \<theta>") force+
+    hence "(\<theta> \<circ>\<^sub>s \<delta>) x \<notin> pubval_terms"
+      using assms(2) pubval_terms_subst[of "\<theta> x" \<delta>] pubval_terms_subst_range_disj
+      by (metis (mono_tags, lifting) subst_compose_def)
+    hence False using t(2,3,4) x by blast
+  } thus ?thesis by fast
+qed
+
+lemma pubval_terms_subst_range_comp':
+  assumes "(\<theta> ` X) \<inter> pubval_terms = {}" "(\<delta> ` fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` X)) \<inter> pubval_terms = {}"
+  shows "((\<theta> \<circ>\<^sub>s \<delta>) ` X) \<inter> pubval_terms = {}"
+proof -
+  { fix t f assume t:
+      "t \<in> (\<theta> \<circ>\<^sub>s \<delta>) ` X" "f \<in> funs_term t" "is_Val f" "public f"
+    then obtain x where x: "(\<theta> \<circ>\<^sub>s \<delta>) x = t" "x \<in> X" by auto
+    have "\<theta> x \<notin> pubval_terms" using assms(1) x(2) by force
+    moreover have "fv (\<theta> x) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` X)" using x(2) by (auto simp add: fv_subset)
+    hence "\<delta> ` fv (\<theta> x) \<inter> pubval_terms = {}" using assms(2) by auto
+    ultimately have "(\<theta> \<circ>\<^sub>s \<delta>) x \<notin> pubval_terms"
+      using pubval_terms_subst[of "\<theta> x" \<delta>]
+      by (metis (mono_tags, lifting) subst_compose_def)
+    hence False using t(2,3,4) x by blast
+  } thus ?thesis by fast
+qed
+
+lemma abs_terms_subst_range_comp:
+  assumes "subst_range \<theta> \<inter> abs_terms = {}" "subst_range \<delta> \<inter> abs_terms = {}"
+  shows "subst_range (\<theta> \<circ>\<^sub>s \<delta>) \<inter> abs_terms = {}"
+proof -
+  { fix t f assume t: "t \<in> subst_range (\<theta> \<circ>\<^sub>s \<delta>)" "f \<in> funs_term t" "is_Abs f"
+    then obtain x where x: "(\<theta> \<circ>\<^sub>s \<delta>) x = t" by auto
+    have "\<theta> x \<notin> abs_terms" using assms(1) by (cases "\<theta> x \<in> subst_range \<theta>") force+
+    hence "(\<theta> \<circ>\<^sub>s \<delta>) x \<notin> abs_terms"
+      using assms(2) abs_terms_subst[of "\<theta> x" \<delta>] abs_terms_subst_range_disj
+      by (metis (mono_tags, lifting) subst_compose_def)
+    hence False using t(2,3) x by blast
+  } thus ?thesis by fast
+qed
+
+lemma abs_terms_subst_range_comp':
+  assumes "(\<theta> ` X) \<inter> abs_terms = {}" "(\<delta> ` fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` X)) \<inter> abs_terms = {}"
+  shows "((\<theta> \<circ>\<^sub>s \<delta>) ` X) \<inter> abs_terms = {}"
+proof -
+  { fix t f assume t:
+      "t \<in> (\<theta> \<circ>\<^sub>s \<delta>) ` X" "f \<in> funs_term t" "is_Abs f"
+    then obtain x where x: "(\<theta> \<circ>\<^sub>s \<delta>) x = t" "x \<in> X" by auto
+    have "\<theta> x \<notin> abs_terms" using assms(1) x(2) by force
+    moreover have "fv (\<theta> x) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` X)" using x(2) by (auto simp add: fv_subset)
+    hence "\<delta> ` fv (\<theta> x) \<inter> abs_terms = {}" using assms(2) by auto
+    ultimately have "(\<theta> \<circ>\<^sub>s \<delta>) x \<notin> abs_terms"
+      using abs_terms_subst[of "\<theta> x" \<delta>]
+      by (metis (mono_tags, lifting) subst_compose_def)
+    hence False using t(2,3) x by blast
+  } thus ?thesis by fast
+qed
+
+context
+begin
+private lemma Ana_abs_aux1:
+  fixes \<delta>::"(('fun,'atom,'sets) prot_fun, nat, ('fun,'atom,'sets) prot_var) gsubst"
+    and \<alpha>::"nat \<times> bool \<Rightarrow> 'sets set"
+  assumes "Ana\<^sub>f f = (K,T)"
+  shows "(K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> = K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (\<lambda>n. \<delta> n \<cdot>\<^sub>\<alpha> \<alpha>)"
+proof -
+  { fix k assume "k \<in> set K"
+    hence "k \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)" by force
+    hence "k \<cdot> \<delta> \<cdot>\<^sub>\<alpha> \<alpha> = k \<cdot> (\<lambda>n. \<delta> n \<cdot>\<^sub>\<alpha> \<alpha>)"
+    proof (induction k)
+      case (Fun g S)
+      have "\<And>s. s \<in> set S \<Longrightarrow> s \<cdot> \<delta> \<cdot>\<^sub>\<alpha> \<alpha> = s \<cdot> (\<lambda>n. \<delta> n \<cdot>\<^sub>\<alpha> \<alpha>)"
+        using Fun.IH in_subterms_subset_Union[OF Fun.prems] Fun_param_in_subterms[of _ S g]
+        by (meson contra_subsetD)
+      thus ?case using Ana\<^sub>f_assm1_alt[OF assms Fun.prems] by (cases g) auto
+    qed simp
+  } thus ?thesis unfolding abs_apply_list_def by force
+qed
+
+private lemma Ana_abs_aux2:
+  fixes \<alpha>::"nat \<times> bool \<Rightarrow> 'sets set"
+    and K::"(('fun,'atom,'sets) prot_fun, nat) term list"
+    and M::"nat list"
+    and T::"('fun,'atom,'sets) prot_term list"
+  assumes "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K) \<union> set M. i < length T"
+    and "(K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T) \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> = K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (\<lambda>n. T ! n \<cdot>\<^sub>\<alpha> \<alpha>)"
+  shows "(K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T) \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> = K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T)" (is "?A1 = ?A2")
+    and "(map ((!) T) M) \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> = map ((!) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T)) M" (is "?B1 = ?B2")
+proof -
+  have "T ! i \<cdot>\<^sub>\<alpha> \<alpha> = (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ! i" when "i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K)" for i
+    using that assms(1) by auto
+  hence "k \<cdot> (\<lambda>i. T ! i \<cdot>\<^sub>\<alpha> \<alpha>) = k \<cdot> (\<lambda>i. (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ! i)" when "k \<in> set K" for k
+    using that term_subst_eq_conv[of k "\<lambda>i. T ! i \<cdot>\<^sub>\<alpha> \<alpha>" "\<lambda>i. (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ! i"]
+    by auto
+  thus "?A1 = ?A2" using assms(2) by (force simp add: abs_apply_terms_def)
+
+  have "T ! i \<cdot>\<^sub>\<alpha> \<alpha> = map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T ! i" when "i \<in> set M" for i
+    using that assms(1) by auto
+  thus "?B1 = ?B2" by (force simp add: abs_apply_list_def)
+qed
+
+private lemma Ana_abs_aux1_set:
+  fixes \<delta>::"(('fun,'atom,'sets) prot_fun, nat, ('fun,'atom,'sets) prot_var) gsubst"
+    and \<alpha>::"nat \<times> bool \<Rightarrow> 'sets set"
+  assumes "Ana\<^sub>f f = (K,T)"
+  shows "(set K \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> = set K \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<lambda>n. \<delta> n \<cdot>\<^sub>\<alpha> \<alpha>)"
+proof -
+  { fix k assume "k \<in> set K"
+    hence "k \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set K)" by force
+    hence "k \<cdot> \<delta> \<cdot>\<^sub>\<alpha> \<alpha> = k \<cdot> (\<lambda>n. \<delta> n \<cdot>\<^sub>\<alpha> \<alpha>)"
+    proof (induction k)
+      case (Fun g S)
+      have "\<And>s. s \<in> set S \<Longrightarrow> s \<cdot> \<delta> \<cdot>\<^sub>\<alpha> \<alpha> = s \<cdot> (\<lambda>n. \<delta> n \<cdot>\<^sub>\<alpha> \<alpha>)"
+        using Fun.IH in_subterms_subset_Union[OF Fun.prems] Fun_param_in_subterms[of _ S g]
+        by (meson contra_subsetD)
+      thus ?case using Ana\<^sub>f_assm1_alt[OF assms Fun.prems] by (cases g) auto
+    qed simp
+  } thus ?thesis unfolding abs_apply_terms_def by force
+qed
+
+private lemma Ana_abs_aux2_set:
+  fixes \<alpha>::"nat \<times> bool \<Rightarrow> 'sets set"
+    and K::"(('fun,'atom,'sets) prot_fun, nat) terms"
+    and M::"nat set"
+    and T::"('fun,'atom,'sets) prot_term list"
+  assumes "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t K \<union> M. i < length T"
+    and "(K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) T) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> = K \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<lambda>n. T ! n \<cdot>\<^sub>\<alpha> \<alpha>)"
+  shows "(K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) T) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> = K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T)" (is "?A1 = ?A2")
+    and "((!) T ` M) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> = (!) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ` M" (is "?B1 = ?B2")
+proof -
+  have "T ! i \<cdot>\<^sub>\<alpha> \<alpha> = (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ! i" when "i \<in> fv\<^sub>s\<^sub>e\<^sub>t K" for i
+    using that assms(1) by auto
+  hence "k \<cdot> (\<lambda>i. T ! i \<cdot>\<^sub>\<alpha> \<alpha>) = k \<cdot> (\<lambda>i. (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ! i)" when "k \<in> K" for k
+    using that term_subst_eq_conv[of k "\<lambda>i. T ! i \<cdot>\<^sub>\<alpha> \<alpha>" "\<lambda>i. (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T) ! i"]
+    by auto
+  thus "?A1 = ?A2" using assms(2) by (force simp add: abs_apply_terms_def)
+
+  have "T ! i \<cdot>\<^sub>\<alpha> \<alpha> = map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) T ! i" when "i \<in> M" for i
+    using that assms(1) by auto
+  thus "?B1 = ?B2" by (force simp add: abs_apply_terms_def)
+qed
+
+lemma Ana_abs:
+  fixes t::"('fun,'atom,'sets) prot_term"
+  assumes "Ana t = (K, T)"
+  shows "Ana (t \<cdot>\<^sub>\<alpha> \<alpha>) = (K \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>, T \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>)"
+  using assms
+proof (induction t rule: Ana.induct)
+  case (1 f S)
+  obtain K' T' where *: "Ana\<^sub>f f = (K',T')" by moura
+  show ?case using 1
+  proof (cases "arity\<^sub>f f = length S \<and> arity\<^sub>f f > 0")
+    case True
+    hence "K = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) S" "T = map ((!) S) T'"
+        and **: "arity\<^sub>f f = length (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) S)" "arity\<^sub>f f > 0"
+      using 1 * by auto
+    hence "K \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> = K' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) S)"
+          "T \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> = map ((!) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) S)) T'"
+      using Ana\<^sub>f_assm2_alt[OF *] Ana_abs_aux2[OF _ Ana_abs_aux1[OF *], of T' S \<alpha>]
+      unfolding abs_apply_list_def
+      by auto
+    moreover have "Fun (Fu f) S \<cdot>\<^sub>\<alpha> \<alpha> = Fun (Fu f) (map (\<lambda>s. s \<cdot>\<^sub>\<alpha> \<alpha>) S)" by simp
+    ultimately show ?thesis using Ana_Fu_intro[OF ** *] by metis
+  qed (auto simp add: abs_apply_list_def)
+qed (simp_all add: abs_apply_list_def)
+end
+
+lemma deduct_FP_if_deduct:
+  fixes M IK FP::"('fun,'atom,'sets) prot_terms"
+  assumes IK: "IK \<subseteq> GSMP M - (pubval_terms \<union> abs_terms)" "\<forall>t \<in> IK \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>. FP \<turnstile>\<^sub>c t"
+    and t: "IK \<turnstile> t" "t \<in> GSMP M - (pubval_terms \<union> abs_terms)"
+  shows "FP \<turnstile> t \<cdot>\<^sub>\<alpha> \<alpha>"
+proof -
+  let ?P = "\<lambda>f. is_Val f \<longrightarrow> \<not>public f"
+  let ?GSMP = "GSMP M - (pubval_terms \<union> abs_terms)"
+
+  have 1: "\<forall>m \<in> IK. m \<in> ?GSMP"
+    using IK(1) by blast
+
+  have 2: "\<forall>t t'. t \<in> ?GSMP \<longrightarrow> t' \<sqsubseteq> t \<longrightarrow> t' \<in> ?GSMP"
+  proof (intro allI impI)
+    fix t t' assume t: "t \<in> ?GSMP" "t' \<sqsubseteq> t"
+    hence "t' \<in> GSMP M" using ground_subterm unfolding GSMP_def by auto
+    moreover have "\<not>public f"
+      when "f \<in> funs_term t" "is_Val f" for f
+      using t(1) that by auto
+    hence "\<not>public f"
+      when "f \<in> funs_term t'" "is_Val f" for f
+      using that subtermeq_imp_funs_term_subset[OF t(2)] by auto
+    moreover have "\<not>is_Abs f" when "f \<in> funs_term t" for f using t(1) that by auto
+    hence "\<not>is_Abs f" when "f \<in> funs_term t'" for f
+      using that subtermeq_imp_funs_term_subset[OF t(2)] by auto
+    ultimately show "t' \<in> ?GSMP" by simp
+  qed
+
+  have 3: "\<forall>t K T k. t \<in> ?GSMP \<longrightarrow> Ana t = (K, T) \<longrightarrow> k \<in> set K \<longrightarrow> k \<in> ?GSMP"
+  proof (intro allI impI)
+    fix t K T k assume t: "t \<in> ?GSMP" "Ana t = (K, T)" "k \<in> set K"
+    hence "k \<in> GSMP M" using GSMP_Ana_key by blast
+    moreover have "\<forall>f \<in> funs_term t. ?P f" using t(1) by auto
+    with t(2,3) have "\<forall>f \<in> funs_term k. ?P f"
+    proof (induction t arbitrary: k rule: Ana.induct)
+      case 1 thus ?case by (metis Ana_Fu_keys_not_pubval_terms surj_pair)
+    qed auto
+    moreover have "\<forall>f \<in> funs_term t. \<not>is_Abs f" using t(1) by auto
+    with t(2,3) have "\<forall>f \<in> funs_term k. \<not>is_Abs f"
+    proof (induction t arbitrary: k rule: Ana.induct)
+      case 1 thus ?case by (metis Ana_Fu_keys_not_abs_terms surj_pair)
+    qed auto
+    ultimately show "k \<in> ?GSMP" by simp
+  qed
+
+  have "\<langle>IK; M\<rangle> \<turnstile>\<^sub>G\<^sub>S\<^sub>M\<^sub>P t"
+    unfolding intruder_deduct_GSMP_def
+    by (rule restricted_deduct_if_deduct'[OF 1 2 3 t])
+  thus ?thesis
+  proof (induction t rule: intruder_deduct_GSMP_induct)
+    case (AxiomH t)
+    show ?case using IK(2) abs_in[OF AxiomH.hyps] by force
+  next
+    case (ComposeH T f)
+    have *: "Fun f T \<cdot>\<^sub>\<alpha> \<alpha> = Fun f (map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) T)"
+      using ComposeH.hyps(2,4)
+      by (cases f) auto
+
+    have **: "length (map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) T) = arity f"
+      using ComposeH.hyps(1)
+      by auto
+
+    show ?case
+      using intruder_deduct.Compose[OF ** ComposeH.hyps(2)] ComposeH.IH(1) *
+      by auto
+  next
+    case (DecomposeH t K T' t\<^sub>i)
+    have *: "Ana (t \<cdot>\<^sub>\<alpha> \<alpha>) = (K \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>, T' \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>)"
+      using Ana_abs[OF DecomposeH.hyps(2)]
+      by metis
+
+    have **: "t\<^sub>i \<cdot>\<^sub>\<alpha> \<alpha> \<in> set (T' \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>)"
+      using DecomposeH.hyps(4) abs_in abs_list_set_is_set_abs_set[of T']
+      by auto
+
+    have ***: "FP \<turnstile> k"
+      when k: "k \<in> set (K \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>)" for k
+    proof -
+      obtain k' where k': "k' \<in> set K" "k = k' \<cdot>\<^sub>\<alpha> \<alpha>"
+        by (metis (no_types) k abs_apply_terms_def imageE abs_list_set_is_set_abs_set)
+
+      show "FP \<turnstile> k"
+        using DecomposeH.IH k' by blast
+    qed
+
+    show ?case
+      using intruder_deduct.Decompose[OF _ * _ **]
+            DecomposeH.IH(1) ***(1)
+      by blast
+  qed
+qed
+
+end
+
+
+subsection \<open>Computing and Checking Term Implications and Messages\<close>
+context stateful_protocol_model
+begin
+
+abbreviation (input) "absc s \<equiv> (Fun (Abs s) []::('fun, 'atom, 'sets) prot_term)"
+
+fun absdbupd where
+  "absdbupd [] _ a = a"
+| "absdbupd (insert\<langle>Var y, Fun (Set s) T\<rangle>#D) x a = (
+    if x = y then absdbupd D x (insert s a) else absdbupd D x a)"
+| "absdbupd (delete\<langle>Var y, Fun (Set s) T\<rangle>#D) x a = (
+    if x = y then absdbupd D x (a - {s}) else absdbupd D x a)"
+| "absdbupd (_#D) x a = absdbupd D x a"
+
+lemma absdbupd_cons_cases:
+  "absdbupd (insert\<langle>Var x, Fun (Set s) T\<rangle>#D) x d = absdbupd D x (insert s d)"
+  "absdbupd (delete\<langle>Var x, Fun (Set s) T\<rangle>#D) x d = absdbupd D x (d - {s})"
+  "t \<noteq> Var x \<or> (\<nexists>s T. u = Fun (Set s) T) \<Longrightarrow> absdbupd (insert\<langle>t,u\<rangle>#D) x d = absdbupd D x d"
+  "t \<noteq> Var x \<or> (\<nexists>s T. u = Fun (Set s) T) \<Longrightarrow> absdbupd (delete\<langle>t,u\<rangle>#D) x d = absdbupd D x d"
+proof -
+  assume *: "t \<noteq> Var x \<or> (\<nexists>s T. u = Fun (Set s) T)"
+  let ?P = "absdbupd (insert\<langle>t,u\<rangle>#D) x d = absdbupd D x d"
+  let ?Q = "absdbupd (delete\<langle>t,u\<rangle>#D) x d = absdbupd D x d"
+  { fix y f T assume "t = Fun f T \<or> u = Var y" hence ?P ?Q by auto
+  } moreover {
+    fix y f T assume "t = Var y" "u = Fun f T" hence ?P using * by (cases f) auto
+  } moreover {
+    fix y f T assume "t = Var y" "u = Fun f T" hence ?Q using * by (cases f) auto
+  } ultimately show ?P ?Q by (metis term.exhaust)+
+qed simp_all
+
+lemma absdbupd_filter: "absdbupd S x d = absdbupd (filter is_Update S) x d"
+by (induction S x d rule: absdbupd.induct) simp_all
+
+lemma absdbupd_append:
+  "absdbupd (A@B) x d = absdbupd B x (absdbupd A x d)"
+proof (induction A arbitrary: d)
+  case (Cons a A) thus ?case
+  proof (cases a)
+    case (Insert t u) thus ?thesis
+    proof (cases "t \<noteq> Var x \<or> (\<nexists>s T. u = Fun (Set s) T)")
+      case False
+      then obtain s T where "t = Var x" "u = Fun (Set s) T" by moura
+      thus ?thesis by (simp add: Insert Cons.IH absdbupd_cons_cases(1))
+    qed (simp_all add: Cons.IH absdbupd_cons_cases(3))
+  next
+    case (Delete t u) thus ?thesis
+    proof (cases "t \<noteq> Var x \<or> (\<nexists>s T. u = Fun (Set s) T)")
+      case False
+      then obtain s T where "t = Var x" "u = Fun (Set s) T" by moura
+      thus ?thesis by (simp add: Delete Cons.IH absdbupd_cons_cases(2))
+    qed (simp_all add: Cons.IH absdbupd_cons_cases(4))
+  qed simp_all
+qed simp
+
+lemma absdbupd_wellformed_transaction:
+  assumes T: "wellformed_transaction T"
+  shows "absdbupd (unlabel (transaction_strand T)) = absdbupd (unlabel (transaction_updates T))"
+proof -
+  define S0 where "S0 \<equiv> unlabel (transaction_strand T)"
+  define S1 where "S1 \<equiv> unlabel (transaction_receive T)"
+  define S2 where "S2 \<equiv> unlabel (transaction_selects T)"
+  define S3 where "S3 \<equiv> unlabel (transaction_checks T)"
+  define S4 where "S4 \<equiv> unlabel (transaction_updates T)"
+  define S5 where "S5 \<equiv> unlabel (transaction_send T)"
+
+  note S_defs = S0_def S1_def S2_def S3_def S4_def S5_def
+
+  have 0: "list_all is_Receive S1"
+          "list_all is_Assignment S2"
+          "list_all is_Check S3"
+          "list_all is_Update S4"
+          "list_all is_Send S5"
+    using T unfolding wellformed_transaction_def S_defs by metis+
+
+  have "filter is_Update S1 = []"
+       "filter is_Update S2 = []"
+       "filter is_Update S3 = []"
+       "filter is_Update S4 = S4"
+       "filter is_Update S5 = []"
+    using list_all_filter_nil[OF 0(1), of is_Update]
+          list_all_filter_nil[OF 0(2), of is_Update]
+          list_all_filter_nil[OF 0(3), of is_Update]
+          list_all_filter_eq[OF 0(4)]
+          list_all_filter_nil[OF 0(5), of is_Update]
+    by blast+
+  moreover have "S0 = S1@S2@S3@S4@S5"
+    unfolding S_defs transaction_strand_def unlabel_def by auto
+  ultimately have "filter is_Update S0 = S4"
+    using filter_append[of is_Update] list_all_append[of is_Update]
+    by simp
+  thus ?thesis
+    using absdbupd_filter[of S0]
+    unfolding S_defs by presburger
+qed
+
+fun abs_substs_set::
+  "[('fun,'atom,'sets) prot_var list,
+    'sets set list,
+    ('fun,'atom,'sets) prot_var \<Rightarrow> 'sets set,
+    ('fun,'atom,'sets) prot_var \<Rightarrow> 'sets set]
+  \<Rightarrow> ((('fun,'atom,'sets) prot_var \<times> 'sets set) list) list"
+where
+  "abs_substs_set [] _ _ _ = [[]]"
+| "abs_substs_set (x#xs) as posconstrs negconstrs = (
+    let bs = filter (\<lambda>a. posconstrs x \<subseteq> a \<and> a \<inter> negconstrs x = {}) as
+    in concat (map (\<lambda>b. map (\<lambda>\<delta>. (x, b)#\<delta>) (abs_substs_set xs as posconstrs negconstrs)) bs))"
+
+definition abs_substs_fun::
+  "[(('fun,'atom,'sets) prot_var \<times> 'sets set) list,
+    ('fun,'atom,'sets) prot_var]
+  \<Rightarrow> 'sets set"
+where
+  "abs_substs_fun \<delta> x = (case find (\<lambda>b. fst b = x) \<delta> of Some (_,a) \<Rightarrow> a | None \<Rightarrow> {})"
+
+lemmas abs_substs_set_induct = abs_substs_set.induct[case_names Nil Cons]
+
+fun transaction_poschecks_comp::
+  "(('fun,'atom,'sets) prot_fun, ('fun,'atom,'sets) prot_var) stateful_strand
+  \<Rightarrow> (('fun,'atom,'sets) prot_var \<Rightarrow> 'sets set)"
+where
+  "transaction_poschecks_comp [] = (\<lambda>_. {})"
+| "transaction_poschecks_comp (\<langle>_: Var x \<in> Fun (Set s) []\<rangle>#T) = (
+    let f = transaction_poschecks_comp T in f(x := insert s (f x)))"
+| "transaction_poschecks_comp (_#T) = transaction_poschecks_comp T"
+
+fun transaction_negchecks_comp::
+  "(('fun,'atom,'sets) prot_fun, ('fun,'atom,'sets) prot_var) stateful_strand
+  \<Rightarrow> (('fun,'atom,'sets) prot_var \<Rightarrow> 'sets set)"
+where
+  "transaction_negchecks_comp [] = (\<lambda>_. {})"
+| "transaction_negchecks_comp (\<langle>Var x not in Fun (Set s) []\<rangle>#T) = (
+    let f = transaction_negchecks_comp T in f(x := insert s (f x)))"
+| "transaction_negchecks_comp (_#T) = transaction_negchecks_comp T"
+
+definition transaction_check_pre where
+  "transaction_check_pre FP TI T \<delta> \<equiv>
+    let C = set (unlabel (transaction_checks T));
+        S = set (unlabel (transaction_selects T));
+        xs = fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T));
+        \<theta> = \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x
+    in (\<forall>x \<in> set (transaction_fresh T). \<delta> x = {}) \<and>
+       (\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<delta>)) \<and>
+       (\<forall>u \<in> S \<union> C.
+          (is_InSet u \<longrightarrow> (
+            let x = the_elem_term u; s = the_set_term u
+            in (is_Var x \<and> is_Fun_Set s) \<longrightarrow> the_Set (the_Fun s) \<in> \<delta> (the_Var x))) \<and>
+          ((is_NegChecks u \<and> bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p u = [] \<and> the_eqs u = [] \<and> length (the_ins u) = 1) \<longrightarrow> (
+            let x = fst (hd (the_ins u)); s = snd (hd (the_ins u))
+            in (is_Var x \<and> is_Fun_Set s) \<longrightarrow> the_Set (the_Fun s) \<notin> \<delta> (the_Var x))))"
+
+definition transaction_check_post where
+  "transaction_check_post FP TI T \<delta> \<equiv>
+    let xs = fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T));
+        \<theta> = \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x;
+        u = \<lambda>\<delta> x. absdbupd (unlabel (transaction_updates T)) x (\<delta> x)
+    in (\<forall>x \<in> set xs - set (transaction_fresh T). \<delta> x \<noteq> u \<delta> x \<longrightarrow> List.member TI (\<delta> x, u \<delta> x)) \<and>
+       (\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> (u \<delta>)))"
+
+definition transaction_check_comp::
+  "[('fun,'atom,'sets) prot_term list,
+    'sets set list,
+    ('sets set \<times> 'sets set) list,
+    ('fun,'atom,'sets,'lbl) prot_transaction]
+  \<Rightarrow> ((('fun,'atom,'sets) prot_var \<times> 'sets set) list) list"
+where
+  "transaction_check_comp FP OCC TI T \<equiv>
+    let S = unlabel (transaction_strand T);
+        C = unlabel (transaction_selects T@transaction_checks T);
+        xs = filter (\<lambda>x. x \<notin> set (transaction_fresh T) \<and> fst x = TAtom Value) (fv_list\<^sub>s\<^sub>s\<^sub>t S);
+        posconstrs = transaction_poschecks_comp C;
+        negconstrs = transaction_negchecks_comp C;
+        pre_check = transaction_check_pre FP TI T
+    in filter (\<lambda>\<delta>. pre_check (abs_substs_fun \<delta>)) (abs_substs_set xs OCC posconstrs negconstrs)"
+
+definition transaction_check::
+  "[('fun,'atom,'sets) prot_term list,
+    'sets set list,
+    ('sets set \<times> 'sets set) list,
+    ('fun,'atom,'sets,'lbl) prot_transaction]
+  \<Rightarrow> bool"
+where
+  "transaction_check FP OCC TI T \<equiv>
+    list_all (\<lambda>\<delta>. transaction_check_post FP TI T (abs_substs_fun \<delta>)) (transaction_check_comp FP OCC TI T)"
+
+lemma abs_subst_fun_cons:
+  "abs_substs_fun ((x,b)#\<delta>) = (abs_substs_fun \<delta>)(x := b)"
+unfolding abs_substs_fun_def by fastforce
+
+lemma abs_substs_cons:
+  assumes "\<delta> \<in> set (abs_substs_set xs as poss negs)" "b \<in> set as" "poss x \<subseteq> b" "b \<inter> negs x = {}"
+  shows "(x,b)#\<delta> \<in> set (abs_substs_set (x#xs) as poss negs)"
+using assms by auto
+
+lemma abs_substs_cons':
+  assumes \<delta>: "\<delta> \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs)"
+    and b: "b \<in> set as" "poss x \<subseteq> b" "b \<inter> negs x = {}"
+  shows "\<delta>(x := b) \<in> abs_substs_fun ` set (abs_substs_set (x#xs) as poss negs)"
+proof -
+  obtain \<theta> where \<theta>: "\<delta> = abs_substs_fun \<theta>" "\<theta> \<in> set (abs_substs_set xs as poss negs)"
+    using \<delta> by moura
+  have "abs_substs_fun ((x, b)#\<theta>) \<in> abs_substs_fun ` set (abs_substs_set (x#xs) as poss negs)"
+    using abs_substs_cons[OF \<theta>(2) b] by blast
+  thus ?thesis
+    using \<theta>(1) abs_subst_fun_cons[of x b \<theta>] by argo
+qed
+
+lemma abs_substs_has_all_abs:
+  assumes "\<forall>x. x \<in> set xs \<longrightarrow> \<delta> x \<in> set as"
+    and "\<forall>x. x \<in> set xs \<longrightarrow> poss x \<subseteq> \<delta> x"
+    and "\<forall>x. x \<in> set xs \<longrightarrow> \<delta> x \<inter> negs x = {}"
+    and "\<forall>x. x \<notin> set xs \<longrightarrow> \<delta> x = {}"
+  shows "\<delta> \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs)"
+using assms
+proof (induction xs arbitrary: \<delta>)
+  case (Cons x xs)
+  define \<theta> where "\<theta> \<equiv> \<lambda>y. if y \<in> set xs then \<delta> y else {}"
+
+  have "\<theta> \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs)"
+    using Cons.prems Cons.IH by (simp add: \<theta>_def)
+  moreover have "\<delta> x \<in> set as" "poss x \<subseteq> \<delta> x" "\<delta> x \<inter> negs x = {}"
+    using Cons.prems(1,2,3) by fastforce+
+  ultimately have 0: "\<theta>(x := \<delta> x) \<in> abs_substs_fun ` set (abs_substs_set (x#xs) as poss negs)"
+    by (metis abs_substs_cons')
+
+  have "\<delta> = \<theta>(x := \<delta> x)"
+  proof
+    fix y show "\<delta> y = (\<theta>(x := \<delta> x)) y"
+    proof (cases "y \<in> set (x#xs)")
+      case False thus ?thesis using Cons.prems(4) by (fastforce simp add: \<theta>_def)
+    qed (auto simp add: \<theta>_def)
+  qed
+  thus ?case by (metis 0)
+qed (auto simp add: abs_substs_fun_def)
+
+lemma abs_substs_abss_bounded:
+  assumes "\<delta> \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs)"
+    and "x \<in> set xs"
+  shows "\<delta> x \<in> set as"
+    and "poss x \<subseteq> \<delta> x"
+    and "\<delta> x \<inter> negs x = {}"
+using assms
+proof (induct xs as poss negs arbitrary: \<delta> rule: abs_substs_set_induct)
+  case (Cons y xs as poss negs)
+  { case 1 thus ?case using Cons.hyps(1) unfolding abs_substs_fun_def by fastforce }
+
+  { case 2 thus ?case
+    proof (cases "x = y")
+      case False
+      then obtain \<delta>' where \<delta>':
+          "\<delta>' \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs)" "\<delta>' x = \<delta> x"
+        using 2 unfolding abs_substs_fun_def by force
+      moreover have "x \<in> set xs" using 2(2) False by simp
+      moreover have "\<exists>b. b \<in> set as \<and> poss y \<subseteq> b \<and> b \<inter> negs y = {}"
+        using 2 False by auto
+      ultimately show ?thesis using Cons.hyps(2) by fastforce
+    qed (auto simp add: abs_substs_fun_def)
+  }
+
+  { case 3 thus ?case
+    proof (cases "x = y")
+      case False
+      then obtain \<delta>' where \<delta>':
+          "\<delta>' \<in> abs_substs_fun ` set (abs_substs_set xs as poss negs)" "\<delta>' x = \<delta> x"
+        using 3 unfolding abs_substs_fun_def by force
+      moreover have "x \<in> set xs" using 3(2) False by simp
+      moreover have "\<exists>b. b \<in> set as \<and> poss y \<subseteq> b \<and> b \<inter> negs y = {}"
+        using 3 False by auto
+      ultimately show ?thesis using Cons.hyps(3) by fastforce
+    qed (auto simp add: abs_substs_fun_def)
+  }
+qed (simp_all add: abs_substs_fun_def)
+
+lemma transaction_poschecks_comp_unfold:
+  "transaction_poschecks_comp C x = {s. \<exists>a. \<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> set C}"
+proof (induction C)
+  case (Cons c C) thus ?case
+  proof (cases "\<exists>a y s. c = \<langle>a: Var y \<in> Fun (Set s) []\<rangle>")
+    case True
+    then obtain a y s where c: "c = \<langle>a: Var y \<in> Fun (Set s) []\<rangle>" by moura
+
+    define f where "f \<equiv> transaction_poschecks_comp C"
+
+    have "transaction_poschecks_comp (c#C) = f(y := insert s (f y))"
+      using c by (simp add: f_def Let_def)
+    moreover have "f x = {s. \<exists>a. \<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> set C}"
+      using Cons.IH unfolding f_def by blast
+    ultimately show ?thesis using c by auto
+  next
+    case False
+    hence "transaction_poschecks_comp (c#C) = transaction_poschecks_comp C" (is ?P)
+      using transaction_poschecks_comp.cases[of "c#C" ?P] by force
+    thus ?thesis using False Cons.IH by auto
+  qed
+qed simp
+
+lemma transaction_poschecks_comp_notin_fv_empty:
+  assumes "x \<notin> fv\<^sub>s\<^sub>s\<^sub>t C"
+  shows "transaction_poschecks_comp C x = {}"
+using assms transaction_poschecks_comp_unfold[of C x] by fastforce
+
+lemma transaction_negchecks_comp_unfold:
+  "transaction_negchecks_comp C x = {s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> set C}"
+proof (induction C)
+  case (Cons c C) thus ?case
+  proof (cases "\<exists>y s. c = \<langle>Var y not in Fun (Set s) []\<rangle>")
+    case True
+    then obtain y s where c: "c = \<langle>Var y not in Fun (Set s) []\<rangle>" by moura
+
+    define f where "f \<equiv> transaction_negchecks_comp C"
+
+    have "transaction_negchecks_comp (c#C) = f(y := insert s (f y))"
+      using c by (simp add: f_def Let_def)
+    moreover have "f x = {s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> set C}"
+      using Cons.IH unfolding f_def by blast
+    ultimately show ?thesis using c by auto
+  next
+    case False
+    hence "transaction_negchecks_comp (c#C) = transaction_negchecks_comp C" (is ?P)
+      using transaction_negchecks_comp.cases[of "c#C" ?P] 
+      by force
+    thus ?thesis using False Cons.IH by fastforce
+  qed
+qed simp  
+
+lemma transaction_negchecks_comp_notin_fv_empty:
+  assumes "x \<notin> fv\<^sub>s\<^sub>s\<^sub>t C"
+  shows "transaction_negchecks_comp C x = {}"
+using assms transaction_negchecks_comp_unfold[of C x] by fastforce
+
+lemma transaction_check_preI[intro]:
+  fixes T
+  defines "\<theta> \<equiv> \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x"
+    and "S \<equiv> set (unlabel (transaction_selects T))"
+    and "C \<equiv> set (unlabel (transaction_checks T))"
+  assumes a0: "\<forall>x \<in> set (transaction_fresh T). \<delta> x = {}"
+    and a1: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> \<delta> x \<in> set OCC"
+    and a2: "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<delta>)"
+    and a3: "\<forall>a x s. \<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> S \<union> C \<longrightarrow> s \<in> \<delta> x"
+    and a4: "\<forall>x s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> S \<union> C \<longrightarrow> s \<notin> \<delta> x"
+  shows "transaction_check_pre FP TI T \<delta>"
+proof -
+  let ?P = "\<lambda>u. is_InSet u \<longrightarrow> (
+    let x = the_elem_term u; s = the_set_term u
+    in (is_Var x \<and> is_Fun_Set s) \<longrightarrow> the_Set (the_Fun s) \<in> \<delta> (the_Var x))"
+
+  let ?Q = "\<lambda>u. (is_NegChecks u \<and> bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p u = [] \<and> the_eqs u = [] \<and> length (the_ins u) = 1) \<longrightarrow> (
+    let x = fst (hd (the_ins u)); s = snd (hd (the_ins u))
+    in (is_Var x \<and> is_Fun_Set s) \<longrightarrow> the_Set (the_Fun s) \<notin> \<delta> (the_Var x))"
+
+  have 1: "?P u" when u: "u \<in> S \<union> C" for u
+    apply (unfold Let_def, intro impI, elim conjE)
+    using u a3 Fun_Set_InSet_iff[of u] by metis
+
+  have 2: "?Q u" when u: "u \<in> S \<union> C" for u
+    apply (unfold Let_def, intro impI, elim conjE)
+    using u a4 Fun_Set_NotInSet_iff[of u] by metis
+
+  show ?thesis
+    using a0 a1 a2 1 2 fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
+    unfolding transaction_check_pre_def \<theta>_def S_def C_def Let_def
+    by blast
+qed
+
+lemma transaction_check_pre_InSetE:
+  assumes T: "transaction_check_pre FP TI T \<delta>"
+    and u: "u = \<langle>a: Var x \<in> Fun (Set s) []\<rangle>"
+           "u \<in> set (unlabel (transaction_selects T)) \<union> set (unlabel (transaction_checks T))"
+  shows "s \<in> \<delta> x"
+proof -
+  have "is_InSet u \<longrightarrow> is_Var (the_elem_term u) \<and> is_Fun_Set (the_set_term u) \<longrightarrow>
+        the_Set (the_Fun (the_set_term u)) \<in> \<delta> (the_Var (the_elem_term u))"
+    using T u unfolding transaction_check_pre_def Let_def by blast
+  thus ?thesis using Fun_Set_InSet_iff[of u a x s] u by argo
+qed
+
+lemma transaction_check_pre_NotInSetE:
+  assumes T: "transaction_check_pre FP TI T \<delta>"
+    and u: "u = \<langle>Var x not in Fun (Set s) []\<rangle>"
+           "u \<in> set (unlabel (transaction_selects T)) \<union> set (unlabel (transaction_checks T))"
+  shows "s \<notin> \<delta> x"
+proof -
+  have "is_NegChecks u \<and> bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p u = [] \<and> the_eqs u = [] \<and> length (the_ins u) = 1 \<longrightarrow>
+         is_Var (fst (hd (the_ins u))) \<and> is_Fun_Set (snd (hd (the_ins u))) \<longrightarrow>
+         the_Set (the_Fun (snd (hd (the_ins u)))) \<notin> \<delta> (the_Var (fst (hd (the_ins u))))"
+    using T u unfolding transaction_check_pre_def Let_def by blast
+  thus ?thesis using Fun_Set_NotInSet_iff[of u  x s] u by argo
+qed
+
+lemma transaction_check_compI[intro]:
+  assumes T: "transaction_check_pre FP TI T \<delta>"
+    and T_adm: "admissible_transaction T"
+    and x1: "\<forall>x. (x \<in> fv_transaction T - set (transaction_fresh T) \<and> fst x = TAtom Value)
+                  \<longrightarrow> \<delta> x \<in> set OCC"
+    and x2: "\<forall>x. (x \<notin> fv_transaction T - set (transaction_fresh T) \<or> fst x \<noteq> TAtom Value)
+                  \<longrightarrow> \<delta> x = {}"
+  shows "\<delta> \<in> abs_substs_fun ` set (transaction_check_comp FP OCC TI T)"
+proof -
+  define S where "S \<equiv> unlabel (transaction_strand T)"
+  define C where "C \<equiv> unlabel (transaction_selects T@transaction_checks T)"
+  define C' where "C' \<equiv> set (unlabel (transaction_selects T)) \<union>
+                        set (unlabel (transaction_checks T))"
+
+  let ?xs = "fv_list\<^sub>s\<^sub>s\<^sub>t S"
+
+  define poss where "poss \<equiv> transaction_poschecks_comp C"
+  define negs where "negs \<equiv> transaction_negchecks_comp C"
+  define ys where "ys \<equiv> filter (\<lambda>x. x \<notin> set (transaction_fresh T) \<and> fst x = TAtom Value) ?xs"
+
+  have C_C'_eq: "set C = C'"
+    using unlabel_append[of "transaction_selects T" "transaction_checks T"]
+    unfolding C_def C'_def by simp
+
+  have ys: "{x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value} = set ys"
+    using fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of S]
+    unfolding ys_def S_def by force
+  
+  have "\<delta> x \<in> set OCC"
+    when x: "x \<in> set ys" for x
+    using x1 x ys by blast
+  moreover have "\<delta> x = {}"
+    when x: "x \<notin> set ys" for x
+    using x2 x ys by blast
+  moreover have "poss x \<subseteq> \<delta> x" when x: "x \<in> set ys" for x
+  proof -
+    have "s \<in> \<delta> x" when u: "u = \<langle>a: Var x \<in> Fun (Set s) []\<rangle>" "u \<in> C'" for u a s
+      using T u transaction_check_pre_InSetE[of FP TI T \<delta>]
+      unfolding C'_def by blast
+    thus ?thesis
+      using transaction_poschecks_comp_unfold[of C x] C_C'_eq
+      unfolding poss_def by blast
+  qed
+  moreover have "\<delta> x \<inter> negs x = {}" when x: "x \<in> set ys" for x
+  proof (cases "x \<in> fv\<^sub>s\<^sub>s\<^sub>t C")
+    case True
+    hence "s \<notin> \<delta> x" when u: "u = \<langle>Var x not in Fun (Set s) []\<rangle>" "u \<in> C'" for u s
+      using T u transaction_check_pre_NotInSetE[of FP TI T \<delta>]
+      unfolding C'_def by blast
+    thus ?thesis
+      using transaction_negchecks_comp_unfold[of C x] C_C'_eq
+      unfolding negs_def by blast
+  next
+    case False
+    hence "negs x = {}"
+      using x C_C'_eq transaction_negchecks_comp_notin_fv_empty
+      unfolding negs_def by blast
+    thus ?thesis by blast
+  qed
+  ultimately have "\<delta> \<in> abs_substs_fun ` set (abs_substs_set ys OCC poss negs)"
+    using abs_substs_has_all_abs[of ys \<delta> OCC poss negs] 
+    by fast
+  thus ?thesis
+    using T
+    unfolding transaction_check_comp_def Let_def S_def C_def ys_def poss_def negs_def
+    by fastforce
+qed
+
+context
+begin
+private lemma transaction_check_comp_in_aux:
+  fixes T
+  defines "S \<equiv> set (unlabel (transaction_selects T))"
+    and "C \<equiv> set (unlabel (transaction_checks T))"
+  assumes T_adm: "admissible_transaction T"
+    and a1: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> (\<forall>s.
+          select\<langle>Var x, Fun (Set s) []\<rangle> \<in> S \<longrightarrow> s \<in> \<alpha> x)"
+    and a2: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> (\<forall>s.
+          \<langle>Var x in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<in> \<alpha> x)"
+    and a3: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> (\<forall>s.
+          \<langle>Var x not in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<notin> \<alpha> x)"
+  shows "\<forall>a x s. \<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> S \<union> C \<longrightarrow> s \<in> \<alpha> x" (is ?A)
+    and "\<forall>x s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> S \<union> C \<longrightarrow> s \<notin> \<alpha> x" (is ?B)
+proof -
+  have T_valid: "wellformed_transaction T"
+      and T_adm_S: "admissible_transaction_selects T"
+      and T_adm_C: "admissible_transaction_checks T"
+    using T_adm unfolding admissible_transaction_def by blast+
+
+  note * = admissible_transaction_strand_step_cases(2,3)[OF T_adm]
+
+  have 1: "fst x = TAtom Value" "x \<in> fv_transaction T - set (transaction_fresh T)"
+    when x: "\<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> S \<union> C" for a x s
+    using * x unfolding S_def C_def by fast+
+
+  have 2: "fst x = TAtom Value" "x \<in> fv_transaction T - set (transaction_fresh T)"
+    when x: "\<langle>Var x not in Fun (Set s) []\<rangle> \<in> S \<union> C" for x s
+    using * x unfolding S_def C_def by fast+
+
+  have 3: "select\<langle>Var x, Fun (Set s) []\<rangle> \<in> S"
+    when x: "select\<langle>Var x, Fun (Set s) []\<rangle> \<in> S \<union> C" for x s
+    using * x unfolding S_def C_def by fast
+
+  have 4: "\<langle>Var x in Fun (Set s) []\<rangle> \<in> C"
+    when x: "\<langle>Var x in Fun (Set s) []\<rangle> \<in> S \<union> C" for x s
+    using * x unfolding S_def C_def by fast
+
+  have 5: "\<langle>Var x not in Fun (Set s) []\<rangle> \<in> C"
+    when x: "\<langle>Var x not in Fun (Set s) []\<rangle> \<in> S \<union> C" for x s
+    using * x unfolding S_def C_def by fast
+
+  show ?A
+  proof (intro allI impI)
+    fix a x s assume u: "\<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> S \<union> C"
+    thus "s \<in> \<alpha> x" using 1 3 4 a1 a2 by (cases a) metis+
+  qed
+
+  show ?B
+  proof (intro allI impI)
+    fix x s assume u: "\<langle>Var x not in Fun (Set s) []\<rangle> \<in> S \<union> C"
+    thus "s \<notin> \<alpha> x" using 2 5 a3 by meson
+  qed
+qed
+
+lemma transaction_check_comp_in:
+  fixes T
+  defines "\<theta> \<equiv> \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x"
+    and "S \<equiv> set (unlabel (transaction_selects T))"
+    and "C \<equiv> set (unlabel (transaction_checks T))"
+  assumes T_adm: "admissible_transaction T"
+    and a1: "\<forall>x \<in> set (transaction_fresh T). \<alpha> x = {}"
+    and a2: "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<alpha>)"
+    and a3: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). \<forall>s.
+          select\<langle>Var x, Fun (Set s) []\<rangle> \<in> S \<longrightarrow> s \<in> \<alpha> x"
+    and a4: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). \<forall>s.
+          \<langle>Var x in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<in> \<alpha> x"
+    and a5: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). \<forall>s.
+          \<langle>Var x not in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<notin> \<alpha> x"
+    and a6: "\<forall>x \<in> fv_transaction T - set (transaction_fresh T).
+          fst x = TAtom Value \<longrightarrow> \<alpha> x \<in> set OCC"
+  shows "\<exists>\<delta> \<in> abs_substs_fun ` set (transaction_check_comp FP OCC TI T). \<forall>x \<in> fv_transaction T.
+          fst x = TAtom Value \<longrightarrow> \<alpha> x = \<delta> x"
+proof -
+  let ?xs = "fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))"
+  let ?ys = "filter (\<lambda>x. x \<notin> set (transaction_fresh T)) ?xs"
+
+  define \<alpha>' where "\<alpha>' \<equiv> \<lambda>x.
+    if x \<in> fv_transaction T - set (transaction_fresh T) \<and> fst x = TAtom Value
+    then \<alpha> x
+    else {}"
+
+  have T_valid: "wellformed_transaction T"
+    using T_adm unfolding admissible_transaction_def by blast
+
+  have \<theta>\<alpha>_Fun: "is_Fun (t \<cdot> \<theta> \<alpha>) \<longleftrightarrow> is_Fun (t \<cdot> \<theta> \<alpha>')" for t
+    unfolding \<alpha>'_def \<theta>_def
+    by (induct t) auto
+
+  have "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<alpha>')"
+  proof (intro ballI impI)
+    fix t assume t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
+
+    have 1: "intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<alpha>)"
+      using t a2
+      by auto
+
+    obtain r where r:
+        "r \<in> set (unlabel (transaction_receive T))"
+        "t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r"
+      using t by auto
+    hence "r = receive\<langle>t\<rangle>"
+      using wellformed_transaction_unlabel_cases(1)[OF T_valid]
+      by fastforce
+    hence 2: "fv t \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" using r by force
+
+    have "fv t \<subseteq> fv_transaction T"
+      by (metis (no_types, lifting) 2 transaction_strand_def sst_vars_append_subset(1)
+                unlabel_append subset_Un_eq sup.bounded_iff)
+    moreover have "fv t \<inter> set (transaction_fresh T) = {}"
+      using 2 T_valid vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_receive T)"]
+      unfolding wellformed_transaction_def
+      by fast
+    ultimately have "\<theta> \<alpha> x = \<theta> \<alpha>' x" when "x \<in> fv t" for x
+      using that unfolding \<alpha>'_def \<theta>_def by fastforce
+    hence 3: "t \<cdot> \<theta> \<alpha> = t \<cdot> \<theta> \<alpha>'"
+      using term_subst_eq by blast
+
+    show "intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> \<alpha>')" using 1 3 by simp
+  qed
+  moreover have
+      "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> (\<forall>s.
+          select\<langle>Var x, Fun (Set s) []\<rangle> \<in> S \<longrightarrow> s \<in> \<alpha>' x)"
+      "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> (\<forall>s.
+          \<langle>Var x in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<in> \<alpha>' x)"
+      "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \<longrightarrow> (\<forall>s.
+          \<langle>Var x not in Fun (Set s) []\<rangle> \<in> C \<longrightarrow> s \<notin> \<alpha>' x)"
+    using a3 a4 a5
+    unfolding \<alpha>'_def \<theta>_def S_def C_def
+    by meson+
+  hence "\<forall>a x s. \<langle>a: Var x \<in> Fun (Set s) []\<rangle> \<in> S \<union> C \<longrightarrow> s \<in> \<alpha>' x"
+        "\<forall>x s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> S \<union> C \<longrightarrow> s \<notin> \<alpha>' x"
+    using transaction_check_comp_in_aux[OF T_adm, of \<alpha>']
+    unfolding S_def C_def
+    by fast+
+  ultimately have 4: "transaction_check_pre FP TI T \<alpha>'"
+    using a6 transaction_check_preI[of T \<alpha>' OCC FP TI]
+    unfolding \<alpha>'_def \<theta>_def S_def C_def by simp
+
+  have 5: "\<forall>x \<in> fv_transaction T. fst x = TAtom Value \<longrightarrow> \<alpha> x = \<alpha>' x"
+    using a1 by (auto simp add: \<alpha>'_def)
+
+  have 6: "\<alpha>' \<in> abs_substs_fun ` set (transaction_check_comp FP OCC TI T)"
+    using transaction_check_compI[OF 4 T_adm] a6
+    unfolding \<alpha>'_def
+    by auto
+
+  show ?thesis using 5 6 by blast
+qed
+end
+
+end
+
+
+subsection \<open>Automatically Checking Protocol Security in a Typed Model\<close>
+context stateful_protocol_model
+begin
+
+definition abs_intruder_knowledge ("\<alpha>\<^sub>i\<^sub>k") where
+  "\<alpha>\<^sub>i\<^sub>k S \<I> \<equiv> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<I>)"
+
+definition abs_value_constants ("\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s") where
+  "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s S \<I> \<equiv> {t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>. \<exists>n. t = Fun (Val n) []} \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<I>)"
+
+definition abs_term_implications ("\<alpha>\<^sub>t\<^sub>i") where
+  "\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I> \<equiv> {(s,t) | s t x.
+    s \<noteq> t \<and> x \<in> fv_transaction T \<and> x \<notin> set (transaction_fresh T) \<and>
+    Fun (Abs s) [] = (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) \<and>
+    Fun (Abs t) [] = (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>)}"
+
+lemma abs_intruder_knowledge_append:
+  "\<alpha>\<^sub>i\<^sub>k (A@B) \<I> =
+    (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) \<I>) \<union>
+    (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) \<I>)"
+by (metis unlabel_append abs_set_union image_Un ik\<^sub>s\<^sub>s\<^sub>t_append abs_intruder_knowledge_def)
+
+lemma abs_value_constants_append:
+  fixes A B::"('a,'b,'c,'d) prot_strand"
+  shows "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s (A@B) \<I> =
+      {t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>. \<exists>n. t = Fun (Val n) []} \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) \<I>) \<union>
+      {t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>. \<exists>n. t = Fun (Val n) []} \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) \<I>)"
+proof -
+  define a0 where "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B)) \<I>)"
+  define M where "M \<equiv> \<lambda>a::('a,'b,'c,'d) prot_strand.
+                            {t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t a) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>. \<exists>n. t = Fun (Val n) []}"
+
+  have "M (A@B) = M A \<union> M B"
+    using unlabel_append[of A B] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" "unlabel B"]
+          image_Un[of "\<lambda>x. x \<cdot> \<I>" "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"]
+    unfolding M_def by force
+  hence "M (A@B) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0 = (M A \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0) \<union> (M B \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0)" by (simp add: abs_set_union)
+  thus ?thesis unfolding abs_value_constants_def a0_def M_def by blast
+qed
+
+lemma transaction_renaming_subst_has_no_pubconsts_abss:
+  fixes \<alpha>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_renaming_subst \<alpha> P A"
+  shows "subst_range \<alpha> \<inter> pubval_terms = {}" (is ?A)
+    and "subst_range \<alpha> \<inter> abs_terms = {}" (is ?B)
+proof -
+  { fix t assume "t \<in> subst_range \<alpha>"
+    then obtain x where "t = Var x" 
+      using transaction_renaming_subst_is_renaming[OF assms]
+      by force
+    hence "t \<notin> pubval_terms" "t \<notin> abs_terms" by simp_all
+  } thus ?A ?B by auto
+qed
+
+lemma transaction_fresh_subst_has_no_pubconsts_abss:
+  fixes \<sigma>::"('fun,'atom,'sets) prot_subst"
+  assumes "transaction_fresh_subst \<sigma> T \<A>"
+  shows "subst_range \<sigma> \<inter> pubval_terms = {}" (is ?A)
+    and "subst_range \<sigma> \<inter> abs_terms = {}" (is ?B)
+proof -
+  { fix t assume "t \<in> subst_range \<sigma>"
+    then obtain n where "t = Fun (Val (n,False)) []" 
+      using assms unfolding transaction_fresh_subst_def
+      by force
+    hence "t \<notin> pubval_terms" "t \<notin> abs_terms" by simp_all
+  } thus ?A ?B by auto
+qed
+
+lemma reachable_constraints_no_pubconsts_abss:
+  assumes "\<A> \<in> reachable_constraints P"
+    and P: "\<forall>T \<in> set P. \<forall>n. Val (n,True) \<notin> \<Union>(funs_term ` trms_transaction T)"
+           "\<forall>T \<in> set P. \<forall>n. Abs n \<notin> \<Union>(funs_term ` trms_transaction T)"
+           "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+           "\<forall>T \<in> set P. bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = {}"
+    and \<I>: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
+           "\<forall>n. Val (n,True) \<notin> \<Union>(funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
+           "\<forall>n. Abs n \<notin> \<Union>(funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
+  shows "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> GSMP (\<Union>T \<in> set P. trms_transaction T) - (pubval_terms \<union> abs_terms)"
+    (is "?A \<subseteq> ?B")
+using assms(1) \<I>(4,5)
+proof (induction \<A> rule: reachable_constraints.induct)
+  case (step \<A> T \<sigma> \<alpha>)
+  define trms_P where "trms_P \<equiv> (\<Union>T \<in> set P. trms_transaction T)"
+  define T' where "T' \<equiv> transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+
+  have \<I>': "\<forall>n. Val (n,True) \<notin> \<Union> (funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
+           "\<forall>n. Abs n \<notin> \<Union> (funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
+    using step.prems fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] unlabel_append[of \<A>]
+    by auto
+
+  have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+    using transaction_renaming_subst_wt[OF step.hyps(4)]
+          transaction_fresh_subst_wt[OF step.hyps(3)]
+    by (metis step.hyps(2) P(3) wt_subst_compose)
+  hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<alpha>))" for X
+    using wt_subst_rm_vars[of "\<sigma> \<circ>\<^sub>s \<alpha>" "set X"]
+    by metis
+  hence wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t ((rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<alpha>)) \<circ>\<^sub>s \<I>)" for X
+    using \<I>(2) wt_subst_compose by fast
+
+  have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<sigma> \<circ>\<^sub>s \<alpha>))"
+    using transaction_fresh_subst_range_wf_trms[OF step.hyps(3)]
+          transaction_renaming_subst_range_wf_trms[OF step.hyps(4)]
+    by (metis wf_trms_subst_compose)
+  hence wftrms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range ((rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<alpha>)) \<circ>\<^sub>s \<I>))" for X
+    using wf_trms_subst_compose[OF wf_trms_subst_rm_vars' \<I>(3)] by fast
+
+  have "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> ?B"
+  proof
+    fix t assume "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
+    hence "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq by blast
+    then obtain s X where s:
+        "s \<in> trms_transaction T"
+        "t = s \<cdot> rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<alpha>) \<circ>\<^sub>s \<I>"
+        "set X \<subseteq> bvars_transaction T"
+      using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst'' unfolding T'_def by blast
+
+    define \<theta> where "\<theta> \<equiv> rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<alpha>)"
+
+    have 1: "s \<in> trms_P" using step.hyps(2) s(1) unfolding trms_P_def by auto
+
+    have s_nin: "s \<notin> pubval_terms" "s \<notin> abs_terms"
+      using 1 P(1,2) funs_term_Fun_subterm
+      unfolding trms_P_def is_Val_def is_Abs_def
+      by fastforce+
+
+    have 2: "(\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')) \<inter> pubval_terms = {}"
+            "(\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')) \<inter> abs_terms = {}"
+            "subst_range (\<sigma> \<circ>\<^sub>s \<alpha>) \<inter> pubval_terms = {}"
+            "subst_range (\<sigma> \<circ>\<^sub>s \<alpha>) \<inter> abs_terms = {}"
+            "subst_range \<theta> \<inter> pubval_terms = {}"
+            "subst_range \<theta> \<inter> abs_terms = {}"
+            "(\<theta> ` fv s) \<inter> pubval_terms = {}"
+            "(\<theta> ` fv s) \<inter> abs_terms = {}"
+      unfolding T'_def \<theta>_def
+      using step.prems funs_term_Fun_subterm
+      apply (fastforce simp add: is_Val_def,
+             fastforce simp add: is_Abs_def)
+      using pubval_terms_subst_range_comp[OF 
+              transaction_fresh_subst_has_no_pubconsts_abss(1)[OF step.hyps(3)]
+              transaction_renaming_subst_has_no_pubconsts_abss(1)[OF step.hyps(4)]]
+            abs_terms_subst_range_comp[OF 
+              transaction_fresh_subst_has_no_pubconsts_abss(2)[OF step.hyps(3)]
+              transaction_renaming_subst_has_no_pubconsts_abss(2)[OF step.hyps(4)]]
+      unfolding is_Val_def is_Abs_def
+      by force+
+    
+    have "(\<I> ` fv (s \<cdot> \<theta>)) \<inter> pubval_terms = {}"
+         "(\<I> ` fv (s \<cdot> \<theta>)) \<inter> abs_terms = {}"
+    proof -
+      have "\<theta> = \<sigma> \<circ>\<^sub>s \<alpha>" "bvars_transaction T = {}" "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
+        using s(3) P(4) step.hyps(2) rm_vars_empty
+              vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel T'"]
+              bvars\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel (transaction_strand T)" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+              unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+        unfolding \<theta>_def T'_def by simp_all
+      hence "fv (s \<cdot> \<theta>) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"
+        using trms\<^sub>s\<^sub>s\<^sub>t_fv_subst_subset[OF s(1), of \<theta>] unlabel_subst[of "transaction_strand T" \<theta>]
+        unfolding T'_def by auto
+      moreover have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"
+        using fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"]
+              unlabel_append[of \<A> "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"]
+              fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of T']
+        by simp_all
+      hence "\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<inter> pubval_terms = {}" "\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<inter> abs_terms = {}"
+        using 2(1,2) by blast+
+      ultimately show "(\<I> ` fv (s \<cdot> \<theta>)) \<inter> pubval_terms = {}" "(\<I> ` fv (s \<cdot> \<theta>)) \<inter> abs_terms = {}"
+        by blast+
+    qed
+    hence \<sigma>\<alpha>\<I>_disj: "((\<theta> \<circ>\<^sub>s \<I>) ` fv s) \<inter> pubval_terms = {}" 
+                    "((\<theta> \<circ>\<^sub>s \<I>) ` fv s) \<inter> abs_terms = {}" 
+      using pubval_terms_subst_range_comp'[of \<theta> "fv s" \<I>]
+            abs_terms_subst_range_comp'[of \<theta> "fv s" \<I>]
+            2(7,8)
+      by (simp_all add: subst_apply_fv_unfold)
+    
+    have 3: "t \<notin> pubval_terms" "t \<notin> abs_terms"
+      using s(2) s_nin \<sigma>\<alpha>\<I>_disj
+            pubval_terms_subst[of s "rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<alpha>) \<circ>\<^sub>s \<I>"]
+            pubval_terms_subst_range_disj[of "rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<alpha>) \<circ>\<^sub>s \<I>" s]
+            abs_terms_subst[of s "rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<alpha>) \<circ>\<^sub>s \<I>"]
+            abs_terms_subst_range_disj[of "rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<alpha>) \<circ>\<^sub>s \<I>" s]
+      unfolding \<theta>_def
+      by blast+
+
+    have "t \<in> SMP trms_P" "fv t = {}"
+      by (metis s(2) SMP.Substitution[OF SMP.MP[OF 1] wt wftrms, of X], 
+          metis s(2) subst_subst_compose[of s "rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<alpha>)" \<I>]
+                     interpretation_grounds[OF \<I>(1), of "s \<cdot> rm_vars (set X) (\<sigma> \<circ>\<^sub>s \<alpha>)"])
+    hence 4: "t \<in> GSMP trms_P" unfolding GSMP_def by simp
+    
+    show "t \<in> ?B" using 3 4 by (auto simp add: trms_P_def)
+  qed
+  thus ?case
+    using step.IH[OF \<I>'] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] unlabel_append[of \<A>]
+          image_Un[of "\<lambda>x. x \<cdot> \<I>" "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"]
+    by (simp add: T'_def)
+qed simp
+
+lemma \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_aux:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and T: "T \<in> set P"
+    and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+           "t = Fun (Val n) [] \<or> t = Var x"
+    and neq:
+      "t \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) \<noteq>
+       t \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>)"
+  shows "\<exists>y \<in> fv_transaction T - set (transaction_fresh T).
+          t \<cdot> \<I> = (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<and> \<Gamma>\<^sub>v y = TAtom Value"
+proof -
+  let ?\<A>' = "\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+  let ?\<B> = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"
+  let ?\<B>' = "?\<B> \<cdot>\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"
+  let ?\<B>'' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+
+  have \<I>_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
+    and \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
+    and \<I>_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
+    by (metis \<I> welltyped_constraint_model_def constraint_model_def,
+        metis \<I> welltyped_constraint_model_def,
+        metis \<I> welltyped_constraint_model_def constraint_model_def)
+
+  have T_adm: "admissible_transaction T"
+    using T P(1) by blast
+  hence T_valid: "wellformed_transaction T"
+    unfolding admissible_transaction_def by blast
+
+  have T_adm_upds: "admissible_transaction_updates T"
+    by (metis P(1) T admissible_transaction_def)
+
+  have T_fresh_vars_value_typed: "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+    using T P(1) protocol_transaction_vars_TAtom_typed(3)[of T] P(1) by simp
+
+  have wt_\<sigma>\<alpha>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+    using wt_subst_compose transaction_fresh_subst_wt[OF \<sigma> T_fresh_vars_value_typed]
+          transaction_renaming_subst_wt[OF \<alpha>]
+    by blast
+
+  have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+    by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \<A>_reach)
+  hence t_wf: "wf\<^sub>t\<^sub>r\<^sub>m t" using t by auto
+
+  have \<A>_no_val_bvars: "\<not>TAtom Value \<sqsubseteq> \<Gamma>\<^sub>v x"
+    when "x \<in> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" for x
+    using P(1) reachable_constraints_no_bvars \<A>_reach
+          vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"] that
+    unfolding admissible_transaction_def by fast
+
+  have x': "x \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" when "t = Var x"
+    using that t by (simp add: var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t)
+
+  have "\<exists>f \<in> funs_term (t \<cdot> \<I>). is_Val f"
+    using abs_eq_if_no_Val neq by metis
+  hence "\<exists>n T. Fun (Val n) T \<sqsubseteq> t \<cdot> \<I>"
+    using funs_term_Fun_subterm
+    unfolding is_Val_def by fast
+  hence "TAtom Value \<sqsubseteq> \<Gamma> (Var x)" when "t = Var x"
+    using wt_subst_trm''[OF \<I>_wt, of "Var x"] that
+          subtermeq_imp_subtermtypeeq[of "t \<cdot> \<I>"] wf_trm_subst[OF \<I>_wf, of t] t_wf
+    by fastforce
+  hence x_val: "\<Gamma>\<^sub>v x = TAtom Value" when "t = Var x"
+    using reachable_constraints_vars_TAtom_typed[OF \<A>_reach P x'] that
+    by fastforce
+  hence x_fv: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" when "t = Var x" using x'
+    using reachable_constraints_Value_vars_are_fv[OF \<A>_reach P x'] that
+    by blast
+  then obtain m where m: "t \<cdot> \<I> = Fun (Val m) []"
+    using constraint_model_Value_term_is_Val[
+            OF \<A>_reach welltyped_constraint_model_prefix[OF \<I>] P, of x]
+          t(2) x_val
+    by force
+  hence 0: "\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) m \<noteq> \<alpha>\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>@?\<B>'') \<I>) m"
+    using neq by (simp add: unlabel_def)
+
+  have t_val: "\<Gamma> t = TAtom Value" using x_val t by force
+
+  obtain u s where s: "t \<cdot> \<I> = u \<cdot> \<I>" "insert\<langle>u,s\<rangle> \<in> set ?\<B>' \<or> delete\<langle>u,s\<rangle> \<in> set ?\<B>'"
+    using to_abs_neq_imp_db_update[OF 0] m
+    by (metis (no_types, lifting) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst subst_lsst_unlabel)
+  then obtain u' s' where s':
+      "u = u' \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>" "s = s' \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>"
+      "insert\<langle>u',s'\<rangle> \<in> set ?\<B> \<or> delete\<langle>u',s'\<rangle> \<in> set ?\<B>"
+    using stateful_strand_step_subst_inv_cases(4,5)
+    by blast
+  hence s'': "insert\<langle>u',s'\<rangle> \<in> set (unlabel (transaction_strand T)) \<or>
+              delete\<langle>u',s'\<rangle> \<in> set (unlabel (transaction_strand T))"
+    using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(4,5)[of u' s' "transaction_strand T"]
+    by simp_all
+  then obtain y where y: "y \<in> fv_transaction T" "u' = Var y"
+    using transaction_inserts_are_Value_vars[OF T_valid T_adm_upds, of u' s']
+          transaction_deletes_are_Value_vars[OF T_valid T_adm_upds, of u' s']
+          stateful_strand_step_fv_subset_cases(4,5)[of u' s' "unlabel (transaction_strand T)"]
+    by auto
+  hence 1: "t \<cdot> \<I> = (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>" using y s(1) s'(1) by (metis subst_apply_term.simps(1)) 
+
+  have 2: "y \<notin> set (transaction_fresh T)" when "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<noteq> \<sigma> y"
+    using transaction_fresh_subst_grounds_domain[OF \<sigma>, of y] subst_compose[of \<sigma> \<alpha> y] that
+    by (auto simp add: subst_ground_ident)
+
+  have 3: "y \<notin> set (transaction_fresh T)" when "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+    using 2 that \<sigma> unfolding transaction_fresh_subst_def by fastforce
+
+  have 4: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
+            (\<exists>B. prefix B \<A> \<and> x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> \<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B))"
+    by (metis welltyped_constraint_model_prefix[OF \<I>]
+              constraint_model_Value_var_in_constr_prefix[OF \<A>_reach _ P])
+
+  have 5: "\<Gamma>\<^sub>v y = TAtom Value"
+    using 1 t_val
+          wt_subst_trm''[OF wt_\<sigma>\<alpha>, of "Var y"]
+          wt_subst_trm''[OF \<I>_wt, of t]
+          wt_subst_trm''[OF \<I>_wt, of "(\<sigma> \<circ>\<^sub>s \<alpha>) y"]
+    by (auto simp del: subst_subst_compose)
+
+  have "y \<notin> set (transaction_fresh T)"
+  proof (cases "t = Var x")
+    case True (* \<I> x occurs in \<A> but not in subst_range \<sigma>, so y cannot be fresh *)
+    hence *: "\<I> x = Fun (Val m) []" "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" "\<I> x = (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>"
+      using m t(1) 1 x_fv x' by (force, blast, force)
+
+    obtain B where B: "prefix B \<A>" "\<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
+      using *(2) 4 x_val[OF True] by fastforce
+    hence "\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
+      using transaction_fresh_subst_range_fresh(1)[OF \<sigma>] trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)[of B]
+      unfolding prefix_def by fast
+    thus ?thesis using *(1,3) B(2) 2 by (metis subst_imgI term.distinct(1))
+  next
+    case False
+    hence "t \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" using t by simp
+    thus ?thesis using 1 3 by argo
+  qed
+  thus ?thesis using 1 5 y(1) by fast
+qed
+
+lemma \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_Var:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and T: "T \<in> set P"
+    and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and x: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
+  shows "\<I> x \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>) \<in>
+            timpl_closure_set {\<I> x \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)} (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>)"
+proof -
+  define a0 where "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+  define a0' where "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>)"
+  define a3 where "a3 \<equiv> \<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>"
+
+  have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+    by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \<A>_reach)
+
+  have T_adm: "admissible_transaction T" by (metis P(1) T)
+
+  have \<I>_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
+    and \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
+    and \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
+    by (metis \<I> welltyped_constraint_model_def constraint_model_def,
+        metis \<I> welltyped_constraint_model_def,
+        metis \<I> welltyped_constraint_model_def constraint_model_def)
+
+  have "\<Gamma>\<^sub>v x = Var Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = Var (prot_atom.Atom a))"
+    using reachable_constraints_vars_TAtom_typed[OF \<A>_reach P, of x]
+          x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"]
+    by auto
+
+  hence "\<I> x \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {\<I> x \<cdot>\<^sub>\<alpha> a0} a3"
+  proof
+    assume x_val: "\<Gamma>\<^sub>v x = TAtom Value"
+    show "\<I> x \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {\<I> x \<cdot>\<^sub>\<alpha> a0} a3"
+    proof (cases "\<I> x \<cdot>\<^sub>\<alpha> a0 = \<I> x \<cdot>\<^sub>\<alpha> a0'")
+      case False
+      hence "\<exists>y \<in> fv_transaction T - set (transaction_fresh T).
+              \<I> x = (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<and> \<Gamma>\<^sub>v y = TAtom Value"
+        using \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_aux[OF \<A>_reach T \<I> \<sigma> \<alpha> P fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t[OF x], of _ x]
+        unfolding a0_def a0'_def
+        by fastforce
+      then obtain y where y:
+          "y \<in> fv_transaction T - set (transaction_fresh T)"
+          "\<I> x = (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>"
+          "\<I> x \<cdot>\<^sub>\<alpha> a0 = (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0"
+          "\<I> x \<cdot>\<^sub>\<alpha> a0' = (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0'"
+          "\<Gamma>\<^sub>v y = TAtom Value"
+        by metis
+      then obtain n where n: "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = Fun (Val (n,False)) []"
+        using \<Gamma>\<^sub>v_TAtom''(2)[of y] x x_val
+              transaction_var_becomes_Val[
+                OF reachable_constraints.step[OF \<A>_reach T \<sigma> \<alpha>] \<I> \<sigma> \<alpha> P T, of y]
+        by force
+
+      have "a0 (n,False) \<noteq> a0' (n,False)"
+           "y \<in> fv_transaction T"
+           "y \<notin> set (transaction_fresh T)"
+           "absc (a0 (n,False)) = (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0"
+           "absc (a0' (n,False)) = (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0'"
+        using y n False by force+
+      hence 1: "(a0 (n,False), a0' (n,False)) \<in> a3" 
+        unfolding a0_def a0'_def a3_def abs_term_implications_def
+        by blast
+      
+      have 2: "\<I> x \<cdot>\<^sub>\<alpha> a0' \<in> set \<langle>a0 (n,False) --\<guillemotright> a0' (n,False)\<rangle>\<langle>\<I> x \<cdot>\<^sub>\<alpha> a0\<rangle>"
+        using y n timpl_apply_const by auto
+
+      show ?thesis
+        using timpl_closure.TI[OF timpl_closure.FP 1] 2
+              term_variants_pred_iff_in_term_variants[
+                of "(\<lambda>_. [])(Abs (a0 (n, False)) := [Abs (a0' (n, False))])"]
+        unfolding timpl_closure_set_def timpl_apply_term_def
+        by auto
+    qed (auto intro: timpl_closure_setI)
+  next
+    assume "\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a)"
+    then obtain a where x_atom: "\<Gamma>\<^sub>v x = TAtom (Atom a)" by moura
+
+    obtain f T where fT: "\<I> x = Fun f T"
+      using interpretation_grounds[OF \<I>_interp, of "Var x"]
+      by (cases "\<I> x") auto
+
+    have fT_atom: "\<Gamma> (Fun f T) = TAtom (Atom a)"
+      using wt_subst_trm''[OF \<I>_wt, of "Var x"] x_atom fT
+      by simp
+
+    have T: "T = []"
+      using fT wf_trm_subst[OF \<I>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s, of "Var x"] const_type_inv_wf[OF fT_atom]
+      by fastforce
+
+    have f: "\<not>is_Val f" using fT_atom unfolding is_Val_def by auto
+
+    have "\<I> x \<cdot>\<^sub>\<alpha> b = \<I> x" for b
+      using T fT abs_term_apply_const(2)[OF f]
+      by auto
+    thus "\<I> x \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {\<I> x \<cdot>\<^sub>\<alpha> a0} a3"
+      by (auto intro: timpl_closure_setI)
+  qed
+  thus ?thesis by (metis a0_def a0'_def a3_def)
+qed
+
+lemma \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_Val:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and T: "T \<in> set P"
+    and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and n: "Fun (Val n) [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+  shows "Fun (Val n) [] \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>) \<in>
+            timpl_closure_set {Fun (Val n) [] \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)} (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>)"
+proof -
+  define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+  define a0 where "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+  define a0' where "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<I>)"
+  define a3 where "a3 \<equiv> \<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>"
+
+  have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+    by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \<A>_reach)
+
+  have T_adm: "admissible_transaction T" by (metis P(1) T)
+
+  have "Fun (Abs (a0' n)) [] \<in> timpl_closure_set {Fun (Abs (a0 n)) []} a3"
+  proof (cases "a0 n = a0' n")
+    case False
+    then obtain x where x:
+        "x \<in> fv_transaction T - set (transaction_fresh T)" "Fun (Val n) [] = (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I>"
+      using \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_aux[OF \<A>_reach T \<I> \<sigma> \<alpha> P n]
+      by (fastforce simp add: a0_def a0'_def T'_def)
+    hence "absc (a0 n) = (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0" "absc (a0' n) = (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0'" by simp_all
+    hence 1: "(a0 n, a0' n) \<in> a3"
+      using False x(1)
+      unfolding a0_def a0'_def a3_def abs_term_implications_def T'_def
+      by blast
+    show ?thesis
+      using timpl_apply_Abs[of "[]" "[]" "a0 n" "a0' n"]
+            timpl_closure.TI[OF timpl_closure.FP[of "Fun (Abs (a0 n)) []" a3] 1]
+            term_variants_pred_iff_in_term_variants[of "(\<lambda>_. [])(Abs (a0 n) := [Abs (a0' n)])"]
+      unfolding timpl_closure_set_def timpl_apply_term_def
+      by force
+  qed (auto intro: timpl_closure_setI)
+  thus ?thesis by (simp add: a0_def a0'_def a3_def T'_def)
+qed
+
+lemma \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_ik:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and T: "T \<in> set P"
+    and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and t: "t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
+  shows "t \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>) \<in>
+            timpl_closure_set {t \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)} (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>)"
+proof -
+  define a0 where "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+  define a0' where "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>)"
+  define a3 where "a3 \<equiv> \<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>"
+
+  let ?U = "\<lambda>T a. map (\<lambda>s. s \<cdot> \<I> \<cdot>\<^sub>\<alpha> a) T"
+
+  have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+    by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \<A>_reach)
+
+  have T_adm: "admissible_transaction T" by (metis P(1) T)
+
+  have "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" "wf\<^sub>t\<^sub>r\<^sub>m t" using \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s t ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset by force+
+  hence "\<forall>t0 \<in> subterms t. t0 \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {t0 \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0} a3"
+  proof (induction t)
+    case (Var x) thus ?case
+      using \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_Var[OF \<A>_reach T \<I> \<sigma> \<alpha> P, of x]
+            ik\<^sub>s\<^sub>s\<^sub>t_var_is_fv[of x "unlabel \<A>"] vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"]
+      by (simp add: a0_def a0'_def a3_def)
+  next
+    case (Fun f S)
+    have IH: "\<forall>t0 \<in> subterms t. t0 \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {t0 \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0} a3"
+      when "t \<in> set S" for t
+      using that Fun.prems(1) wf_trm_param[OF Fun.prems(2)] Fun.IH
+      by (meson in_subterms_subset_Union params_subterms subsetCE)
+    hence "t \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {t \<cdot>\<^sub>\<alpha> a0} a3"
+      when "t \<in> set (map (\<lambda>s. s \<cdot> \<I>) S)" for t
+      using that by auto
+    hence "t \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure (t \<cdot>\<^sub>\<alpha> a0) a3"
+      when "t \<in> set (map (\<lambda>s. s \<cdot> \<I>) S)" for t
+      using that timpl_closureton_is_timpl_closure by auto
+    hence "(t \<cdot>\<^sub>\<alpha> a0, t \<cdot>\<^sub>\<alpha> a0') \<in> timpl_closure' a3"
+      when "t \<in> set (map (\<lambda>s. s \<cdot> \<I>) S)" for t
+      using that timpl_closure_is_timpl_closure' by auto
+    hence IH': "((?U S a0) ! i, (?U S a0') ! i) \<in> timpl_closure' a3"
+      when "i < length (map (\<lambda>s. s \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0) S)" for i
+      using that by auto
+
+    show ?case
+    proof (cases "\<exists>n. f = Val n")
+      case True
+      then obtain n where "Fun f S = Fun (Val n) []"
+        using Fun.prems(2) unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by force
+      moreover have "Fun f S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+        using ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset Fun.prems(1) by blast
+      ultimately show ?thesis
+        using \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_Val[OF \<A>_reach T \<I> \<sigma> \<alpha> P]
+        by (simp add: a0_def a0'_def a3_def)
+    next
+      case False
+      hence "Fun f S \<cdot> \<I> \<cdot>\<^sub>\<alpha> a = Fun f (map (\<lambda>t. t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a) S)" for a by (cases f) simp_all
+      hence "(Fun f S \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0, Fun f S \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0') \<in> timpl_closure' a3"
+        using timpl_closure_FunI[OF IH']
+        by simp
+      hence "Fun f S \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {Fun f S \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0} a3"
+        using timpl_closureton_is_timpl_closure
+              timpl_closure_is_timpl_closure'
+        by metis
+      thus ?thesis using IH by simp
+    qed
+  qed
+  thus ?thesis by (simp add: a0_def a0'_def a3_def)
+qed
+
+lemma transaction_prop1:
+  assumes "\<delta> \<in> abs_substs_fun ` set (transaction_check_comp FP OCC TI T)"
+    and "x \<in> fv_transaction T"
+    and "x \<notin> set (transaction_fresh T)"
+    and "\<delta> x \<noteq> absdbupd (unlabel (transaction_updates T)) x (\<delta> x)"
+    and "transaction_check FP OCC TI T"
+    and TI:
+      "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+  shows "(\<delta> x, absdbupd (unlabel (transaction_updates T)) x (\<delta> x)) \<in> (set TI)\<^sup>+"
+proof -
+  let ?upd = "\<lambda>x. absdbupd (unlabel (transaction_updates T)) x (\<delta> x)"
+
+  have 0: "fv_transaction T = set (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)))"
+    by (metis fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]) 
+
+  have 1: "transaction_check_post FP TI T \<delta>"
+    using assms(1,5)
+    unfolding transaction_check_def list_all_iff
+    by blast
+
+  have "(\<delta> x, ?upd x) \<in> set TI \<longleftrightarrow> (\<delta> x, ?upd x) \<in> (set TI)\<^sup>+"
+    using TI using assms(4) by blast
+  thus ?thesis
+    using assms(2,3,4) 0 1 in_trancl_closure_iff_in_trancl_fun[of _ _ TI]
+    unfolding transaction_check_post_def List.member_def
+    by (metis (no_types, lifting) DiffI) 
+qed
+
+lemma transaction_prop2:
+  assumes \<delta>: "\<delta> \<in> abs_substs_fun ` set (transaction_check_comp FP OCC TI T)"
+    and x: "x \<in> fv_transaction T" "fst x = TAtom Value"
+    and T_check: "transaction_check FP OCC TI T"
+    and T_adm: "admissible_transaction T"
+    and FP:
+      "analyzed (timpl_closure_set (set FP) (set TI))"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
+    and OCC:
+      "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
+      "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
+    and TI:
+      "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+  shows "x \<notin> set (transaction_fresh T) \<Longrightarrow> \<delta> x \<in> set OCC" (is "?A' \<Longrightarrow> ?A")
+    and "absdbupd (unlabel (transaction_updates T)) x (\<delta> x) \<in> set OCC" (is ?B)
+proof -
+  let ?xs = "fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))"
+  let ?ys = "filter (\<lambda>x. x \<notin> set (transaction_fresh T) \<and> fst x = TAtom Value) ?xs"
+  let ?C = "unlabel (transaction_selects T@transaction_checks T)"
+  let ?poss = "transaction_poschecks_comp ?C"
+  let ?negs = "transaction_negchecks_comp ?C"
+  let ?\<delta>upd = "\<lambda>y. absdbupd (unlabel (transaction_updates T)) y (\<delta> y)"
+
+  have T_wf: "wellformed_transaction T"
+    and T_occ: "admissible_transaction_occurs_checks T"
+    using T_adm by (metis admissible_transaction_def)+
+
+  have 0: "{x \<in> fv_transaction T - set (transaction_fresh T). fst x = TAtom Value} = set ?ys"
+    using fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]
+    by force
+
+  have 1: "transaction_check_pre FP TI T \<delta>"
+    using \<delta> unfolding transaction_check_comp_def Let_def by fastforce
+
+  have 2: "transaction_check_post FP TI T \<delta>"
+    using \<delta> T_check unfolding transaction_check_def list_all_iff by blast
+
+  have 3: "\<delta> \<in> abs_substs_fun ` set (abs_substs_set ?ys OCC ?poss ?negs)"
+    using \<delta> unfolding transaction_check_comp_def Let_def by force
+
+  show A: ?A when ?A' using that 0 3 x abs_substs_abss_bounded by blast
+
+  have 4: "x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
+    when x': "x \<in> set (transaction_fresh T)"
+    using T_wf x' unfolding wellformed_transaction_def by fast
+
+  have "intruder_synth_mod_timpls FP TI (occurs (absc (?\<delta>upd x)))"
+    when x': "x \<in> set (transaction_fresh T)"
+    using 2 x' x T_occ
+    unfolding transaction_check_post_def admissible_transaction_occurs_checks_def
+    by fastforce
+  hence "timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c occurs (absc (?\<delta>upd x))"
+    when x': "x \<in> set (transaction_fresh T)"
+    using x' intruder_synth_mod_timpls_is_synth_timpl_closure_set[
+            OF TI, of FP "occurs (absc (?\<delta>upd x))"]
+    by argo
+  hence "Abs (?\<delta>upd x) \<in> \<Union>(funs_term ` timpl_closure_set (set FP) (set TI))"
+    when x': "x \<in> set (transaction_fresh T)"
+    using x' ideduct_synth_priv_fun_in_ik[
+            of "timpl_closure_set (set FP) (set TI)" "occurs (absc (?\<delta>upd x))"]
+    by simp
+  hence "\<exists>t \<in> timpl_closure_set (set FP) (set TI). Abs (?\<delta>upd x) \<in> funs_term t"
+    when x': "x \<in> set (transaction_fresh T)"
+    using x' by force
+  hence 5: "?\<delta>upd x \<in> set OCC" when x': "x \<in> set (transaction_fresh T)"
+    using x' OCC by fastforce
+
+  have 6: "?\<delta>upd x \<in> set OCC" when x': "x \<notin> set (transaction_fresh T)"
+  proof (cases "\<delta> x = ?\<delta>upd x")
+    case False
+    hence "(\<delta> x, ?\<delta>upd x) \<in> (set TI)\<^sup>+" "\<delta> x \<in> set OCC"
+      using A 2 x' x TI
+      unfolding transaction_check_post_def fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t Let_def
+                in_trancl_closure_iff_in_trancl_fun[symmetric]
+                List.member_def
+      by blast+
+    thus ?thesis using timpl_closure_set_absc_subset_in[OF OCC(2)] by blast
+  qed (simp add: A x' x(1))
+
+  show ?B by (metis 5 6)
+qed
+
+lemma transaction_prop3:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and T: "T \<in> set P"
+    and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+    and FP:
+      "analyzed (timpl_closure_set (set FP) (set TI))"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
+      "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
+    and OCC:
+      "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
+      "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
+      "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
+    and TI:
+      "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+    and P:
+      "\<forall>T \<in> set P. admissible_transaction T"
+  shows "\<forall>x \<in> set (transaction_fresh T). (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc {}" (is ?A)
+    and "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T).
+            intruder_synth_mod_timpls FP TI (t \<cdot> (\<sigma> \<circ>\<^sub>s \<alpha>) \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>))" (is ?B)
+    and "\<forall>x \<in> fv_transaction T - set (transaction_fresh T).
+         \<forall>s. select\<langle>Var x,Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_selects T))
+                 \<longrightarrow> (\<exists>ss. (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc ss \<and> s \<in> ss)" (is ?C)
+    and "\<forall>x \<in> fv_transaction T - set (transaction_fresh T).
+         \<forall>s. \<langle>Var x in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))
+                 \<longrightarrow> (\<exists>ss. (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc ss \<and> s \<in> ss)" (is ?D)
+    and "\<forall>x \<in> fv_transaction T - set (transaction_fresh T).
+         \<forall>s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))
+                 \<longrightarrow> (\<exists>ss. (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc ss \<and> s \<notin> ss)" (is ?E)
+    and "\<forall>x \<in> fv_transaction T - set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
+         (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) \<in> absc ` set OCC" (is ?F)
+proof -
+  let ?T' = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+
+  define a0 where "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+  define a0' where "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@?T') \<I>)"
+  define fv_AT' where "fv_AT' \<equiv> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@?T')"
+
+  have T_adm: "admissible_transaction T"
+    using T P(1) by blast
+  hence T_valid: "wellformed_transaction T"
+    unfolding admissible_transaction_def by blast
+
+  have T_adm':
+      "admissible_transaction_selects T"
+      "admissible_transaction_checks T"
+      "admissible_transaction_updates T"
+    using T_adm unfolding admissible_transaction_def by simp_all
+
+  have \<I>': "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
+           "\<forall>n. Val (n,True) \<notin> \<Union>(funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
+           "\<forall>n. Abs n \<notin> \<Union>(funs_term ` (\<I> ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
+           "\<forall>n. Val (n,True) \<notin> \<Union>(funs_term ` (\<I> ` fv_AT'))"
+           "\<forall>n. Abs n \<notin> \<Union>(funs_term ` (\<I> ` fv_AT'))"
+    using \<I> admissible_transaction_occurs_checks_prop'[
+            OF \<A>_reach welltyped_constraint_model_prefix[OF \<I>] P]
+          admissible_transaction_occurs_checks_prop'[
+            OF reachable_constraints.step[OF \<A>_reach T \<sigma> \<alpha>] \<I> P]
+    unfolding welltyped_constraint_model_def constraint_model_def is_Val_def is_Abs_def fv_AT'_def
+    by fastforce+
+
+  have \<P>': "\<forall>T \<in> set P. \<forall>n. Val (n,True) \<notin> \<Union>(funs_term ` trms_transaction T)"
+           "\<forall>T \<in> set P. \<forall>n. Abs n \<notin> \<Union>(funs_term ` trms_transaction T)"
+           "\<forall>T \<in> set P. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+    and "\<forall>T \<in> set P. \<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
+    using protocol_transaction_vars_TAtom_typed
+          protocol_transactions_no_pubconsts
+          protocol_transactions_no_abss
+          funs_term_Fun_subterm P
+    by fast+
+  hence T_no_pubconsts: "\<forall>n. Val (n,True) \<notin> \<Union>(funs_term ` trms_transaction T)"
+    and T_no_abss: "\<forall>n. Abs n \<notin> \<Union>(funs_term ` trms_transaction T)"
+    and T_fresh_vars_value_typed: "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+    and T_fv_const_typed: "\<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
+    using T by simp_all
+
+  have wt_\<sigma>\<alpha>\<I>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>)"
+      using \<I>'(2) wt_subst_compose transaction_fresh_subst_wt[OF \<sigma> T_fresh_vars_value_typed]
+            transaction_renaming_subst_wt[OF \<alpha>]
+      by blast
+
+  have 1: "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = \<sigma> y" when "y \<in> set (transaction_fresh T)" for y
+    using transaction_fresh_subst_grounds_domain[OF \<sigma> that] subst_compose[of \<sigma> \<alpha> y]
+    by (simp add: subst_ground_ident)
+
+  have 2: "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" when "y \<in> set (transaction_fresh T)" for y
+    using 1[OF that] that \<sigma> unfolding transaction_fresh_subst_def by auto
+
+  have 3: "\<forall>x \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
+            (\<exists>B. prefix B \<A> \<and> x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> \<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B))"
+    by (metis welltyped_constraint_model_prefix[OF \<I>]
+              constraint_model_Value_var_in_constr_prefix[OF \<A>_reach _ P])
+
+  have 4: "\<exists>n. (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = Fun (Val n) []"
+    when "y \<in> fv_transaction T" "\<Gamma>\<^sub>v y = TAtom Value" for y
+    using transaction_var_becomes_Val[OF reachable_constraints.step[OF \<A>_reach T \<sigma> \<alpha>] \<I> \<sigma> \<alpha> P T]
+          that T_fv_const_typed \<Gamma>\<^sub>v_TAtom''[of y]
+    by metis
+
+  have \<I>_is_T_model: "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) (set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)) (unlabel ?T') \<I>"
+    using \<I> unlabel_append[of \<A> ?T'] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>" \<I> "[]"]
+          strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" "unlabel ?T'" \<I>]
+    by (simp add: welltyped_constraint_model_def constraint_model_def db\<^sub>s\<^sub>s\<^sub>t_def)
+
+  have T_rcv_no_val_bvars: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<inter> subst_domain (\<sigma> \<circ>\<^sub>s \<alpha>) = {}"
+    using transaction_no_bvars[OF T_adm] bvars_transaction_unfold[of T] by blast
+
+  show ?A
+  proof
+    fix y assume y: "y \<in> set (transaction_fresh T)"
+    then obtain yn where yn: "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = Fun (Val yn) []" "Fun (Val yn) [] \<in> subst_range \<sigma>"
+      by (metis transaction_fresh_subst_sends_to_val'[OF \<sigma>])
+
+    { \<comment> \<open>since \<open>y\<close> is fresh \<open>(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>\<close> cannot be part of the database state of \<open>\<I> \<A>\<close>\<close>
+      fix t' s assume t': "insert\<langle>t',s\<rangle> \<in> set (unlabel \<A>)" "t' \<cdot> \<I> = Fun (Val yn) []"
+      then obtain z where t'_z: "t' = Var z" using 2[OF y] yn(1) by (cases t') auto
+      hence z: "z \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" "\<I> z = (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>" using t' yn(1) by force+
+      hence z': "\<Gamma>\<^sub>v z = TAtom Value"
+        by (metis \<Gamma>.simps(1) \<Gamma>_consts_simps(2) t'(2) t'_z wt_subst_trm'' \<I>'(2))
+
+      obtain B where B: "prefix B \<A>" "\<I> z \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" using z z' 3 by fastforce
+      hence "\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
+        using transaction_fresh_subst_range_fresh(1)[OF \<sigma>] trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)[of B]
+        unfolding prefix_def by fast
+      hence False using B(2) 1[OF y] z yn(1) by (metis subst_imgI term.distinct(1)) 
+    } hence "\<nexists>s. ((\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>, s) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+      using db\<^sub>s\<^sub>s\<^sub>t_in_cases[of "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>" _ "unlabel \<A>" \<I> "[]"] yn(1)
+      by (force simp add: db\<^sub>s\<^sub>s\<^sub>t_def)
+    thus "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc {}"
+      using to_abs_empty_iff_notin_db[of yn "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I> []"] yn(1)
+      by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def)
+  qed
+
+  show receives_covered: ?B
+  proof
+    fix t assume t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
+    hence t_in_T: "t \<in> trms_transaction T"
+      using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)[of "transaction_receive T"]
+      unfolding transaction_strand_def by fast
+
+    have t_rcv: "receive\<langle>t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+      using subst_lsst_unlabel_member[of "receive\<langle>t\<rangle>" "transaction_receive T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+            wellformed_transaction_unlabel_cases(1)[OF T_valid] trms\<^sub>s\<^sub>s\<^sub>t_in[OF t]
+      by fastforce
+    hence *: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I>"
+      using wellformed_transaction_sem_receives[OF T_valid \<I>_is_T_model]
+      by simp
+
+    have t_fv: "fv (t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>) \<subseteq> fv_AT'"
+      using fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] unlabel_append[of \<A>]
+            fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
+            t_rcv fv_transaction_subst_unfold[of T " \<sigma> \<circ>\<^sub>s \<alpha>"]
+      unfolding fv_AT'_def by force
+
+    have **: "\<forall>t \<in> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
+      using FP(3) by (auto simp add: a0_def abs_intruder_knowledge_def)
+
+    note lms1 = pubval_terms_subst[OF _ pubval_terms_subst_range_disj[
+                  OF transaction_fresh_subst_has_no_pubconsts_abss(1)[OF \<sigma>], of t]]
+                pubval_terms_subst[OF _ pubval_terms_subst_range_disj[
+                  OF transaction_renaming_subst_has_no_pubconsts_abss(1)[OF \<alpha>], of "t \<cdot> \<sigma>"]]
+
+    note lms2 = abs_terms_subst[OF _ abs_terms_subst_range_disj[
+                  OF transaction_fresh_subst_has_no_pubconsts_abss(2)[OF \<sigma>], of t]]
+                abs_terms_subst[OF _ abs_terms_subst_range_disj[
+                  OF transaction_renaming_subst_has_no_pubconsts_abss(2)[OF \<alpha>], of "t \<cdot> \<sigma>"]]
+
+    have "t \<in> (\<Union>T\<in>set P. trms_transaction T)" "fv (t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I>) = {}"
+      using t_in_T T interpretation_grounds[OF \<I>'(1)] by fast+
+    moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>))"
+      using wf_trm_subst_rangeI[of \<sigma>, OF transaction_fresh_subst_is_wf_trm[OF \<sigma>]]
+            wf_trm_subst_rangeI[of \<alpha>, OF transaction_renaming_subst_is_wf_trm[OF \<alpha>]]
+            wf_trms_subst_compose[of \<sigma> \<alpha>, THEN wf_trms_subst_compose[OF _ \<I>'(3)]]
+      by blast
+    moreover
+    have "t \<notin> pubval_terms"
+      using t_in_T T_no_pubconsts funs_term_Fun_subterm
+      unfolding is_Val_def by fastforce
+    hence "t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<notin> pubval_terms"
+      using lms1
+      by auto
+    hence "t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I> \<notin> pubval_terms"
+      using \<I>'(6) t_fv pubval_terms_subst'[of "t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>" \<I>]
+      by auto
+    moreover have "t \<notin> abs_terms"
+      using t_in_T T_no_abss funs_term_Fun_subterm
+      unfolding is_Abs_def by force
+    hence "t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<notin> abs_terms"
+      using lms2
+      by auto
+    hence "t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I> \<notin> abs_terms"
+      using \<I>'(7) t_fv abs_terms_subst'[of "t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>" \<I>]
+      by auto
+    ultimately have ***:
+        "t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I> \<in> GSMP (\<Union>T\<in>set P. trms_transaction T) - (pubval_terms \<union> abs_terms)"
+      using SMP.Substitution[OF SMP.MP[of t "\<Union>T\<in>set P. trms_transaction T"], of "\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>"]
+            subst_subst_compose[of t "\<sigma> \<circ>\<^sub>s \<alpha>" \<I>] wt_\<sigma>\<alpha>\<I>
+      unfolding GSMP_def by fastforce
+
+    have "\<forall>T\<in>set P. bvars_transaction T = {}"
+      using transaction_no_bvars P unfolding list_all_iff by blast
+    hence ****:
+        "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> GSMP (\<Union>T\<in>set P. trms_transaction T) - (pubval_terms \<union> abs_terms)"
+      using reachable_constraints_no_pubconsts_abss[OF \<A>_reach \<P>' _ \<I>'(1,2,3,4,5)]
+            ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel \<A>"]
+      by blast
+
+    show "intruder_synth_mod_timpls FP TI (t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>))"
+      using deduct_FP_if_deduct[OF **** ** * ***] deducts_eq_if_analyzed[OF FP(1)]
+            intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI, of FP]
+      unfolding a0_def by force
+  qed
+
+  show ?C
+  proof (intro ballI allI impI)
+    fix y s
+    assume y: "y \<in> fv_transaction T - set (transaction_fresh T)"
+       and s: "select\<langle>Var y, Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_selects T))"
+    hence "select\<langle>Var y, Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_strand T))"
+      unfolding transaction_strand_def unlabel_def by auto
+    hence y_val: "\<Gamma>\<^sub>v y = TAtom Value"
+      using transaction_selects_are_Value_vars[OF T_valid T_adm'(1)]
+      by fastforce
+
+    have "select\<langle>(\<sigma> \<circ>\<^sub>s \<alpha>) y, Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)))"
+      using subst_lsst_unlabel_member[OF s]
+      by fastforce
+    hence "((\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>, Fun (Set s) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+      using wellformed_transaction_sem_selects[
+              OF T_valid \<I>_is_T_model,
+              of "(\<sigma> \<circ>\<^sub>s \<alpha>) y" "Fun (Set s) []"]
+      by simp
+    thus "\<exists>ss. (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc ss \<and> s \<in> ss"
+      using to_abs_alt_def[of "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>"] 4[of y] y y_val by auto
+  qed
+
+  show ?D
+  proof (intro ballI allI impI)
+    fix y s
+    assume y: "y \<in> fv_transaction T - set (transaction_fresh T)"
+       and s: "\<langle>Var y in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))"
+    hence "\<langle>Var y in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_strand T))"
+      unfolding transaction_strand_def unlabel_def by auto
+    hence y_val: "\<Gamma>\<^sub>v y = TAtom Value"
+      using transaction_inset_checks_are_Value_vars[OF T_valid T_adm'(2)]
+      by fastforce
+
+    have "\<langle>(\<sigma> \<circ>\<^sub>s \<alpha>) y in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)))"
+      using subst_lsst_unlabel_member[OF s]
+      by fastforce
+    hence "((\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>, Fun (Set s) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+      using wellformed_transaction_sem_pos_checks[
+              OF T_valid \<I>_is_T_model,
+              of "(\<sigma> \<circ>\<^sub>s \<alpha>) y" "Fun (Set s) []"]
+      by simp
+    thus "\<exists>ss. (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc ss \<and> s \<in> ss"
+      using to_abs_alt_def[of "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>"] 4[of y] y y_val by auto
+  qed
+
+  show ?E
+  proof (intro ballI allI impI)
+    fix y s
+    assume y: "y \<in> fv_transaction T - set (transaction_fresh T)"
+       and s: "\<langle>Var y not in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T))"
+    hence "\<langle>Var y not in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_strand T))"
+      unfolding transaction_strand_def unlabel_def by auto
+    hence y_val: "\<Gamma>\<^sub>v y = TAtom Value"
+      using transaction_notinset_checks_are_Value_vars[OF T_valid T_adm'(2)]
+      by fastforce
+
+    have "\<langle>(\<sigma> \<circ>\<^sub>s \<alpha>) y not in Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)))"
+      using subst_lsst_unlabel_member[OF s]
+      by fastforce
+    hence "((\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>, Fun (Set s) []) \<notin> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+      using wellformed_transaction_sem_neg_checks(2)[
+              OF T_valid \<I>_is_T_model,
+              of "[]" "(\<sigma> \<circ>\<^sub>s \<alpha>) y" "Fun (Set s) []"]
+      by simp
+    moreover have "list_all admissible_transaction_updates P"
+      using Ball_set[of P "admissible_transaction"] P(1)
+            Ball_set[of P admissible_transaction_updates]
+      unfolding admissible_transaction_def
+      by fast
+    moreover have "list_all wellformed_transaction P"
+      using P(1) Ball_set[of P "admissible_transaction"] Ball_set[of P wellformed_transaction]
+      unfolding admissible_transaction_def
+      by blast
+    ultimately have "((\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>, Fun (Set s) S) \<notin> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)" for S
+      using reachable_constraints_db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_args_empty[OF \<A>_reach] 
+      unfolding admissible_transaction_updates_def
+      by auto
+    thus "\<exists>ss. (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = absc ss \<and> s \<notin> ss"
+      using to_abs_alt_def[of "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>"] 4[of y] y y_val by auto
+  qed
+
+  show ?F
+  proof (intro ballI impI)
+    fix y assume y: "y \<in> fv_transaction T - set (transaction_fresh T)" "\<Gamma>\<^sub>v y = TAtom Value"
+    then obtain yn where yn: "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = Fun (Val yn) []" using 4 by moura
+    hence y_abs: "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) = Fun (Abs (\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) yn)) []" by simp
+
+    have *: "\<forall>r \<in> set (unlabel (transaction_selects T)). \<exists>x s. r = select\<langle>Var x, Fun (Set s) []\<rangle>"
+      using admissible_transaction_strand_step_cases(2)[OF T_adm] by fast
+
+    have "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<or> y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+      using wellformed_transaction_fv_in_receives_or_selects[OF T_valid] y by blast
+    thus "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) \<in> absc ` set OCC"
+    proof
+      assume "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
+      then obtain t where t: "receive\<langle>t\<rangle> \<in> set (unlabel (transaction_receive T))" "y \<in> fv t"
+        using wellformed_transaction_unlabel_cases(1)[OF T_valid]
+        by (force simp add: unlabel_def)
+      
+      have **: "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<in> subterms (t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>)"
+               "timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+        using fv_subterms_substI[OF t(2), of "\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>"] subst_compose[of "\<sigma> \<circ>\<^sub>s \<alpha>" \<I> y]
+              subterms_subst_subset[of "\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>" t] receives_covered t(1)
+        unfolding intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI, symmetric]
+        by auto
+
+      have "Abs (\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) yn) \<in> \<Union>(funs_term ` (timpl_closure_set (set FP) (set TI)))"
+        using y_abs abs_subterms_in[OF **(1), of "\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"]
+              ideduct_synth_priv_fun_in_ik[
+                OF **(2) funs_term_Fun_subterm'[of "Abs (\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) yn)" "[]"]]
+        by force
+      hence "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) \<in> subterms\<^sub>s\<^sub>e\<^sub>t (timpl_closure_set (set FP) (set TI))"
+        using y_abs wf_trms_subterms[OF timpl_closure_set_wf_trms[OF FP(2), of "set TI"]]
+              funs_term_Fun_subterm[of "Abs (\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>) yn)"]
+        unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by fastforce
+      hence "funs_term ((\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>))
+              \<subseteq> (\<Union>t \<in> timpl_closure_set (set FP) (set TI). funs_term t)"
+        using funs_term_subterms_eq(2)[of "timpl_closure_set (set FP) (set TI)"] by blast
+      thus ?thesis using y_abs OCC(1) by fastforce
+    next
+      assume "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+      then obtain l s where "(l,select\<langle>Var y, Fun (Set s) []\<rangle>) \<in> set (transaction_selects T)"
+        using * by (auto simp add: unlabel_def)
+      then obtain U where U:
+          "prefix (U@[(l,select\<langle>Var y, Fun (Set s) []\<rangle>)]) (transaction_selects T)"
+        using in_set_conv_decomp[of "(l, select\<langle>Var y,Fun (Set s) []\<rangle>)" "transaction_selects T"]
+        by (auto simp add: prefix_def)
+      hence "select\<langle>Var y, Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_selects T))"
+        by (force simp add: prefix_def unlabel_def)
+      hence "select\<langle>(\<sigma> \<circ>\<^sub>s \<alpha>) y, Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+        using subst_lsst_unlabel_member
+        by fastforce
+      hence "(Fun (Val yn) [], Fun (Set s) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+        using yn wellformed_transaction_sem_selects[
+                OF T_valid \<I>_is_T_model, of "(\<sigma> \<circ>\<^sub>s \<alpha>) y" "Fun (Set s) []"]
+        by fastforce
+      hence "Fun (Val yn) [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
+        using db\<^sub>s\<^sub>s\<^sub>t_in_cases[of "Fun (Val yn) []"]
+        by (fastforce simp add: db\<^sub>s\<^sub>s\<^sub>t_def)
+      thus ?thesis
+        using OCC(3) yn abs_in[of "Fun (Val yn) []" _ "\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"]
+        unfolding abs_value_constants_def
+        by (metis (mono_tags, lifting) mem_Collect_eq subsetCE) 
+    qed
+  qed
+qed
+
+lemma transaction_prop4:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and T: "T \<in> set P"
+    and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+    and P: "\<forall>T \<in> set P. admissible_transaction T"
+    and x: "x \<in> set (transaction_fresh T)"
+    and y: "y \<in> fv_transaction T - set (transaction_fresh T)" "\<Gamma>\<^sub>v y = TAtom Value"
+  shows "(\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>))" (is ?A)
+    and "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>))" (is ?B)
+proof -
+  let ?T' = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+
+  from \<I> have \<I>': "welltyped_constraint_model \<I> \<A>"
+    using welltyped_constraint_model_prefix by auto
+
+  have T_P_addm: "admissible_transaction T'" when T': "T' \<in> set P " for T'
+    by (meson T' P)
+
+  have T_adm: "admissible_transaction T"
+    by (metis (full_types) P T)
+
+  from T_adm have T_valid: "wellformed_transaction T"
+    unfolding admissible_transaction_def by blast
+
+  have be: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
+    using T_P_addm \<A>_reach reachable_constraints_no_bvars transaction_no_bvars(2) by blast
+
+  have T_no_bvars: "fv_transaction T = vars_transaction T"
+    using transaction_no_bvars[OF T_adm] by simp
+
+  have \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" by (metis \<I> welltyped_constraint_model_def)
+
+  obtain xn where xn: "\<sigma> x = Fun (Val xn) []"
+    using \<sigma> x unfolding transaction_fresh_subst_def by force
+
+  then have xnxn: "(\<sigma> \<circ>\<^sub>s \<alpha>) x = Fun (Val xn) []"
+    unfolding subst_compose_def by auto
+
+  from xn xnxn have a0: "(\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> = Fun (Val xn) []"
+    by auto
+
+  have b0: "\<Gamma>\<^sub>v x = TAtom Value"
+    using P x T protocol_transaction_vars_TAtom_typed(3)
+    by metis
+
+  note 0 = a0 b0
+
+  have xT: "x \<in> fv_transaction T"
+    using x transaction_fresh_vars_subset[OF T_valid]
+    by fast
+
+  have \<sigma>_x_nin_A: "\<sigma> x \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+  proof -
+    have "\<sigma> x \<in> subst_range \<sigma>"
+      by (metis \<sigma> transaction_fresh_subst_sends_to_val x)
+    moreover
+    have "(\<forall>t \<in> subst_range \<sigma>. t \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))"
+      using \<sigma> transaction_fresh_subst_def[of \<sigma> T \<A>] by auto
+    ultimately
+    show ?thesis
+      by auto
+  qed
+
+  have *: "y \<notin> set (transaction_fresh T)"
+     using assms by auto
+
+  have **: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<or> y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+    using * y wellformed_transaction_fv_in_receives_or_selects[OF T_valid]
+    by blast
+
+  have y_fv: "y \<in> fv_transaction T" using y fv_transaction_unfold by blast
+  
+  have y_val: "fst y = TAtom Value" using y(2) \<Gamma>\<^sub>v_TAtom''(2) by blast
+
+  have "list_all (\<lambda>x. fst x = Var Value) (transaction_fresh T)"
+    using x T_adm unfolding admissible_transaction_def by fast
+  hence x_val: "fst x = TAtom Value" using x unfolding list_all_iff by blast
+
+  have "\<sigma> x \<cdot> \<I> \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>))"
+  proof (rule ccontr)
+    assume "\<not>\<sigma> x \<cdot> \<I> \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>))"
+    then have a: "\<sigma> x \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>))"
+      by auto
+
+    then have \<sigma>_x_I_in_A: "\<sigma> x \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
+      using reachable_constraints_subterms_subst[OF \<A>_reach \<I>' P] by blast
+
+    have "\<exists>u. u \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<and> \<I> u = \<sigma> x"
+    proof -
+      from \<sigma>_x_I_in_A have "\<exists>tu. tu \<in> \<Union> (subterms ` (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<and> tu \<cdot> \<I> = \<sigma> x \<cdot> \<I>"
+        by force
+      then obtain tu where tu: "tu \<in> \<Union> (subterms ` (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<and> tu \<cdot> \<I> = \<sigma> x \<cdot> \<I>"
+        by auto
+      then have "tu \<noteq> \<sigma> x"
+        using \<sigma>_x_nin_A by auto
+      moreover
+      have "tu \<cdot> \<I> = \<sigma> x"
+        using tu by (simp add: xn)
+      ultimately
+      have "\<exists>u. tu = Var u"
+        unfolding xn by (cases tu) auto
+      then obtain u where "tu = Var u"
+        by auto
+      have "u \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<and> \<I> u = \<sigma> x"
+      proof -
+        have "u \<in> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
+          using \<open>tu = Var u\<close> tu var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t by fastforce 
+        then have "u \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"
+          using be vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"] by blast
+        moreover
+        have "\<I> u = \<sigma> x"
+          using \<open>tu = Var u\<close> \<open>tu \<cdot> \<I> = \<sigma> x\<close> by auto
+        ultimately
+        show ?thesis
+          by auto
+      qed
+      then show "\<exists>u. u \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<and> \<I> u = \<sigma> x"
+        by metis
+    qed
+    then obtain u where u:
+      "u \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" "\<I> u = \<sigma> x"
+      by auto
+    then have u_TA: "\<Gamma>\<^sub>v u = TAtom Value"
+      using P(1) T x_val \<Gamma>\<^sub>v_TAtom''(2)[of x]
+            wt_subst_trm''[OF \<I>_wt, of "Var u"] wt_subst_trm''[of \<sigma> "Var x"] 
+            transaction_fresh_subst_wt[OF \<sigma>] protocol_transaction_vars_TAtom_typed(3)
+      by force
+    have "\<exists>B. prefix B \<A> \<and> u \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> \<I> u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
+      using u u_TA
+      by (metis welltyped_constraint_model_prefix[OF \<I>]
+                constraint_model_Value_var_in_constr_prefix[OF \<A>_reach _ P])
+    then obtain B where "prefix B \<A> \<and> u \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<and> \<I> u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"
+      by blast
+    moreover have "\<Union>(subterms ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t xs) \<subseteq> \<Union>(subterms ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ys)"
+      when "prefix xs ys"
+      for xs ys::"('fun,'atom,'sets,'lbl) prot_strand"
+      using that subterms\<^sub>s\<^sub>e\<^sub>t_mono trms\<^sub>s\<^sub>s\<^sub>t_mono unlabel_mono set_mono_prefix by metis
+    ultimately have "\<I> u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+      by blast
+    then have "\<sigma> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+      using u by auto
+    then show "False"
+      using \<sigma>_x_nin_A by auto
+  qed
+  then show ?A
+    unfolding subst_compose_def xn by auto
+
+  from ** show ?B
+  proof
+    define T' where "T' \<equiv> transaction_receive T"
+    define \<theta> where "\<theta> \<equiv> \<sigma> \<circ>\<^sub>s \<alpha>"
+
+    assume y: "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
+    hence "Var y \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" by (metis T'_def fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t)
+    then obtain z where z: "z \<in> set (unlabel T')" "Var y \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p z)"
+      by (induct T') auto
+
+    have "is_Receive z"
+      using T_adm Ball_set[of "unlabel T'" is_Receive] z(1)
+      unfolding admissible_transaction_def wellformed_transaction_def T'_def
+      by blast
+    then obtain ty where "z = receive\<langle>ty\<rangle>" by (cases z) auto
+    hence ty: "receive\<langle>ty \<cdot> \<theta>\<rangle> \<in> set (unlabel (T' \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" "\<theta> y \<in> subterms (ty \<cdot> \<theta>)"
+      using z subst_mono unfolding subst_apply_labeled_stateful_strand_def unlabel_def by force+
+    hence y_deduct: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> ty \<cdot> \<theta> \<cdot> \<I>"
+      using transaction_receive_deduct[OF T_adm _ \<sigma> \<alpha>]
+      by (metis \<I> T'_def \<theta>_def welltyped_constraint_model_def)
+
+    obtain zn where zn: "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = Fun (Val (zn, False)) []"
+      using transaction_var_becomes_Val[
+              OF reachable_constraints.step[OF \<A>_reach T \<sigma> \<alpha>] \<I> \<sigma> \<alpha> P T, of y]
+            transaction_fresh_subst_transaction_renaming_subst_range(2)[OF \<sigma> \<alpha> *]
+            y_fv y_val
+      by (metis subst_apply_term.simps(1))
+
+    have "(\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)"
+      using private_fun_deduct_in_ik[OF y_deduct, of "Val (zn, False)"]
+      by (metis \<theta>_def ty(2) zn subst_mono public.simps(3) snd_eqD)
+    thus ?B
+      using ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel \<A>" \<I>] unlabel_subst[of \<A> \<I>]
+            subterms\<^sub>s\<^sub>e\<^sub>t_mono[OF ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>)"]]
+      by fastforce
+  next
+    assume y': "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+    then obtain s where s: "select\<langle>Var y,s\<rangle> \<in> set (unlabel (transaction_selects T))"
+                           "fst y = TAtom Value"
+      using admissible_transaction_strand_step_cases(1,2)[OF T_adm] by fastforce
+
+    obtain z zn where zn: "(\<sigma> \<circ>\<^sub>s \<alpha>) y = Var z" "\<I> z = Fun (Val zn) []"
+      using transaction_var_becomes_Val[
+              OF reachable_constraints.step[OF \<A>_reach T \<sigma> \<alpha>] \<I> \<sigma> \<alpha> P T]
+            transaction_fresh_subst_transaction_renaming_subst_range(2)[OF \<sigma> \<alpha> *]
+            y_fv T_no_bvars(1) s(2)
+      by (metis subst_apply_term.simps(1))
+
+    have transaction_selects_db_here:
+        "\<And>n s. select\<langle>Var (TAtom Value, n), Fun (Set s) []\<rangle> \<in> set (unlabel (transaction_selects T))
+                \<Longrightarrow> (\<alpha> (TAtom Value, n) \<cdot> \<I>, Fun (Set s) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+      using transaction_selects_db[OF T_adm _ \<sigma> \<alpha>] \<I>
+      unfolding welltyped_constraint_model_def by auto
+
+    have "\<exists>n. y = (Var Value, n)"
+      using T \<Gamma>\<^sub>v_TAtom_inv(2) y_fv y(2)
+      by blast
+    moreover
+    have "admissible_transaction_selects T"
+      using T_adm admissible_transaction_def
+      by blast
+    then have "is_Fun_Set (the_set_term (select\<langle>Var y,s\<rangle>))"
+      using s unfolding admissible_transaction_selects_def
+      by auto
+    then have "\<exists>ss. s = Fun (Set ss) []"
+      using is_Fun_Set_exi
+      by auto
+    ultimately
+    obtain n ss where nss: "y = (TAtom Value, n)" "s = Fun (Set ss) []"
+      by auto
+    then have "select\<langle>Var (TAtom Value, n), Fun (Set ss) []\<rangle> \<in> set (unlabel (transaction_selects T))"
+      using s by auto
+    then have in_db: "(\<alpha> (TAtom Value, n) \<cdot> \<I>, Fun (Set ss) []) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+      using transaction_selects_db_here[of n ss] by auto
+    have "(\<I> z, s) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+    proof -
+      have "(\<alpha> y \<cdot> \<I>, s) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+        using in_db nss by auto
+      moreover 
+      have "\<alpha> y = Var z"
+        using zn
+        by (metis (no_types, hide_lams) \<sigma> subst_compose_def subst_imgI subst_to_var_is_var
+                  term.distinct(1) transaction_fresh_subst_def var_comp(2)) 
+      then have "\<alpha> y \<cdot> \<I> = \<I> z"
+        by auto
+      ultimately
+      show "(\<I> z, s) \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+        by auto
+    qed
+    then have "\<exists>t' s'. insert\<langle>t',s'\<rangle> \<in> set (unlabel \<A>) \<and> \<I> z = t' \<cdot> \<I> \<and> s = s' \<cdot> \<I>"
+      using db\<^sub>s\<^sub>s\<^sub>t_in_cases[of "\<I> z" s "unlabel \<A>" \<I> "[]"] unfolding db\<^sub>s\<^sub>s\<^sub>t_def by auto
+    then obtain t' s' where t's': "insert\<langle>t',s'\<rangle> \<in> set (unlabel \<A>) \<and> \<I> z = t' \<cdot> \<I> \<and> s = s' \<cdot> \<I>"
+      by auto
+    then have "t' \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+      by force
+    then have "t' \<cdot> \<I> \<in> (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
+      by auto
+    then have "\<I> z \<in> (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
+      using t's' by auto
+    then have "\<I> z \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A> \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<I>))"
+      using reachable_constraints_subterms_subst[
+              OF \<A>_reach welltyped_constraint_model_prefix[OF \<I>] P]
+      by auto
+    then show ?B
+      using zn(1) by simp
+  qed
+qed
+
+lemma transaction_prop5:
+  fixes T \<sigma> \<alpha> \<A> \<I> T' a0 a0' \<theta>
+  defines "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+    and "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+    and "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<I>)"
+    and "\<theta> \<equiv> \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x"
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and T: "T \<in> set P"
+    and \<I>: "welltyped_constraint_model \<I> (\<A>@T')"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+    and FP:
+      "analyzed (timpl_closure_set (set FP) (set TI))"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
+      "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
+    and OCC:
+      "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
+      "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
+      "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
+    and TI:
+      "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+    and P:
+      "\<forall>T \<in> set P. admissible_transaction T"
+    and step: "list_all (transaction_check FP OCC TI) P"
+  shows "\<exists>\<delta> \<in> abs_substs_fun ` set (transaction_check_comp FP OCC TI T).
+         \<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
+            (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 = absc (\<delta> x) \<and>
+            (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' = absc (absdbupd (unlabel (transaction_updates T)) x (\<delta> x))"
+proof -
+  define comp0 where "comp0 \<equiv> abs_substs_fun ` set (transaction_check_comp FP OCC TI T)"
+  define check0 where "check0 \<equiv> transaction_check FP OCC TI T"
+  define upd where "upd \<equiv> \<lambda>\<delta> x. absdbupd (unlabel (transaction_updates T)) x (\<delta> x)"
+  define b0 where "b0 \<equiv> \<lambda>x. THE b. absc b = (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0"
+
+  note all_defs = comp0_def check0_def a0_def a0'_def upd_def b0_def \<theta>_def T'_def
+
+  have \<theta>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<delta>)" for \<delta>
+    unfolding \<theta>_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
+    by fastforce
+
+  have \<A>_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+    by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \<A>_reach)
+
+  have \<I>_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
+    and \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
+    and \<I>_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
+    by (metis \<I> welltyped_constraint_model_def constraint_model_def,
+        metis \<I> welltyped_constraint_model_def,
+        metis \<I> welltyped_constraint_model_def constraint_model_def)
+
+  have \<I>_is_T_model: "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) (set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)) (unlabel T') \<I>"
+    using \<I> unlabel_append[of \<A> T'] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>" \<I> "[]"]
+          strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" "unlabel T'" \<I>]
+    by (simp add: welltyped_constraint_model_def constraint_model_def db\<^sub>s\<^sub>s\<^sub>t_def)
+
+  have T_adm: "admissible_transaction T"
+    using T P(1) Ball_set[of P "admissible_transaction"]
+    by blast
+  hence T_valid: "wellformed_transaction T"
+    unfolding admissible_transaction_def by blast
+
+  have T_no_bvars: "fv_transaction T = vars_transaction T" "bvars_transaction T = {}"
+    using transaction_no_bvars[OF T_adm] by simp_all
+
+  have T_vars_const_typed: "\<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<or> (\<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a))"
+    and T_fresh_vars_value_typed: "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+    using T P protocol_transaction_vars_TAtom_typed(2,3)[of T] by simp_all
+
+  have wt_\<sigma>\<alpha>\<I>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>)" and wt_\<sigma>\<alpha>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+    using \<I>_wt wt_subst_compose transaction_fresh_subst_wt[OF \<sigma> T_fresh_vars_value_typed]
+          transaction_renaming_subst_wt[OF \<alpha>]
+    by blast+
+
+  have T_vars_vals: "\<forall>x \<in> fv_transaction T. \<exists>n. (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> = Fun (Val (n, False)) []"
+  proof
+    fix x assume x: "x \<in> fv_transaction T"
+    show "\<exists>n. (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> = Fun (Val (n, False)) []"
+    proof (cases "x \<in> subst_domain \<sigma>")
+      case True
+      then obtain n where "\<sigma> x = Fun (Val (n, False)) []"
+        using \<sigma> unfolding transaction_fresh_subst_def
+        by moura
+      thus ?thesis by (simp add: subst_compose_def)
+    next
+      case False
+      hence *: "(\<sigma> \<circ>\<^sub>s \<alpha>) x = \<alpha> x" by (auto simp add: subst_compose_def)
+      
+      obtain y where y: "\<Gamma>\<^sub>v x = \<Gamma>\<^sub>v y" "\<alpha> x = Var y"
+        using transaction_renaming_subst_wt[OF \<alpha>]
+              transaction_renaming_subst_is_renaming[OF \<alpha>]
+        by (metis \<Gamma>.simps(1) prod.exhaust wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
+      hence "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+        using x * T_no_bvars(2) unlabel_subst[of "transaction_strand T" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+              fv\<^sub>s\<^sub>s\<^sub>t_subst_fv_subset[of x "unlabel (transaction_strand T)" "\<sigma> \<circ>\<^sub>s \<alpha>"]
+        by auto
+      hence "y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+        using fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
+              fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] unlabel_append[of \<A>]
+        by auto
+      thus ?thesis
+        using x y * T P (* T_vars_const_typed *)
+              constraint_model_Value_term_is_Val[
+                OF reachable_constraints.step[OF \<A>_reach T \<sigma> \<alpha>] \<I>[unfolded T'_def] P(1), of y]
+              admissible_transaction_Value_vars[of T]
+        by simp
+    qed
+  qed
+
+  have T_vars_absc: "\<forall>x \<in> fv_transaction T. \<exists>!n. (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 = absc n"
+    using T_vars_vals by fastforce
+  hence "(absc \<circ> b0) x = (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0" when "x \<in> fv_transaction T" for x
+    using that unfolding b0_def by fastforce
+  hence T_vars_absc': "t \<cdot> (absc \<circ> b0) = t \<cdot> (\<sigma> \<circ>\<^sub>s \<alpha>) \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0"
+    when "fv t \<subseteq> fv_transaction T" "\<nexists>n T. Fun (Val n) T \<in> subterms t" for t
+    using that(1) abs_term_subst_eq'[OF _ that(2), of "\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>" a0 "absc \<circ> b0"]
+          subst_compose[of "\<sigma> \<circ>\<^sub>s \<alpha>" \<I>] subst_subst_compose[of t "\<sigma> \<circ>\<^sub>s \<alpha>" \<I>]
+    by fastforce
+
+  have "\<exists>\<delta> \<in> comp0. \<forall>x \<in> fv_transaction T. fst x = TAtom Value \<longrightarrow> b0 x = \<delta> x"
+  proof -
+    let ?S = "set (unlabel (transaction_selects T))"
+    let ?C = "set (unlabel (transaction_checks T))"
+    let ?xs = "fv_transaction T - set (transaction_fresh T)"
+
+    note * = transaction_prop3[OF \<A>_reach T \<I>[unfolded T'_def] \<sigma> \<alpha> FP OCC TI P(1)]
+
+    have **:
+        "\<forall>x \<in> set (transaction_fresh T). b0 x = {}"
+        "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> b0)"
+          (is ?B)
+    proof -
+      show ?B
+      proof (intro ballI impI)
+        fix t assume t: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
+        hence t': "fv t \<subseteq> fv_transaction T" "\<nexists>n T. Fun (Val n) T \<in> subterms t"
+          using trms_transaction_unfold[of T] vars_transaction_unfold[of T]
+                trms\<^sub>s\<^sub>s\<^sub>t_fv_vars\<^sub>s\<^sub>s\<^sub>t_subset[of t "unlabel (transaction_strand T)"]
+                transactions_have_no_Value_consts'[OF T_adm]
+                wellformed_transaction_send_receive_fv_subset(1)[OF T_valid t(1)]
+          by blast+
+        
+        have "intruder_synth_mod_timpls FP TI (t \<cdot> (absc \<circ> b0))"
+          using t(1) t' *(2) T_vars_absc'
+          by (metis a0_def)
+        moreover have "(absc \<circ> b0) x = (\<theta> b0) x" when "x \<in> fv t" for x
+          using that T P admissible_transaction_Value_vars[of T]
+                \<open>fv t \<subseteq> fv_transaction T\<close> \<Gamma>\<^sub>v_TAtom''(2)[of x]
+          unfolding \<theta>_def by fastforce
+        hence "t \<cdot> (absc \<circ> b0) = t \<cdot> \<theta> b0"
+          using term_subst_eq[of t "absc \<circ> b0" "\<theta> b0"] by argo
+        ultimately show "intruder_synth_mod_timpls FP TI (t \<cdot> \<theta> b0)"
+          using intruder_synth.simps[of "set FP"] by (cases "t \<cdot> \<theta> b0") metis+
+      qed
+    qed (simp add: *(1) a0_def b0_def)
+
+    have ***: "\<forall>x \<in> ?xs. \<forall>s. select\<langle>Var x,Fun (Set s) []\<rangle> \<in> ?S \<longrightarrow> s \<in> b0 x"
+              "\<forall>x \<in> ?xs. \<forall>s. \<langle>Var x in Fun (Set s) []\<rangle> \<in> ?C \<longrightarrow> s \<in> b0 x"
+              "\<forall>x \<in> ?xs. \<forall>s. \<langle>Var x not in Fun (Set s) []\<rangle> \<in> ?C \<longrightarrow> s \<notin> b0 x"
+              "\<forall>x \<in> ?xs. fst x = TAtom Value \<longrightarrow> b0 x \<in> set OCC"
+      unfolding a0_def b0_def
+      using *(3,4) apply (force, force)
+      using *(5) apply force
+      using *(6) admissible_transaction_Value_vars[OF bspec[OF P T]] by force
+
+    show ?thesis
+      using transaction_check_comp_in[OF T_adm **[unfolded \<theta>_def] ***]
+      unfolding comp0_def
+      by metis
+  qed
+  hence 1: "\<exists>\<delta> \<in> comp0. \<forall>x \<in> fv_transaction T.
+              fst x = TAtom Value \<longrightarrow> (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 = absc (\<delta> x)"
+    using T_vars_absc unfolding b0_def a0_def by fastforce
+
+  obtain \<delta> where \<delta>:
+      "\<delta> \<in> comp0" "\<forall>x \<in> fv_transaction T. fst x = TAtom Value \<longrightarrow> (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 = absc (\<delta> x)"
+    using 1 by moura
+
+  have 2: "\<theta> x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) = absc (absdbupd (unlabel A) x d)"
+    when "\<theta> x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 D = absc d"
+    and "\<forall>t u. insert\<langle>t,u\<rangle> \<in> set (unlabel A) \<longrightarrow> (\<exists>y s. t = Var y \<and> u = Fun (Set s) [])"
+    and "\<forall>t u. delete\<langle>t,u\<rangle> \<in> set (unlabel A) \<longrightarrow> (\<exists>y s. t = Var y \<and> u = Fun (Set s) [])"
+    and "\<forall>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<theta> x \<cdot> \<I> = \<theta> y \<cdot> \<I> \<longrightarrow> x = y"
+    and "\<forall>y \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<exists>n. \<theta> y \<cdot> \<I> = Fun (Val n) []"
+    and x: "\<theta> x \<cdot> \<I> = Fun (Val n) []"
+    and D: "\<forall>d \<in> set D. \<exists>s. snd d = Fun (Set s) []"
+    for A::"('fun,'atom,'sets,'nat) prot_strand" and x \<theta> D n d
+    using that(2,3,4,5)
+  proof (induction A rule: List.rev_induct)
+    case (snoc a A)
+    then obtain l b where a: "a = (l,b)" by (metis surj_pair)
+
+    have IH: "\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n = absdbupd (unlabel A) x d"
+      using snoc unlabel_append[of A "[a]"] a x
+      by (simp del: unlabel_append)
+
+    have b_prems: "\<forall>y \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p b. \<theta> x \<cdot> \<I> = \<theta> y \<cdot> \<I> \<longrightarrow> x = y"
+                  "\<forall>y \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p b. \<exists>n. \<theta> y \<cdot> \<I> = Fun (Val n) []"
+      using snoc.prems(3,4) a by (simp_all add: unlabel_def)
+
+    have *: "filter is_Update (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))) =
+             filter is_Update (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))"
+            "filter is_Update (unlabel (A@[a])) = filter is_Update (unlabel A)"
+      when "\<not>is_Update b"
+      using that a
+      by (cases b, simp_all add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def unlabel_def subst_apply_labeled_stateful_strand_def)+
+
+    note ** = IH a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_append[of A "[a]" \<theta>]
+
+    note *** = * absdbupd_filter[of "unlabel (A@[a])"]
+               absdbupd_filter[of "unlabel A"]
+               db\<^sub>s\<^sub>s\<^sub>t_filter[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"]
+               db\<^sub>s\<^sub>s\<^sub>t_filter[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"]
+
+    note **** = **(2,3) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc[of A a \<theta>]
+                unlabel_append[of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>" "[dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]"]
+                db\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" "unlabel [dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]" \<I> D]
+
+    have "\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n = absdbupd (unlabel (A@[a])) x d" using ** ***
+    proof (cases b)
+      case (Insert t t')
+      then obtain y s m where y: "t = Var y" "t' = Fun (Set s) []" "\<theta> y \<cdot> \<I> = Fun (Val m) []"
+        using snoc.prems(1) b_prems(2) a by (fastforce simp add: unlabel_def)
+      hence a': "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D =
+                 List.insert ((Fun (Val m) [], Fun (Set s) [])) (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<I> D)"
+                "unlabel [dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>] = [insert\<langle>\<theta> y, Fun (Set s) []\<rangle>]"
+                "unlabel [a] = [insert\<langle>Var y, Fun (Set s) []\<rangle>]"
+        using **** Insert by simp_all
+
+      show ?thesis
+      proof (cases "x = y")
+        case True
+        hence "\<theta> x \<cdot> \<I> = \<theta> y \<cdot> \<I>" by simp
+        hence "\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n =
+               insert s (\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n)"
+          by (metis (no_types, lifting) y(3) a'(1) x dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst to_abs_list_insert')
+        thus ?thesis using True IH a'(3) absdbupd_append[of "unlabel A"] by (simp add: unlabel_def)
+      next
+        case False
+        hence "\<theta> x \<cdot> \<I> \<noteq> \<theta> y \<cdot> \<I>" using b_prems(1) y Insert by simp
+        hence "\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n = \<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n"
+          by (metis (no_types, lifting) y(3) a'(1) x dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst to_abs_list_insert)
+        thus ?thesis using False IH a'(3) absdbupd_append[of "unlabel A"] by (simp add: unlabel_def)
+      qed
+    next
+      case (Delete t t')
+      then obtain y s m where y: "t = Var y" "t' = Fun (Set s) []" "\<theta> y \<cdot> \<I> = Fun (Val m) []"
+        using snoc.prems(2) b_prems(2) a by (fastforce simp add: unlabel_def)
+      hence a': "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D =
+                 List.removeAll ((Fun (Val m) [], Fun (Set s) [])) (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<I> D)"
+                "unlabel [dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>] = [delete\<langle>\<theta> y, Fun (Set s) []\<rangle>]"
+                "unlabel [a] = [delete\<langle>Var y, Fun (Set s) []\<rangle>]"
+        using **** Delete by simp_all
+
+      have "\<exists>s S. snd d = Fun (Set s) []" when "d \<in> set (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<I> D)" for d
+        using snoc.prems(1,2) db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_ex[OF that _ _ D] by (simp add: unlabel_def)
+      moreover {
+        fix t::"('fun,'atom,'sets) prot_term"
+          and D::"(('fun,'atom,'sets) prot_term \<times> ('fun,'atom,'sets) prot_term) list"
+        assume "\<forall>d \<in> set D. \<exists>s. snd d = Fun (Set s) []"
+        hence "removeAll (t, Fun (Set s) []) D = filter (\<lambda>d. \<nexists>S. d = (t, Fun (Set s) S)) D"
+          by (induct D) auto
+      } ultimately have a'':
+          "List.removeAll ((Fun (Val m) [], Fun (Set s) [])) (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<I> D) =
+           filter (\<lambda>d. \<nexists>S. d = (Fun (Val m) [], Fun (Set s) S)) (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<I> D)"
+        by simp
+
+      show ?thesis
+      proof (cases "x = y")
+        case True
+        hence "\<theta> x \<cdot> \<I> = \<theta> y \<cdot> \<I>" by simp
+        hence "\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n =
+               (\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n) - {s}"
+          using y(3) a'' a'(1) x by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst to_abs_list_remove_all')
+        thus ?thesis using True IH a'(3) absdbupd_append[of "unlabel A"] by (simp add: unlabel_def)
+      next
+        case False
+        hence "\<theta> x \<cdot> \<I> \<noteq> \<theta> y \<cdot> \<I>" using b_prems(1) y Delete by simp
+        hence "\<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n = \<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<I> D) n"
+          by (metis (no_types, lifting) y(3) a'(1) x dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst to_abs_list_remove_all)
+        thus ?thesis using False IH a'(3) absdbupd_append[of "unlabel A"] by (simp add: unlabel_def)
+      qed
+    qed simp_all
+    thus ?case by (simp add: x)
+  qed (simp add: that(1))
+
+  have 3: "x = y"
+    when xy: "(\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> = (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I>" "x \<in> fv_transaction T" "y \<in> fv_transaction T"
+    for x y
+  proof -
+    have "x \<notin> set (transaction_fresh T) \<Longrightarrow> y \<notin> set (transaction_fresh T) \<Longrightarrow> ?thesis"
+      using xy admissible_transaction_strand_sem_fv_ineq[OF T_adm \<I>_is_T_model[unfolded T'_def]]
+      by fast
+    moreover {
+      assume *: "x \<in> set (transaction_fresh T)" "y \<in> set (transaction_fresh T)"
+      then obtain xn yn where "\<sigma> x = Fun (Val xn) []" "\<sigma> y = Fun (Val yn) []"
+        by (metis transaction_fresh_subst_sends_to_val[OF \<sigma>])
+      hence "\<sigma> x = \<sigma> y" using that(1) by (simp add: subst_compose)
+      moreover have "inj_on \<sigma> (subst_domain \<sigma>)" "x \<in> subst_domain \<sigma>" "y \<in> subst_domain \<sigma>"
+        using * \<sigma> unfolding transaction_fresh_subst_def by auto
+      ultimately have ?thesis unfolding inj_on_def by blast
+    } moreover have False when "x \<in> set (transaction_fresh T)" "y \<notin> set (transaction_fresh T)"
+      using that(2) xy T_no_bvars admissible_transaction_Value_vars[OF bspec[OF P T], of y]
+            transaction_prop4[OF \<A>_reach T \<I>[unfolded T'_def] \<sigma> \<alpha> P that(1), of y]
+      by auto
+    moreover have False when "x \<notin> set (transaction_fresh T)" "y \<in> set (transaction_fresh T)"
+      using that(1) xy T_no_bvars admissible_transaction_Value_vars[OF bspec[OF P T], of x]
+            transaction_prop4[OF \<A>_reach T \<I>[unfolded T'_def] \<sigma> \<alpha> P that(2), of x]
+      by fastforce
+    ultimately show ?thesis by metis
+  qed
+
+  have 4: "\<exists>y s. t = Var y \<and> u = Fun (Set s) []"
+    when "insert\<langle>t,u\<rangle> \<in> set (unlabel (transaction_strand T))" for t u
+    using that admissible_transaction_strand_step_cases(4)[OF T_adm] T_valid
+    by blast
+
+  have 5: "\<exists>y s. t = Var y \<and> u = Fun (Set s) []"
+    when "delete\<langle>t,u\<rangle> \<in> set (unlabel (transaction_strand T))" for t u
+    using that admissible_transaction_strand_step_cases(4)[OF T_adm] T_valid
+    by blast
+
+  have 6: "\<exists>n. (\<sigma> \<circ>\<^sub>s \<alpha>) y \<cdot> \<I> = Fun (Val (n, False)) []" when "y \<in> fv_transaction T" for y
+    using that by (simp add: T_vars_vals)
+
+  have "list_all wellformed_transaction P" "list_all admissible_transaction_updates P"
+    using P(1) Ball_set[of P "admissible_transaction"] Ball_set[of P wellformed_transaction]
+          Ball_set[of P admissible_transaction_updates]
+    unfolding admissible_transaction_def by fastforce+
+  hence 7: "\<exists>s. snd d = Fun (Set s) []" when "d \<in> set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)" for d
+    using that reachable_constraints_db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_args_empty[OF \<A>_reach]
+    unfolding admissible_transaction_updates_def by (cases d) simp
+
+  have "(\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' = absc (upd \<delta> x)"
+    when x: "x \<in> fv_transaction T" "fst x = TAtom Value" for x
+  proof -
+    have "(\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) \<I> (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>))
+           = absc (absdbupd (unlabel (transaction_strand T)) x (\<delta> x))"
+      using 2[of "\<sigma> \<circ>\<^sub>s \<alpha>" x "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>" "\<delta> x" "transaction_strand T"]
+            3[OF _ x(1)] 4 5 6[OF that(1)] 6 7 x \<delta>(2)
+      unfolding all_defs by blast
+    thus ?thesis
+      using x db\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>"] absdbupd_wellformed_transaction[OF T_valid]
+      unfolding all_defs db\<^sub>s\<^sub>s\<^sub>t_def by force
+  qed
+  thus ?thesis using \<delta> \<Gamma>\<^sub>v_TAtom''(2) unfolding all_defs by blast
+qed
+
+lemma transaction_prop6:
+  fixes T \<sigma> \<alpha> \<A> \<I> T' a0 a0'
+  defines "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+    and "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+    and "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<I>)"
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and T: "T \<in> set P"
+    and \<I>: "welltyped_constraint_model \<I> (\<A>@T')"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+    and FP:
+      "analyzed (timpl_closure_set (set FP) (set TI))"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
+      "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
+    and OCC:
+      "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
+      "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
+      "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
+    and TI:
+      "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+    and P:
+      "\<forall>T \<in> set P. admissible_transaction T"
+    and step: "list_all (transaction_check FP OCC TI) P"
+  shows "\<forall>t \<in> timpl_closure_set (\<alpha>\<^sub>i\<^sub>k \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>).
+          timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t" (is ?A)
+    and "timpl_closure_set (\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>) \<subseteq> absc ` set OCC" (is ?B)
+    and "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T). is_Fun (t \<cdot> (\<sigma> \<circ>\<^sub>s \<alpha>) \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0') \<longrightarrow>
+          timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t \<cdot> (\<sigma> \<circ>\<^sub>s \<alpha>) \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0'" (is ?C)
+    and "\<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
+          (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> absc ` set OCC" (is ?D)
+proof -
+  define comp0 where "comp0 \<equiv> abs_substs_fun ` set (transaction_check_comp FP OCC TI T)"
+  define check0 where "check0 \<equiv> transaction_check FP OCC TI T"
+
+  define upd where "upd \<equiv> \<lambda>\<delta> x. absdbupd (unlabel (transaction_updates T)) x (\<delta> x)"
+
+  define \<theta> where "\<theta> \<equiv> \<lambda>\<delta> x. if fst x = TAtom Value then (absc \<circ> \<delta>) x else Var x"
+
+  have T_adm: "admissible_transaction T" using T P(1) by metis
+  hence T_valid: "wellformed_transaction T" by (metis admissible_transaction_def)
+
+  have \<theta>_prop: "\<theta> \<sigma> x = absc (\<sigma> x)" when "\<Gamma>\<^sub>v x = TAtom Value" for \<sigma> x
+    using that \<Gamma>\<^sub>v_TAtom''(2)[of x] unfolding \<theta>_def by simp
+
+  (* The set-membership status of all value constants in T under \<I>, \<sigma>, \<alpha> are covered by the check *)
+  have 0: "\<exists>\<delta> \<in> comp0. \<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
+            (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 = absc (\<delta> x) \<and>
+            (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' = absc (upd \<delta> x)"
+    using transaction_prop5[OF \<A>_reach T \<I>[unfolded T'_def] \<sigma> \<alpha> FP OCC TI P step]
+    unfolding a0_def a0'_def T'_def upd_def comp0_def
+    by blast
+
+  (* All set-membership changes are covered by the term implication graph *)
+  have 1: "(\<delta> x, upd \<delta> x) \<in> (set TI)\<^sup>+"
+    when "\<delta> \<in> comp0" "\<delta> x \<noteq> upd \<delta> x" "x \<in> fv_transaction T" "x \<notin> set (transaction_fresh T)"
+    for x \<delta> 
+    using T that step Ball_set[of P "transaction_check FP OCC TI"]
+          transaction_prop1[of \<delta> FP OCC TI T x] TI
+    unfolding upd_def comp0_def
+    by blast
+
+  (* All set-membership changes are covered by the fixed point *)
+  have 2: (* "\<delta> x \<in> set OCC" *) "upd \<delta> x \<in> set OCC"
+    when "\<delta> \<in> comp0" "x \<in> fv_transaction T" "fst x = TAtom Value" for x \<delta>
+    using T that step Ball_set[of P "transaction_check FP OCC TI"]
+          T_adm FP OCC TI transaction_prop2[of \<delta> FP OCC TI T x]
+    unfolding upd_def comp0_def
+    by blast+
+  
+  obtain \<delta> where \<delta>:
+      "\<delta> \<in> comp0"
+      "\<forall>x \<in> fv_transaction T. \<Gamma>\<^sub>v x = TAtom Value \<longrightarrow>
+        (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 = absc (\<delta> x) \<and>
+        (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' = absc (upd \<delta> x)"
+    using 0 by moura
+
+  have "\<exists>x. ab = (\<delta> x, upd \<delta> x) \<and> x \<in> fv_transaction T - set (transaction_fresh T) \<and> \<delta> x \<noteq> upd \<delta> x"
+    when ab: "ab \<in> \<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>" for ab
+  proof -
+    obtain a b where ab': "ab = (a,b)" by (metis surj_pair)
+    then obtain x where x:
+        "a \<noteq> b" "x \<in> fv_transaction T" "x \<notin> set (transaction_fresh T)"
+        "absc a = (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0" "absc b = (\<sigma> \<circ>\<^sub>s \<alpha>) x \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0'"
+      using ab unfolding abs_term_implications_def a0_def a0'_def T'_def by blast
+    hence "absc a = absc (\<delta> x)" "absc b = absc (upd \<delta> x)"
+      using \<delta>(2) admissible_transaction_Value_vars[OF bspec[OF P T] x(2)]
+      by metis+
+    thus ?thesis using x ab' by blast
+  qed
+  hence \<alpha>\<^sub>t\<^sub>i_TI_subset: "\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I> \<subseteq> {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}" using 1[OF \<delta>(1)] by blast
+  
+  have "timpl_closure_set (timpl_closure_set (set FP) (set TI)) (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>) \<turnstile>\<^sub>c t"
+    when t: "t \<in> timpl_closure_set (\<alpha>\<^sub>i\<^sub>k \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>)" for t
+    using timpl_closure_set_is_timpl_closure_union[of "\<alpha>\<^sub>i\<^sub>k \<A> \<I>" "\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>"]
+          intruder_synth_timpl_closure_set FP(3) t
+    by blast
+  thus ?A
+    using ideduct_synth_mono[OF _ timpl_closure_set_mono[OF
+            subset_refl[of "timpl_closure_set (set FP) (set TI)"]
+            \<alpha>\<^sub>t\<^sub>i_TI_subset]]
+          timpl_closure_set_timpls_trancl_eq'[of "timpl_closure_set (set FP) (set TI)" "set TI"]
+    unfolding timpl_closure_set_idem
+    by force
+
+  have "timpl_closure_set (\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>) \<subseteq>
+        timpl_closure_set (absc ` set OCC) {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+    using timpl_closure_set_mono[OF _ \<alpha>\<^sub>t\<^sub>i_TI_subset] OCC(3) by blast
+  thus ?B using OCC(2) timpl_closure_set_timpls_trancl_subset' by blast
+
+  have "transaction_check_post FP TI T \<delta>"
+    using T \<delta>(1) step
+    unfolding transaction_check_def comp0_def list_all_iff
+    by blast
+  hence 3: "timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t \<cdot> \<theta> (upd \<delta>)"
+    when "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "is_Fun (t \<cdot> \<theta> (upd \<delta>))" for t
+    using that
+    unfolding transaction_check_post_def upd_def \<theta>_def
+              intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI, symmetric]
+    by meson
+
+  have 4: "\<forall>x \<in> fv t. (\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>) x \<cdot>\<^sub>\<alpha> a0' = \<theta> (upd \<delta>) x"
+    when "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" for t
+    using wellformed_transaction_send_receive_fv_subset(2)[OF T_valid that]
+          \<delta>(2) subst_compose[of "\<sigma> \<circ>\<^sub>s \<alpha>" \<I>] \<theta>_prop
+          admissible_transaction_Value_vars[OF bspec[OF P T]]
+    by fastforce
+  
+  have 5: "\<nexists>n T. Fun (Val n) T \<in> subterms t" when "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" for t
+    using that transactions_have_no_Value_consts'[OF T_adm] trms_transaction_unfold[of T]
+    by blast
+
+  show ?D using 2[OF \<delta>(1)] \<delta>(2) \<Gamma>\<^sub>v_TAtom''(2) unfolding a0'_def T'_def by blast
+
+  show ?C using 3 abs_term_subst_eq'[OF 4 5] by simp
+qed
+
+lemma reachable_constraints_covered_step:
+  fixes \<A>::"('fun,'atom,'sets,'lbl) prot_constr"
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and T: "T \<in> set P"
+    and \<I>: "welltyped_constraint_model \<I> (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>))"
+    and \<sigma>: "transaction_fresh_subst \<sigma> T \<A>"
+    and \<alpha>: "transaction_renaming_subst \<alpha> P \<A>"
+    and FP:
+      "analyzed (timpl_closure_set (set FP) (set TI))"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
+      "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
+      "ground (set FP)"
+    and OCC:
+      "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
+      "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
+      "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
+    and TI:
+      "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+    and P:
+      "\<forall>T \<in> set P. admissible_transaction T"
+    and transactions_covered: "list_all (transaction_check FP OCC TI) P"
+  shows "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) \<I>.
+          timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t" (is ?A)
+    and "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s (\<A>@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)) \<I> \<subseteq> absc ` set OCC" (is ?B)
+proof -
+  note step_props = transaction_prop6[OF \<A>_reach T \<I> \<sigma> \<alpha> FP(1,2,3) OCC TI P transactions_covered]
+
+  define T' where "T' \<equiv> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>)"
+  define a0 where "a0 \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)"
+  define a0' where "a0' \<equiv> \<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@T') \<I>)"
+
+  define vals where "vals \<equiv> \<lambda>S::('fun,'atom,'sets,'lbl) prot_constr.
+      {t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>. \<exists>n. t = Fun (Val n) []}"
+
+  define vals_sym where "vals_sym \<equiv> \<lambda>S::('fun,'atom,'sets,'lbl) prot_constr.
+      {t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S). (\<exists>n. t = Fun (Val n) []) \<or> (\<exists>m. t = Var (TAtom Value,m))}"
+
+  have \<I>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" by (metis \<I> welltyped_constraint_model_def)
+
+  have \<I>_grounds: "fv (t \<cdot> \<I>) = {}" for t
+    using \<I> interpretation_grounds[of \<I>]
+    unfolding welltyped_constraint_model_def constraint_model_def by auto
+
+  have T_fresh_vars_value_typed: "\<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+    using protocol_transaction_vars_TAtom_typed[OF bspec[OF P(1) T]] by simp_all
+
+  have wt_\<sigma>\<alpha>\<I>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>)" and wt_\<sigma>\<alpha>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>)"
+    using \<I>_wt wt_subst_compose transaction_fresh_subst_wt[OF \<sigma> T_fresh_vars_value_typed]
+          transaction_renaming_subst_wt[OF \<alpha>]
+    by blast+
+
+  have "\<forall>T\<in>set P. bvars_transaction T = {}"
+    using P unfolding list_all_iff admissible_transaction_def by metis
+  hence \<A>_no_bvars: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
+    using reachable_constraints_no_bvars[OF \<A>_reach] by metis
+
+  have \<I>_vals: "\<exists>n. \<I> (TAtom Value, m) = Fun (Val n) []"
+    when "(TAtom Value, m) \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" for m
+    using constraint_model_Value_term_is_Val'[
+            OF \<A>_reach welltyped_constraint_model_prefix[OF \<I>] P(1)]
+          \<A>_no_bvars vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \<A>"] that
+    by blast
+
+  have vals_sym_vals: "t \<cdot> \<I> \<in> vals \<A>" when t: "t \<in> vals_sym \<A>" for t
+  proof (cases t)
+    case (Var x)
+    then obtain m where *: "x = (TAtom Value,m)" using t unfolding vals_sym_def by blast
+    moreover have "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" using t unfolding vals_sym_def by blast
+    hence "t \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "\<exists>n. \<I> (Var Value, m) = Fun (Val n) []"
+      using Var * \<I>_vals[of m] var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t[of x "unlabel \<A>"]
+            \<Gamma>\<^sub>v_TAtom[of Value m] reachable_constraints_Value_vars_are_fv[OF \<A>_reach P(1), of x]
+      by blast+
+    ultimately show ?thesis using Var unfolding vals_def by auto
+  next
+    case (Fun f T)
+    then obtain n where "f = Val n" "T = []" using t unfolding vals_sym_def by blast
+    moreover have "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" using t unfolding vals_sym_def by blast
+    hence "t \<cdot> \<I> \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using Fun by blast
+    ultimately show ?thesis using Fun unfolding vals_def by auto
+  qed
+
+  have vals_vals_sym: "\<exists>s. s \<in> vals_sym \<A> \<and> t = s \<cdot> \<I>" when "t \<in> vals \<A>" for t
+    using that constraint_model_Val_is_Value_term[OF \<I>]
+    unfolding vals_def vals_sym_def by fast
+
+  have T_adm: "admissible_transaction T" and T_valid: "wellformed_transaction T"
+    apply (metis P(1) T)
+    using P(1) T Ball_set[of P "admissible_transaction"]
+    unfolding admissible_transaction_def by fastforce
+
+  have 0:
+      "\<alpha>\<^sub>i\<^sub>k (\<A>@T') \<I> = (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0' \<union> (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0'"
+      "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s (\<A>@T') \<I> = vals \<A> \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0' \<union> vals T' \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0'"
+    by (metis abs_intruder_knowledge_append a0'_def,
+        metis abs_value_constants_append[of \<A> T' \<I>] a0'_def vals_def)
+
+  have 1: "(ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0' =
+           (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0'"
+    by (metis T'_def dual_transaction_ik_is_transaction_send''[OF T_valid])
+
+  have 2: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<inter> subst_domain \<sigma> = {}"
+          "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<inter> subst_domain \<alpha> = {}"
+    using T_adm unfolding admissible_transaction_def
+    by blast+
+
+  have "vals T' \<subseteq> (\<sigma> \<circ>\<^sub>s \<alpha>) ` fv_transaction T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
+  proof
+    fix t assume "t \<in> vals T'"
+    then obtain s n where s:
+        "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" "t = s \<cdot> \<I>" "t = Fun (Val n) []"
+      unfolding vals_def by fast
+    then obtain u where u:
+        "u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))"
+        "s = u \<cdot> (\<sigma> \<circ>\<^sub>s \<alpha>)"
+      using transaction_fresh_subst_transaction_renaming_subst_trms[OF \<sigma> \<alpha> 2]
+            trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma> \<circ>\<^sub>s \<alpha>"]
+      unfolding T'_def by blast
+
+    have *: "t = u \<cdot> (\<sigma> \<circ>\<^sub>s \<alpha> \<circ>\<^sub>s \<I>)" by (metis subst_subst_compose s(2) u(2)) 
+    then obtain x where x: "u = Var x"
+      using s(3) transactions_have_no_Value_consts(1)[OF T_adm u(1)] by (cases u) force+
+    hence **: "x \<in> vars_transaction T"
+      by (metis u(1) var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t)
+
+    have "\<Gamma>\<^sub>v x = TAtom Value"
+      using * x s(3) wt_subst_trm''[OF wt_\<sigma>\<alpha>\<I>, of u]
+      by simp
+    thus "t \<in> (\<sigma> \<circ>\<^sub>s \<alpha>) ` fv_transaction T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
+      using transaction_Value_vars_are_fv[OF T_adm **] x *
+      by (metis subst_comp_set_image rev_image_eqI subst_apply_term.simps(1))
+  qed
+  hence 3: "vals T' \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0' \<subseteq> ((\<sigma> \<circ>\<^sub>s \<alpha>) ` fv_transaction T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0'"
+    by (simp add: abs_apply_terms_def image_mono)
+
+  have "t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set (\<alpha>\<^sub>i\<^sub>k \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>)"
+    when "t \<in> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>" for t
+    using that abs_in[OF imageI[OF that]]
+          \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_ik[OF \<A>_reach T \<I> \<sigma> \<alpha> P(1)]
+          timpl_closure_set_mono[of "{t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0}" "\<alpha>\<^sub>i\<^sub>k \<A> \<I>" "\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>" "\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>"]
+    unfolding a0_def a0'_def T'_def abs_intruder_knowledge_def by fast
+  hence A: "\<alpha>\<^sub>i\<^sub>k (\<A>@T') \<I> \<subseteq>
+              timpl_closure_set (\<alpha>\<^sub>i\<^sub>k \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>) \<union>
+              (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<sigma> \<circ>\<^sub>s \<alpha>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0'"
+    using 0(1) 1 by (auto simp add: abs_apply_terms_def)
+
+  have "t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set {t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0} (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>)"
+    when t: "t \<in> vals_sym \<A>" for t
+  proof -
+    have "(\<exists>n. t = Fun (Val n) [] \<and> t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)) \<or>
+          (\<exists>n. t = Var (TAtom Value,n) \<and> (TAtom Value,n) \<in> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+      (is "?P \<or> ?Q")
+      using t var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t[of _ "unlabel \<A>"]
+            \<Gamma>\<^sub>v_TAtom[of Value] reachable_constraints_Value_vars_are_fv[OF \<A>_reach P(1)]
+      unfolding vals_sym_def by fast
+    thus ?thesis
+    proof
+      assume ?P
+      then obtain n where n: "t = Fun (Val n) []" "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" by moura
+      thus ?thesis 
+        using \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_Val[OF \<A>_reach T \<I> \<sigma> \<alpha> P(1), of n]
+        unfolding a0_def a0'_def T'_def by fastforce
+    next
+      assume ?Q
+      thus ?thesis
+        using \<alpha>\<^sub>t\<^sub>i_covers_\<alpha>\<^sub>0_Var[OF \<A>_reach T \<I> \<sigma> \<alpha> P(1)]
+        unfolding a0_def a0'_def T'_def by fastforce
+    qed
+  qed
+  moreover have "t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0 \<in> \<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>"
+    when "t \<in> vals_sym \<A>" for t
+    using that abs_in vals_sym_vals
+    unfolding a0_def abs_value_constants_def vals_sym_def vals_def
+    by (metis (mono_tags, lifting))
+  ultimately have "t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set (\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>)"
+    when t: "t \<in> vals_sym \<A>" for t
+    using t timpl_closure_set_mono[of "{t \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0}" "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>" "\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>" "\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>"]
+    by blast
+  hence "t \<cdot>\<^sub>\<alpha> a0' \<in> timpl_closure_set (\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>)"
+    when t: "t \<in> vals \<A>" for t
+    using vals_vals_sym[OF t] by blast
+  hence B: "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s (\<A>@T') \<I> \<subseteq>
+              timpl_closure_set (\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I>) (\<alpha>\<^sub>t\<^sub>i \<A> T \<sigma> \<alpha> \<I>) \<union>
+              ((\<sigma> \<circ>\<^sub>s \<alpha>) ` fv_transaction T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a0'"
+    using 0(2) 3
+    by (simp add: abs_apply_terms_def image_subset_iff)
+
+  have 4: "fv (t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I> \<cdot>\<^sub>\<alpha> a) = {}" for t a
+    using \<I>_grounds[of "t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha>"] abs_fv[of "t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I>" a]
+    by argo
+
+  have "is_Fun (t \<cdot> \<sigma> \<circ>\<^sub>s \<alpha> \<cdot> \<I> \<cdot>\<^sub>\<alpha> a0')" for t
+    using 4[of t a0'] by force
+  thus ?A
+    using A step_props(1,3)
+    unfolding T'_def a0_def a0'_def abs_apply_terms_def
+    by blast
+
+  show ?B
+    using B step_props(2,4) admissible_transaction_Value_vars[OF bspec[OF P T]]
+    by (auto simp add: T'_def a0_def a0'_def abs_apply_terms_def)
+qed
+
+lemma reachable_constraints_covered:
+  assumes \<A>_reach: "\<A> \<in> reachable_constraints P"
+    and \<I>: "welltyped_constraint_model \<I> \<A>"
+    and FP:
+      "analyzed (timpl_closure_set (set FP) (set TI))"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
+      "ground (set FP)"
+    and OCC:
+      "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
+      "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
+    and TI:
+      "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+    and P:
+      "\<forall>T \<in> set P. admissible_transaction T"
+    and transactions_covered: "list_all (transaction_check FP OCC TI) P"
+  shows "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
+    and "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
+using \<A>_reach \<I>
+proof (induction rule: reachable_constraints.induct)
+  case init
+  { case 1 show ?case by (simp add: abs_intruder_knowledge_def) }
+  { case 2 show ?case by (simp add: abs_value_constants_def) }
+next
+  case (step \<A> T \<sigma> \<alpha>)
+  { case 1
+    hence "welltyped_constraint_model \<I> \<A>"
+      by (metis welltyped_constraint_model_prefix)
+    hence IH: "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
+              "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
+      using step.IH by metis+
+    show ?case
+      using reachable_constraints_covered_step[
+              OF step.hyps(1,2) "1.prems" step.hyps(3,4) FP(1,2) IH(1)
+                 FP(3) OCC IH(2) TI P transactions_covered]
+      by metis
+  }
+  { case 2
+    hence "welltyped_constraint_model \<I> \<A>"
+      by (metis welltyped_constraint_model_prefix)
+    hence IH: "\<forall>t \<in> \<alpha>\<^sub>i\<^sub>k \<A> \<I>. timpl_closure_set (set FP) (set TI) \<turnstile>\<^sub>c t"
+              "\<alpha>\<^sub>v\<^sub>a\<^sub>l\<^sub>s \<A> \<I> \<subseteq> absc ` set OCC"
+      using step.IH by metis+
+    show ?case
+      using reachable_constraints_covered_step[
+              OF step.hyps(1,2) "2.prems" step.hyps(3,4) FP(1,2) IH(1)
+                 FP(3) OCC IH(2) TI P transactions_covered]
+      by metis
+  }
+qed
+
+lemma attack_in_fixpoint_if_attack_in_ik:
+  fixes FP::"('fun,'atom,'sets) prot_terms"
+  assumes "\<forall>t \<in> IK \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a. FP \<turnstile>\<^sub>c t"
+    and "attack\<langle>n\<rangle> \<in> IK"
+  shows "attack\<langle>n\<rangle> \<in> FP"
+proof -
+  have "attack\<langle>n\<rangle> \<cdot>\<^sub>\<alpha> a \<in> IK \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a" by (rule abs_in[OF assms(2)])
+  hence "FP \<turnstile>\<^sub>c attack\<langle>n\<rangle> \<cdot>\<^sub>\<alpha> a" using assms(1) by blast
+  moreover have "attack\<langle>n\<rangle> \<cdot>\<^sub>\<alpha> a = attack\<langle>n\<rangle>" by simp
+  ultimately have "FP \<turnstile>\<^sub>c attack\<langle>n\<rangle>" by metis
+  thus ?thesis using ideduct_synth_priv_const_in_ik[of FP "Attack n"] by simp
+qed
+
+lemma attack_in_fixpoint_if_attack_in_timpl_closure_set:
+  fixes FP::"('fun,'atom,'sets) prot_terms"
+  assumes "attack\<langle>n\<rangle> \<in> timpl_closure_set FP TI"
+  shows "attack\<langle>n\<rangle> \<in> FP"
+proof -
+  have "\<forall>f \<in> funs_term (attack\<langle>n\<rangle>). \<not>is_Abs f" by auto
+  thus ?thesis using timpl_closure_set_no_Abs_in_set[OF assms] by blast
+qed
+
+theorem prot_secure_if_fixpoint_covered_typed:
+  assumes FP:
+      "analyzed (timpl_closure_set (set FP) (set TI))"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
+      "ground (set FP)"
+    and OCC:
+      "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
+      "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
+    and TI:
+      "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+    and P:
+      "\<forall>T \<in> set P. admissible_transaction T"
+    and transactions_covered: "list_all (transaction_check FP OCC TI) P"
+    and attack_notin_FP: "attack\<langle>n\<rangle> \<notin> set FP"
+    and \<A>: "\<A> \<in> reachable_constraints P"
+  shows "\<nexists>\<I>. welltyped_constraint_model \<I> (\<A>@[(l, send\<langle>attack\<langle>n\<rangle>\<rangle>)])" (is "\<nexists>\<I>. ?P \<I>")
+proof
+  assume "\<exists>\<I>. ?P \<I>"
+  then obtain \<I> where \<I>: "welltyped_constraint_model \<I> (\<A>@[(l, send\<langle>attack\<langle>n\<rangle>\<rangle>)])"
+    by moura
+  hence \<I>': "constr_sem_stateful \<I> (unlabel (\<A>@[(l, send\<langle>attack\<langle>n\<rangle>\<rangle>)]))"
+            "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
+    unfolding welltyped_constraint_model_def constraint_model_def by metis+
+
+  have 0: "attack\<langle>n\<rangle> \<notin> ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
+    using welltyped_constraint_model_prefix[OF \<I>]
+          reachable_constraints_covered(1)[OF \<A> _ FP OCC TI P transactions_covered]
+          attack_in_fixpoint_if_attack_in_ik[
+            of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "\<alpha>\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>)" "timpl_closure_set (set FP) (set TI)" n]
+          attack_in_fixpoint_if_attack_in_timpl_closure_set
+          attack_notin_FP
+    unfolding abs_intruder_knowledge_def by blast
+
+  have 1: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> attack\<langle>n\<rangle>"
+    using \<I> strand_sem_append_stateful[of "{}" "{}" "unlabel \<A>" _ \<I>]
+    unfolding welltyped_constraint_model_def constraint_model_def by force
+
+  have 2: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)"
+    using reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s[OF _ \<A>] admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1)
+          ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel \<A>"] wf_trms_subst[OF \<I>'(3)]
+    by fast
+
+  have 3: "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>). \<not>TAtom AttackType \<sqsubseteq> \<Gamma>\<^sub>v x"
+    using reachable_constraints_vars_TAtom_typed[OF \<A> P(1)]
+          fv_ik_subset_vars_sst'[of "unlabel \<A>"]
+    by fastforce
+
+  have 4: "attack\<langle>n\<rangle> \<notin> set (snd (Ana t)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" when t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" for t
+  proof
+    assume "attack\<langle>n\<rangle> \<in> set (snd (Ana t)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
+    then obtain s where s: "s \<in> set (snd (Ana t))" "s \<cdot> \<I> = attack\<langle>n\<rangle>" by moura
+
+    obtain x where x: "s = Var x"
+      by (cases s) (use s reachable_constraints_no_Ana_Attack[OF \<A> P(1) t] in auto)
+
+    have "x \<in> fv t" using x Ana_subterm'[OF s(1)] vars_iff_subtermeq by force
+    hence "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" using t fv_subterms by fastforce
+    hence "\<Gamma>\<^sub>v x \<noteq> TAtom AttackType" using 3 by fastforce
+    thus False using s(2) x wt_subst_trm''[OF \<I>'(4), of "Var x"] by fastforce
+  qed
+
+  have 5: "attack\<langle>n\<rangle> \<notin> set (snd (Ana t))" when t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)" for t
+  proof
+    assume "attack\<langle>n\<rangle> \<in> set (snd (Ana t))"
+    then obtain s where s:
+        "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<I> ` fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>))" "attack\<langle>n\<rangle> \<in> set (snd (Ana s))"
+      using Ana_subst_subterms_cases[OF t] 4 by fast
+    then obtain x where x: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)" "s \<sqsubseteq> \<I> x" by moura
+    hence "\<I> x \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)"
+      using var_is_subterm[of x] subterms_subst_subset'[of \<I> "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>"]
+      by force
+    hence *: "wf\<^sub>t\<^sub>r\<^sub>m (\<I> x)" "wf\<^sub>t\<^sub>r\<^sub>m s"
+      using wf_trms_subterms[OF 2] wf_trm_subtermeq[OF _ x(2)]
+      by auto
+
+    show False
+      using term.order_trans[
+              OF subtermeq_imp_subtermtypeeq[OF *(2) Ana_subterm'[OF s(2)]]
+                 subtermeq_imp_subtermtypeeq[OF *(1) x(2)]]
+            3 x(1) wt_subst_trm''[OF \<I>'(4), of "Var x"]
+      by force
+  qed
+
+  show False
+    using 0 private_const_deduct[OF _ 1] 5
+    by simp
+qed
+
+end
+
+
+subsection \<open>Theorem: A Protocol is Secure if it is Covered by a Fixed-Point\<close>
+context stateful_protocol_model
+begin
+
+theorem prot_secure_if_fixpoint_covered:
+  fixes P
+  assumes FP:
+      "analyzed (timpl_closure_set (set FP) (set TI))"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
+      "ground (set FP)"
+    and OCC:
+      "\<forall>t \<in> timpl_closure_set (set FP) (set TI). \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
+      "timpl_closure_set (absc ` set OCC) (set TI) \<subseteq> absc ` set OCC"
+    and TI:
+      "set TI = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+    and M:
+      "has_all_wt_instances_of \<Gamma> (\<Union>T \<in> set P. trms_transaction T) N"
+      "finite N"
+      "tfr\<^sub>s\<^sub>e\<^sub>t N"
+      "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
+    and P:
+      "\<forall>T \<in> set P. admissible_transaction T"
+      "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
+    and transactions_covered: "list_all (transaction_check FP OCC TI) P"
+    and attack_notin_FP: "attack\<langle>n\<rangle> \<notin> set FP"
+    and A: "\<A> \<in> reachable_constraints P"
+  shows "\<nexists>\<I>. constraint_model \<I> (\<A>@[(l, send\<langle>attack\<langle>n\<rangle>\<rangle>)])"
+    (is "\<nexists>\<I>. ?P \<A> \<I>")
+proof
+  assume "\<exists>\<I>. ?P \<A> \<I>"
+  then obtain \<I> where I:
+      "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
+      "constr_sem_stateful \<I> (unlabel (\<A>@[(l, send\<langle>attack\<langle>n\<rangle>\<rangle>)]))"
+    unfolding constraint_model_def by moura
+
+  let ?n = "[(l, send\<langle>attack\<langle>n\<rangle>\<rangle>)]"
+  let ?A = "\<A>@?n"
+
+  have "\<forall>T \<in> set P. wellformed_transaction T"
+       "\<forall>T \<in> set P. admissible_transaction_terms T"
+    using P(1) unfolding admissible_transaction_def by blast+
+  moreover have "\<forall>T \<in> set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
+    using P(1) unfolding admissible_transaction_def admissible_transaction_terms_def by blast
+  ultimately have 0: "wf\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)" "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
+    using reachable_constraints_tfr[OF _ M P A] reachable_constraints_wf[OF _ _ A] by metis+
+  
+  have 1: "wf\<^sub>s\<^sub>s\<^sub>t (unlabel ?A)" "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel ?A)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?A)"
+  proof -
+    show "wf\<^sub>s\<^sub>s\<^sub>t (unlabel ?A)"
+      using 0(1) wf\<^sub>s\<^sub>s\<^sub>t_append_suffix'[of "{}" "unlabel \<A>" "unlabel ?n"] unlabel_append[of \<A> ?n]
+      by simp
+
+    show "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?A)"
+      using 0(3) trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel ?n"] unlabel_append[of \<A> ?n]
+      by fastforce
+
+    have "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?n \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ?n). \<exists>c. t = Fun c []"
+         "\<forall>t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?n \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ?n). Ana t = ([],[])"
+      by (simp_all add: setops\<^sub>s\<^sub>s\<^sub>t_def)
+    hence "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<union>
+                  (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?n \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ?n)))"
+      using 0(2) tfr_consts_mono unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by blast
+    hence "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>@?n) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (\<A>@?n)))"
+      using unlabel_append[of \<A> ?n] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel ?n"]
+            setops\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \<A>" "unlabel ?n"]
+      by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
+    thus "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel ?A)"
+      using 0(2) unlabel_append[of ?A ?n]
+      unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by auto
+  qed
+
+  obtain \<I>\<^sub>\<tau> where I':
+      "welltyped_constraint_model \<I>\<^sub>\<tau> ?A"
+    using stateful_typing_result[OF 1 I(1,3)]
+    by (metis welltyped_constraint_model_def constraint_model_def)
+
+  note a = FP OCC TI P(1) transactions_covered attack_notin_FP A
+
+  show False
+    using prot_secure_if_fixpoint_covered_typed[OF a] I'
+    by force
+qed
+
+end
+
+
+subsection \<open>Automatic Fixed-Point Computation\<close>
+context stateful_protocol_model
+begin
+
+definition compute_fixpoint_fun' where
+  "compute_fixpoint_fun' P (n::nat option) enable_traces S0 \<equiv>
+    let sy = intruder_synth_mod_timpls;
+
+        FP' = \<lambda>S. fst (fst S);
+        TI' = \<lambda>S. snd (fst S);
+        OCC' = \<lambda>S. remdups (
+          (map (\<lambda>t. the_Abs (the_Fun (args t ! 1)))
+               (filter (\<lambda>t. is_Fun t \<and> the_Fun t = OccursFact) (FP' S)))@
+          (map snd (TI' S)));
+
+        equal_states = \<lambda>S S'. set (FP' S) = set (FP' S') \<and> set (TI' S) = set (TI' S');
+
+        trace' = \<lambda>S. snd S;
+
+        close = \<lambda>M f. let g = remdups \<circ> f in while (\<lambda>A. set (g A) \<noteq> set A) g M;
+        close' = \<lambda>M f. let g = remdups \<circ> f in while (\<lambda>A. set (g A) \<noteq> set A) g M;
+        trancl_minus_refl = \<lambda>TI.
+          let aux = \<lambda>ts p. map (\<lambda>q. (fst p,snd q)) (filter ((=) (snd p) \<circ> fst) ts)
+          in filter (\<lambda>p. fst p \<noteq> snd p) (close' TI (\<lambda>ts. concat (map (aux ts) ts)@ts));
+        snd_Ana = \<lambda>N M TI. let N' = filter (\<lambda>t. \<forall>k \<in> set (fst (Ana t)). sy M TI k) N in
+          filter (\<lambda>t. \<not>sy M TI t)
+                 (concat (map (\<lambda>t. filter (\<lambda>s. s \<in> set (snd (Ana t))) (args t)) N'));
+        Ana_cl = \<lambda>FP TI.
+          close FP (\<lambda>M. (M@snd_Ana M M TI));
+        TI_cl = \<lambda>FP TI.
+          close FP (\<lambda>M. (M@filter (\<lambda>t. \<not>sy M TI t)
+                                  (concat (map (\<lambda>m. concat (map (\<lambda>(a,b). \<langle>a --\<guillemotright> b\<rangle>\<langle>m\<rangle>) TI)) M))));
+        Ana_cl' = \<lambda>FP TI.
+          let N = \<lambda>M. comp_timpl_closure_list (filter (\<lambda>t. \<exists>k\<in>set (fst (Ana t)). \<not>sy M TI k) M) TI
+          in close FP (\<lambda>M. M@snd_Ana (N M) M TI);
+
+        \<Delta> = \<lambda>S. transaction_check_comp (FP' S) (OCC' S) (TI' S);
+        result = \<lambda>S T \<delta>.
+          let not_fresh = \<lambda>x. x \<notin> set (transaction_fresh T);
+              xs = filter not_fresh (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)));
+              u = \<lambda>\<delta> x. absdbupd (unlabel (transaction_strand T)) x (\<delta> x)
+          in (remdups (filter (\<lambda>t. \<not>sy (FP' S) (TI' S) t)
+                              (map (\<lambda>t. the_msg t \<cdot> (absc \<circ> u \<delta>))
+                                   (filter is_Send (unlabel (transaction_send T))))),
+              remdups (filter (\<lambda>s. fst s \<noteq> snd s) (map (\<lambda>x. (\<delta> x, u \<delta> x)) xs)));
+        update_state = \<lambda>S. if list_ex (\<lambda>t. is_Fun t \<and> is_Attack (the_Fun t)) (FP' S) then S
+          else let results = map (\<lambda>T. map (\<lambda>\<delta>. result S T (abs_substs_fun \<delta>)) (\<Delta> S T)) P;
+                   newtrace_flt = (\<lambda>n. let x = results ! n; y = map fst x; z = map snd x
+                    in set (concat y) - set (FP' S) \<noteq> {} \<or> set (concat z) - set (TI' S) \<noteq> {});
+                   trace =
+                    if enable_traces
+                    then trace' S@[filter newtrace_flt [0..<length results]]
+                    else [];
+                   U = concat results;
+                   V = ((remdups (concat (map fst U)@FP' S),
+                         remdups (filter (\<lambda>x. fst x \<noteq> snd x) (concat (map snd U)@TI' S))),
+                        trace);
+                   W = ((Ana_cl (TI_cl (FP' V) (TI' V)) (TI' V),
+                         trancl_minus_refl (TI' V)),
+                        trace' V)
+          in if \<not>equal_states W S then W
+          else ((Ana_cl' (FP' W) (TI' W), TI' W), trace' W);
+
+        S = ((\<lambda>h. case n of None \<Rightarrow> while (\<lambda>S. \<not>equal_states S (h S)) h | Some m \<Rightarrow> h ^^ m)
+             update_state S0)
+    in ((FP' S, OCC' S, TI' S), trace' S)"
+
+definition compute_fixpoint_fun where
+  "compute_fixpoint_fun P \<equiv> fst (compute_fixpoint_fun' P None False (([],[]),[]))"
+
+end
+
+
+subsection \<open>Locales for Protocols Proven Secure through Fixed-Point Coverage\<close>
+type_synonym ('f,'a,'s) fixpoint_triple =
+  "('f,'a,'s) prot_term list \<times> 's set list \<times> ('s set \<times> 's set) list"
+
+context stateful_protocol_model
+begin
+
+definition "attack_notin_fixpoint (FPT::('fun,'atom,'sets) fixpoint_triple) \<equiv>
+  list_all (\<lambda>t. \<forall>f \<in> funs_term t. \<not>is_Attack f) (fst FPT)"
+
+definition "protocol_covered_by_fixpoint (FPT::('fun,'atom,'sets) fixpoint_triple) P \<equiv>
+  let (FP, OCC, TI) = FPT
+  in list_all (transaction_check FP OCC TI) P"
+
+definition "analyzed_fixpoint (FPT::('fun,'atom,'sets) fixpoint_triple) \<equiv>
+  let (FP, _, TI) = FPT
+  in analyzed_closed_mod_timpls FP TI"
+
+definition "wellformed_protocol' (P::('fun,'atom,'sets,'lbl) prot) N \<equiv>
+  list_all admissible_transaction P \<and>
+  has_all_wt_instances_of \<Gamma> (\<Union>T \<in> set P. trms_transaction T) (set N) \<and>
+  comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> N \<and>
+  list_all (\<lambda>T. list_all (comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<Gamma> Pair) (unlabel (transaction_strand T))) P"
+
+definition "wellformed_protocol (P::('fun,'atom,'sets,'lbl) prot) \<equiv>
+  let f = \<lambda>M. remdups (concat (map subterms_list M@map (fst \<circ> Ana) M));
+      N0 = remdups (concat (map (trms_list\<^sub>s\<^sub>s\<^sub>t \<circ> unlabel \<circ> transaction_strand) P));
+      N = while (\<lambda>A. set (f A) \<noteq> set A) f N0
+  in wellformed_protocol' P N"
+
+definition "wellformed_fixpoint (FPT::('fun,'atom,'sets) fixpoint_triple) \<equiv>
+  let (FP, OCC, TI) = FPT; OCC' = set OCC
+  in list_all (\<lambda>t. wf\<^sub>t\<^sub>r\<^sub>m' arity t \<and> fv t = {}) FP \<and>
+     list_all (\<lambda>a. a \<in> OCC') (map snd TI) \<and>
+     list_all (\<lambda>(a,b). list_all (\<lambda>(c,d). b = c \<and> a \<noteq> d \<longrightarrow> List.member TI (a,d)) TI) TI \<and>
+     list_all (\<lambda>p. fst p \<noteq> snd p) TI \<and>
+     list_all (\<lambda>t. \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> the_Abs f \<in> OCC') FP"
+
+lemma protocol_covered_by_fixpoint_I1[intro]:
+  assumes "list_all (protocol_covered_by_fixpoint FPT) P"
+  shows "protocol_covered_by_fixpoint FPT (concat P)"
+using assms by (auto simp add: protocol_covered_by_fixpoint_def list_all_iff)
+
+lemma protocol_covered_by_fixpoint_I2[intro]:
+  assumes "protocol_covered_by_fixpoint FPT P1"
+    and "protocol_covered_by_fixpoint FPT P2"
+  shows "protocol_covered_by_fixpoint FPT (P1@P2)"
+using assms by (auto simp add: protocol_covered_by_fixpoint_def)
+
+lemma protocol_covered_by_fixpoint_I3[intro]:
+  assumes "\<forall>T \<in> set P. \<forall>\<delta>::('fun,'atom,'sets) prot_var \<Rightarrow> 'sets set.
+    transaction_check_pre FP TI T \<delta> \<longrightarrow> transaction_check_post FP TI T \<delta>"
+  shows "protocol_covered_by_fixpoint (FP,OCC,TI) P"
+using assms
+unfolding protocol_covered_by_fixpoint_def transaction_check_def transaction_check_comp_def
+          list_all_iff Let_def case_prod_unfold Product_Type.fst_conv Product_Type.snd_conv
+by fastforce
+
+lemmas protocol_covered_by_fixpoint_intros =
+  protocol_covered_by_fixpoint_I1
+  protocol_covered_by_fixpoint_I2
+  protocol_covered_by_fixpoint_I3
+
+lemma prot_secure_if_prot_checks:
+  fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list"
+    and FP_OCC_TI:: "('fun, 'atom, 'sets) fixpoint_triple"
+  assumes attack_notin_fixpoint: "attack_notin_fixpoint FP_OCC_TI"
+    and transactions_covered: "protocol_covered_by_fixpoint FP_OCC_TI P"
+    and analyzed_fixpoint: "analyzed_fixpoint FP_OCC_TI"
+    and wellformed_protocol: "wellformed_protocol' P N"
+    and wellformed_fixpoint: "wellformed_fixpoint FP_OCC_TI"
+  shows "\<forall>\<A> \<in> reachable_constraints P. \<nexists>\<I>. constraint_model \<I> (\<A>@[(l, send\<langle>attack\<langle>n\<rangle>\<rangle>)])"
+proof -
+  define FP where "FP \<equiv> let (FP,_,_) = FP_OCC_TI in FP"
+  define OCC where "OCC \<equiv> let (_,OCC,_) = FP_OCC_TI in OCC"
+  define TI where "TI \<equiv> let (_,_,TI) = FP_OCC_TI in TI"
+
+  have attack_notin_FP: "attack\<langle>n\<rangle> \<notin> set FP"
+    using attack_notin_fixpoint[unfolded attack_notin_fixpoint_def]
+    unfolding list_all_iff FP_def by force
+
+  have 1: "\<forall>(a,b) \<in> set TI. \<forall>(c,d) \<in> set TI. b = c \<and> a \<noteq> d \<longrightarrow> (a,d) \<in> set TI"
+    using wellformed_fixpoint
+    unfolding wellformed_fixpoint_def wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric] Let_def TI_def
+              list_all_iff member_def case_prod_unfold
+    by auto
+
+  have 0: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)"
+    and 2: "\<forall>(a,b) \<in> set TI. a \<noteq> b"
+    and 3: "snd ` set TI \<subseteq> set OCC"
+    and 4: "\<forall>t \<in> set FP. \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` set OCC"
+    and 5: "ground (set FP)"
+    using wellformed_fixpoint
+    unfolding wellformed_fixpoint_def wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric] is_Abs_def the_Abs_def
+              list_all_iff Let_def case_prod_unfold set_map FP_def OCC_def TI_def
+    by (fast, fast, blast, fastforce, simp)
+
+  have 8: "finite (set N)"
+    and 9: "has_all_wt_instances_of \<Gamma> (\<Union>T \<in> set P. trms_transaction T) (set N)"
+    and 10: "tfr\<^sub>s\<^sub>e\<^sub>t (set N)"
+    and 11: "\<forall>T \<in> set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
+    and 12: "\<forall>T \<in> set P. admissible_transaction T"
+    using wellformed_protocol tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[of N]
+    unfolding Let_def list_all_iff wellformed_protocol_def wellformed_protocol'_def
+              wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric] tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p[symmetric]
+    by fast+
+
+  have 13: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set N)"
+    using wellformed_protocol
+    unfolding wellformed_protocol_def wellformed_protocol'_def
+              wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric] comp_tfr\<^sub>s\<^sub>e\<^sub>t_def list_all_iff
+              finite_SMP_representation_def
+    by blast
+
+  note TI0 = trancl_eqI'[OF 1 2]
+
+  have "analyzed (timpl_closure_set (set FP) (set TI))"
+    using analyzed_fixpoint[unfolded analyzed_fixpoint_def]
+          analyzed_closed_mod_timpls_is_analyzed_timpl_closure_set[OF TI0 0]
+    unfolding FP_def TI_def
+    by force
+  note FP0 = this 0 5
+
+  note OCC0 = funs_term_OCC_TI_subset(1)[OF 4 3]
+              timpl_closure_set_supset'[OF funs_term_OCC_TI_subset(2)[OF 4 3]]
+
+  note M0 = 9 8 10 13
+
+  have "list_all (transaction_check FP OCC TI) P"
+    using transactions_covered[unfolded protocol_covered_by_fixpoint_def]
+    unfolding FP_def OCC_def TI_def
+    by force
+  note P0 = 12 11 this attack_notin_FP
+
+  show ?thesis by (metis prot_secure_if_fixpoint_covered[OF FP0 OCC0 TI0 M0 P0])
+qed
+
+end
+
+locale secure_stateful_protocol =
+  pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
+  for arity\<^sub>f::"'fun \<Rightarrow> nat"
+    and arity\<^sub>s::"'sets \<Rightarrow> nat"
+    and public\<^sub>f::"'fun \<Rightarrow> bool"
+    and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets) prot_fun, nat) term list \<times> nat list)"
+    and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
+    and label_witness1::"'lbl"
+    and label_witness2::"'lbl"
+  +
+  fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list"
+    and FP_OCC_TI:: "('fun, 'atom, 'sets) fixpoint_triple"
+    and P_SMP::"('fun, 'atom, 'sets) prot_term list"
+  assumes attack_notin_fixpoint: "pm.attack_notin_fixpoint FP_OCC_TI"
+    and transactions_covered: "pm.protocol_covered_by_fixpoint FP_OCC_TI P"
+    and analyzed_fixpoint: "pm.analyzed_fixpoint FP_OCC_TI"
+    and wellformed_protocol: "pm.wellformed_protocol' P P_SMP"
+    and wellformed_fixpoint: "pm.wellformed_fixpoint FP_OCC_TI"
+begin
+
+theorem protocol_secure:
+  "\<forall>\<A> \<in> pm.reachable_constraints P. \<nexists>\<I>. pm.constraint_model \<I> (\<A>@[(l, send\<langle>attack\<langle>n\<rangle>\<rangle>)])"
+by (rule pm.prot_secure_if_prot_checks[OF
+            attack_notin_fixpoint transactions_covered
+            analyzed_fixpoint wellformed_protocol wellformed_fixpoint])
+
+end
+
+locale secure_stateful_protocol' =
+  pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
+  for arity\<^sub>f::"'fun \<Rightarrow> nat"
+    and arity\<^sub>s::"'sets \<Rightarrow> nat"
+    and public\<^sub>f::"'fun \<Rightarrow> bool"
+    and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets) prot_fun, nat) term list \<times> nat list)"
+    and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
+    and label_witness1::"'lbl"
+    and label_witness2::"'lbl"
+  +
+  fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list"
+    and FP_OCC_TI:: "('fun, 'atom, 'sets) fixpoint_triple"
+  assumes attack_notin_fixpoint': "pm.attack_notin_fixpoint FP_OCC_TI"
+    and transactions_covered': "pm.protocol_covered_by_fixpoint FP_OCC_TI P"
+    and analyzed_fixpoint': "pm.analyzed_fixpoint FP_OCC_TI"
+    and wellformed_protocol': "pm.wellformed_protocol P"
+    and wellformed_fixpoint': "pm.wellformed_fixpoint FP_OCC_TI"
+begin
+
+sublocale secure_stateful_protocol
+  arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P
+  FP_OCC_TI
+  "let f = \<lambda>M. remdups (concat (map subterms_list M@map (fst \<circ> pm.Ana) M));
+       N0 = remdups (concat (map (trms_list\<^sub>s\<^sub>s\<^sub>t \<circ> unlabel \<circ> transaction_strand) P))
+   in while (\<lambda>A. set (f A) \<noteq> set A) f N0"
+apply unfold_locales
+using attack_notin_fixpoint' transactions_covered' analyzed_fixpoint'
+      wellformed_protocol'[unfolded pm.wellformed_protocol_def Let_def] wellformed_fixpoint'
+unfolding Let_def by blast+
+
+end
+
+locale secure_stateful_protocol'' =
+  pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
+  for arity\<^sub>f::"'fun \<Rightarrow> nat"
+    and arity\<^sub>s::"'sets \<Rightarrow> nat"
+    and public\<^sub>f::"'fun \<Rightarrow> bool"
+    and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets) prot_fun, nat) term list \<times> nat list)"
+    and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
+    and label_witness1::"'lbl"
+    and label_witness2::"'lbl"
+  +
+  fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list"
+  assumes checks: "let FPT = pm.compute_fixpoint_fun P
+    in pm.attack_notin_fixpoint FPT \<and> pm.protocol_covered_by_fixpoint FPT P \<and>
+       pm.analyzed_fixpoint FPT \<and> pm.wellformed_protocol P \<and> pm.wellformed_fixpoint FPT"
+begin
+
+sublocale secure_stateful_protocol'
+  arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P "pm.compute_fixpoint_fun P"
+using checks[unfolded Let_def case_prod_unfold] by unfold_locales meson+
+
+end
+
+locale secure_stateful_protocol''' =
+  pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
+  for arity\<^sub>f::"'fun \<Rightarrow> nat"
+    and arity\<^sub>s::"'sets \<Rightarrow> nat"
+    and public\<^sub>f::"'fun \<Rightarrow> bool"
+    and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets) prot_fun, nat) term list \<times> nat list)"
+    and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
+    and label_witness1::"'lbl"
+    and label_witness2::"'lbl"
+  +
+  fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list"
+    and FP_OCC_TI:: "('fun, 'atom, 'sets) fixpoint_triple"
+    and P_SMP::"('fun, 'atom, 'sets) prot_term list"
+  assumes checks': "let P' = P; FPT = FP_OCC_TI; P'_SMP = P_SMP
+                    in pm.attack_notin_fixpoint FPT \<and>
+                       pm.protocol_covered_by_fixpoint FPT P' \<and>
+                       pm.analyzed_fixpoint FPT \<and>
+                       pm.wellformed_protocol' P' P'_SMP \<and>
+                       pm.wellformed_fixpoint FPT"
+begin
+
+sublocale secure_stateful_protocol
+  arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P FP_OCC_TI P_SMP
+using checks'[unfolded Let_def case_prod_unfold] by unfold_locales meson+
+
+end
+
+locale secure_stateful_protocol'''' =
+  pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2
+  for arity\<^sub>f::"'fun \<Rightarrow> nat"
+    and arity\<^sub>s::"'sets \<Rightarrow> nat"
+    and public\<^sub>f::"'fun \<Rightarrow> bool"
+    and Ana\<^sub>f::"'fun \<Rightarrow> ((('fun,'atom::finite,'sets) prot_fun, nat) term list \<times> nat list)"
+    and \<Gamma>\<^sub>f::"'fun \<Rightarrow> 'atom option"
+    and label_witness1::"'lbl"
+    and label_witness2::"'lbl"
+  +
+  fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list"
+    and FP_OCC_TI:: "('fun, 'atom, 'sets) fixpoint_triple"
+  assumes checks'': "let P' = P; FPT = FP_OCC_TI
+                     in pm.attack_notin_fixpoint FPT \<and>
+                        pm.protocol_covered_by_fixpoint FPT P' \<and>
+                        pm.analyzed_fixpoint FPT \<and>
+                        pm.wellformed_protocol P' \<and>
+                        pm.wellformed_fixpoint FPT"
+begin
+
+sublocale secure_stateful_protocol'
+  arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \<Gamma>\<^sub>f label_witness1 label_witness2 P FP_OCC_TI
+using checks''[unfolded Let_def case_prod_unfold] by unfold_locales meson+
+
+end
+
+
+subsection \<open>Automatic Protocol Composition\<close>
+context stateful_protocol_model
+begin
+
+definition wellformed_composable_protocols where
+  "wellformed_composable_protocols (P::('fun,'atom,'sets,'lbl) prot list) N \<equiv>
+    let
+      Ts = concat P;
+      steps = concat (map transaction_strand Ts);
+      MP0 = \<Union>T \<in> set Ts. trms_transaction T \<union> pair' Pair ` setops_transaction T
+    in
+      list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) N \<and>
+      has_all_wt_instances_of \<Gamma> MP0 (set N) \<and>
+      comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> N \<and>
+      list_all (comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<Gamma> Pair \<circ> snd) steps \<and>
+      list_all (\<lambda>T. wellformed_transaction T) Ts \<and>
+      list_all (\<lambda>T. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)) Ts \<and>
+      list_all (\<lambda>T. list_all (\<lambda>x. \<Gamma>\<^sub>v x = TAtom Value) (transaction_fresh T)) Ts"
+
+definition composable_protocols where
+  "composable_protocols (P::('fun,'atom,'sets,'lbl) prot list) Ms S \<equiv>
+    let
+      Ts = concat P;
+      steps = concat (map transaction_strand Ts);
+      MP0 = \<Union>T \<in> set Ts. trms_transaction T \<union> pair' Pair ` setops_transaction T;
+      M_fun = (\<lambda>l. case find ((=) l \<circ> fst) Ms of Some M \<Rightarrow> snd M | None \<Rightarrow> [])
+    in comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> Pair steps M_fun S"
+
+lemma composable_protocols_par_comp_constr:
+  fixes S f
+  defines "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. t \<in> M \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> fv (t \<cdot> \<delta>) = {}}"
+    and "Sec \<equiv> (f (set S)) - {m. intruder_synth {} m}"
+  assumes Ps_pc: "wellformed_composable_protocols Ps N" "composable_protocols Ps Ms S"
+  shows "\<forall>\<A> \<in> reachable_constraints (concat Ps). \<forall>\<I>. constraint_model \<I> \<A> \<longrightarrow>
+            (\<exists>\<I>\<^sub>\<tau>. welltyped_constraint_model \<I>\<^sub>\<tau> \<A> \<and>
+                  ((\<forall>n. welltyped_constraint_model \<I>\<^sub>\<tau> (proj n \<A>)) \<or>
+                   (\<exists>\<A>'. prefix \<A>' \<A> \<and> strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' Sec \<I>\<^sub>\<tau>)))"
+    (is "\<forall>\<A> \<in> _. \<forall>_. _ \<longrightarrow> ?Q \<A> \<I>")
+proof (intro allI ballI impI)
+  fix \<A> \<I>
+  assume \<A>: "\<A> \<in> reachable_constraints (concat Ps)" and \<I>: "constraint_model \<I> \<A>"
+
+  let ?Ts = "concat Ps"
+  let ?steps = "concat (map transaction_strand ?Ts)"
+  let ?MP0 = "\<Union>T \<in> set ?Ts. trms_transaction T \<union> pair' Pair ` setops_transaction T"
+  let ?M_fun = "\<lambda>l. case find ((=) l \<circ> fst) Ms of Some M \<Rightarrow> snd M | None \<Rightarrow> []"
+
+  have M:
+      "has_all_wt_instances_of \<Gamma> ?MP0 (set N)"
+      "finite (set N)" "tfr\<^sub>s\<^sub>e\<^sub>t (set N)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set N)"
+    using Ps_pc tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[of N]
+    unfolding composable_protocols_def wellformed_composable_protocols_def
+              Let_def list_all_iff wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric]
+    by fast+
+
+  have P:
+      "\<forall>T \<in> set ?Ts. wellformed_transaction T"
+      "\<forall>T \<in> set ?Ts. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)"
+      "\<forall>T \<in> set ?Ts. \<forall>x \<in> set (transaction_fresh T). \<Gamma>\<^sub>v x = TAtom Value"
+      "\<forall>T \<in> set ?Ts. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))"
+      "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> Pair ?steps ?M_fun S"
+    using Ps_pc tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p
+    unfolding wellformed_composable_protocols_def composable_protocols_def
+              Let_def list_all_iff unlabel_def wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric]
+    by (meson, meson, meson, fastforce, blast)
+
+  show "?Q \<A> \<I>"
+    using reachable_constraints_par_comp_constr[OF M P \<A> \<I>]
+    unfolding Sec_def f_def by fast
+qed
+
+end
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/Term_Abstraction.thy b/Automated_Stateful_Protocol_Verification/Term_Abstraction.thy
new file mode 100644
index 0000000..f526edb
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/Term_Abstraction.thy
@@ -0,0 +1,246 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      Term_Abstraction.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>Term Abstraction\<close>
+theory Term_Abstraction
+  imports Transactions
+begin
+
+subsection \<open>Definitions\<close>
+fun to_abs ("\<alpha>\<^sub>0") where
+  "\<alpha>\<^sub>0 [] _ = {}"
+| "\<alpha>\<^sub>0 ((Fun (Val m) [],Fun (Set s) S)#D) n =
+    (if m = n then insert s (\<alpha>\<^sub>0 D n) else \<alpha>\<^sub>0 D n)"
+| "\<alpha>\<^sub>0 (_#D) n = \<alpha>\<^sub>0 D n"
+
+fun abs_apply_term (infixl "\<cdot>\<^sub>\<alpha>" 67) where
+  "Var x \<cdot>\<^sub>\<alpha> \<alpha> = Var x"
+| "Fun (Val n) T \<cdot>\<^sub>\<alpha> \<alpha> = Fun (Abs (\<alpha> n)) (map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) T)"
+| "Fun f T \<cdot>\<^sub>\<alpha> \<alpha> = Fun f (map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) T)"
+
+definition abs_apply_list (infixl "\<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t" 67) where
+  "M \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> \<equiv> map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) M"
+
+definition abs_apply_terms (infixl "\<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t" 67) where
+  "M \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> \<equiv> (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) ` M"
+
+definition abs_apply_pairs (infixl "\<cdot>\<^sub>\<alpha>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s" 67) where
+  "F \<cdot>\<^sub>\<alpha>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<alpha> \<equiv> map (\<lambda>(s,t). (s \<cdot>\<^sub>\<alpha> \<alpha>, t \<cdot>\<^sub>\<alpha> \<alpha>)) F"
+
+definition abs_apply_strand_step (infixl "\<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t\<^sub>p" 67) where
+  "s \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t\<^sub>p \<alpha> \<equiv> (case s of
+    (l,send\<langle>t\<rangle>) \<Rightarrow> (l,send\<langle>t \<cdot>\<^sub>\<alpha> \<alpha>\<rangle>)
+  | (l,receive\<langle>t\<rangle>) \<Rightarrow> (l,receive\<langle>t \<cdot>\<^sub>\<alpha> \<alpha>\<rangle>)
+  | (l,\<langle>ac: t \<doteq> t'\<rangle>) \<Rightarrow> (l,\<langle>ac: (t \<cdot>\<^sub>\<alpha> \<alpha>) \<doteq> (t' \<cdot>\<^sub>\<alpha> \<alpha>)\<rangle>)
+  | (l,insert\<langle>t,t'\<rangle>) \<Rightarrow> (l,insert\<langle>t \<cdot>\<^sub>\<alpha> \<alpha>,t' \<cdot>\<^sub>\<alpha> \<alpha>\<rangle>)
+  | (l,delete\<langle>t,t'\<rangle>) \<Rightarrow> (l,delete\<langle>t \<cdot>\<^sub>\<alpha> \<alpha>,t' \<cdot>\<^sub>\<alpha> \<alpha>\<rangle>)
+  | (l,\<langle>ac: t \<in> t'\<rangle>) \<Rightarrow> (l,\<langle>ac: (t \<cdot>\<^sub>\<alpha> \<alpha>) \<in> (t' \<cdot>\<^sub>\<alpha> \<alpha>)\<rangle>)
+  | (l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle>) \<Rightarrow> (l,\<forall>X\<langle>\<or>\<noteq>: (F \<cdot>\<^sub>\<alpha>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<alpha>) \<or>\<notin>: (F' \<cdot>\<^sub>\<alpha>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<alpha>)\<rangle>))"
+
+definition abs_apply_strand (infixl "\<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t" 67) where
+  "S \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t \<alpha> \<equiv> map (\<lambda>x. x \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t\<^sub>p \<alpha>) S"
+
+
+subsection \<open>Lemmata\<close>
+lemma to_abs_alt_def:
+  "\<alpha>\<^sub>0 D n = {s. \<exists>S. (Fun (Val n) [], Fun (Set s) S) \<in> set D}"
+by (induct D n rule: to_abs.induct) auto
+
+lemma abs_term_apply_const[simp]:
+  "is_Val f \<Longrightarrow> Fun f [] \<cdot>\<^sub>\<alpha> a = Fun (Abs (a (the_Val f))) []"
+  "\<not>is_Val f \<Longrightarrow> Fun f [] \<cdot>\<^sub>\<alpha> a = Fun f []"
+by (cases f; auto)+
+
+lemma abs_fv: "fv (t \<cdot>\<^sub>\<alpha> a) = fv t"
+by (induct t a rule: abs_apply_term.induct) auto
+
+lemma abs_eq_if_no_Val:
+  assumes "\<forall>f \<in> funs_term t. \<not>is_Val f"
+  shows "t \<cdot>\<^sub>\<alpha> a = t \<cdot>\<^sub>\<alpha> b"
+using assms
+proof (induction t)
+  case (Fun f T) thus ?case by (cases f) simp_all
+qed simp
+
+lemma abs_list_set_is_set_abs_set: "set (M \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>) = (set M) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>"
+unfolding abs_apply_list_def abs_apply_terms_def by simp
+
+lemma abs_set_empty[simp]: "{} \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> = {}"
+unfolding abs_apply_terms_def by simp
+
+lemma abs_in:
+  assumes "t \<in> M"
+  shows "t \<cdot>\<^sub>\<alpha> \<alpha> \<in> M \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>"
+using assms unfolding abs_apply_terms_def
+by (induct t \<alpha> rule: abs_apply_term.induct) blast+
+
+lemma abs_set_union: "(A \<union> B) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a = (A \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a) \<union> (B \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a)"
+unfolding abs_apply_terms_def
+by auto
+
+lemma abs_subterms: "subterms (t \<cdot>\<^sub>\<alpha> \<alpha>) = subterms t \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>"
+proof (induction t)
+  case (Fun f T) thus ?case by (cases f) (auto simp add: abs_apply_terms_def)
+qed (simp add: abs_apply_terms_def)
+
+lemma abs_subterms_in: "s \<in> subterms t \<Longrightarrow> s \<cdot>\<^sub>\<alpha> a \<in> subterms (t \<cdot>\<^sub>\<alpha> a)"
+proof (induction t)
+  case (Fun f T) thus ?case by (cases f) auto
+qed simp
+
+lemma abs_ik_append: "(ik\<^sub>s\<^sub>s\<^sub>t (A@B) \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a = (ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a \<union> (ik\<^sub>s\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a"
+unfolding abs_apply_terms_def ik\<^sub>s\<^sub>s\<^sub>t_def
+by auto
+
+lemma to_abs_in:
+  assumes "(Fun (Val n) [], Fun (Set s) []) \<in> set D"
+  shows "s \<in> \<alpha>\<^sub>0 D n"
+using assms by (induct rule: to_abs.induct) auto
+
+lemma to_abs_empty_iff_notin_db:
+  "Fun (Val n) [] \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 D = Fun (Abs {}) [] \<longleftrightarrow> (\<nexists>s S. (Fun (Val n) [], Fun (Set s) S) \<in> set D)"
+by (simp add: to_abs_alt_def)
+
+lemma to_abs_list_insert:
+  assumes "Fun (Val n) [] \<noteq> t"
+  shows "\<alpha>\<^sub>0 D n = \<alpha>\<^sub>0 (List.insert (t,s) D) n"
+using assms to_abs_alt_def[of D n] to_abs_alt_def[of "List.insert (t,s) D" n]
+by auto
+
+lemma to_abs_list_insert':
+  "insert s (\<alpha>\<^sub>0 D n) = \<alpha>\<^sub>0 (List.insert (Fun (Val n) [], Fun (Set s) S) D) n"
+using to_abs_alt_def[of D n]
+      to_abs_alt_def[of "List.insert (Fun (Val n) [], Fun (Set s) S) D" n]
+by auto
+
+lemma to_abs_list_remove_all:
+  assumes "Fun (Val n) [] \<noteq> t"
+  shows "\<alpha>\<^sub>0 D n = \<alpha>\<^sub>0 (List.removeAll (t,s) D) n"
+using assms to_abs_alt_def[of D n] to_abs_alt_def[of "List.removeAll (t,s) D" n]
+by auto
+
+lemma to_abs_list_remove_all':
+  "\<alpha>\<^sub>0 D n - {s} = \<alpha>\<^sub>0 (filter (\<lambda>d. \<nexists>S. d = (Fun (Val n) [], Fun (Set s) S)) D) n"
+using to_abs_alt_def[of D n]
+      to_abs_alt_def[of "filter (\<lambda>d. \<nexists>S. d = (Fun (Val n) [], Fun (Set s) S)) D" n]
+by auto
+
+lemma to_abs_db\<^sub>s\<^sub>s\<^sub>t_append:
+  assumes "\<forall>u s. insert\<langle>u, s\<rangle> \<in> set B \<longrightarrow> Fun (Val n) [] \<noteq> u \<cdot> \<I>"
+    and "\<forall>u s. delete\<langle>u, s\<rangle> \<in> set B \<longrightarrow> Fun (Val n) [] \<noteq> u \<cdot> \<I>"
+  shows "\<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t A \<I> D) n = \<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \<I> D) n"
+using assms
+proof (induction B rule: List.rev_induct)
+  case (snoc b B)
+  hence IH: "\<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t A \<I> D) n = \<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \<I> D) n" by auto
+  have *: "\<forall>u s. b = insert\<langle>u,s\<rangle> \<longrightarrow> Fun (Val n) [] \<noteq> u \<cdot> \<I>"
+          "\<forall>u s. b = delete\<langle>u,s\<rangle> \<longrightarrow> Fun (Val n) [] \<noteq> u \<cdot> \<I>"
+    using snoc.prems by simp_all
+  show ?case
+  proof (cases b)
+    case (Insert u s)
+    hence **: "db'\<^sub>s\<^sub>s\<^sub>t (A@B@[b]) \<I> D = List.insert (u \<cdot> \<I>,s \<cdot> \<I>) (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \<I> D)"
+      using db\<^sub>s\<^sub>s\<^sub>t_append[of "A@B" "[b]"] by simp
+    have "Fun (Val n) [] \<noteq> u \<cdot> \<I>" using *(1) Insert by auto
+    thus ?thesis using IH ** to_abs_list_insert by metis
+  next
+    case (Delete u s)
+    hence **: "db'\<^sub>s\<^sub>s\<^sub>t (A@B@[b]) \<I> D = List.removeAll (u \<cdot> \<I>,s \<cdot> \<I>) (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \<I> D)"
+      using db\<^sub>s\<^sub>s\<^sub>t_append[of "A@B" "[b]"] by simp
+    have "Fun (Val n) [] \<noteq> u \<cdot> \<I>" using *(2) Delete by auto
+    thus ?thesis using IH ** to_abs_list_remove_all by metis
+  qed (simp_all add: db\<^sub>s\<^sub>s\<^sub>t_no_upd_append[of "[b]" "A@B"] IH)
+qed simp
+
+lemma to_abs_neq_imp_db_update:
+  assumes "\<alpha>\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t A I) n \<noteq> \<alpha>\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t (A@B) I) n"
+  shows "\<exists>u s. u \<cdot> I = Fun (Val n) [] \<and> (insert\<langle>u,s\<rangle> \<in> set B \<or> delete\<langle>u,s\<rangle> \<in> set B)"
+proof -
+  { fix D have ?thesis when "\<alpha>\<^sub>0 D n \<noteq> \<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t B I D) n" using that
+    proof (induction B I D rule: db'\<^sub>s\<^sub>s\<^sub>t.induct)
+      case 2 thus ?case
+        by (metis db'\<^sub>s\<^sub>s\<^sub>t.simps(2) list.set_intros(1,2) subst_apply_pair_pair to_abs_list_insert)
+    next
+      case 3 thus ?case
+        by (metis db'\<^sub>s\<^sub>s\<^sub>t.simps(3) list.set_intros(1,2) subst_apply_pair_pair to_abs_list_remove_all)
+    qed simp_all
+  } thus ?thesis using assms by (metis db\<^sub>s\<^sub>s\<^sub>t_append db\<^sub>s\<^sub>s\<^sub>t_def)
+qed
+
+lemma abs_term_subst_eq:
+  fixes \<delta> \<theta>::"(('a,'b,'c) prot_fun, ('d,'e prot_atom) term \<times> nat) subst"
+  assumes "\<forall>x \<in> fv t. \<delta> x \<cdot>\<^sub>\<alpha> a = \<theta> x \<cdot>\<^sub>\<alpha> b"
+    and "\<nexists>n T. Fun (Val n) T \<in> subterms t"
+  shows "t \<cdot> \<delta> \<cdot>\<^sub>\<alpha> a = t \<cdot> \<theta> \<cdot>\<^sub>\<alpha> b"
+using assms
+proof (induction t)
+  case (Fun f T) thus ?case
+  proof (cases f)
+    case (Val n)
+    hence False using Fun.prems(2) by blast
+    thus ?thesis by metis
+  qed auto
+qed simp
+
+lemma abs_term_subst_eq':
+  fixes \<delta> \<theta>::"(('a,'b,'c) prot_fun, ('d,'e prot_atom) term \<times> nat) subst"
+  assumes "\<forall>x \<in> fv t. \<delta> x \<cdot>\<^sub>\<alpha> a = \<theta> x"
+    and "\<nexists>n T. Fun (Val n) T \<in> subterms t"
+  shows "t \<cdot> \<delta> \<cdot>\<^sub>\<alpha> a = t \<cdot> \<theta>"
+using assms
+proof (induction t)
+  case (Fun f T) thus ?case
+  proof (cases f)
+    case (Val n)
+    hence False using Fun.prems(2) by blast
+    thus ?thesis by metis
+  qed auto
+qed simp
+
+lemma abs_val_in_funs_term:
+  assumes "f \<in> funs_term t" "is_Val f"
+  shows "Abs (\<alpha> (the_Val f)) \<in> funs_term (t \<cdot>\<^sub>\<alpha> \<alpha>)"
+using assms by (induct t \<alpha> rule: abs_apply_term.induct) auto
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/Term_Implication.thy b/Automated_Stateful_Protocol_Verification/Term_Implication.thy
new file mode 100644
index 0000000..b0c75d0
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/Term_Implication.thy
@@ -0,0 +1,2579 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      Term_Implication.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>Term Implication\<close>
+theory Term_Implication
+  imports Stateful_Protocol_Model Term_Variants
+begin
+
+subsection \<open>Single Term Implications\<close>
+definition timpl_apply_term ("\<langle>_ --\<guillemotright> _\<rangle>\<langle>_\<rangle>") where
+  "\<langle>a --\<guillemotright> b\<rangle>\<langle>t\<rangle> \<equiv> term_variants ((\<lambda>_. [])(Abs a := [Abs b])) t"
+
+definition timpl_apply_terms ("\<langle>_ --\<guillemotright> _\<rangle>\<langle>_\<rangle>\<^sub>s\<^sub>e\<^sub>t") where
+  "\<langle>a --\<guillemotright> b\<rangle>\<langle>M\<rangle>\<^sub>s\<^sub>e\<^sub>t \<equiv> \<Union>((set o timpl_apply_term a b) ` M)"
+
+lemma timpl_apply_Fun:
+  assumes "\<And>i. i < length T \<Longrightarrow> S ! i \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>T ! i\<rangle>"
+    and "length T = length S"
+  shows "Fun f S \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>Fun f T\<rangle>"
+using assms term_variants_Fun term_variants_pred_iff_in_term_variants
+by (metis timpl_apply_term_def)
+
+lemma timpl_apply_Abs:
+  assumes "\<And>i. i < length T \<Longrightarrow> S ! i \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>T ! i\<rangle>"
+    and "length T = length S"
+  shows "Fun (Abs b) S \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>Fun (Abs a) T\<rangle>"
+using assms(1) term_variants_P[OF assms(2), of "(\<lambda>_. [])(Abs a := [Abs b])" "Abs b" "Abs a"]
+unfolding timpl_apply_term_def term_variants_pred_iff_in_term_variants[symmetric]
+by fastforce
+
+lemma timpl_apply_refl: "t \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>t\<rangle>"
+unfolding timpl_apply_term_def
+by (metis term_variants_pred_refl term_variants_pred_iff_in_term_variants)
+
+lemma timpl_apply_const: "Fun (Abs b) [] \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>Fun (Abs a) []\<rangle>"
+using term_variants_pred_iff_in_term_variants term_variants_pred_const
+unfolding timpl_apply_term_def by auto
+
+lemma timpl_apply_const':
+  "c = a \<Longrightarrow> set \<langle>a --\<guillemotright> b\<rangle>\<langle>Fun (Abs c) []\<rangle> = {Fun (Abs b) [], Fun (Abs c) []}"
+  "c \<noteq> a \<Longrightarrow> set \<langle>a --\<guillemotright> b\<rangle>\<langle>Fun (Abs c) []\<rangle> = {Fun (Abs c) []}"
+using term_variants_pred_const_cases[of "(\<lambda>_. [])(Abs a := [Abs b])" "Abs c"]
+      term_variants_pred_iff_in_term_variants[of "(\<lambda>_. [])(Abs a := [Abs b])"]
+unfolding timpl_apply_term_def by auto
+
+lemma timpl_apply_term_subst:
+  "s \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>t\<rangle> \<Longrightarrow> s \<cdot> \<delta> \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>t \<cdot> \<delta>\<rangle>"
+by (metis term_variants_pred_iff_in_term_variants term_variants_pred_subst timpl_apply_term_def)
+
+lemma timpl_apply_inv:
+  assumes "Fun h S \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>Fun f T\<rangle>"
+  shows "length T = length S"
+    and "\<And>i. i < length T \<Longrightarrow> S ! i \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>T ! i\<rangle>"
+    and "f \<noteq> h \<Longrightarrow> f = Abs a \<and> h = Abs b"
+using assms term_variants_pred_iff_in_term_variants[of "(\<lambda>_. [])(Abs a := [Abs b])"]
+unfolding timpl_apply_term_def
+by (metis (full_types) term_variants_pred_inv(1),
+    metis (full_types) term_variants_pred_inv(2),
+    fastforce dest: term_variants_pred_inv(3))
+
+lemma timpl_apply_inv':
+  assumes "s \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>Fun f T\<rangle>"
+  shows "\<exists>g S. s = Fun g S"
+proof -
+  have *: "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) (Fun f T) s"
+    using assms term_variants_pred_iff_in_term_variants[of "(\<lambda>_. [])(Abs a := [Abs b])"]
+    unfolding timpl_apply_term_def by force
+  show ?thesis using term_variants_pred.cases[OF *, of ?thesis] by fastforce
+qed
+
+lemma timpl_apply_term_Var_iff:
+  "Var x \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>t\<rangle> \<longleftrightarrow> t = Var x"
+using term_variants_pred_inv_Var term_variants_pred_iff_in_term_variants
+unfolding timpl_apply_term_def by metis
+
+
+
+subsection \<open>Term Implication Closure\<close>
+inductive_set timpl_closure for t TI where
+  FP: "t \<in> timpl_closure t TI"
+| TI: "\<lbrakk>u \<in> timpl_closure t TI; (a,b) \<in> TI; term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) u s\<rbrakk>
+       \<Longrightarrow> s \<in> timpl_closure t TI"
+
+definition "timpl_closure_set M TI \<equiv> (\<Union>t \<in> M. timpl_closure t TI)"
+
+inductive_set timpl_closure'_step for TI where
+  "\<lbrakk>(a,b) \<in> TI; term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) t s\<rbrakk>
+    \<Longrightarrow> (t,s) \<in> timpl_closure'_step TI"
+
+definition "timpl_closure' TI \<equiv> (timpl_closure'_step TI)\<^sup>*"
+
+definition comp_timpl_closure where
+  "comp_timpl_closure FP TI \<equiv>
+    let f = \<lambda>X. FP \<union> (\<Union>x \<in> X. \<Union>(a,b) \<in> TI. set \<langle>a --\<guillemotright> b\<rangle>\<langle>x\<rangle>)
+    in while (\<lambda>X. f X \<noteq> X) f {}"
+
+definition comp_timpl_closure_list where
+  "comp_timpl_closure_list FP TI \<equiv>
+    let f = \<lambda>X. remdups (concat (map (\<lambda>x. concat (map (\<lambda>(a,b). \<langle>a --\<guillemotright> b\<rangle>\<langle>x\<rangle>) TI)) X))
+    in while (\<lambda>X. set (f X) \<noteq> set X) f FP"
+
+lemma timpl_closure_setI:
+  "t \<in> M \<Longrightarrow> t \<in> timpl_closure_set M TI"
+unfolding timpl_closure_set_def by (auto intro: timpl_closure.FP)
+
+lemma timpl_closure_set_empty_timpls:
+  "timpl_closure t {} = {t}" (is "?A = ?B")
+proof (intro subset_antisym subsetI)
+  fix s show "s \<in> ?A \<Longrightarrow> s \<in> ?B"
+    by (induct s rule: timpl_closure.induct) auto
+qed (simp add: timpl_closure.FP)
+
+lemmas timpl_closure_set_is_timpl_closure_union = meta_eq_to_obj_eq[OF timpl_closure_set_def]
+
+lemma term_variants_pred_eq_case_Abs:
+  fixes a b
+  defines "P \<equiv> (\<lambda>_. [])(Abs a := [Abs b])"
+  assumes "term_variants_pred P t s" "\<forall>f \<in> funs_term s. \<not>is_Abs f"
+  shows "t = s"
+using assms(2,3) P_def
+proof (induction P t s rule: term_variants_pred.induct)
+  case (term_variants_Fun T S f)
+  have "\<not>is_Abs h" when i: "i < length S" and h: "h \<in> funs_term (S ! i)" for i h
+    using i h term_variants_Fun.hyps(4) by auto
+  hence "T ! i = S ! i" when i: "i < length T" for i using i term_variants_Fun.hyps(1,3) by auto
+  hence "T = S" using term_variants_Fun.hyps(1) nth_equalityI[of T S] by fast
+  thus ?case using term_variants_Fun.hyps(1) by blast
+qed (simp_all add: term_variants_pred_refl)
+
+lemma timpl_closure'_step_inv:
+  assumes "(t,s) \<in> timpl_closure'_step TI"
+  obtains a b where "(a,b) \<in> TI" "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) t s"
+using assms by (auto elim: timpl_closure'_step.cases)
+
+lemma timpl_closure_mono:
+  assumes "TI \<subseteq> TI'"
+  shows "timpl_closure t TI \<subseteq> timpl_closure t TI'"
+proof
+  fix s show "s \<in> timpl_closure t TI \<Longrightarrow> s \<in> timpl_closure t TI'"
+    apply (induct rule: timpl_closure.induct)
+    using assms by (auto intro: timpl_closure.intros)
+qed
+
+lemma timpl_closure_set_mono:
+  assumes "M \<subseteq> M'" "TI \<subseteq> TI'"
+  shows "timpl_closure_set M TI \<subseteq> timpl_closure_set M' TI'"
+using assms(1) timpl_closure_mono[OF assms(2)] unfolding timpl_closure_set_def by fast
+
+lemma timpl_closure_idem:
+  "timpl_closure_set (timpl_closure t TI) TI = timpl_closure t TI" (is "?A = ?B")
+proof
+  have "s \<in> timpl_closure t TI"
+    when "s \<in> timpl_closure u TI" "u \<in> timpl_closure t TI"
+    for s u
+    using that
+    by (induction rule: timpl_closure.induct)
+       (auto intro: timpl_closure.intros)
+  thus "?A \<subseteq> ?B" unfolding timpl_closure_set_def by blast
+
+  show "?B \<subseteq> ?A"
+    unfolding timpl_closure_set_def
+    by (blast intro: timpl_closure.FP)
+qed
+
+lemma timpl_closure_set_idem:
+  "timpl_closure_set (timpl_closure_set M TI) TI = timpl_closure_set M TI"
+using timpl_closure_idem[of _ TI]unfolding timpl_closure_set_def by auto
+
+lemma timpl_closure_set_mono_timpl_closure_set:
+  assumes N: "N \<subseteq> timpl_closure_set M TI"
+  shows "timpl_closure_set N TI \<subseteq> timpl_closure_set M TI"
+using timpl_closure_set_mono[OF N, of TI TI] timpl_closure_set_idem[of M TI]
+by simp
+
+lemma timpl_closure_is_timpl_closure':
+  "s \<in> timpl_closure t TI \<longleftrightarrow> (t,s) \<in> timpl_closure' TI"
+proof
+  show "s \<in> timpl_closure t TI \<Longrightarrow> (t,s) \<in> timpl_closure' TI"
+    unfolding timpl_closure'_def
+    by (induct rule: timpl_closure.induct)
+       (auto intro: rtrancl_into_rtrancl timpl_closure'_step.intros)
+
+  show "(t,s) \<in> timpl_closure' TI \<Longrightarrow> s \<in> timpl_closure t TI"
+    unfolding timpl_closure'_def
+    by (induct rule: rtrancl_induct)
+       (auto dest: timpl_closure'_step_inv
+             intro: timpl_closure.FP timpl_closure.TI)
+qed
+
+lemma timpl_closure'_mono:
+  assumes "TI \<subseteq> TI'"
+  shows "timpl_closure' TI \<subseteq> timpl_closure' TI'"
+using timpl_closure_mono[OF assms]
+      timpl_closure_is_timpl_closure'[of _ _ TI]
+      timpl_closure_is_timpl_closure'[of _ _ TI']
+by fast
+
+lemma timpl_closureton_is_timpl_closure:
+  "timpl_closure_set {t} TI = timpl_closure t TI"
+by (simp add: timpl_closure_set_is_timpl_closure_union)
+
+lemma timpl_closure'_timpls_trancl_subset:
+  "timpl_closure' (c\<^sup>+) \<subseteq> timpl_closure' c"
+unfolding timpl_closure'_def
+proof
+  fix s t::"(('a,'b,'c) prot_fun,'d) term"
+  show "(s,t) \<in> (timpl_closure'_step (c\<^sup>+))\<^sup>* \<Longrightarrow> (s,t) \<in> (timpl_closure'_step c)\<^sup>*"
+  proof (induction rule: rtrancl_induct)
+    case (step u t)
+    obtain a b where ab:
+        "(a,b) \<in> c\<^sup>+" "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) u t"
+      using step.hyps(2) timpl_closure'_step_inv by blast
+    hence "(u,t) \<in> (timpl_closure'_step c)\<^sup>*"
+    proof (induction arbitrary: t rule: trancl_induct)
+      case (step d e)
+      obtain s where s:
+          "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs d])) u s"
+          "term_variants_pred ((\<lambda>_. [])(Abs d := [Abs e])) s t"
+        using term_variants_pred_dense'[OF step.prems, of "Abs d"] by blast
+
+      have "(u,s) \<in> (timpl_closure'_step c)\<^sup>*"
+           "(s,t) \<in> timpl_closure'_step c"
+        using step.hyps(2) s(2) step.IH[OF s(1)]
+        by (auto intro: timpl_closure'_step.intros)
+      thus ?case by simp
+    qed (auto intro: timpl_closure'_step.intros)
+    thus ?case using step.IH by simp
+  qed simp
+qed
+
+lemma timpl_closure'_timpls_trancl_subset':
+  "timpl_closure' {(a,b) \<in> c\<^sup>+. a \<noteq> b} \<subseteq> timpl_closure' c"
+using timpl_closure'_timpls_trancl_subset
+      timpl_closure'_mono[of "{(a,b) \<in> c\<^sup>+. a \<noteq> b}" "c\<^sup>+"]
+by fast
+
+lemma timpl_closure_set_timpls_trancl_subset:
+  "timpl_closure_set M (c\<^sup>+) \<subseteq> timpl_closure_set M c"
+using timpl_closure'_timpls_trancl_subset[of c]
+      timpl_closure_is_timpl_closure'[of _ _ c]
+      timpl_closure_is_timpl_closure'[of _ _ "c\<^sup>+"]
+      timpl_closure_set_is_timpl_closure_union[of M c]
+      timpl_closure_set_is_timpl_closure_union[of M "c\<^sup>+"]
+by fastforce
+
+lemma timpl_closure_set_timpls_trancl_subset':
+  "timpl_closure_set M {(a,b) \<in> c\<^sup>+. a \<noteq> b} \<subseteq> timpl_closure_set M c"
+using timpl_closure'_timpls_trancl_subset'[of c]
+      timpl_closure_is_timpl_closure'[of _ _ c]
+      timpl_closure_is_timpl_closure'[of _ _ "{(a,b) \<in> c\<^sup>+. a \<noteq> b}"]
+      timpl_closure_set_is_timpl_closure_union[of M c]
+      timpl_closure_set_is_timpl_closure_union[of M "{(a,b) \<in> c\<^sup>+. a \<noteq> b}"]
+by fastforce
+
+lemma timpl_closure'_timpls_trancl_supset':
+  "timpl_closure' c \<subseteq> timpl_closure' {(a,b) \<in> c\<^sup>+. a \<noteq> b}"
+unfolding timpl_closure'_def
+proof
+  let ?cl = "{(a,b) \<in> c\<^sup>+. a \<noteq> b}"
+
+  fix s t::"(('e,'f,'c) prot_fun,'g) term"
+  show "(s,t) \<in> (timpl_closure'_step c)\<^sup>* \<Longrightarrow> (s,t) \<in> (timpl_closure'_step ?cl)\<^sup>*"
+  proof (induction rule: rtrancl_induct)
+    case (step u t)
+    obtain a b where ab:
+        "(a,b) \<in> c" "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) u t"
+      using step.hyps(2) timpl_closure'_step_inv by blast
+    hence "(a,b) \<in> c\<^sup>+" by simp
+    hence "(u,t) \<in> (timpl_closure'_step ?cl)\<^sup>*" using ab(2)
+    proof (induction arbitrary: t rule: trancl_induct)
+      case (base d) show ?case
+      proof (cases "a = d")
+        case True thus ?thesis
+          using base term_variants_pred_refl_inv[of _ u t]
+          by force
+      next
+        case False thus ?thesis
+          using base timpl_closure'_step.intros[of a d ?cl]
+          by fast
+      qed
+    next
+      case (step d e)
+      obtain s where s:
+          "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs d])) u s"
+          "term_variants_pred ((\<lambda>_. [])(Abs d := [Abs e])) s t"
+        using term_variants_pred_dense'[OF step.prems, of "Abs d"] by blast
+
+      show ?case
+      proof (cases "d = e")
+        case True
+        thus ?thesis
+          using step.prems step.IH[of t]
+          by blast
+      next
+        case False
+        hence "(u,s) \<in> (timpl_closure'_step ?cl)\<^sup>*"
+              "(s,t) \<in> timpl_closure'_step ?cl"
+          using step.hyps(2) s(2) step.IH[OF s(1)]
+          by (auto intro: timpl_closure'_step.intros)
+        thus ?thesis by simp
+      qed
+    qed
+    thus ?case using step.IH by simp
+  qed simp
+qed
+
+lemma timpl_closure'_timpls_trancl_supset:
+  "timpl_closure' c \<subseteq> timpl_closure' (c\<^sup>+)"
+using timpl_closure'_timpls_trancl_supset'[of c]
+      timpl_closure'_mono[of "{(a,b) \<in> c\<^sup>+. a \<noteq> b}" "c\<^sup>+"]
+by fast
+
+lemma timpl_closure'_timpls_trancl_eq:
+  "timpl_closure' (c\<^sup>+) = timpl_closure' c"
+using timpl_closure'_timpls_trancl_subset timpl_closure'_timpls_trancl_supset
+by blast
+
+lemma timpl_closure'_timpls_trancl_eq':
+  "timpl_closure' {(a,b) \<in> c\<^sup>+. a \<noteq> b} = timpl_closure' c"
+using timpl_closure'_timpls_trancl_subset' timpl_closure'_timpls_trancl_supset'
+by blast
+
+lemma timpl_closure'_timpls_rtrancl_subset:
+  "timpl_closure' (c\<^sup>*) \<subseteq> timpl_closure' c"
+unfolding timpl_closure'_def
+proof
+  fix s t::"(('a,'b,'c) prot_fun,'d) term"
+  show "(s,t) \<in> (timpl_closure'_step (c\<^sup>*))\<^sup>* \<Longrightarrow> (s,t) \<in> (timpl_closure'_step c)\<^sup>*"
+  proof (induction rule: rtrancl_induct)
+    case (step u t)
+    obtain a b where ab:
+        "(a,b) \<in> c\<^sup>*" "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) u t"
+      using step.hyps(2) timpl_closure'_step_inv by blast
+    hence "(u,t) \<in> (timpl_closure'_step c)\<^sup>*"
+    proof (induction arbitrary: t rule: rtrancl_induct)
+      case base
+      hence "u = t" using term_variants_pred_refl_inv by fastforce
+      thus ?case by simp
+    next
+      case (step d e)
+      obtain s where s:
+          "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs d])) u s"
+          "term_variants_pred ((\<lambda>_. [])(Abs d := [Abs e])) s t"
+        using term_variants_pred_dense'[OF step.prems, of "Abs d"] by blast
+
+      have "(u,s) \<in> (timpl_closure'_step c)\<^sup>*"
+           "(s,t) \<in> timpl_closure'_step c"
+        using step.hyps(2) s(2) step.IH[OF s(1)]
+        by (auto intro: timpl_closure'_step.intros)
+      thus ?case by simp
+    qed
+    thus ?case using step.IH by simp
+  qed simp
+qed
+
+lemma timpl_closure'_timpls_rtrancl_supset:
+  "timpl_closure' c \<subseteq> timpl_closure' (c\<^sup>*)"
+unfolding timpl_closure'_def
+proof
+  fix s t::"(('e,'f,'c) prot_fun,'g) term"
+  show "(s,t) \<in> (timpl_closure'_step c)\<^sup>* \<Longrightarrow> (s,t) \<in> (timpl_closure'_step (c\<^sup>*))\<^sup>*"
+  proof (induction rule: rtrancl_induct)
+    case (step u t)
+    obtain a b where ab:
+        "(a,b) \<in> c" "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) u t"
+      using step.hyps(2) timpl_closure'_step_inv by blast
+    hence "(a,b) \<in> c\<^sup>*" by simp
+    hence "(u,t) \<in> (timpl_closure'_step (c\<^sup>*))\<^sup>*" using ab(2)
+    proof (induction arbitrary: t rule: rtrancl_induct)
+      case (base t) thus ?case using term_variants_pred_refl_inv[of _ u t] by fastforce
+    next
+      case (step d e)
+      obtain s where s:
+          "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs d])) u s"
+          "term_variants_pred ((\<lambda>_. [])(Abs d := [Abs e])) s t"
+        using term_variants_pred_dense'[OF step.prems, of "Abs d"] by blast
+
+      show ?case
+      proof (cases "d = e")
+        case True
+        thus ?thesis
+          using step.prems step.IH[of t]
+          by blast
+      next
+        case False
+        hence "(u,s) \<in> (timpl_closure'_step (c\<^sup>*))\<^sup>*"
+              "(s,t) \<in> timpl_closure'_step (c\<^sup>*)"
+          using step.hyps(2) s(2) step.IH[OF s(1)]
+          by (auto intro: timpl_closure'_step.intros)
+        thus ?thesis by simp
+      qed
+    qed
+    thus ?case using step.IH by simp
+  qed simp
+qed
+
+lemma timpl_closure'_timpls_rtrancl_eq:
+  "timpl_closure' (c\<^sup>*) = timpl_closure' c"
+using timpl_closure'_timpls_rtrancl_subset timpl_closure'_timpls_rtrancl_supset
+by blast
+
+lemma timpl_closure_timpls_trancl_eq:
+  "timpl_closure t (c\<^sup>+) = timpl_closure t c"
+using timpl_closure'_timpls_trancl_eq[of c]
+      timpl_closure_is_timpl_closure'[of _ _ c]
+      timpl_closure_is_timpl_closure'[of _ _ "c\<^sup>+"]
+by fastforce
+
+lemma timpl_closure_set_timpls_trancl_eq:
+  "timpl_closure_set M (c\<^sup>+) = timpl_closure_set M c"
+using timpl_closure_timpls_trancl_eq
+      timpl_closure_set_is_timpl_closure_union[of M c]
+      timpl_closure_set_is_timpl_closure_union[of M "c\<^sup>+"]
+by fastforce
+
+lemma timpl_closure_set_timpls_trancl_eq':
+  "timpl_closure_set M {(a,b) \<in> c\<^sup>+. a \<noteq> b} = timpl_closure_set M c"
+using timpl_closure'_timpls_trancl_eq'[of c]
+      timpl_closure_is_timpl_closure'[of _ _ c]
+      timpl_closure_is_timpl_closure'[of _ _ "{(a,b) \<in> c\<^sup>+. a \<noteq> b}"]
+      timpl_closure_set_is_timpl_closure_union[of M c]
+      timpl_closure_set_is_timpl_closure_union[of M "{(a,b) \<in> c\<^sup>+. a \<noteq> b}"]
+by fastforce
+
+lemma timpl_closure_Var_in_iff:
+  "Var x \<in> timpl_closure t TI \<longleftrightarrow> t = Var x" (is "?A \<longleftrightarrow> ?B")
+proof
+  have "s \<in> timpl_closure t TI \<Longrightarrow> s = Var x \<Longrightarrow> s = t" for s
+    apply (induction rule: timpl_closure.induct)
+    by (simp, metis term_variants_pred_inv_Var(2))
+  thus "?A \<Longrightarrow> ?B" by blast
+qed (blast intro: timpl_closure.FP)
+
+lemma timpl_closure_set_Var_in_iff:
+  "Var x \<in> timpl_closure_set M TI \<longleftrightarrow> Var x \<in> M"
+unfolding timpl_closure_set_def by (simp add: timpl_closure_Var_in_iff[of x _ TI]) 
+
+lemma timpl_closure_Var_inv:
+  assumes "t \<in> timpl_closure (Var x) TI"
+  shows "t = Var x"
+using assms
+proof (induction rule: timpl_closure.induct)
+  case (TI u a b s) thus ?case using term_variants_pred_inv_Var by fast
+qed simp
+
+lemma timpls_Un_mono: "mono (\<lambda>X. FP \<union> (\<Union>x \<in> X. \<Union>(a,b) \<in> TI. set \<langle>a --\<guillemotright> b\<rangle>\<langle>x\<rangle>))"
+by (auto intro!: monoI)
+
+lemma timpl_closure_set_lfp:
+  fixes M TI
+  defines "f \<equiv> \<lambda>X. M \<union> (\<Union>x \<in> X. \<Union>(a,b) \<in> TI. set \<langle>a --\<guillemotright> b\<rangle>\<langle>x\<rangle>)"
+  shows "lfp f = timpl_closure_set M TI"
+proof
+  note 0 = timpls_Un_mono[of M TI, unfolded f_def[symmetric]]
+
+  let ?N = "timpl_closure_set M TI"
+
+  show "lfp f \<subseteq> ?N"
+  proof (induction rule: lfp_induct)
+    case 2 thus ?case
+    proof
+      fix t assume "t \<in> f (lfp f \<inter> ?N)"
+      hence "t \<in> M \<or> t \<in> (\<Union>x \<in> ?N. \<Union>(a,b) \<in> TI. set \<langle>a --\<guillemotright> b\<rangle>\<langle>x\<rangle>)" (is "?A \<or> ?B")
+        unfolding f_def by blast
+      thus "t \<in> ?N"
+      proof
+        assume ?B
+        then obtain s a b where s: "s \<in> ?N" "(a,b) \<in> TI" "t \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>s\<rangle>" by moura
+        thus ?thesis 
+          using term_variants_pred_iff_in_term_variants[of "(\<lambda>_. [])(Abs a := [Abs b])" s]
+          unfolding timpl_closure_set_def timpl_apply_term_def
+          by (auto intro: timpl_closure.intros)
+      qed (auto simp add: timpl_closure_set_def intro: timpl_closure.intros)
+    qed
+  qed (rule 0)
+
+  have "t \<in> lfp f" when t: "t \<in> timpl_closure s TI" and s: "s \<in> M" for t s
+    using t
+  proof (induction t rule: timpl_closure.induct)
+    case (TI u a b v) thus ?case 
+      using term_variants_pred_iff_in_term_variants[of "(\<lambda>_. [])(Abs a := [Abs b])"]
+            lfp_fixpoint[OF 0]
+      unfolding timpl_apply_term_def f_def by fastforce
+  qed (use s lfp_fixpoint[OF 0] f_def in blast)
+  thus "?N \<subseteq> lfp f" unfolding timpl_closure_set_def by blast
+qed
+
+lemma timpl_closure_set_supset:
+  assumes "\<forall>t \<in> FP. t \<in> closure"
+  and "\<forall>t \<in> closure. \<forall>(a,b) \<in> TI. \<forall>s \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>t\<rangle>. s \<in> closure"
+  shows "timpl_closure_set FP TI \<subseteq> closure"
+proof -
+  have "t \<in> closure" when t: "t \<in> timpl_closure s TI" and s: "s \<in> FP" for t s
+    using t
+  proof (induction rule: timpl_closure.induct)
+    case FP thus ?case using s assms(1) by blast
+  next
+    case (TI u a b s') thus ?case
+      using assms(2) term_variants_pred_iff_in_term_variants[of "(\<lambda>_. [])(Abs a := [Abs b])"]
+      unfolding timpl_apply_term_def by fastforce
+  qed
+  thus ?thesis unfolding timpl_closure_set_def by blast
+qed
+
+lemma timpl_closure_set_supset':
+  assumes "\<forall>t \<in> FP. \<forall>(a,b) \<in> TI. \<forall>s \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>t\<rangle>. s \<in> FP"
+  shows "timpl_closure_set FP TI \<subseteq> FP"
+using timpl_closure_set_supset[OF _ assms] by blast
+
+lemma timpl_closure'_param:
+  assumes "(t,s) \<in> timpl_closure' c"
+    and fg: "f = g \<or> (\<exists>a b. (a,b) \<in> c \<and> f = Abs a \<and> g = Abs b)"
+  shows "(Fun f (S@t#T), Fun g (S@s#T)) \<in> timpl_closure' c"
+using assms(1) unfolding timpl_closure'_def
+proof (induction rule: rtrancl_induct)
+  case base thus ?case
+  proof (cases "f = g")
+    case False
+    then obtain a b where ab: "(a,b) \<in> c" "f = Abs a" "g = Abs b"
+      using fg by moura
+    show ?thesis
+      using term_variants_pred_param[OF term_variants_pred_refl[of "(\<lambda>_. [])(Abs a := [Abs b])" t]]
+            timpl_closure'_step.intros[OF ab(1)] ab(2,3)
+      by fastforce
+  qed simp
+next
+  case (step u s)
+  obtain a b where ab: "(a,b) \<in> c" "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) u s"
+    using timpl_closure'_step_inv[OF step.hyps(2)] by blast
+  have "(Fun g (S@u#T), Fun g (S@s#T)) \<in> timpl_closure'_step c"
+      using ab(1) term_variants_pred_param[OF ab(2), of g g S T]
+      by (auto simp add: timpl_closure'_def intro: timpl_closure'_step.intros)
+  thus ?case using rtrancl_into_rtrancl[OF step.IH] fg by blast
+qed
+
+lemma timpl_closure'_param':
+  assumes "(t,s) \<in> timpl_closure' c"
+  shows "(Fun f (S@t#T), Fun f (S@s#T)) \<in> timpl_closure' c"
+using timpl_closure'_param[OF assms] by simp
+
+lemma timpl_closure_FunI:
+  assumes IH: "\<And>i. i < length T \<Longrightarrow> (T ! i, S ! i) \<in> timpl_closure' c"
+    and len: "length T = length S"
+    and fg: "f = g \<or> (\<exists>a b. (a,b) \<in> c\<^sup>+ \<and> f = Abs a \<and> g = Abs b)"
+  shows "(Fun f T, Fun g S) \<in> timpl_closure' c"
+proof -
+  have aux: "(Fun f T, Fun g (take n S@drop n T)) \<in> timpl_closure' c"
+    when "n \<le> length T" for n
+    using that
+  proof (induction n)
+    case 0
+    have "(T ! n, T ! n) \<in> timpl_closure' c" when n: "n < length T" for n
+      using n unfolding timpl_closure'_def by simp
+    hence "(Fun f T, Fun g T) \<in> timpl_closure' c"
+    proof (cases "f = g")
+      case False
+      then obtain a b where ab: "(a, b) \<in> c\<^sup>+" "f = Abs a" "g = Abs b"
+        using fg by moura
+      show ?thesis
+        using timpl_closure'_step.intros[OF ab(1), of "Fun f T" "Fun g T"] ab(2,3)
+              term_variants_P[OF _ term_variants_pred_refl[of "(\<lambda>_. [])(Abs a := [Abs b])"],
+                              of T g f]
+              timpl_closure'_timpls_trancl_eq
+        unfolding timpl_closure'_def
+        by (metis fun_upd_same list.set_intros(1) r_into_rtrancl)
+    qed (simp add: timpl_closure'_def)
+    thus ?case by simp
+  next
+    case (Suc n)
+    hence IH': "(Fun f T, Fun g (take n S@drop n T)) \<in> timpl_closure' c"
+      and n: "n < length T" "n < length S"
+      by (simp_all add: len)
+
+    obtain T1 T2 where T: "T = T1@T ! n#T2" "length T1 = n"
+      using length_prefix_ex'[OF n(1)] by auto
+
+    obtain S1 S2 where S: "S = S1@S ! n#S2" "length S1 = n"
+      using length_prefix_ex'[OF n(2)] by auto
+
+    have "take n S@drop n T = S1@T ! n#T2" "take (Suc n) S@drop (Suc n) T = S1@S ! n#T2"
+      using n T S append_eq_conv_conj
+      by (metis, metis (no_types, hide_lams) Cons_nth_drop_Suc append.assoc append_Cons
+                                             append_Nil take_Suc_conv_app_nth) 
+    moreover have "(T ! n, S ! n) \<in> timpl_closure' c" using IH Suc.prems by simp
+    ultimately show ?case
+      using timpl_closure'_param IH'(1)
+      by (metis (no_types, lifting) timpl_closure'_def rtrancl_trans)
+  qed
+
+  show ?thesis using aux[of "length T"] len by simp
+qed
+
+lemma timpl_closure_FunI':
+  assumes IH: "\<And>i. i < length T \<Longrightarrow> (T ! i, S ! i) \<in> timpl_closure' c"
+    and len: "length T = length S"
+  shows "(Fun f T, Fun f S) \<in> timpl_closure' c"
+using timpl_closure_FunI[OF IH len] by simp
+
+lemma timpl_closure_FunI2:
+  fixes f g::"('a, 'b, 'c) prot_fun"
+  assumes IH: "\<And>i. i < length T \<Longrightarrow> \<exists>u. (T!i, u) \<in> timpl_closure' c \<and> (S!i, u) \<in> timpl_closure' c"
+    and len: "length T = length S"
+    and fg: "f = g \<or> (\<exists>a b d. (a, d) \<in> c\<^sup>+ \<and> (b, d) \<in> c\<^sup>+ \<and> f = Abs a \<and> g = Abs b)"
+  shows "\<exists>h U. (Fun f T, Fun h U) \<in> timpl_closure' c \<and> (Fun g S, Fun h U) \<in> timpl_closure' c"
+proof -
+  let ?P = "\<lambda>i u. (T ! i, u) \<in> timpl_closure' c \<and> (S ! i, u) \<in> timpl_closure' c"
+
+  define U where "U \<equiv> map (\<lambda>i. SOME u. ?P i u) [0..<length T]"
+
+  have U1: "length U = length T"
+    unfolding U_def by auto
+
+  have U2: "(T ! i, U ! i) \<in> timpl_closure' c \<and> (S ! i, U ! i) \<in> timpl_closure' c"
+    when i: "i < length U" for i
+    using i someI_ex[of "?P i"] IH[of i] U1 len
+    unfolding U_def by simp
+
+  show ?thesis
+  proof (cases "f = g")
+    case False
+    then obtain a b d where abd: "(a, d) \<in> c\<^sup>+" "(b, d) \<in> c\<^sup>+" "f = Abs a" "g = Abs b"
+      using fg by moura
+
+    define h::"('a, 'b, 'c) prot_fun" where "h = Abs d"
+
+    have "f = h \<or> (\<exists>a b. (a, b) \<in> c\<^sup>+ \<and> f = Abs a \<and> h = Abs b)"
+         "g = h \<or> (\<exists>a b. (a, b) \<in> c\<^sup>+ \<and> g = Abs a \<and> h = Abs b)"
+      using abd unfolding h_def by blast+
+    thus ?thesis by (metis timpl_closure_FunI len U1 U2)
+  qed (metis timpl_closure_FunI' len U1 U2)
+qed
+
+lemma timpl_closure_FunI3:
+  fixes f g::"('a, 'b, 'c) prot_fun"
+  assumes IH: "\<And>i. i < length T \<Longrightarrow> \<exists>u. (T!i, u) \<in> timpl_closure' c \<and> (S!i, u) \<in> timpl_closure' c"
+    and len: "length T = length S"
+    and fg: "f = g \<or> (\<exists>a b d. (a, d) \<in> c \<and> (b, d) \<in> c \<and> f = Abs a \<and> g = Abs b)"
+  shows "\<exists>h U. (Fun f T, Fun h U) \<in> timpl_closure' c \<and> (Fun g S, Fun h U) \<in> timpl_closure' c"
+using timpl_closure_FunI2[OF IH len] fg unfolding timpl_closure'_timpls_trancl_eq by blast
+
+lemma timpl_closure_fv_eq:
+  assumes "s \<in> timpl_closure t T"
+  shows "fv s = fv t"
+using assms
+by (induct rule: timpl_closure.induct)
+   (metis, metis term_variants_pred_fv_eq)
+
+lemma (in stateful_protocol_model) timpl_closure_subst:
+  assumes t: "wf\<^sub>t\<^sub>r\<^sub>m t" "\<forall>x \<in> fv t. \<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a)"
+    and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
+  shows "timpl_closure (t \<cdot> \<delta>) T = timpl_closure t T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
+proof
+  have "s \<in> timpl_closure t T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
+    when "s \<in> timpl_closure (t \<cdot> \<delta>) T" for s
+    using that
+  proof (induction s rule: timpl_closure.induct)
+    case FP thus ?case using timpl_closure.FP[of t T] by simp
+  next
+    case (TI u a b s)
+    then obtain u' where u': "u' \<in> timpl_closure t T" "u = u' \<cdot> \<delta>" by moura
+    
+    have u'_fv: "\<forall>x \<in> fv u'. \<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a)"
+      using timpl_closure_fv_eq[OF u'(1)] t(2) by simp
+    hence u_fv: "\<forall>x \<in> fv u. \<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a)"
+      using u'(2) wt_subst_trm''[OF \<delta>(1)] wt_subst_const_fv_type_eq[OF _ \<delta>(1,2), of u']
+      by fastforce
+
+    have "\<forall>x \<in> fv u' \<union> fv s. (\<exists>y. \<delta> x = Var y) \<or> (\<exists>f. \<delta> x = Fun f [] \<and> Abs a \<noteq> f)"
+    proof (intro ballI)
+      fix x assume x: "x \<in> fv u' \<union> fv s"
+      then obtain c where c: "\<Gamma>\<^sub>v x = TAtom (Atom c)"
+        using u'_fv u_fv term_variants_pred_fv_eq[OF TI.hyps(3)]
+        by blast
+
+      show "(\<exists>y. \<delta> x = Var y) \<or> (\<exists>f. \<delta> x = Fun f [] \<and> Abs a \<noteq> f)"
+      proof (cases "\<delta> x")
+        case (Fun f T)
+        hence **: "\<Gamma> (Fun f T) = TAtom (Atom c)" and "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)"
+          using c wt_subst_trm''[OF \<delta>(1), of "Var x"] \<delta>(2)
+          by fastforce+
+        hence "\<delta> x = Fun f []" using Fun const_type_inv_wf by metis
+        thus ?thesis using ** by force
+      qed metis
+    qed
+    hence *: "\<forall>x \<in> fv u' \<union> fv s.
+                (\<exists>y. \<delta> x = Var y) \<or> (\<exists>f. \<delta> x = Fun f [] \<and> ((\<lambda>_. [])(Abs a := [Abs b])) f = [])"
+      by fastforce
+
+    obtain s' where s': "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) u' s'" "s = s' \<cdot> \<delta>"
+      using term_variants_pred_subst'[OF _ *] u'(2) TI.hyps(3)
+      by blast
+
+    show ?case using timpl_closure.TI[OF u'(1) TI.hyps(2) s'(1)] s'(2) by blast
+  qed
+  thus "timpl_closure (t \<cdot> \<delta>) T \<subseteq> timpl_closure t T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>" by fast
+
+  have "s \<in> timpl_closure (t \<cdot> \<delta>) T"
+    when s: "s \<in> timpl_closure t T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>" for s
+  proof -
+    obtain s' where s': "s' \<in> timpl_closure t T" "s = s' \<cdot> \<delta>" using s by moura
+    have "s' \<cdot> \<delta> \<in> timpl_closure (t \<cdot> \<delta>) T" using s'(1)
+    proof (induction s' rule: timpl_closure.induct)
+      case FP thus ?case using timpl_closure.FP[of "t \<cdot> \<delta>" T] by simp
+    next
+      case (TI u' a b s') show ?case
+        using timpl_closure.TI[OF TI.IH TI.hyps(2)]
+              term_variants_pred_subst[OF TI.hyps(3)]
+        by blast
+    qed
+    thus ?thesis using s'(2) by metis
+  qed
+  thus "timpl_closure t T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<subseteq> timpl_closure (t \<cdot> \<delta>) T" by fast
+qed
+
+lemma (in stateful_protocol_model) timpl_closure_subst_subset:
+  assumes t: "t \<in> M"
+    and M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a)"
+    and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "ground (subst_range \<delta>)" "subst_domain \<delta> \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
+    and M_supset: "timpl_closure t T \<subseteq> M"
+  shows "timpl_closure (t \<cdot> \<delta>) T \<subseteq> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
+proof -
+  have t': "wf\<^sub>t\<^sub>r\<^sub>m t" "\<forall>x \<in> fv t. \<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a)" using t M by auto
+  show ?thesis using timpl_closure_subst[OF t' \<delta>(1,2), of T] M_supset by blast
+qed
+
+lemma (in stateful_protocol_model) timpl_closure_set_subst_subset:
+  assumes M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<exists>a. \<Gamma>\<^sub>v x = TAtom (Atom a)"
+    and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "ground (subst_range \<delta>)" "subst_domain \<delta> \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
+    and M_supset: "timpl_closure_set M T \<subseteq> M"
+  shows "timpl_closure_set (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) T \<subseteq> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
+using timpl_closure_subst_subset[OF _ M \<delta>, of _ T] M_supset
+      timpl_closure_set_is_timpl_closure_union[of "M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>" T]
+      timpl_closure_set_is_timpl_closure_union[of M T]
+by auto
+
+lemma timpl_closure_set_Union:
+  "timpl_closure_set (\<Union>Ms) T = (\<Union>M \<in> Ms. timpl_closure_set M T)"
+using timpl_closure_set_is_timpl_closure_union[of "\<Union>Ms" T]
+      timpl_closure_set_is_timpl_closure_union[of _ T]
+by force
+
+lemma timpl_closure_set_Union_subst_set:
+  assumes "s \<in> timpl_closure_set (\<Union>{M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> | \<delta>. P \<delta>}) T"
+  shows "\<exists>\<delta>. P \<delta> \<and> s \<in> timpl_closure_set (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) T"
+using assms timpl_closure_set_is_timpl_closure_union[of "(\<Union>{M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> | \<delta>. P \<delta>})" T]
+      timpl_closure_set_is_timpl_closure_union[of _ T]
+by blast
+
+lemma timpl_closure_set_Union_subst_singleton:
+  assumes "s \<in> timpl_closure_set {t \<cdot> \<delta> | \<delta>. P \<delta>} T"
+  shows "\<exists>\<delta>. P \<delta> \<and> s \<in> timpl_closure_set {t \<cdot> \<delta>} T"
+using assms timpl_closure_set_is_timpl_closure_union[of "{t \<cdot> \<delta> |\<delta>. P \<delta>}" T]
+      timpl_closureton_is_timpl_closure[of _ T]
+by fast
+
+lemma timpl_closure'_inv:
+  assumes "(s, t) \<in> timpl_closure' TI"
+  shows "(\<exists>x. s = Var x \<and> t = Var x) \<or> (\<exists>f g S T. s = Fun f S \<and> t = Fun g T \<and> length S = length T)"
+using assms unfolding timpl_closure'_def
+proof (induction rule: rtrancl_induct)
+  case base thus ?case by (cases s) auto
+next
+  case (step t u)
+  obtain a b where ab: "(a, b) \<in> TI" "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) t u"
+    using timpl_closure'_step_inv[OF step.hyps(2)] by blast
+  show ?case using step.IH
+  proof
+    assume "\<exists>x. s = Var x \<and> t = Var x"
+    thus ?case using step.hyps(2) term_variants_pred_inv_Var ab by fastforce
+  next
+    assume "\<exists>f g S T. s = Fun f S \<and> t = Fun g T \<and> length S = length T"
+    then obtain f g S T where st: "s = Fun f S" "t = Fun g T" "length S = length T" by moura
+    thus ?case
+      using ab step.hyps(2) term_variants_pred_inv'[of "(\<lambda>_. [])(Abs a := [Abs b])" g T u]
+      by auto
+  qed
+qed
+
+lemma timpl_closure'_inv':
+  assumes "(s, t) \<in> timpl_closure' TI"
+  shows "(\<exists>x. s = Var x \<and> t = Var x) \<or>
+         (\<exists>f g S T. s = Fun f S \<and> t = Fun g T \<and> length S = length T \<and>
+                    (\<forall>i < length T. (S ! i, T ! i) \<in> timpl_closure' TI) \<and>
+                    (f \<noteq> g \<longrightarrow> is_Abs f \<and> is_Abs g \<and> (the_Abs f, the_Abs g) \<in> TI\<^sup>+))"
+    (is "?A s t \<or> ?B s t (timpl_closure' TI)")
+using assms unfolding timpl_closure'_def
+proof (induction rule: rtrancl_induct)
+  case base thus ?case by (cases s) auto
+next
+  case (step t u)
+  obtain a b where ab: "(a, b) \<in> TI" "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) t u"
+    using timpl_closure'_step_inv[OF step.hyps(2)] by blast
+  show ?case using step.IH
+  proof
+    assume "?A s t"
+    thus ?case using step.hyps(2) term_variants_pred_inv_Var ab by fastforce
+  next
+    assume "?B s t ((timpl_closure'_step TI)\<^sup>*)"
+    then obtain f g S T where st:
+        "s = Fun f S" "t = Fun g T" "length S = length T"
+        "\<And>i. i < length T \<Longrightarrow> (S ! i, T ! i) \<in> (timpl_closure'_step TI)\<^sup>*"
+        "f \<noteq> g \<Longrightarrow> is_Abs f \<and> is_Abs g \<and> (the_Abs f, the_Abs g) \<in> TI\<^sup>+"
+      by moura
+    obtain h U where u:
+        "u = Fun h U" "length T = length U"
+        "\<And>i. i < length T \<Longrightarrow> term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) (T ! i) (U ! i)"
+        "g \<noteq> h \<Longrightarrow> is_Abs g \<and> is_Abs h \<and> (the_Abs g, the_Abs h) \<in> TI\<^sup>+"
+      using ab(2) st(2) r_into_trancl[OF ab(1)]
+            term_variants_pred_inv'(1,2,3,4)[of "(\<lambda>_. [])(Abs a := [Abs b])" g T u]
+            term_variants_pred_inv'(5)[of "(\<lambda>_. [])(Abs a := [Abs b])" g T u "Abs a" "Abs b"]
+      unfolding is_Abs_def the_Abs_def by force
+
+    have "(S ! i, U ! i) \<in> (timpl_closure'_step TI)\<^sup>*" when i: "i < length U" for i
+      using u(2) i rtrancl.rtrancl_into_rtrancl[OF
+              st(4)[of i] timpl_closure'_step.intros[OF ab(1) u(3)[of i]]]
+      by argo
+    moreover have "length S = length U" using st u by argo
+    moreover have "is_Abs f \<and> is_Abs h \<and> (the_Abs f, the_Abs h) \<in> TI\<^sup>+" when fh: "f \<noteq> h"
+      using fh st u by fastforce
+    ultimately show ?case using st(1) u(1) by blast
+  qed
+qed
+
+lemma timpl_closure'_inv'':
+  assumes "(Fun f S, Fun g T) \<in> timpl_closure' TI"
+  shows "length S = length T"
+    and "\<And>i. i < length T \<Longrightarrow> (S ! i, T ! i) \<in> timpl_closure' TI"
+    and "f \<noteq> g \<Longrightarrow> is_Abs f \<and> is_Abs g \<and> (the_Abs f, the_Abs g) \<in> TI\<^sup>+"
+using assms timpl_closure'_inv' by auto
+
+lemma timpl_closure_Fun_inv:
+  assumes "s \<in> timpl_closure (Fun f T) TI"
+  shows "\<exists>g S. s = Fun g S"
+using assms timpl_closure_is_timpl_closure' timpl_closure'_inv
+by fastforce
+
+lemma timpl_closure_Fun_inv':
+  assumes "Fun g S \<in> timpl_closure (Fun f T) TI"
+  shows "length S = length T"
+    and "\<And>i. i < length S \<Longrightarrow> S ! i \<in> timpl_closure (T ! i) TI"
+    and "f \<noteq> g \<Longrightarrow> is_Abs f \<and> is_Abs g \<and> (the_Abs f, the_Abs g) \<in> TI\<^sup>+"
+using assms timpl_closure_is_timpl_closure'
+by (metis timpl_closure'_inv''(1), metis timpl_closure'_inv''(2), metis timpl_closure'_inv''(3))
+
+lemma timpl_closure_Fun_not_Var[simp]:
+  "Fun f T \<notin> timpl_closure (Var x) TI"
+using timpl_closure_Var_inv by fast
+
+lemma timpl_closure_Var_not_Fun[simp]:
+  "Var x \<notin> timpl_closure (Fun f T) TI"
+using timpl_closure_Fun_inv by fast
+
+lemma (in stateful_protocol_model) timpl_closure_wf_trms:
+  assumes m: "wf\<^sub>t\<^sub>r\<^sub>m m"
+  shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (timpl_closure m TI)"
+proof
+  fix t assume "t \<in> timpl_closure m TI"
+  thus "wf\<^sub>t\<^sub>r\<^sub>m t"
+  proof (induction t rule: timpl_closure.induct)
+    case TI thus ?case using term_variants_pred_wf_trms by force
+  qed (rule m)
+qed
+
+lemma (in stateful_protocol_model) timpl_closure_set_wf_trms:
+  assumes M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
+  shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (timpl_closure_set M TI)"
+proof
+  fix t assume "t \<in> timpl_closure_set M TI"
+  then obtain m where "t \<in> timpl_closure m TI" "m \<in> M" "wf\<^sub>t\<^sub>r\<^sub>m m"
+    using M timpl_closure_set_is_timpl_closure_union by blast
+  thus "wf\<^sub>t\<^sub>r\<^sub>m t" using timpl_closure_wf_trms by blast
+qed
+
+lemma timpl_closure_Fu_inv:
+  assumes "t \<in> timpl_closure (Fun (Fu f) T) TI"
+  shows "\<exists>S. length S = length T \<and> t = Fun (Fu f) S"
+using assms
+proof (induction t rule: timpl_closure.induct)
+  case (TI u a b s)
+  then obtain U where U: "length U = length T" "u = Fun (Fu f) U"
+    by moura
+  hence *: "term_variants_pred ((\<lambda>_. [])(Abs a := [Abs b])) (Fun (Fu f) U) s"
+    using TI.hyps(3) by meson
+
+  show ?case
+    using term_variants_pred_inv'(1,2,4)[OF *] U
+    by force
+qed simp
+
+lemma timpl_closure_Fu_inv':
+  assumes "Fun (Fu f) T \<in> timpl_closure t TI"
+  shows "\<exists>S. length S = length T \<and> t = Fun (Fu f) S"
+using assms
+proof (induction "Fun (Fu f) T" arbitrary: T rule: timpl_closure.induct)
+  case (TI u a b)
+  obtain g U where U:
+      "u = Fun g U" "length U = length T"
+      "Fu f \<noteq> g \<Longrightarrow> Abs a = g \<and> Fu f = Abs b"
+    using term_variants_pred_inv''[OF TI.hyps(4)] by fastforce
+
+  have g: "g = Fu f" using U(3) by blast
+  
+  show ?case using TI.hyps(2)[OF U(1)[unfolded g]] U(2) by auto
+qed simp
+
+lemma timpl_closure_no_Abs_eq:
+  assumes "t \<in> timpl_closure s TI"
+    and "\<forall>f \<in> funs_term t. \<not>is_Abs f"
+  shows "t = s"
+using assms
+proof (induction t rule: timpl_closure.induct)
+  case (TI t a b s) thus ?case
+    using term_variants_pred_eq_case_Abs[of a b t s]
+    unfolding timpl_apply_term_def term_variants_pred_iff_in_term_variants[symmetric]
+    by metis
+qed simp
+
+lemma timpl_closure_set_no_Abs_in_set:
+  assumes "t \<in> timpl_closure_set FP TI"
+    and "\<forall>f \<in> funs_term t. \<not>is_Abs f"
+  shows "t \<in> FP"
+using assms timpl_closure_no_Abs_eq unfolding timpl_closure_set_def by blast
+
+lemma timpl_closure_funs_term_subset:
+  "\<Union>(funs_term ` (timpl_closure t TI)) \<subseteq> funs_term t \<union> Abs ` snd ` TI"
+  (is "?A \<subseteq> ?B \<union> ?C")
+proof
+  fix f assume "f \<in> ?A"
+  then obtain s where "s \<in> timpl_closure t TI" "f \<in> funs_term s" by moura
+  thus "f \<in> ?B \<union> ?C"
+  proof (induction s rule: timpl_closure.induct)
+    case (TI u a b s)
+    have "Abs b \<in> Abs ` snd ` TI" using TI.hyps(2) by force
+    thus ?case using term_variants_pred_funs_term[OF TI.hyps(3) TI.prems] TI.IH by force
+  qed blast
+qed
+
+lemma timpl_closure_set_funs_term_subset:
+  "\<Union>(funs_term ` (timpl_closure_set FP TI)) \<subseteq> \<Union>(funs_term ` FP) \<union> Abs ` snd ` TI"
+using timpl_closure_funs_term_subset[of _ TI]
+      timpl_closure_set_is_timpl_closure_union[of FP TI]
+by auto
+
+lemma funs_term_OCC_TI_subset:
+  defines "absc \<equiv> \<lambda>a. Fun (Abs a) []"
+  assumes OCC1: "\<forall>t \<in> FP. \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` OCC"
+    and OCC2: "snd ` TI \<subseteq> OCC"
+  shows "\<forall>t \<in> timpl_closure_set FP TI. \<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> f \<in> Abs ` OCC" (is ?A)
+    and "\<forall>t \<in> absc ` OCC. \<forall>(a,b) \<in> TI. \<forall>s \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>t\<rangle>. s \<in> absc ` OCC" (is ?B)
+proof -
+  let ?F = "\<Union>(funs_term ` FP)"
+  let ?G = "Abs ` snd ` TI"
+
+  show ?A
+  proof (intro ballI impI)
+    fix t f assume t: "t \<in> timpl_closure_set FP TI" and f: "f \<in> funs_term t" "is_Abs f"
+    hence "f \<in> ?F \<or> f \<in> ?G" using timpl_closure_set_funs_term_subset[of FP TI] by auto
+    thus "f \<in> Abs ` OCC"
+    proof
+      assume "f \<in> ?F" thus ?thesis using OCC1 f(2) by fast
+    next
+      assume "f \<in> ?G" thus ?thesis using OCC2 by auto
+    qed
+  qed
+
+  { fix s t a b
+    assume t: "t \<in> absc ` OCC"
+      and ab: "(a, b) \<in> TI"
+      and s: "s \<in> set \<langle>a --\<guillemotright> b\<rangle>\<langle>t\<rangle>"
+    obtain c where c: "t = absc c" "c \<in> OCC" using t by moura
+    hence "s = absc b \<or> s = absc c"
+      using ab s timpl_apply_const'[of c a b] unfolding absc_def by auto
+    moreover have "b \<in> OCC" using ab OCC2 by auto
+    ultimately have "s \<in> absc ` OCC" using c(2) by blast
+  } thus ?B by blast
+qed
+
+lemma (in stateful_protocol_model) intruder_synth_timpl_closure_set:
+  fixes M::"('fun,'atom,'sets) prot_terms" and t::"('fun,'atom,'sets) prot_term"
+  assumes "M \<turnstile>\<^sub>c t"
+    and "s \<in> timpl_closure t TI"
+  shows "timpl_closure_set M TI \<turnstile>\<^sub>c s"
+using assms
+proof (induction t arbitrary: s rule: intruder_synth_induct)
+  case (AxiomC t)
+  hence "s \<in> timpl_closure_set M TI"
+    using timpl_closure_set_is_timpl_closure_union[of M TI]
+    by blast
+  thus ?case by simp
+next
+  case (ComposeC T f)
+  obtain g S where s: "s = Fun g S"
+    using timpl_closure_Fun_inv[OF ComposeC.prems] by moura
+  hence s':
+      "f = g" "length S = length T"
+      "\<And>i. i < length S \<Longrightarrow> S ! i \<in> timpl_closure (T ! i) TI"
+    using timpl_closure_Fun_inv'[of g S f T TI] ComposeC.prems ComposeC.hyps(2)
+    unfolding is_Abs_def by fastforce+
+  
+  have "timpl_closure_set M TI \<turnstile>\<^sub>c u" when u: "u \<in> set S" for u
+    using ComposeC.IH u s'(2,3) in_set_conv_nth[of _ T] in_set_conv_nth[of u S] by auto
+  thus ?case
+    using s s'(1,2) ComposeC.hyps(1,2) intruder_synth.ComposeC[of S g "timpl_closure_set M TI"]
+    by argo
+qed
+
+lemma (in stateful_protocol_model) intruder_synth_timpl_closure':
+  fixes M::"('fun,'atom,'sets) prot_terms" and t::"('fun,'atom,'sets) prot_term"
+  assumes "timpl_closure_set M TI \<turnstile>\<^sub>c t"
+    and "s \<in> timpl_closure t TI"
+  shows "timpl_closure_set M TI \<turnstile>\<^sub>c s"
+by (metis intruder_synth_timpl_closure_set[OF assms] timpl_closure_set_idem)
+
+lemma timpl_closure_set_absc_subset_in:
+  defines "absc \<equiv> \<lambda>a. Fun (Abs a) []"
+  assumes A: "timpl_closure_set (absc ` A) TI \<subseteq> absc ` A"
+    and a: "a \<in> A" "(a,b) \<in> TI\<^sup>+"
+  shows "b \<in> A"
+proof -
+  have "timpl_closure (absc a) (TI\<^sup>+) \<subseteq> absc ` A"
+    using a(1) A timpl_closure_timpls_trancl_eq
+    unfolding timpl_closure_set_def by fast
+  thus ?thesis
+    using timpl_closure.TI[OF timpl_closure.FP[of "absc a"] a(2), of "absc b"]
+          term_variants_P[of "[]" "[]" "(\<lambda>_. [])(Abs a := [Abs b])" "Abs b" "Abs a"]
+    unfolding absc_def by auto
+qed
+
+
+subsection \<open>Composition-only Intruder Deduction Modulo Term Implication Closure of the Intruder Knowledge\<close>
+context stateful_protocol_model
+begin
+
+fun in_trancl where
+  "in_trancl TI a b = (
+    if (a,b) \<in> set TI then True
+    else list_ex (\<lambda>(c,d). c = a \<and> in_trancl (removeAll (c,d) TI) d b) TI)"
+
+definition in_rtrancl where
+  "in_rtrancl TI a b \<equiv> a = b \<or> in_trancl TI a b"
+
+declare in_trancl.simps[simp del]
+
+fun timpls_transformable_to where
+  "timpls_transformable_to TI (Var x) (Var y) = (x = y)"
+| "timpls_transformable_to TI (Fun f T) (Fun g S) = (
+    (f = g \<or> (is_Abs f \<and> is_Abs g \<and> (the_Abs f, the_Abs g) \<in> set TI)) \<and>
+    list_all2 (timpls_transformable_to TI) T S)"
+| "timpls_transformable_to _ _ _ = False"
+
+fun timpls_transformable_to' where
+  "timpls_transformable_to' TI (Var x) (Var y) = (x = y)"
+| "timpls_transformable_to' TI (Fun f T) (Fun g S) = (
+    (f = g \<or> (is_Abs f \<and> is_Abs g \<and> in_trancl TI (the_Abs f) (the_Abs g))) \<and>
+    list_all2 (timpls_transformable_to' TI) T S)"
+| "timpls_transformable_to' _ _ _ = False"
+
+fun equal_mod_timpls where
+  "equal_mod_timpls TI (Var x) (Var y) = (x = y)"
+| "equal_mod_timpls TI (Fun f T) (Fun g S) = (
+    (f = g \<or> (is_Abs f \<and> is_Abs g \<and>
+                ((the_Abs f, the_Abs g) \<in> set TI \<or>
+                 (the_Abs g, the_Abs f) \<in> set TI \<or>
+                 (\<exists>ti \<in> set TI. (the_Abs f, snd ti) \<in> set TI \<and> (the_Abs g, snd ti) \<in> set TI)))) \<and>
+    list_all2 (equal_mod_timpls TI) T S)"
+| "equal_mod_timpls _ _ _ = False"
+
+fun intruder_synth_mod_timpls where
+  "intruder_synth_mod_timpls M TI (Var x) = List.member M (Var x)"
+| "intruder_synth_mod_timpls M TI (Fun f T) = (
+    (list_ex (\<lambda>t. timpls_transformable_to TI t (Fun f T)) M) \<or>
+    (public f \<and> length T = arity f \<and> list_all (intruder_synth_mod_timpls M TI) T))"
+
+fun intruder_synth_mod_timpls' where
+  "intruder_synth_mod_timpls' M TI (Var x) = List.member M (Var x)"
+| "intruder_synth_mod_timpls' M TI (Fun f T) = (
+    (list_ex (\<lambda>t. timpls_transformable_to' TI t (Fun f T)) M) \<or>
+    (public f \<and> length T = arity f \<and> list_all (intruder_synth_mod_timpls' M TI) T))"
+
+fun intruder_synth_mod_eq_timpls where
+  "intruder_synth_mod_eq_timpls M TI (Var x) = (Var x \<in> M)"
+| "intruder_synth_mod_eq_timpls M TI (Fun f T) = (
+    (\<exists>t \<in> M. equal_mod_timpls TI t (Fun f T)) \<or>
+    (public f \<and> length T = arity f \<and> list_all (intruder_synth_mod_eq_timpls M TI) T))"
+
+definition analyzed_closed_mod_timpls where
+  "analyzed_closed_mod_timpls M TI \<equiv>
+    let f = list_all (intruder_synth_mod_timpls M TI);
+        g = \<lambda>t. if f (fst (Ana t)) then f (snd (Ana t))
+                else \<forall>s \<in> comp_timpl_closure {t} (set TI). case Ana s of (K,R) \<Rightarrow> f K \<longrightarrow> f R
+    in list_all g M"
+
+definition analyzed_closed_mod_timpls' where
+  "analyzed_closed_mod_timpls' M TI \<equiv>
+    let f = list_all (intruder_synth_mod_timpls' M TI);
+        g = \<lambda>t. if f (fst (Ana t)) then f (snd (Ana t))
+                else \<forall>s \<in> comp_timpl_closure {t} (set TI). case Ana s of (K,R) \<Rightarrow> f K \<longrightarrow> f R
+    in list_all g M"
+(* Alternative definition (allows for computing the closures beforehand which may be useful) *)
+definition analyzed_closed_mod_timpls_alt where
+  "analyzed_closed_mod_timpls_alt M TI timpl_cl_witness \<equiv>
+    let f = \<lambda>R. \<forall>r \<in> set R. intruder_synth_mod_timpls M TI r;
+        N = {t \<in> set M. f (fst (Ana t))};
+        N' = set M - N
+    in (\<forall>t \<in> N. f (snd (Ana t))) \<and>
+       (N' \<noteq> {} \<longrightarrow> (N' \<union> (\<Union>x\<in>timpl_cl_witness. \<Union>(a,b)\<in>set TI. set \<langle>a --\<guillemotright> b\<rangle>\<langle>x\<rangle>) \<subseteq> timpl_cl_witness)) \<and>
+       (\<forall>s \<in> timpl_cl_witness. case Ana s of (K,R) \<Rightarrow> f K \<longrightarrow> f R)"
+
+lemma in_trancl_closure_iff_in_trancl_fun:
+  "(a,b) \<in> (set TI)\<^sup>+ \<longleftrightarrow> in_trancl TI a b" (is "?A TI a b \<longleftrightarrow> ?B TI a b")
+proof
+  show "?A TI a b \<Longrightarrow> ?B TI a b"
+  proof (induction rule: trancl_induct)
+    case (step c d)
+    show ?case using step.IH step.hyps(2)
+    proof (induction TI a c rule: in_trancl.induct)
+      case (1 TI a b) thus ?case using in_trancl.simps
+        by (smt Bex_set case_prodE case_prodI member_remove prod.sel(2) remove_code(1))
+    qed
+  qed (metis in_trancl.simps)
+
+  show "?B TI a b \<Longrightarrow> ?A TI a b"
+  proof (induction TI a b rule: in_trancl.induct)
+    case (1 TI a b)
+    let ?P = "\<lambda>TI a b c d. in_trancl (List.removeAll (c,d) TI) d b"
+    have *: "\<exists>(c,d) \<in> set TI. c = a \<and> ?P TI a b c d" when "(a,b) \<notin> set TI"
+      using that "1.prems" list_ex_iff[of _ TI] in_trancl.simps[of TI a b]
+      by auto
+    show ?case
+    proof (cases "(a,b) \<in> set TI")
+      case False
+      hence "\<exists>(c,d) \<in> set TI. c = a \<and> ?P TI a b c d" using * by blast
+      then obtain d where d: "(a,d) \<in> set TI" "?P TI a b a d" by blast
+      have "(d,b) \<in> (set (removeAll (a,d) TI))\<^sup>+" using "1.IH"[OF False d(1)] d(2) by blast
+      moreover have "set (removeAll (a,d) TI) \<subseteq> set TI" by simp
+      ultimately have "(d,b) \<in> (set TI)\<^sup>+" using trancl_mono by blast
+      thus ?thesis using d(1) by fastforce
+    qed simp
+  qed
+qed
+
+lemma in_rtrancl_closure_iff_in_rtrancl_fun:
+  "(a,b) \<in> (set TI)\<^sup>* \<longleftrightarrow> in_rtrancl TI a b"
+by (metis rtrancl_eq_or_trancl in_trancl_closure_iff_in_trancl_fun in_rtrancl_def)
+
+lemma in_trancl_mono:
+  assumes "set TI \<subseteq> set TI'"
+    and "in_trancl TI a b"
+  shows "in_trancl TI' a b"
+by (metis assms in_trancl_closure_iff_in_trancl_fun trancl_mono)
+
+lemma equal_mod_timpls_refl:
+  "equal_mod_timpls TI t t"
+proof (induction t)
+  case (Fun f T) thus ?case
+    using list_all2_conv_all_nth[of "equal_mod_timpls TI" T T] by force
+qed simp
+
+lemma equal_mod_timpls_inv_Var:
+  "equal_mod_timpls TI (Var x) t \<Longrightarrow> t = Var x" (is "?A \<Longrightarrow> ?C")
+  "equal_mod_timpls TI t (Var x) \<Longrightarrow> t = Var x" (is "?B \<Longrightarrow> ?C")
+proof -
+  show "?A \<Longrightarrow> ?C" by (cases t) auto
+  show "?B \<Longrightarrow> ?C" by (cases t) auto
+qed
+
+lemma equal_mod_timpls_inv:
+  assumes "equal_mod_timpls TI (Fun f T) (Fun g S)"
+  shows "length T = length S"
+    and "\<And>i. i < length T \<Longrightarrow> equal_mod_timpls TI (T ! i) (S ! i)"
+    and "f \<noteq> g \<Longrightarrow> (is_Abs f \<and> is_Abs g \<and> (
+                      (the_Abs f, the_Abs g) \<in> set TI \<or> (the_Abs g, the_Abs f) \<in> set TI \<or>
+                      (\<exists>ti \<in> set TI. (the_Abs f, snd ti) \<in> set TI \<and>
+                                     (the_Abs g, snd ti) \<in> set TI)))"
+using assms list_all2_conv_all_nth[of "equal_mod_timpls TI" T S]
+by (auto elim: equal_mod_timpls.cases)
+
+lemma equal_mod_timpls_inv':
+  assumes "equal_mod_timpls TI (Fun f T) t"
+  shows "is_Fun t"
+    and "length T = length (args t)"
+    and "\<And>i. i < length T \<Longrightarrow> equal_mod_timpls TI (T ! i) (args t ! i)"
+    and "f \<noteq> the_Fun t \<Longrightarrow> (is_Abs f \<and> is_Abs (the_Fun t) \<and> (
+                      (the_Abs f, the_Abs (the_Fun t)) \<in> set TI \<or>
+                      (the_Abs (the_Fun t), the_Abs f) \<in> set TI \<or>
+                      (\<exists>ti \<in> set TI. (the_Abs f, snd ti) \<in> set TI \<and>
+                                     (the_Abs (the_Fun t), snd ti) \<in> set TI)))"
+    and "\<not>is_Abs f \<Longrightarrow> f = the_Fun t"
+using assms list_all2_conv_all_nth[of "equal_mod_timpls TI" T]
+by (cases t; auto)+
+
+lemma equal_mod_timpls_if_term_variants:
+  fixes s t::"(('a, 'b, 'c) prot_fun, 'd) term" and a b::"'c set"
+  defines "P \<equiv> (\<lambda>_. [])(Abs a := [Abs b])"
+  assumes st: "term_variants_pred P s t"
+    and ab: "(a,b) \<in> set TI"
+  shows "equal_mod_timpls TI s t"
+using st P_def
+proof (induction rule: term_variants_pred.induct)
+  case (term_variants_P T S f) thus ?case
+    using ab list_all2_conv_all_nth[of "equal_mod_timpls TI" T S]
+          in_trancl_closure_iff_in_trancl_fun[of _ _ TI]
+    by auto
+next
+  case (term_variants_Fun T S f) thus ?case
+    using ab list_all2_conv_all_nth[of "equal_mod_timpls TI" T S]
+          in_trancl_closure_iff_in_trancl_fun[of _ _ TI]
+    by auto
+qed simp
+
+lemma equal_mod_timpls_mono:
+  assumes "set TI \<subseteq> set TI'"
+    and "equal_mod_timpls TI s t"
+  shows "equal_mod_timpls TI' s t"
+  using assms
+proof (induction TI s t rule: equal_mod_timpls.induct)
+  case (2 TI f T g S)
+  have *: "f = g \<or> (is_Abs f \<and> is_Abs g \<and> ((the_Abs f, the_Abs g) \<in> set TI \<or>
+                 (the_Abs g, the_Abs f) \<in> set TI \<or>
+                 (\<exists>ti \<in> set TI. (the_Abs f, snd ti) \<in> set TI \<and>
+                                (the_Abs g, snd ti) \<in> set TI)))"
+          "list_all2 (equal_mod_timpls TI) T S"
+    using "2.prems" by simp_all
+
+  show ?case
+    using "2.IH" "2.prems"(1) list.rel_mono_strong[OF *(2)] *(1) in_trancl_mono[of TI TI']
+    by (metis (no_types, lifting) equal_mod_timpls.simps(2) set_rev_mp)
+qed auto
+
+lemma equal_mod_timpls_refl_minus_eq:
+  "equal_mod_timpls TI s t \<longleftrightarrow> equal_mod_timpls (filter (\<lambda>(a,b). a \<noteq> b) TI) s t"
+  (is "?A \<longleftrightarrow> ?B")
+proof
+  show ?A when ?B using that equal_mod_timpls_mono[of "filter (\<lambda>(a,b). a \<noteq> b) TI" TI] by auto
+
+  show ?B when ?A using that
+  proof (induction TI s t rule: equal_mod_timpls.induct)
+    case (2 TI f T g S)
+    define TI' where "TI' \<equiv> filter (\<lambda>(a,b). a \<noteq> b) TI"
+
+    let ?P = "\<lambda>X Y. f = g \<or> (is_Abs f \<and> is_Abs g \<and> ((the_Abs f, the_Abs g) \<in> set X \<or>
+                 (the_Abs g, the_Abs f) \<in> set X \<or> (\<exists>ti \<in> set Y.
+                 (the_Abs f, snd ti) \<in> set X \<and> (the_Abs g, snd ti) \<in> set X)))"
+
+    have *: "?P TI TI" "list_all2 (equal_mod_timpls TI) T S"
+      using "2.prems" by simp_all
+
+    have "?P TI' TI"
+      using *(1) unfolding TI'_def is_Abs_def by auto
+    hence "?P TI' TI'"
+      by (metis (no_types, lifting) snd_conv)
+    moreover have "list_all2 (equal_mod_timpls TI') T S"
+      using *(2) "2.IH" list.rel_mono_strong unfolding TI'_def by blast
+    ultimately show ?case unfolding TI'_def by force
+  qed auto
+qed
+
+lemma timpls_transformable_to_refl:
+  "timpls_transformable_to TI t t" (is ?A)
+  "timpls_transformable_to' TI t t" (is ?B)
+by (induct t) (auto simp add: list_all2_conv_all_nth)
+
+lemma timpls_transformable_to_inv_Var:
+  "timpls_transformable_to TI (Var x) t \<Longrightarrow> t = Var x" (is "?A \<Longrightarrow> ?C")
+  "timpls_transformable_to TI t (Var x) \<Longrightarrow> t = Var x" (is "?B \<Longrightarrow> ?C")
+  "timpls_transformable_to' TI (Var x) t \<Longrightarrow> t = Var x" (is "?A' \<Longrightarrow> ?C")
+  "timpls_transformable_to' TI t (Var x) \<Longrightarrow> t = Var x" (is "?B' \<Longrightarrow> ?C")
+by (cases t; auto)+
+
+lemma timpls_transformable_to_inv:
+  assumes "timpls_transformable_to TI (Fun f T) (Fun g S)"
+  shows "length T = length S"
+    and "\<And>i. i < length T \<Longrightarrow> timpls_transformable_to TI (T ! i) (S ! i)"
+    and "f \<noteq> g \<Longrightarrow> (is_Abs f \<and> is_Abs g \<and> (the_Abs f, the_Abs g) \<in> set TI)"
+using assms list_all2_conv_all_nth[of "timpls_transformable_to TI" T S] by auto
+
+lemma timpls_transformable_to'_inv:
+  assumes "timpls_transformable_to' TI (Fun f T) (Fun g S)"
+  shows "length T = length S"
+    and "\<And>i. i < length T \<Longrightarrow> timpls_transformable_to' TI (T ! i) (S ! i)"
+    and "f \<noteq> g \<Longrightarrow> (is_Abs f \<and> is_Abs g \<and> in_trancl TI (the_Abs f) (the_Abs g))"
+using assms list_all2_conv_all_nth[of "timpls_transformable_to' TI" T S] by auto
+
+lemma timpls_transformable_to_inv':
+  assumes "timpls_transformable_to TI (Fun f T) t"
+  shows "is_Fun t"
+    and "length T = length (args t)"
+    and "\<And>i. i < length T \<Longrightarrow> timpls_transformable_to TI (T ! i) (args t ! i)"
+    and "f \<noteq> the_Fun t \<Longrightarrow> (
+          is_Abs f \<and> is_Abs (the_Fun t) \<and> (the_Abs f, the_Abs (the_Fun t)) \<in> set TI)"
+    and "\<not>is_Abs f \<Longrightarrow> f = the_Fun t"
+using assms list_all2_conv_all_nth[of "timpls_transformable_to TI" T]
+by (cases t; auto)+
+
+lemma timpls_transformable_to'_inv':
+  assumes "timpls_transformable_to' TI (Fun f T) t"
+  shows "is_Fun t"
+    and "length T = length (args t)"
+    and "\<And>i. i < length T \<Longrightarrow> timpls_transformable_to' TI (T ! i) (args t ! i)"
+    and "f \<noteq> the_Fun t \<Longrightarrow> (
+          is_Abs f \<and> is_Abs (the_Fun t) \<and> in_trancl TI (the_Abs f) (the_Abs (the_Fun t)))"
+    and "\<not>is_Abs f \<Longrightarrow> f = the_Fun t"
+using assms list_all2_conv_all_nth[of "timpls_transformable_to' TI" T]
+by (cases t; auto)+
+
+lemma timpls_transformable_to_size_eq:
+  fixes s t::"(('b, 'c, 'a) prot_fun, 'd) term"
+  shows "timpls_transformable_to TI s t \<Longrightarrow> size s = size t" (is "?A \<Longrightarrow> ?C")
+    and "timpls_transformable_to' TI s t \<Longrightarrow> size s = size t" (is "?B \<Longrightarrow> ?C")
+proof -
+  have *: "size_list size T = size_list size S"
+    when "length T = length S" "\<And>i. i < length T \<Longrightarrow> size (T ! i) = size (S ! i)"
+    for S T::"(('b, 'c, 'a) prot_fun, 'd) term list"
+    using that
+  proof (induction T arbitrary: S)
+    case (Cons x T')
+    then obtain y S' where y: "S = y#S'" by (cases S) auto
+    hence "size_list size T' = size_list size S'" "size x = size y"
+      using Cons.prems Cons.IH[of S'] by force+
+    thus ?case using y by simp
+  qed simp
+
+  show ?C when ?A using that
+  proof (induction rule: timpls_transformable_to.induct)
+    case (2 TI f T g S)
+    hence "length T = length S" "\<And>i. i < length T \<Longrightarrow> size (T ! i) = size (S ! i)"
+      using timpls_transformable_to_inv(1,2)[of TI f T g S] by auto
+    thus ?case using *[of S T] by simp
+  qed simp_all
+
+  show ?C when ?B using that
+  proof (induction rule: timpls_transformable_to.induct)
+    case (2 TI f T g S)
+    hence "length T = length S" "\<And>i. i < length T \<Longrightarrow> size (T ! i) = size (S ! i)"
+      using timpls_transformable_to'_inv(1,2)[of TI f T g S] by auto
+    thus ?case using *[of S T] by simp
+  qed simp_all
+qed
+
+lemma timpls_transformable_to_if_term_variants:
+  fixes s t::"(('a, 'b, 'c) prot_fun, 'd) term" and a b::"'c set"
+  defines "P \<equiv> (\<lambda>_. [])(Abs a := [Abs b])"
+  assumes st: "term_variants_pred P s t"
+    and ab: "(a,b) \<in> set TI"
+  shows "timpls_transformable_to TI s t"
+using st P_def
+proof (induction rule: term_variants_pred.induct)
+  case (term_variants_P T S f) thus ?case
+    using ab list_all2_conv_all_nth[of "timpls_transformable_to TI" T S]
+    by auto
+next
+  case (term_variants_Fun T S f) thus ?case
+    using ab list_all2_conv_all_nth[of "timpls_transformable_to TI" T S]
+    by auto
+qed simp
+
+lemma timpls_transformable_to'_if_term_variants:
+  fixes s t::"(('a, 'b, 'c) prot_fun, 'd) term" and a b::"'c set"
+  defines "P \<equiv> (\<lambda>_. [])(Abs a := [Abs b])"
+  assumes st: "term_variants_pred P s t"
+    and ab: "(a,b) \<in> (set TI)\<^sup>+"
+  shows "timpls_transformable_to' TI s t"
+using st P_def
+proof (induction rule: term_variants_pred.induct)
+  case (term_variants_P T S f) thus ?case
+    using ab list_all2_conv_all_nth[of "timpls_transformable_to' TI" T S]
+          in_trancl_closure_iff_in_trancl_fun[of _ _ TI]
+    by auto
+next
+  case (term_variants_Fun T S f) thus ?case
+    using ab list_all2_conv_all_nth[of "timpls_transformable_to' TI" T S]
+          in_trancl_closure_iff_in_trancl_fun[of _ _ TI]
+    by auto
+qed simp
+
+lemma timpls_transformable_to_trans:
+  assumes TI_trancl: "\<forall>(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b \<longrightarrow> (a,b) \<in> set TI"
+    and st: "timpls_transformable_to TI s t"
+    and tu: "timpls_transformable_to TI t u"
+  shows "timpls_transformable_to TI s u"
+using st tu
+proof (induction s arbitrary: t u)
+  case (Var x) thus ?case using tu timpls_transformable_to_inv_Var(1) by fast
+next
+  case (Fun f T)
+  obtain g S where t:
+      "t = Fun g S" "length T = length S"
+      "\<And>i. i < length T \<Longrightarrow> timpls_transformable_to TI (T ! i) (S ! i)"
+      "f \<noteq> g \<Longrightarrow> is_Abs f \<and> is_Abs g \<and> (the_Abs f, the_Abs g) \<in> set TI"
+    using timpls_transformable_to_inv'[OF Fun.prems(1)] TI_trancl by moura
+
+  obtain h U where u:
+      "u = Fun h U" "length S = length U"
+      "\<And>i. i < length S \<Longrightarrow> timpls_transformable_to TI (S ! i) (U ! i)"
+      "g \<noteq> h \<Longrightarrow> is_Abs g \<and> is_Abs h \<and> (the_Abs g, the_Abs h) \<in> set TI"
+    using timpls_transformable_to_inv'[OF Fun.prems(2)[unfolded t(1)]] TI_trancl by moura
+
+  have "list_all2 (timpls_transformable_to TI) T U"
+    using t(1,2,3) u(1,2,3) Fun.IH
+          list_all2_conv_all_nth[of "timpls_transformable_to TI" T S]
+          list_all2_conv_all_nth[of "timpls_transformable_to TI" S U]
+          list_all2_conv_all_nth[of "timpls_transformable_to TI" T U]
+    by force
+  moreover have "(the_Abs f, the_Abs h) \<in> set TI"
+    when "(the_Abs f, the_Abs g) \<in> set TI" "(the_Abs g, the_Abs h) \<in> set TI"
+         "f \<noteq> h" "is_Abs f" "is_Abs h"
+    using that(3,4,5) TI_trancl trancl_into_trancl[OF r_into_trancl[OF that(1)] that(2)]
+    unfolding is_Abs_def the_Abs_def
+    by force
+  hence "is_Abs f \<and> is_Abs h \<and> (the_Abs f, the_Abs h) \<in> set TI"
+    when "f \<noteq> h"
+    using that TI_trancl t(4) u(4) by fast
+  ultimately show ?case using t(1) u(1) by force
+qed
+
+lemma timpls_transformable_to'_trans:
+  assumes st: "timpls_transformable_to' TI s t"
+    and tu: "timpls_transformable_to' TI t u"
+  shows "timpls_transformable_to' TI s u"
+using st tu
+proof (induction s arbitrary: t u)
+  case (Var x) thus ?case using tu timpls_transformable_to_inv_Var(3) by fast
+next
+  case (Fun f T)
+  note 0 = in_trancl_closure_iff_in_trancl_fun[of _ _ TI]
+
+  obtain g S where t:
+      "t = Fun g S" "length T = length S"
+      "\<And>i. i < length T \<Longrightarrow> timpls_transformable_to' TI (T ! i) (S ! i)"
+      "f \<noteq> g \<Longrightarrow> is_Abs f \<and> is_Abs g \<and> (the_Abs f, the_Abs g) \<in> (set TI)\<^sup>+"
+    using timpls_transformable_to'_inv'[OF Fun.prems(1)] 0 by moura
+
+  obtain h U where u:
+      "u = Fun h U" "length S = length U"
+      "\<And>i. i < length S \<Longrightarrow> timpls_transformable_to' TI (S ! i) (U ! i)"
+      "g \<noteq> h \<Longrightarrow> is_Abs g \<and> is_Abs h \<and> (the_Abs g, the_Abs h) \<in> (set TI)\<^sup>+"
+    using timpls_transformable_to'_inv'[OF Fun.prems(2)[unfolded t(1)]] 0 by moura
+
+  have "list_all2 (timpls_transformable_to' TI) T U"
+    using t(1,2,3) u(1,2,3) Fun.IH
+          list_all2_conv_all_nth[of "timpls_transformable_to' TI" T S]
+          list_all2_conv_all_nth[of "timpls_transformable_to' TI" S U]
+          list_all2_conv_all_nth[of "timpls_transformable_to' TI" T U]
+    by force
+  moreover have "(the_Abs f, the_Abs h) \<in> (set TI)\<^sup>+"
+    when "(the_Abs f, the_Abs g) \<in> (set TI)\<^sup>+" "(the_Abs g, the_Abs h) \<in> (set TI)\<^sup>+"
+    using that by simp
+  hence "is_Abs f \<and> is_Abs h \<and> (the_Abs f, the_Abs h) \<in> (set TI)\<^sup>+"
+    when "f \<noteq> h"
+    by (metis that t(4) u(4))
+  ultimately show ?case using t(1) u(1) 0 by force
+qed
+
+lemma timpls_transformable_to_mono:
+  assumes "set TI \<subseteq> set TI'"
+    and "timpls_transformable_to TI s t"
+  shows "timpls_transformable_to TI' s t"
+  using assms
+proof (induction TI s t rule: timpls_transformable_to.induct)
+  case (2 TI f T g S)
+  have *: "f = g \<or> (is_Abs f \<and> is_Abs g \<and> (the_Abs f, the_Abs g) \<in> set TI)"
+          "list_all2 (timpls_transformable_to TI) T S"
+    using "2.prems" by simp_all
+
+  show ?case
+    using "2.IH" "2.prems"(1) list.rel_mono_strong[OF *(2)] *(1) in_trancl_mono[of TI TI']
+    by (metis (no_types, lifting) timpls_transformable_to.simps(2) set_rev_mp)
+qed auto
+
+lemma timpls_transformable_to'_mono:
+  assumes "set TI \<subseteq> set TI'"
+    and "timpls_transformable_to' TI s t"
+  shows "timpls_transformable_to' TI' s t"
+  using assms
+proof (induction TI s t rule: timpls_transformable_to'.induct)
+  case (2 TI f T g S)
+  have *: "f = g \<or> (is_Abs f \<and> is_Abs g \<and> in_trancl TI (the_Abs f) (the_Abs g))"
+          "list_all2 (timpls_transformable_to' TI) T S"
+    using "2.prems" by simp_all
+
+  show ?case
+    using "2.IH" "2.prems"(1) list.rel_mono_strong[OF *(2)] *(1) in_trancl_mono[of TI TI']
+    by (metis (no_types, lifting) timpls_transformable_to'.simps(2))
+qed auto
+
+lemma timpls_transformable_to_refl_minus_eq:
+  "timpls_transformable_to TI s t \<longleftrightarrow> timpls_transformable_to (filter (\<lambda>(a,b). a \<noteq> b) TI) s t"
+  (is "?A \<longleftrightarrow> ?B")
+proof
+  let ?TI' = "\<lambda>TI. filter (\<lambda>(a,b). a \<noteq> b) TI"
+
+  show ?A when ?B using that timpls_transformable_to_mono[of "?TI' TI" TI] by auto
+
+  show ?B when ?A using that
+  proof (induction TI s t rule: timpls_transformable_to.induct)
+    case (2 TI f T g S)
+    have *: "f = g \<or> (is_Abs f \<and> is_Abs g \<and> (the_Abs f, the_Abs g) \<in> set TI)"
+            "list_all2 (timpls_transformable_to TI) T S"
+      using "2.prems" by simp_all
+
+    have "f = g \<or> (is_Abs f \<and> is_Abs g \<and> (the_Abs f, the_Abs g) \<in> set (?TI' TI))"
+      using *(1) unfolding is_Abs_def by auto
+    moreover have "list_all2 (timpls_transformable_to (?TI' TI)) T S"
+      using *(2) "2.IH" list.rel_mono_strong by blast
+    ultimately show ?case by force
+  qed auto
+qed
+
+lemma timpls_transformable_to_iff_in_timpl_closure:
+  assumes "set TI' = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+  shows "timpls_transformable_to TI' s t \<longleftrightarrow> t \<in> timpl_closure s (set TI)" (is "?A s t \<longleftrightarrow> ?B s t")
+proof
+  show "?A s t \<Longrightarrow> ?B s t" using assms
+  proof (induction s t rule: timpls_transformable_to.induct)
+    case (2 TI f T g S)
+    note prems = "2.prems"
+    note IH = "2.IH"
+
+    have 1: "length T = length S" "\<forall>i<length T. timpls_transformable_to TI' (T ! i) (S ! i)"
+      using prems(1) list_all2_conv_all_nth[of "timpls_transformable_to TI'" T S] by simp_all
+
+    note 2 = timpl_closure_is_timpl_closure'
+    note 3 = in_set_conv_nth[of _ T] in_set_conv_nth[of _ S]
+
+    have 4: "timpl_closure' (set TI') = timpl_closure' (set TI)"
+      using timpl_closure'_timpls_trancl_eq'[of "set TI"] prems(2) by simp
+
+    have IH': "(T ! i, S ! i) \<in> timpl_closure' (set TI')" when i: "i < length S" for i
+    proof -
+      have "timpls_transformable_to TI' (T ! i) (S ! i)" using i 1 by presburger 
+      hence "S ! i \<in> timpl_closure (T ! i) (set TI)"
+        using IH[of "T ! i" "S ! i"] i 1(1) prems(2) by force
+      thus ?thesis using 2[of "S ! i" "T ! i" "set TI"] 4 by blast
+    qed
+
+    have 5: "f = g \<or> (\<exists>a b. (a, b) \<in> (set TI')\<^sup>+ \<and> f = Abs a \<and> g = Abs b)"
+      using prems(1) the_Abs_def[of f] the_Abs_def[of g] is_Abs_def[of f] is_Abs_def[of g] 
+      by fastforce
+
+    show ?case using 2 4 timpl_closure_FunI[OF IH' 1(1) 5] 1(1) by auto
+  qed (simp_all add: timpl_closure.FP)
+
+  show "?B s t \<Longrightarrow> ?A s t"
+  proof (induction t rule: timpl_closure.induct)
+    case (TI u a b v) show ?case
+    proof (cases "a = b")
+      case True thus ?thesis using TI.hyps(3) TI.IH term_variants_pred_refl_inv by fastforce
+    next
+      case False
+      hence 1: "timpls_transformable_to TI' u v"
+        using TI.hyps(2) assms timpls_transformable_to_if_term_variants[OF TI.hyps(3), of TI']
+        by blast
+      have 2: "(c,d) \<in> set TI'" when cd: "(c,d) \<in> (set TI')\<^sup>+" "c \<noteq> d" for c d
+      proof -
+        let ?cl = "\<lambda>X. {(a,b) \<in> X\<^sup>+. a \<noteq> b}"
+        have "?cl (set TI') = ?cl (?cl (set TI))" using assms by presburger
+        hence "set TI' = ?cl (set TI')" using assms trancl_minus_refl_idem[of "set TI"] by argo
+        thus ?thesis using cd by blast
+      qed
+      show ?thesis using timpls_transformable_to_trans[OF _ TI.IH 1] 2 by blast
+    qed
+  qed (use timpls_transformable_to_refl in fast)
+qed
+
+lemma timpls_transformable_to'_iff_in_timpl_closure:
+  "timpls_transformable_to' TI s t \<longleftrightarrow> t \<in> timpl_closure s (set TI)" (is "?A s t \<longleftrightarrow> ?B s t")
+proof
+  show "?A s t \<Longrightarrow> ?B s t"
+  proof (induction s t rule: timpls_transformable_to'.induct)
+    case (2 TI f T g S)
+    note prems = "2.prems"
+    note IH = "2.IH"
+
+    have 1: "length T = length S" "\<forall>i<length T. timpls_transformable_to' TI (T ! i) (S ! i)"
+      using prems list_all2_conv_all_nth[of "timpls_transformable_to' TI" T S] by simp_all
+
+    note 2 = timpl_closure_is_timpl_closure'
+    note 3 = in_set_conv_nth[of _ T] in_set_conv_nth[of _ S]
+
+    have IH': "(T ! i, S ! i) \<in> timpl_closure' (set TI)" when i: "i < length S" for i
+    proof -
+      have "timpls_transformable_to' TI (T ! i) (S ! i)" using i 1 by presburger 
+      hence "S ! i \<in> timpl_closure (T ! i) (set TI)" using IH[of "T ! i" "S ! i"] i 1(1) by force
+      thus ?thesis using 2[of "S ! i" "T ! i" "set TI"] by blast
+    qed
+
+    have 4: "f = g \<or> (\<exists>a b. (a, b) \<in> (set TI)\<^sup>+ \<and> f = Abs a \<and> g = Abs b)"
+      using prems the_Abs_def[of f] the_Abs_def[of g] is_Abs_def[of f] is_Abs_def[of g]
+            in_trancl_closure_iff_in_trancl_fun[of _ _ TI]
+      by auto
+
+    show ?case using 2 timpl_closure_FunI[OF IH' 1(1) 4] 1(1) by auto
+  qed (simp_all add: timpl_closure.FP)
+
+  show "?B s t \<Longrightarrow> ?A s t"
+  proof (induction t rule: timpl_closure.induct)
+    case (TI u a b v) thus ?case
+      using timpls_transformable_to'_trans
+            timpls_transformable_to'_if_term_variants
+      by blast
+  qed (use timpls_transformable_to_refl(2) in fast)
+qed
+
+lemma equal_mod_timpls_iff_ex_in_timpl_closure:
+  assumes "set TI' = {(a,b) \<in> TI\<^sup>+. a \<noteq> b}"
+  shows "equal_mod_timpls TI' s t \<longleftrightarrow> (\<exists>u. u \<in> timpl_closure s TI \<and> u \<in> timpl_closure t TI)"
+    (is "?A s t \<longleftrightarrow> ?B s t")
+proof
+  show "?A s t \<Longrightarrow> ?B s t" using assms
+  proof (induction s t rule: equal_mod_timpls.induct)
+    case (2 TI' f T g S)
+    note prems = "2.prems"
+    note IH = "2.IH"
+
+    have 1: "length T = length S" "\<forall>i<length T. equal_mod_timpls (TI') (T ! i) (S ! i)"
+      using prems list_all2_conv_all_nth[of "equal_mod_timpls TI'" T S] by simp_all
+
+    note 2 = timpl_closure_is_timpl_closure'
+    note 3 = in_set_conv_nth[of _ T] in_set_conv_nth[of _ S]
+
+    have 4: "timpl_closure' (set TI') = timpl_closure' TI"
+      using timpl_closure'_timpls_trancl_eq'[of TI] prems
+      by simp
+
+    have IH: "\<exists>u. (T ! i, u) \<in> timpl_closure' TI \<and> (S ! i, u) \<in> timpl_closure' TI"
+      when i: "i < length S" for i
+    proof -
+      have "equal_mod_timpls TI' (T ! i) (S ! i)" using i 1 by presburger 
+      hence "\<exists>u. u \<in> timpl_closure (T ! i) TI \<and> u \<in> timpl_closure (S ! i) TI"
+        using IH[of "T ! i" "S ! i"] i 1(1) prems by force
+      thus ?thesis using 4 unfolding 2 by blast
+    qed
+
+    let ?P = "\<lambda>G. f = g \<or> (\<exists>a b. (a, b) \<in> G \<and> f = Abs a \<and> g = Abs b) \<or>
+                   (\<exists>a b. (a, b) \<in> G \<and> f = Abs b \<and> g = Abs a) \<or>
+                   (\<exists>a b c. (a, c) \<in> G \<and> (b, c) \<in> G \<and> f = Abs a \<and> g = Abs b)"
+
+    have "?P (set TI')"
+      using prems the_Abs_def[of f] the_Abs_def[of g] is_Abs_def[of f] is_Abs_def[of g]
+      by fastforce
+    hence "?P (TI\<^sup>+)" unfolding prems by blast
+    hence "?P (rtrancl TI)" by (metis (no_types, lifting) trancl_into_rtrancl)
+    hence 5: "f = g \<or> (\<exists>a b c. (a, c) \<in> TI\<^sup>* \<and> (b, c) \<in> TI\<^sup>* \<and> f = Abs a \<and> g = Abs b)" by blast
+
+    show ?case
+      using timpl_closure_FunI3[OF _ 1(1) 5]  IH 1(1)
+      unfolding timpl_closure'_timpls_rtrancl_eq 2
+      by auto
+  qed (use timpl_closure.FP in auto)
+
+  show "?A s t" when B: "?B s t"
+  proof -
+    obtain u where u: "u \<in> timpl_closure s TI" "u \<in> timpl_closure t TI"
+      using B by moura
+    thus ?thesis using assms
+    proof (induction u arbitrary: s t rule: term.induct)
+      case (Var x s t) thus ?case
+        using timpl_closure_Var_in_iff[of x s TI]
+              timpl_closure_Var_in_iff[of x t TI]
+              equal_mod_timpls.simps(1)[of TI' x x]
+        by blast
+    next
+      case (Fun f U s t)
+      obtain g S where s:
+          "s = Fun g S" "length U = length S"
+          "\<And>i. i < length U \<Longrightarrow> U ! i \<in> timpl_closure (S ! i) TI"
+          "g \<noteq> f \<Longrightarrow> is_Abs g \<and> is_Abs f \<and> (the_Abs g, the_Abs f) \<in> TI\<^sup>+"
+        using Fun.prems(1) timpl_closure_Fun_inv'[of f U _ _ TI]
+        by (cases s) auto
+
+      obtain h T where t:
+          "t = Fun h T" "length U = length T"
+          "\<And>i. i < length U \<Longrightarrow> U ! i \<in> timpl_closure (T ! i) TI"
+          "h \<noteq> f \<Longrightarrow> is_Abs h \<and> is_Abs f \<and> (the_Abs h, the_Abs f) \<in> TI\<^sup>+"
+        using Fun.prems(2) timpl_closure_Fun_inv'[of f U _ _ TI]
+        by (cases t) auto
+
+      have g: "(the_Abs g, the_Abs f) \<in> set TI'" "is_Abs f" "is_Abs g" when neq_f: "g \<noteq> f"
+      proof -
+        obtain ga fa where a: "g = Abs ga" "f = Abs fa"
+          using s(4)[OF neq_f] unfolding is_Abs_def by presburger
+        hence "the_Abs g \<noteq> the_Abs f" using neq_f by simp
+        thus "(the_Abs g, the_Abs f) \<in> set TI'" "is_Abs f" "is_Abs g"
+          using s(4)[OF neq_f] Fun.prems by blast+
+      qed
+
+      have h: "(the_Abs h, the_Abs f) \<in> set TI'" "is_Abs f" "is_Abs h" when neq_f: "h \<noteq> f"
+      proof -
+        obtain ha fa where a: "h = Abs ha" "f = Abs fa"
+          using t(4)[OF neq_f] unfolding is_Abs_def by presburger
+        hence "the_Abs h \<noteq> the_Abs f" using neq_f by simp
+        thus "(the_Abs h, the_Abs f) \<in> set TI'" "is_Abs f" "is_Abs h"
+          using t(4)[OF neq_f] Fun.prems by blast+
+      qed
+
+      have "equal_mod_timpls TI' (S ! i) (T ! i)"
+        when i: "i < length U" for i
+        using i Fun.IH s(1,2,3) t(1,2,3) nth_mem[OF i] Fun.prems by meson
+      hence "list_all2 (equal_mod_timpls TI') S T"
+        using list_all2_conv_all_nth[of "equal_mod_timpls TI'" S T] s(2) t(2) by presburger
+      thus ?case using s(1) t(1) g h by fastforce
+    qed
+  qed
+qed
+
+(* lemma equal_mod_timpls_iff_ex_in_timpl_closure':
+  "equal_mod_timpls (TI\<^sup>+) s t \<longleftrightarrow> (\<exists>u. u \<in> timpl_closure s TI \<and> u \<in> timpl_closure t TI)"
+using equal_mod_timpls_iff_ex_in_timpl_closure equal_mod_timpls_refl_minus_eq
+by blast *)
+
+context
+begin
+private inductive timpls_transformable_to_pred where
+  Var: "timpls_transformable_to_pred A (Var x) (Var x)"
+| Fun: "\<lbrakk>\<not>is_Abs f; length T = length S;
+         \<And>i. i < length T \<Longrightarrow> timpls_transformable_to_pred A (T ! i) (S ! i)\<rbrakk>
+        \<Longrightarrow> timpls_transformable_to_pred A (Fun f T) (Fun f S)"
+| Abs: "b \<in> A \<Longrightarrow> timpls_transformable_to_pred A (Fun (Abs a) []) (Fun (Abs b) [])"
+
+private lemma timpls_transformable_to_pred_inv_Var:
+  assumes "timpls_transformable_to_pred A (Var x) t"
+  shows "t = Var x"
+using assms by (auto elim: timpls_transformable_to_pred.cases)
+
+private lemma timpls_transformable_to_pred_inv:
+  assumes "timpls_transformable_to_pred A (Fun f T) t"
+  shows "is_Fun t"
+    and "length T = length (args t)"
+    and "\<And>i. i < length T \<Longrightarrow> timpls_transformable_to_pred A (T ! i) (args t ! i)"
+    and "\<not>is_Abs f \<Longrightarrow> f = the_Fun t"
+    and "is_Abs f \<Longrightarrow> (is_Abs (the_Fun t) \<and> the_Abs (the_Fun t) \<in> A)"
+using assms by (auto elim!: timpls_transformable_to_pred.cases[of A])
+
+private lemma timpls_transformable_to_pred_finite_aux1:
+  assumes f: "\<not>is_Abs f"
+  shows "{s. timpls_transformable_to_pred A (Fun f T) s} \<subseteq>
+          (\<lambda>S. Fun f S) ` {S. length T = length S \<and>
+                              (\<forall>s \<in> set S. \<exists>t \<in> set T. timpls_transformable_to_pred A t s)}"
+    (is "?B \<subseteq> ?C")
+proof
+  fix s assume s: "s \<in> ?B"
+  hence *: "timpls_transformable_to_pred A (Fun f T) s" by blast
+
+  obtain S where S:
+      "s = Fun f S" "length T = length S" "\<And>i. i < length T \<Longrightarrow> timpls_transformable_to_pred A (T ! i) (S ! i)"
+    using f timpls_transformable_to_pred_inv[OF *] unfolding the_Abs_def is_Abs_def by auto
+
+  have "\<forall>s\<in>set S. \<exists>t\<in>set T. timpls_transformable_to_pred A t s" using S(2,3) in_set_conv_nth by metis
+  thus "s \<in> ?C" using S(1,2) by blast
+qed
+
+private lemma timpls_transformable_to_pred_finite_aux2:
+  "{s. timpls_transformable_to_pred A (Fun (Abs a) []) s} \<subseteq> (\<lambda>b. Fun (Abs b) []) ` A" (is "?B \<subseteq> ?C")
+proof
+  fix s assume s: "s \<in> ?B"
+  hence *: "timpls_transformable_to_pred A (Fun (Abs a) []) s" by blast
+
+  obtain b where b: "s = Fun (Abs b) []" "b \<in> A"
+    using timpls_transformable_to_pred_inv[OF *] unfolding the_Abs_def is_Abs_def by auto
+  thus "s \<in> ?C" by blast
+qed
+
+private lemma timpls_transformable_to_pred_finite:
+  fixes t::"(('fun,'atom,'sets) prot_fun, 'a) term"
+  assumes A: "finite A"
+    and t: "wf\<^sub>t\<^sub>r\<^sub>m t"
+  shows "finite {s. timpls_transformable_to_pred A t s}"
+using t
+proof (induction t)
+  case (Var x)
+  have "{s::(('fun,'atom,'sets) prot_fun, 'a) term. timpls_transformable_to_pred A (Var x) s} = {Var x}"
+    by (auto intro: timpls_transformable_to_pred.Var elim: timpls_transformable_to_pred_inv_Var)
+  thus ?case by simp
+next
+  case (Fun f T)
+  have IH: "finite {s. timpls_transformable_to_pred A t s}" when t: "t \<in> set T" for t
+    using Fun.IH[OF t] wf_trm_param[OF Fun.prems t] by blast
+
+  show ?case
+  proof (cases "is_Abs f")
+    case True
+    then obtain a where a: "f = Abs a" unfolding is_Abs_def by presburger
+    hence "T = []" using wf_trm_arity[OF Fun.prems] by simp_all
+    hence "{a. timpls_transformable_to_pred A (Fun f T) a} \<subseteq> (\<lambda>b. Fun (Abs b) []) ` A"
+      using timpls_transformable_to_pred_finite_aux2[of A a] a by auto
+    thus ?thesis using A finite_subset by fast
+  next
+    case False thus ?thesis
+      using IH finite_lists_length_eq' timpls_transformable_to_pred_finite_aux1[of f A T] finite_subset
+      by blast
+  qed
+qed
+
+private lemma timpls_transformable_to_pred_if_timpls_transformable_to:
+  assumes s: "timpls_transformable_to TI t s"
+    and t: "wf\<^sub>t\<^sub>r\<^sub>m t" "\<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> the_Abs f \<in> A"
+  shows "timpls_transformable_to_pred (A \<union> fst ` (set TI)\<^sup>+ \<union> snd ` (set TI)\<^sup>+) t s"
+using s t
+proof (induction rule: timpls_transformable_to.induct)
+  case (2 TI f T g S)
+  let ?A = "A \<union> fst ` (set TI)\<^sup>+ \<union> snd ` (set TI)\<^sup>+"
+
+  note prems = "2.prems"
+  note IH = "2.IH"
+
+  note 0 = timpls_transformable_to_inv[OF prems(1)]
+
+  have 1: "T = []" "S = []" when f: "f = Abs a" for a
+    using f wf_trm_arity[OF prems(2)] 0(1) by simp_all
+
+  have "\<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> the_Abs f \<in> A" when t: "t \<in> set T" for t
+    using t prems(3) funs_term_subterms_eq(1)[of "Fun f T"] by blast
+  hence 2: "timpls_transformable_to_pred ?A (T ! i) (S ! i)"
+    when i: "i < length T" for i
+    using i IH 0(1,2) wf_trm_param[OF prems(2)]
+    by (metis (no_types) in_set_conv_nth)
+
+  have 3: "the_Abs f \<in> ?A" when f: "is_Abs f" using prems(3) f by force
+
+  show ?case
+  proof (cases "f = g")
+    case True
+    note fg = True
+    show ?thesis
+    proof (cases "is_Abs f")
+      case True
+      then obtain a where a: "f = Abs a" unfolding is_Abs_def by moura
+      thus ?thesis using fg 1[OF a] timpls_transformable_to_pred.Abs[of a ?A a] 3 by simp
+    qed (use fg timpls_transformable_to_pred.Fun[OF _ 0(1) 2, of f] in blast)
+  next
+    case False
+    then obtain a b where ab: "f = Abs a" "g = Abs b" "(a, b) \<in> (set TI)\<^sup>+"
+      using 0(3) in_trancl_closure_iff_in_trancl_fun[of _ _ TI]
+      unfolding is_Abs_def the_Abs_def by fastforce
+    hence "a \<in> ?A" "b \<in> ?A" by force+
+    thus ?thesis using timpls_transformable_to_pred.Abs ab(1,2) 1[OF ab(1)] by metis
+  qed
+qed (simp_all add: timpls_transformable_to_pred.Var)
+
+private lemma timpls_transformable_to_pred_if_timpls_transformable_to':
+  assumes s: "timpls_transformable_to' TI t s"
+    and t: "wf\<^sub>t\<^sub>r\<^sub>m t" "\<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> the_Abs f \<in> A"
+  shows "timpls_transformable_to_pred (A \<union> fst ` (set TI)\<^sup>+ \<union> snd ` (set TI)\<^sup>+) t s"
+using s t
+proof (induction rule: timpls_transformable_to.induct)
+  case (2 TI f T g S)
+  let ?A = "A \<union> fst ` (set TI)\<^sup>+ \<union> snd ` (set TI)\<^sup>+"
+
+  note prems = "2.prems"
+  note IH = "2.IH"
+
+  note 0 = timpls_transformable_to'_inv[OF prems(1)]
+
+  have 1: "T = []" "S = []" when f: "f = Abs a" for a
+    using f wf_trm_arity[OF prems(2)] 0(1) by simp_all
+
+  have "\<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> the_Abs f \<in> A" when t: "t \<in> set T" for t
+    using t prems(3) funs_term_subterms_eq(1)[of "Fun f T"] by blast
+  hence 2: "timpls_transformable_to_pred ?A (T ! i) (S ! i)"
+    when i: "i < length T" for i
+    using i IH 0(1,2) wf_trm_param[OF prems(2)]
+    by (metis (no_types) in_set_conv_nth)
+
+  have 3: "the_Abs f \<in> ?A" when f: "is_Abs f" using prems(3) f by force
+
+  show ?case
+  proof (cases "f = g")
+    case True
+    note fg = True
+    show ?thesis
+    proof (cases "is_Abs f")
+      case True
+      then obtain a where a: "f = Abs a" unfolding is_Abs_def by moura
+      thus ?thesis using fg 1[OF a] timpls_transformable_to_pred.Abs[of a ?A a] 3 by simp
+    qed (use fg timpls_transformable_to_pred.Fun[OF _ 0(1) 2, of f] in blast)
+  next
+    case False
+    then obtain a b where ab: "f = Abs a" "g = Abs b" "(a, b) \<in> (set TI)\<^sup>+"
+      using 0(3) in_trancl_closure_iff_in_trancl_fun[of _ _ TI]
+      unfolding is_Abs_def the_Abs_def by fastforce
+    hence "a \<in> ?A" "b \<in> ?A" by force+
+    thus ?thesis using timpls_transformable_to_pred.Abs ab(1,2) 1[OF ab(1)] by metis
+  qed
+qed (simp_all add: timpls_transformable_to_pred.Var)
+
+private lemma timpls_transformable_to_pred_if_equal_mod_timpls:
+  assumes s: "equal_mod_timpls TI t s"
+    and t: "wf\<^sub>t\<^sub>r\<^sub>m t" "\<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> the_Abs f \<in> A"
+  shows "timpls_transformable_to_pred (A \<union> fst ` (set TI)\<^sup>+ \<union> snd ` (set TI)\<^sup>+) t s"
+using s t
+proof (induction rule: equal_mod_timpls.induct)
+  case (2 TI f T g S)
+  let ?A = "A \<union> fst ` (set TI)\<^sup>+ \<union> snd ` (set TI)\<^sup>+"
+
+  note prems = "2.prems"
+  note IH = "2.IH"
+
+  note 0 = equal_mod_timpls_inv[OF prems(1)]
+
+  have 1: "T = []" "S = []" when f: "f = Abs a" for a
+    using f wf_trm_arity[OF prems(2)] 0(1) by simp_all
+
+  have "\<forall>f \<in> funs_term t. is_Abs f \<longrightarrow> the_Abs f \<in> A" when t: "t \<in> set T" for t
+    using t prems(3) funs_term_subterms_eq(1)[of "Fun f T"] by blast
+  hence 2: "timpls_transformable_to_pred ?A (T ! i) (S ! i)"
+    when i: "i < length T" for i
+    using i IH 0(1,2) wf_trm_param[OF prems(2)]
+    by (metis (no_types) in_set_conv_nth)
+
+  have 3: "the_Abs f \<in> ?A" when f: "is_Abs f" using prems(3) f by force
+
+  show ?case
+  proof (cases "f = g")
+    case True
+    note fg = True
+    show ?thesis
+    proof (cases "is_Abs f")
+      case True
+      then obtain a where a: "f = Abs a" unfolding is_Abs_def by moura
+      thus ?thesis using fg 1[OF a] timpls_transformable_to_pred.Abs[of a ?A a] 3 by simp
+    qed (use fg timpls_transformable_to_pred.Fun[OF _ 0(1) 2, of f] in blast)
+  next
+    case False
+    then obtain a b where ab: "f = Abs a" "g = Abs b"
+        "(a, b) \<in> (set TI)\<^sup>+ \<or> (b, a) \<in> (set TI)\<^sup>+ \<or>
+         (\<exists>ti \<in> set TI. (a, snd ti) \<in> (set TI)\<^sup>+ \<and> (b, snd ti) \<in> (set TI)\<^sup>+)"
+      using 0(3) in_trancl_closure_iff_in_trancl_fun[of _ _ TI]
+      unfolding is_Abs_def the_Abs_def by fastforce
+    hence "a \<in> ?A" "b \<in> ?A" by force+
+    thus ?thesis using timpls_transformable_to_pred.Abs ab(1,2) 1[OF ab(1)] by metis
+  qed
+qed (simp_all add: timpls_transformable_to_pred.Var)
+
+lemma timpls_transformable_to_finite:
+  assumes t: "wf\<^sub>t\<^sub>r\<^sub>m t"
+  shows "finite {s. timpls_transformable_to TI t s}" (is ?P)
+    and "finite {s. timpls_transformable_to' TI t s}" (is ?Q)
+proof -
+  let ?A = "the_Abs ` {f \<in> funs_term t. is_Abs f} \<union> fst ` (set TI)\<^sup>+ \<union> snd ` (set TI)\<^sup>+"
+
+  have 0: "finite ?A" by auto
+
+  have 1: "{s. timpls_transformable_to TI t s} \<subseteq> {s. timpls_transformable_to_pred ?A t s}"
+    using timpls_transformable_to_pred_if_timpls_transformable_to[OF _ t] by auto
+
+  have 2: "{s. timpls_transformable_to' TI t s} \<subseteq> {s. timpls_transformable_to_pred ?A t s}"
+    using timpls_transformable_to_pred_if_timpls_transformable_to'[OF _ t] by auto
+
+  show ?P using timpls_transformable_to_pred_finite[OF 0 t] finite_subset[OF 1] by blast
+  show ?Q using timpls_transformable_to_pred_finite[OF 0 t] finite_subset[OF 2] by blast
+qed
+
+lemma equal_mod_timpls_finite:
+  assumes t: "wf\<^sub>t\<^sub>r\<^sub>m t"
+  shows "finite {s. equal_mod_timpls TI t s}"
+proof -
+  let ?A = "the_Abs ` {f \<in> funs_term t. is_Abs f} \<union> fst ` (set TI)\<^sup>+ \<union> snd ` (set TI)\<^sup>+"
+
+  have 0: "finite ?A" by auto
+
+  have 1: "{s. equal_mod_timpls TI t s} \<subseteq> {s. timpls_transformable_to_pred ?A t s}"
+    using timpls_transformable_to_pred_if_equal_mod_timpls[OF _ t] by auto
+
+  show ?thesis using timpls_transformable_to_pred_finite[OF 0 t] finite_subset[OF 1] by blast
+qed
+
+end
+
+lemma intruder_synth_mod_timpls_is_synth_timpl_closure_set:
+  fixes t::"(('fun, 'atom, 'sets) prot_fun, 'a) term" and TI TI'
+  assumes "set TI' = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+  shows "intruder_synth_mod_timpls M TI' t \<longleftrightarrow> timpl_closure_set (set M) (set TI) \<turnstile>\<^sub>c t"
+      (is "?C t \<longleftrightarrow> ?D t")
+proof -
+  have *: "(\<exists>m \<in> M. timpls_transformable_to TI' m t) \<longleftrightarrow> t \<in> timpl_closure_set M (set TI)"
+    when "set TI' = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+    for M TI TI' and t::"(('fun, 'atom, 'sets) prot_fun, 'a) term"
+    using timpls_transformable_to_iff_in_timpl_closure[OF that]
+          timpl_closure_set_is_timpl_closure_union[of M "set TI"]
+          timpl_closure_set_timpls_trancl_eq[of M "set TI"]
+          timpl_closure_set_timpls_trancl_eq'[of M "set TI"]
+    by auto
+
+  show "?C t \<longleftrightarrow> ?D t"
+  proof
+    show "?C t \<Longrightarrow> ?D t" using assms
+    proof (induction t arbitrary: M TI TI' rule: intruder_synth_mod_timpls.induct)
+      case (1 M TI' x)
+      hence "Var x \<in> timpl_closure_set (set M) (set TI)"
+        using timpl_closure.FP member_def unfolding timpl_closure_set_def by force
+      thus ?case by simp
+    next
+      case (2 M TI f T)
+      show ?case
+      proof (cases "\<exists>m \<in> set M. timpls_transformable_to TI' m (Fun f T)")
+        case True thus ?thesis
+          using "2.prems" *[of TI' TI "set M" "Fun f T"]
+                intruder_synth.AxiomC[of "Fun f T" "timpl_closure_set (set M) (set TI)"]
+          by blast
+      next
+        case False
+        hence "\<not>(list_ex (\<lambda>t. timpls_transformable_to TI' t (Fun f T)) M)"
+          unfolding list_ex_iff by blast
+        hence "public f" "length T = arity f" "list_all (intruder_synth_mod_timpls M TI') T"
+          using "2.prems"(1) by force+
+        thus ?thesis using "2.IH"[OF _ _ "2.prems"(2)] unfolding list_all_iff by force
+      qed
+    qed
+  
+    show "?D t \<Longrightarrow> ?C t"
+    proof (induction t rule: intruder_synth_induct)
+      case (AxiomC t) thus ?case
+        using timpl_closure_set_Var_in_iff[of _ "set M" "set TI"] *[OF assms, of "set M" t]
+        by (cases t rule: term.exhaust) (force simp add: member_def list_ex_iff)+
+    next
+      case (ComposeC T f) thus ?case
+        using list_all_iff[of "intruder_synth_mod_timpls M TI'" T]
+              intruder_synth_mod_timpls.simps(2)[of M TI' f T]
+        by blast
+    qed
+  qed
+qed
+
+lemma intruder_synth_mod_timpls'_is_synth_timpl_closure_set:
+  fixes t::"(('fun, 'atom, 'sets) prot_fun, 'a) term" and TI
+  shows "intruder_synth_mod_timpls' M TI t \<longleftrightarrow> timpl_closure_set (set M) (set TI) \<turnstile>\<^sub>c t"
+      (is "?A t \<longleftrightarrow> ?B t")
+proof -
+  have *: "(\<exists>m \<in> M. timpls_transformable_to' TI m t) \<longleftrightarrow> t \<in> timpl_closure_set M (set TI)"
+    for M TI and t::"(('fun, 'atom, 'sets) prot_fun, 'a) term"
+    using timpls_transformable_to'_iff_in_timpl_closure[of TI _ t]
+          timpl_closure_set_is_timpl_closure_union[of M "set TI"]
+    by blast+
+
+  show "?A t \<longleftrightarrow> ?B t"
+  proof
+    show "?A t \<Longrightarrow> ?B t"
+    proof (induction t arbitrary: M TI rule: intruder_synth_mod_timpls'.induct)
+      case (1 M TI x)
+      hence "Var x \<in> timpl_closure_set (set M) (set TI)"
+        using timpl_closure.FP List.member_def[of M] unfolding timpl_closure_set_def by auto
+      thus ?case by simp
+    next
+      case (2 M TI f T)
+      show ?case
+      proof (cases "\<exists>m \<in> set M. timpls_transformable_to' TI m (Fun f T)")
+        case True thus ?thesis
+          using "2.prems" *[of "set M" TI "Fun f T"]
+                intruder_synth.AxiomC[of "Fun f T" "timpl_closure_set (set M) (set TI)"]
+          by blast
+      next
+        case False
+        hence "public f" "length T = arity f" "list_all (intruder_synth_mod_timpls' M TI) T"
+          using "2.prems" list_ex_iff[of _ M] by force+
+        thus ?thesis
+          using "2.IH"[of _ M TI] list_all_iff[of "intruder_synth_mod_timpls' M TI" T]
+          by force
+      qed
+    qed
+  
+    show "?B t \<Longrightarrow> ?A t"
+    proof (induction t rule: intruder_synth_induct)
+      case (AxiomC t) thus ?case
+        using AxiomC timpl_closure_set_Var_in_iff[of _ "set M" "set TI"] *[of "set M" TI t]
+              list_ex_iff[of _ M] List.member_def[of M]
+        by (cases t rule: term.exhaust) force+
+    next
+      case (ComposeC T f) thus ?case
+        using list_all_iff[of "intruder_synth_mod_timpls' M TI" T]
+              intruder_synth_mod_timpls'.simps(2)[of M TI f T]
+        by blast
+    qed
+  qed
+qed
+
+lemma intruder_synth_mod_eq_timpls_is_synth_timpl_closure_set:
+  fixes t::"(('fun, 'atom, 'sets) prot_fun, 'a) term" and TI
+  defines "cl \<equiv> \<lambda>TI. {(a,b) \<in> TI\<^sup>+. a \<noteq> b}"
+  shows (* "set TI' = (set TI)\<^sup>+ \<Longrightarrow>
+         intruder_synth_mod_eq_timpls M TI' t \<longleftrightarrow>
+         (\<exists>s \<in> timpl_closure t (set TI). timpl_closure_set M (set TI) \<turnstile>\<^sub>c s)"
+      (is "?P TI TI' \<Longrightarrow> ?A t \<longleftrightarrow> ?B t")
+    and *) "set TI' = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b} \<Longrightarrow>
+         intruder_synth_mod_eq_timpls M TI' t \<longleftrightarrow>
+         (\<exists>s \<in> timpl_closure t (set TI). timpl_closure_set M (set TI) \<turnstile>\<^sub>c s)"
+      (is "?Q TI TI' \<Longrightarrow> ?C t \<longleftrightarrow> ?D t")
+proof -
+  (* have *: "(\<exists>m \<in> M. equal_mod_timpls TI' m t) \<longleftrightarrow>
+           (\<exists>s \<in> timpl_closure t (set TI). s \<in> timpl_closure_set M (set TI))"
+    when P: "?P TI TI'"
+    for M TI TI' and t::"(('fun, 'atom, 'sets) prot_fun, 'a) term"
+    using equal_mod_timpls_iff_ex_in_timpl_closure'[OF P]
+          timpl_closure_set_is_timpl_closure_union[of M "set TI"]
+          timpl_closure_set_timpls_trancl_eq[of M "set TI"]
+    by blast *)
+
+  have **: "(\<exists>m \<in> M. equal_mod_timpls TI' m t) \<longleftrightarrow>
+            (\<exists>s \<in> timpl_closure t (set TI). s \<in> timpl_closure_set M (set TI))"
+    when Q: "?Q TI TI'"
+    for M TI TI' and t::"(('fun, 'atom, 'sets) prot_fun, 'a) term"
+    using equal_mod_timpls_iff_ex_in_timpl_closure[OF Q]
+          timpl_closure_set_is_timpl_closure_union[of M "set TI"]
+          timpl_closure_set_timpls_trancl_eq'[of M "set TI"]
+    by fastforce
+
+(*   show "?A t \<longleftrightarrow> ?B t" when P: "?P TI TI'"
+  proof
+    show "?A t \<Longrightarrow> ?B t"
+    proof (induction t arbitrary: M TI rule: intruder_synth_mod_eq_timpls.induct)
+      case (1 M TI x)
+      hence "Var x \<in> timpl_closure_set M TI" "Var x \<in> timpl_closure (Var x) TI"
+        using timpl_closure.FP unfolding timpl_closure_set_def by auto
+      thus ?case by force
+    next
+      case (2 M TI f T)
+      show ?case
+      proof (cases "\<exists>m \<in> M. equal_mod_timpls (TI\<^sup>+) m (Fun f T)")
+        case True thus ?thesis
+          using "2.prems" *[of M TI "Fun f T"] intruder_synth.AxiomC[of _ "timpl_closure_set M TI"]
+          by blast
+      next
+        case False
+        hence f: "public f" "length T = arity f" "list_all (intruder_synth_mod_eq_timpls M (TI\<^sup>+)) T"
+          using "2.prems" by force+
+  
+        let ?sy = "intruder_synth (timpl_closure_set M TI)"
+
+        have IH: "\<exists>u \<in> timpl_closure (T ! i) TI. ?sy u"
+          when i: "i < length T" for i
+          using "2.IH"[of _ M TI] f(3) nth_mem[OF i]
+          unfolding list_all_iff by blast
+  
+        define S where "S \<equiv> map (\<lambda>u. SOME v. v \<in> timpl_closure u TI \<and> ?sy v) T"
+  
+        have S1: "length T = length S"
+          unfolding S_def by simp
+  
+        have S2: "S ! i \<in> timpl_closure (T ! i) TI"
+                 "timpl_closure_set M TI \<turnstile>\<^sub>c S ! i"
+          when i: "i < length S" for i
+          using i IH someI_ex[of "\<lambda>v. v \<in> timpl_closure (T ! i) TI \<and> ?sy v"]
+          unfolding S_def by auto
+  
+        have "Fun f S \<in> timpl_closure (Fun f T) TI"
+          using timpl_closure_FunI[of T S TI f f] S1 S2(1)
+          unfolding timpl_closure_is_timpl_closure' by presburger
+        thus ?thesis
+          by (metis intruder_synth.ComposeC[of S f] f(1,2) S1 S2(2) in_set_conv_nth[of _ S])
+      qed
+    qed
+  
+    show "?A t" when B: "?B t"
+    proof -
+      obtain s where "timpl_closure_set M TI \<turnstile>\<^sub>c s" "s \<in> timpl_closure t TI"
+        using B by moura
+      thus ?thesis
+      proof (induction s arbitrary: t rule: intruder_synth_induct)
+        case (AxiomC s t)
+        note 1 = timpl_closure_set_Var_in_iff[of _ M TI] timpl_closure_Var_inv[of s _ TI]
+        note 2 = *[of M TI]
+        show ?case
+        proof (cases t)
+          case Var thus ?thesis using 1 AxiomC by auto
+        next
+          case Fun thus ?thesis using 2 AxiomC by auto
+        qed
+      next
+        case (ComposeC T f t)
+        obtain g S where gS:
+            "t = Fun g S" "length S = length T"
+            "\<forall>i < length T. T ! i \<in> timpl_closure (S ! i) TI"
+            "g \<noteq> f \<Longrightarrow> is_Abs g \<and> is_Abs f \<and> (the_Abs g, the_Abs f) \<in> TI\<^sup>+"
+          using ComposeC.prems(1) timpl_closure'_inv'[of t "Fun f T" TI]
+                timpl_closure_is_timpl_closure'[of _ _ TI]
+          by fastforce
+  
+        have IH: "intruder_synth_mod_eq_timpls M (TI\<^sup>+) u" when u: "u \<in> set S" for u
+          by (metis u gS(2,3) ComposeC.IH in_set_conv_nth)
+  
+        note 0 = list_all_iff[of "intruder_synth_mod_eq_timpls M (TI\<^sup>+)" S]
+                 intruder_synth_mod_eq_timpls.simps(2)[of M "TI\<^sup>+" g S]
+  
+        have "f = g" using ComposeC.hyps gS(4) unfolding is_Abs_def by fastforce
+        thus ?case by (metis ComposeC.hyps(1,2) gS(1,2) IH 0)
+      qed
+    qed
+  qed *)
+
+  show "?C t \<longleftrightarrow> ?D t" when Q: "?Q TI TI'"
+  proof
+    show "?C t \<Longrightarrow> ?D t" using Q
+    proof (induction t arbitrary: M TI rule: intruder_synth_mod_eq_timpls.induct)
+      case (1 M TI' x M TI)
+      hence "Var x \<in> timpl_closure_set M (set TI)" "Var x \<in> timpl_closure (Var x) (set TI)"
+        using timpl_closure.FP unfolding timpl_closure_set_def by auto
+      thus ?case by force
+    next
+      case (2 M TI' f T M TI)
+      show ?case
+      proof (cases "\<exists>m \<in> M. equal_mod_timpls TI' m (Fun f T)")
+        case True thus ?thesis
+          using **[OF "2.prems"(2), of M "Fun f T"]
+                intruder_synth.AxiomC[of _ "timpl_closure_set M (set TI)"]
+          by blast
+      next
+        case False
+        hence f: "public f" "length T = arity f" "list_all (intruder_synth_mod_eq_timpls M TI') T"
+          using "2.prems" by force+
+  
+        let ?sy = "intruder_synth (timpl_closure_set M (set TI))"
+
+        have IH: "\<exists>u \<in> timpl_closure (T ! i) (set TI). ?sy u"
+          when i: "i < length T" for i
+          using "2.IH"[of _ M TI] f(3) nth_mem[OF i] "2.prems"(2)
+          unfolding list_all_iff by blast
+  
+        define S where "S \<equiv> map (\<lambda>u. SOME v. v \<in> timpl_closure u (set TI) \<and> ?sy v) T"
+  
+        have S1: "length T = length S"
+          unfolding S_def by simp
+  
+        have S2: "S ! i \<in> timpl_closure (T ! i) (set TI)"
+                  "timpl_closure_set M (set TI) \<turnstile>\<^sub>c S ! i"
+          when i: "i < length S" for i
+          using i IH someI_ex[of "\<lambda>v. v \<in> timpl_closure (T ! i) (set TI) \<and> ?sy v"]
+          unfolding S_def by auto
+  
+        have "Fun f S \<in> timpl_closure (Fun f T) (set TI)"
+          using timpl_closure_FunI[of T S "set TI" f f] S1 S2(1)
+          unfolding timpl_closure_is_timpl_closure' by presburger
+        thus ?thesis
+          by (metis intruder_synth.ComposeC[of S f] f(1,2) S1 S2(2) in_set_conv_nth[of _ S])
+      qed
+    qed
+  
+    show "?C t" when D: "?D t"
+    proof -
+      obtain s where "timpl_closure_set M (set TI) \<turnstile>\<^sub>c s" "s \<in> timpl_closure t (set TI)"
+        using D by moura
+      thus ?thesis
+      proof (induction s arbitrary: t rule: intruder_synth_induct)
+        case (AxiomC s t)
+        note 1 = timpl_closure_set_Var_in_iff[of _ M "set TI"] timpl_closure_Var_inv[of s _ "set TI"]
+        note 2 = **[OF Q, of M]
+        show ?case
+        proof (cases t)
+          case Var thus ?thesis using 1 AxiomC by auto
+        next
+          case Fun thus ?thesis using 2 AxiomC by auto
+        qed
+      next
+        case (ComposeC T f t)
+        obtain g S where gS:
+            "t = Fun g S" "length S = length T"
+            "\<forall>i < length T. T ! i \<in> timpl_closure (S ! i) (set TI)"
+            "g \<noteq> f \<Longrightarrow> is_Abs g \<and> is_Abs f \<and> (the_Abs g, the_Abs f) \<in> (set TI)\<^sup>+"
+          using ComposeC.prems(1) timpl_closure'_inv'[of t "Fun f T" "set TI"]
+                timpl_closure_is_timpl_closure'[of _ _ "set TI"]
+          by fastforce
+  
+        have IH: "intruder_synth_mod_eq_timpls M TI' u" when u: "u \<in> set S" for u
+          by (metis u gS(2,3) ComposeC.IH in_set_conv_nth)
+  
+        note 0 = list_all_iff[of "intruder_synth_mod_eq_timpls M TI'" S]
+                 intruder_synth_mod_eq_timpls.simps(2)[of M TI' g S]
+  
+        have "f = g" using ComposeC.hyps gS(4) unfolding is_Abs_def by fastforce
+        thus ?case by (metis ComposeC.hyps(1,2) gS(1,2) IH 0)
+      qed
+    qed
+  qed
+qed
+
+lemma timpl_closure_finite:
+  assumes t: "wf\<^sub>t\<^sub>r\<^sub>m t"
+  shows "finite (timpl_closure t (set TI))"
+using timpls_transformable_to'_iff_in_timpl_closure[of TI t]
+      timpls_transformable_to_finite[OF t, of TI]
+by auto
+
+lemma timpl_closure_set_finite:
+  fixes TI::"('sets set \<times> 'sets set) list"
+  assumes M_finite: "finite M"
+    and M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
+  shows "finite (timpl_closure_set M (set TI))"
+using timpl_closure_set_is_timpl_closure_union[of M "set TI"]
+      timpl_closure_finite[of _ TI] M_finite M_wf finite
+by auto
+
+lemma comp_timpl_closure_is_timpl_closure_set:
+  fixes M and TI::"('sets set \<times> 'sets set) list"
+  assumes M_finite: "finite M"
+    and M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
+  shows "comp_timpl_closure M (set TI) = timpl_closure_set M (set TI)"
+using lfp_while''[OF timpls_Un_mono[of M "set TI"]]
+      timpl_closure_set_finite[OF M_finite M_wf]
+      timpl_closure_set_lfp[of M "set TI"]
+unfolding comp_timpl_closure_def Let_def by presburger
+
+context
+begin
+
+private lemma analyzed_closed_mod_timpls_is_analyzed_closed_timpl_closure_set_aux1:
+  fixes M::"('fun,'atom,'sets) prot_terms"
+  assumes f: "arity\<^sub>f f = length T" "arity\<^sub>f f > 0" "Ana\<^sub>f f = (K, R)"
+    and i: "i < length R"
+    and M: "timpl_closure_set M TI \<turnstile>\<^sub>c T ! (R ! i)"
+    and m: "Fun (Fu f) T \<in> M"
+    and t: "Fun (Fu f) S \<in> timpl_closure (Fun (Fu f) T) TI"
+  shows "timpl_closure_set M TI \<turnstile>\<^sub>c S ! (R ! i)"
+proof -
+  have "R ! i < length T" using i Ana\<^sub>f_assm2_alt[OF f(3)] f(1) by simp
+  thus ?thesis
+    using timpl_closure_Fun_inv'(1,2)[OF t] intruder_synth_timpl_closure'[OF M]
+    by presburger
+qed
+
+private lemma analyzed_closed_mod_timpls_is_analyzed_closed_timpl_closure_set_aux2:
+  fixes M::"('fun,'atom,'sets) prot_terms"
+  assumes M: "\<forall>s \<in> set (snd (Ana m)). timpl_closure_set M TI \<turnstile>\<^sub>c s"
+    and m: "m \<in> M"
+    and t: "t \<in> timpl_closure m TI"
+    and s: "s \<in> set (snd (Ana t))"
+  shows "timpl_closure_set M TI \<turnstile>\<^sub>c s"
+proof -
+  obtain f S K N where fS: "t = Fun (Fu f) S" "arity\<^sub>f f = length S" "0 < arity\<^sub>f f"
+      and Ana_f: "Ana\<^sub>f f = (K, N)"
+      and Ana_t: "Ana t = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) S, map ((!) S) N)"
+    using Ana_nonempty_inv[of t] s by fastforce
+  then obtain T where T: "m = Fun (Fu f) T" "length T = length S"
+    using t timpl_closure_Fu_inv'[of f S m TI]
+    by moura
+  hence Ana_m: "Ana m = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) N)"
+    using fS(2,3) Ana_f by auto
+
+  obtain i where i: "i < length N" "s = S ! (N ! i)"
+    using s[unfolded fS(1)] Ana_t[unfolded fS(1)] T(2)
+          in_set_conv_nth[of s "map (\<lambda>i. S ! i) N"]
+    by auto
+  hence "timpl_closure_set M TI \<turnstile>\<^sub>c T ! (N ! i)"
+    using M[unfolded T(1)] Ana_m[unfolded T(1)] T(2)
+    by simp
+  thus ?thesis
+    using analyzed_closed_mod_timpls_is_analyzed_closed_timpl_closure_set_aux1[
+            OF fS(2)[unfolded T(2)[symmetric]] fS(3) Ana_f
+               i(1) _ m[unfolded T(1)] t[unfolded fS(1) T(1)]]
+          i(2)
+    by argo
+qed
+
+lemma analyzed_closed_mod_timpls_is_analyzed_timpl_closure_set:
+  fixes M::"('fun,'atom,'sets) prot_term list"
+  assumes TI': "set TI' = {(a,b) \<in> (set TI)\<^sup>+. a \<noteq> b}"
+    and M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)"
+  shows "analyzed_closed_mod_timpls M TI' \<longleftrightarrow> analyzed (timpl_closure_set (set M) (set TI))"
+    (is "?A \<longleftrightarrow> ?B")
+proof
+  let ?C = "\<forall>t \<in> timpl_closure_set (set M) (set TI).
+              analyzed_in t (timpl_closure_set (set M) (set TI))"
+
+  let ?P = "\<lambda>T. \<forall>t \<in> set T. timpl_closure_set (set M) (set TI) \<turnstile>\<^sub>c t"
+  let ?Q = "\<lambda>t. \<forall>s \<in> comp_timpl_closure {t} (set TI'). case Ana s of (K, R) \<Rightarrow> ?P K \<longrightarrow> ?P R"
+  
+  note defs = analyzed_closed_mod_timpls_def analyzed_in_code
+  note 0 = intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI', of M]
+  note 1 = timpl_closure_set_is_timpl_closure_union[of _ "set TI"]
+
+  have 2: "comp_timpl_closure {t} (set TI') = timpl_closure_set {t} (set TI)"
+    when t: "t \<in> set M" "wf\<^sub>t\<^sub>r\<^sub>m t" for t
+    using t timpl_closure_set_timpls_trancl_eq'[of "{t}" "set TI"]
+          comp_timpl_closure_is_timpl_closure_set[of "{t}" TI']
+    unfolding TI'[symmetric]
+    by blast
+  hence 3: "comp_timpl_closure {t} (set TI') \<subseteq> timpl_closure_set (set M) (set TI)"
+    when t: "t \<in> set M" "wf\<^sub>t\<^sub>r\<^sub>m t" for t
+    using t timpl_closure_set_mono[of "{t}" "set M"]
+    by fast
+
+  have ?A when C: ?C
+    unfolding analyzed_closed_mod_timpls_def
+              intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI']
+              list_all_iff Let_def
+  proof (intro ballI)
+    fix t assume t: "t \<in> set M"
+    show "if ?P (fst (Ana t)) then ?P (snd (Ana t)) else ?Q t" (is ?R)
+    proof (cases "?P (fst (Ana t))")
+      case True
+      hence "?P (snd (Ana t))"
+        using C timpl_closure_setI[OF t, of "set TI"] prod.exhaust_sel
+        unfolding analyzed_in_def by blast
+      thus ?thesis using True by simp
+    next
+      case False
+      have "?Q t" using 3[OF t] C M_wf t unfolding analyzed_in_def by auto
+      thus ?thesis using False by argo
+    qed
+  qed
+  thus ?A when B: ?B using B analyzed_is_all_analyzed_in by metis
+
+  have ?C when A: ?A unfolding analyzed_in_def Let_def
+  proof (intro ballI allI impI; elim conjE)
+    fix t K T s
+    assume t: "t \<in> timpl_closure_set (set M) (set TI)"
+      and s: "s \<in> set T"
+      and Ana_t: "Ana t = (K, T)"
+      and K: "\<forall>k \<in> set K. timpl_closure_set (set M) (set TI) \<turnstile>\<^sub>c k"
+
+    obtain m where m: "m \<in> set M" "t \<in> timpl_closure m (set TI)"
+      using timpl_closure_set_is_timpl_closure_union t by moura
+
+    show "timpl_closure_set (set M) (set TI) \<turnstile>\<^sub>c s"
+    proof (cases "\<forall>k \<in> set (fst (Ana m)). timpl_closure_set (set M) (set TI) \<turnstile>\<^sub>c k")
+      case True
+      hence *: "\<forall>r \<in> set (snd (Ana m)). timpl_closure_set (set M) (set TI) \<turnstile>\<^sub>c r"
+        using m(1) A
+        unfolding analyzed_closed_mod_timpls_def
+                  intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI']
+                  list_all_iff
+        by simp
+
+      show ?thesis
+        using K s Ana_t A
+              analyzed_closed_mod_timpls_is_analyzed_closed_timpl_closure_set_aux2[OF * m]
+        by simp
+    next
+      case False
+      hence "?Q m"
+        using m(1) A
+        unfolding analyzed_closed_mod_timpls_def
+                  intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI']
+                  list_all_iff Let_def
+        by auto 
+      moreover have "comp_timpl_closure {m} (set TI') = timpl_closure m (set TI)"
+        using 2[OF m(1)] timpl_closureton_is_timpl_closure M_wf m(1)
+        by blast
+      ultimately show ?thesis
+        using m(2) K s Ana_t
+        unfolding Let_def by auto
+    qed
+  qed
+  thus ?B when A: ?A using A analyzed_is_all_analyzed_in by metis
+qed
+
+lemma analyzed_closed_mod_timpls'_is_analyzed_timpl_closure_set:
+  fixes M::"('fun,'atom,'sets) prot_term list"
+  assumes M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)"
+  shows "analyzed_closed_mod_timpls' M TI \<longleftrightarrow> analyzed (timpl_closure_set (set M) (set TI))"
+    (is "?A \<longleftrightarrow> ?B")
+proof
+  let ?C = "\<forall>t \<in> timpl_closure_set (set M) (set TI). analyzed_in t (timpl_closure_set (set M) (set TI))"
+
+  let ?P = "\<lambda>T. \<forall>t \<in> set T. timpl_closure_set (set M) (set TI) \<turnstile>\<^sub>c t"
+  let ?Q = "\<lambda>t. \<forall>s \<in> comp_timpl_closure {t} (set TI). case Ana s of (K, R) \<Rightarrow> ?P K \<longrightarrow> ?P R"
+  
+  note defs = analyzed_closed_mod_timpls'_def analyzed_in_code
+  note 0 = intruder_synth_mod_timpls'_is_synth_timpl_closure_set[of M TI]
+  note 1 = timpl_closure_set_is_timpl_closure_union[of _ "set TI"]
+
+  have 2: "comp_timpl_closure {t} (set TI) = timpl_closure_set {t} (set TI)"
+    when t: "t \<in> set M" "wf\<^sub>t\<^sub>r\<^sub>m t" for t
+    using t timpl_closure_set_timpls_trancl_eq[of "{t}" "set TI"]
+          comp_timpl_closure_is_timpl_closure_set[of "{t}"]
+    by blast
+  hence 3: "comp_timpl_closure {t} (set TI) \<subseteq> timpl_closure_set (set M) (set TI)"
+    when t: "t \<in> set M" "wf\<^sub>t\<^sub>r\<^sub>m t" for t
+    using t timpl_closure_set_mono[of "{t}" "set M"]
+    by fast
+
+  have ?A when C: ?C
+    unfolding analyzed_closed_mod_timpls'_def
+              intruder_synth_mod_timpls'_is_synth_timpl_closure_set
+              list_all_iff Let_def
+  proof (intro ballI)
+    fix t assume t: "t \<in> set M"
+    show "if ?P (fst (Ana t)) then ?P (snd (Ana t)) else ?Q t" (is ?R)
+    proof (cases "?P (fst (Ana t))")
+      case True
+      hence "?P (snd (Ana t))"
+        using C timpl_closure_setI[OF t, of "set TI"] prod.exhaust_sel
+        unfolding analyzed_in_def by blast
+      thus ?thesis using True by simp
+    next
+      case False
+      have "?Q t" using 3[OF t] C M_wf t unfolding analyzed_in_def by auto
+      thus ?thesis using False by argo
+    qed
+  qed
+  thus ?A when B: ?B using B analyzed_is_all_analyzed_in by metis
+
+  have ?C when A: ?A unfolding analyzed_in_def Let_def
+  proof (intro ballI allI impI; elim conjE)
+    fix t K T s
+    assume t: "t \<in> timpl_closure_set (set M) (set TI)"
+      and s: "s \<in> set T"
+      and Ana_t: "Ana t = (K, T)"
+      and K: "\<forall>k \<in> set K. timpl_closure_set (set M) (set TI) \<turnstile>\<^sub>c k"
+
+    obtain m where m: "m \<in> set M" "t \<in> timpl_closure m (set TI)"
+      using timpl_closure_set_is_timpl_closure_union t by moura
+
+    show "timpl_closure_set (set M) (set TI) \<turnstile>\<^sub>c s"
+    proof (cases "\<forall>k \<in> set (fst (Ana m)). timpl_closure_set (set M) (set TI) \<turnstile>\<^sub>c k")
+      case True
+      hence *: "\<forall>r \<in> set (snd (Ana m)). timpl_closure_set (set M) (set TI) \<turnstile>\<^sub>c r"
+        using m(1) A
+        unfolding analyzed_closed_mod_timpls'_def
+                  intruder_synth_mod_timpls'_is_synth_timpl_closure_set
+                  list_all_iff
+        by simp
+
+      show ?thesis
+        using K s Ana_t A
+              analyzed_closed_mod_timpls_is_analyzed_closed_timpl_closure_set_aux2[OF * m]
+        by simp
+    next
+      case False
+      hence "?Q m"
+        using m(1) A
+        unfolding analyzed_closed_mod_timpls'_def
+                  intruder_synth_mod_timpls'_is_synth_timpl_closure_set
+                  list_all_iff Let_def
+        by auto 
+      moreover have "comp_timpl_closure {m} (set TI) = timpl_closure m (set TI)"
+        using 2[OF m(1)] timpl_closureton_is_timpl_closure M_wf m(1)
+        by blast
+      ultimately show ?thesis
+        using m(2) K s Ana_t
+        unfolding Let_def by auto
+    qed
+  qed
+  thus ?B when A: ?A using A analyzed_is_all_analyzed_in by metis
+qed
+
+end
+
+end
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/Term_Variants.thy b/Automated_Stateful_Protocol_Verification/Term_Variants.thy
new file mode 100644
index 0000000..631c23b
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/Term_Variants.thy
@@ -0,0 +1,451 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      Term_Variants.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>Term Variants\<close>
+theory Term_Variants
+  imports Stateful_Protocol_Composition_and_Typing.Intruder_Deduction
+begin
+
+fun term_variants where
+  "term_variants P (Var x) = [Var x]"
+| "term_variants P (Fun f T) = (
+  let S = product_lists (map (term_variants P) T)
+  in map (Fun f) S@concat (map (\<lambda>g. map (Fun g) S) (P f)))"
+
+inductive term_variants_pred where
+  term_variants_Var:
+  "term_variants_pred P (Var x) (Var x)"
+| term_variants_P:
+  "\<lbrakk>length T = length S; \<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (S ! i); g \<in> set (P f)\<rbrakk>
+   \<Longrightarrow> term_variants_pred P (Fun f T) (Fun g S)"
+| term_variants_Fun:
+  "\<lbrakk>length T = length S; \<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (S ! i)\<rbrakk>
+   \<Longrightarrow> term_variants_pred P (Fun f T) (Fun f S)"
+
+lemma term_variants_pred_inv:
+  assumes "term_variants_pred P (Fun f T) (Fun h S)"
+  shows "length T = length S"
+    and "\<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (S ! i)"
+    and "f \<noteq> h \<Longrightarrow> h \<in> set (P f)"
+using assms by (auto elim: term_variants_pred.cases)
+
+lemma term_variants_pred_inv':
+  assumes "term_variants_pred P (Fun f T) t"
+  shows "is_Fun t"
+    and "length T = length (args t)"
+    and "\<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (args t ! i)"
+    and "f \<noteq> the_Fun t \<Longrightarrow> the_Fun t \<in> set (P f)"
+    and "P \<equiv> (\<lambda>_. [])(g := [h]) \<Longrightarrow> f \<noteq> the_Fun t \<Longrightarrow> f = g \<and> the_Fun t = h"
+using assms by (auto elim: term_variants_pred.cases)
+
+lemma term_variants_pred_inv'':
+  assumes "term_variants_pred P t (Fun f T)"
+  shows "is_Fun t"
+    and "length T = length (args t)"
+    and "\<And>i. i < length T \<Longrightarrow> term_variants_pred P (args t ! i) (T ! i)"
+    and "f \<noteq> the_Fun t \<Longrightarrow> f \<in> set (P (the_Fun t))"
+    and "P \<equiv> (\<lambda>_. [])(g := [h]) \<Longrightarrow> f \<noteq> the_Fun t \<Longrightarrow> f = h \<and> the_Fun t = g"
+using assms by (auto elim: term_variants_pred.cases)
+
+lemma term_variants_pred_inv_Var:
+  "term_variants_pred P (Var x) t \<longleftrightarrow> t = Var x"
+  "term_variants_pred P t (Var x) \<longleftrightarrow> t = Var x"
+by (auto intro: term_variants_Var elim: term_variants_pred.cases)
+
+lemma term_variants_pred_inv_const:
+  "term_variants_pred P (Fun c []) t \<longleftrightarrow> ((\<exists>g \<in> set (P c). t = Fun g []) \<or> (t = Fun c []))"
+by (auto intro: term_variants_P term_variants_Fun elim: term_variants_pred.cases)
+
+lemma term_variants_pred_refl: "term_variants_pred P t t"
+by (induct t) (auto intro: term_variants_pred.intros)
+
+lemma term_variants_pred_refl_inv:
+  assumes st: "term_variants_pred P s t"
+    and P: "\<forall>f. \<forall>g \<in> set (P f). f = g"
+  shows "s = t"
+  using st P
+proof (induction s t rule: term_variants_pred.induct)
+case (term_variants_Var P x) thus ?case by blast
+next
+  case (term_variants_P T S P g f)
+  hence "T ! i = S ! i" when i: "i < length T" for i using i by blast
+  hence "T = S" using term_variants_P.hyps(1) by (simp add: nth_equalityI)
+  thus ?case using term_variants_P.prems term_variants_P.hyps(3) by fast
+next
+  case (term_variants_Fun T S P f)
+  hence "T ! i = S ! i" when i: "i < length T" for i using i by blast
+  hence "T = S" using term_variants_Fun.hyps(1) by (simp add: nth_equalityI)
+  thus ?case by fast
+qed
+
+lemma term_variants_pred_const:
+  assumes "b \<in> set (P a)"
+  shows "term_variants_pred P (Fun a []) (Fun b [])"
+using term_variants_P[of "[]" "[]"] assms by simp
+
+lemma term_variants_pred_const_cases:
+  "P a \<noteq> [] \<Longrightarrow> term_variants_pred P (Fun a []) t \<longleftrightarrow>
+                 (t = Fun a [] \<or> (\<exists>b \<in> set (P a). t = Fun b []))"
+  "P a = [] \<Longrightarrow> term_variants_pred P (Fun a []) t \<longleftrightarrow> t = Fun a []"
+using term_variants_pred_inv_const[of P] by auto
+
+lemma term_variants_pred_param:
+  assumes "term_variants_pred P t s"
+    and fg: "f = g \<or> g \<in> set (P f)"
+  shows "term_variants_pred P (Fun f (S@t#T)) (Fun g (S@s#T))"
+proof -
+  have 1: "length (S@t#T) = length (S@s#T)" by simp
+  
+  have "term_variants_pred P (T ! i) (T ! i)" "term_variants_pred P (S ! i) (S ! i)" for i
+    by (metis term_variants_pred_refl)+
+  hence 2: "term_variants_pred P ((S@t#T) ! i) ((S@s#T) ! i)" for i
+    by (simp add: assms nth_Cons' nth_append)
+
+  show ?thesis by (metis term_variants_Fun[OF 1 2] term_variants_P[OF 1 2] fg)
+qed
+
+lemma term_variants_pred_Cons:
+  assumes t: "term_variants_pred P t s"
+    and T: "term_variants_pred P (Fun f T) (Fun f S)"
+    and fg: "f = g \<or> g \<in> set (P f)"
+  shows "term_variants_pred P (Fun f (t#T)) (Fun g (s#S))"
+proof -
+  have 1: "length (t#T) = length (s#S)"
+       and "\<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (S ! i)"
+    using term_variants_pred_inv[OF T] by simp_all
+  hence 2: "\<And>i. i < length (t#T) \<Longrightarrow> term_variants_pred P ((t#T) ! i) ((s#S) ! i)"
+    by (metis t One_nat_def diff_less length_Cons less_Suc_eq less_imp_diff_less nth_Cons'
+              zero_less_Suc) 
+
+  show ?thesis using 1 2 fg by (auto intro: term_variants_pred.intros)
+qed
+
+lemma term_variants_pred_dense:
+  fixes P Q::"'a set" and fs gs::"'a list"
+  defines "P_fs x \<equiv> if x \<in> P then fs else []"
+    and "P_gs x \<equiv> if x \<in> P then gs else []"
+    and "Q_fs x \<equiv> if x \<in> Q then fs else []"
+  assumes ut: "term_variants_pred P_fs u t"
+    and g: "g \<in> Q" "g \<in> set gs"
+  shows "\<exists>s. term_variants_pred P_gs u s \<and> term_variants_pred Q_fs s t"
+proof -
+  define F where "F \<equiv> \<lambda>(P::'a set) (fs::'a list) x. if x \<in> P then fs else []"
+
+  show ?thesis using ut g P_fs_def unfolding P_gs_def Q_fs_def
+  proof (induction P_fs u t arbitrary: g gs rule: term_variants_pred.induct)
+    case (term_variants_Var P h x) thus ?case
+      by (auto intro: term_variants_pred.term_variants_Var)
+  next
+    case (term_variants_P T S P' h' h g gs)
+    note hyps = term_variants_P.hyps(1,2,4,5,6,7)
+    note IH = term_variants_P.hyps(3)
+
+    have "\<exists>s. term_variants_pred (F P gs) (T ! i) s \<and> term_variants_pred (F Q fs) s (S ! i)"
+      when i: "i < length T" for i
+      using IH[OF i hyps(4,5,6)] unfolding F_def by presburger
+    then obtain U where U:
+        "length T = length U" "\<And>i. i < length T \<Longrightarrow> term_variants_pred (F P gs) (T ! i) (U ! i)"
+        "length U = length S" "\<And>i. i < length U \<Longrightarrow> term_variants_pred (F Q fs) (U ! i) (S ! i)"
+      using hyps(1) Skolem_list_nth[of _ "\<lambda>i s. term_variants_pred (F P gs) (T ! i) s \<and>
+                                                term_variants_pred (F Q fs) s (S ! i)"]
+      by moura
+
+    show ?case
+      using term_variants_pred.term_variants_P[OF U(1,2), of g h]
+            term_variants_pred.term_variants_P[OF U(3,4), of h' g]
+            hyps(3)[unfolded hyps(6)] hyps(4,5)
+      unfolding F_def by force
+  next
+    case (term_variants_Fun T S P' h' g gs)
+    note hyps = term_variants_Fun.hyps(1,2,4,5,6)
+    note IH = term_variants_Fun.hyps(3)
+
+    have "\<exists>s. term_variants_pred (F P gs) (T ! i) s \<and> term_variants_pred (F Q fs) s (S ! i)"
+      when i: "i < length T" for i
+      using IH[OF i hyps(3,4,5)] unfolding F_def by presburger
+    then obtain U where U:
+        "length T = length U" "\<And>i. i < length T \<Longrightarrow> term_variants_pred (F P gs) (T ! i) (U ! i)"
+        "length U = length S" "\<And>i. i < length U \<Longrightarrow> term_variants_pred (F Q fs) (U ! i) (S ! i)"
+      using hyps(1) Skolem_list_nth[of _ "\<lambda>i s. term_variants_pred (F P gs) (T ! i) s \<and>
+                                                term_variants_pred (F Q fs) s (S ! i)"]
+      by moura
+    
+    thus ?case
+      using term_variants_pred.term_variants_Fun[OF U(1,2)]
+            term_variants_pred.term_variants_Fun[OF U(3,4)]
+      unfolding F_def by meson
+  qed
+qed
+
+lemma term_variants_pred_dense':
+  assumes ut: "term_variants_pred ((\<lambda>_. [])(a := [b])) u t"
+  shows "\<exists>s. term_variants_pred ((\<lambda>_. [])(a := [c])) u s \<and>
+             term_variants_pred ((\<lambda>_. [])(c := [b])) s t"
+using ut term_variants_pred_dense[of "{a}" "[b]" u t c "{c}" "[c]"]
+unfolding fun_upd_def by simp
+
+lemma term_variants_pred_eq_case:
+  fixes t s::"('a,'b) term"
+  assumes "term_variants_pred P t s" "\<forall>f \<in> funs_term t. P f = []"
+  shows "t = s"
+using assms
+proof (induction P t s rule: term_variants_pred.induct)
+  case (term_variants_Fun T S P f) thus ?case
+    using subtermeq_imp_funs_term_subset[OF Fun_param_in_subterms[OF nth_mem], of _ T f]
+          nth_equalityI[of T S]
+    by blast
+qed (simp_all add: term_variants_pred_refl)
+
+lemma term_variants_pred_subst:
+  assumes "term_variants_pred P t s"
+  shows "term_variants_pred P (t \<cdot> \<delta>) (s \<cdot> \<delta>)"
+using assms
+proof (induction P t s rule: term_variants_pred.induct)
+  case (term_variants_P T S P f g)
+  have 1: "length (map (\<lambda>t. t \<cdot> \<delta>) T) = length (map (\<lambda>t. t \<cdot> \<delta>) S)"
+    using term_variants_P.hyps
+    by simp
+
+  have 2: "term_variants_pred P ((map (\<lambda>t. t \<cdot> \<delta>) T) ! i) ((map (\<lambda>t. t \<cdot> \<delta>) S) ! i)"
+    when "i < length (map (\<lambda>t. t \<cdot> \<delta>) T)" for i
+    using term_variants_P that
+    by fastforce
+
+  show ?case
+    using term_variants_pred.term_variants_P[OF 1 2 term_variants_P.hyps(3)]
+    by fastforce
+next
+  case (term_variants_Fun T S P f)
+  have 1: "length (map (\<lambda>t. t \<cdot> \<delta>) T) = length (map (\<lambda>t. t \<cdot> \<delta>) S)"
+    using term_variants_Fun.hyps
+    by simp
+
+  have 2: "term_variants_pred P ((map (\<lambda>t. t \<cdot> \<delta>) T) ! i) ((map (\<lambda>t. t \<cdot> \<delta>) S) ! i)"
+    when "i < length (map (\<lambda>t. t \<cdot> \<delta>) T)" for i
+    using term_variants_Fun that
+    by fastforce
+
+  show ?case
+    using term_variants_pred.term_variants_Fun[OF 1 2]
+    by fastforce
+qed (simp add: term_variants_pred_refl)
+
+lemma term_variants_pred_subst':
+  fixes t s::"('a,'b) term" and \<delta>::"('a,'b) subst"
+  assumes "term_variants_pred P (t \<cdot> \<delta>) s"
+    and "\<forall>x \<in> fv t \<union> fv s. (\<exists>y. \<delta> x = Var y) \<or> (\<exists>f. \<delta> x = Fun f [] \<and> P f = [])"
+  shows "\<exists>u. term_variants_pred P t u \<and> s = u \<cdot> \<delta>"
+using assms
+proof (induction P "t \<cdot> \<delta>" s arbitrary: t rule: term_variants_pred.induct)
+  case (term_variants_Var P x g) thus ?case using term_variants_pred_refl by fast
+next
+  case (term_variants_P T S P g f) show ?case
+  proof (cases t)
+    case (Var x) thus ?thesis
+      using term_variants_P.hyps(4,5) term_variants_P.prems
+      by fastforce
+  next
+    case (Fun h U)
+    hence 1: "h = f" "T = map (\<lambda>s. s \<cdot> \<delta>) U" "length U = length T"
+      using term_variants_P.hyps(5) by simp_all
+    hence 2: "T ! i = U ! i \<cdot> \<delta>" when "i < length T" for i
+      using that by simp
+
+    have "\<forall>x \<in> fv (U ! i) \<union> fv (S ! i). (\<exists>y. \<delta> x = Var y) \<or> (\<exists>f. \<delta> x = Fun f [] \<and> P f = [])"
+      when "i < length U" for i
+      using that Fun term_variants_P.prems term_variants_P.hyps(1) 1(3)
+      by force
+    hence IH: "\<forall>i < length U. \<exists>u. term_variants_pred P (U ! i) u \<and> S ! i = u \<cdot> \<delta>"
+      by (metis 1(3) term_variants_P.hyps(3)[OF _ 2])
+
+    have "\<exists>V. length U = length V \<and> S = map (\<lambda>v. v \<cdot> \<delta>) V \<and>
+               (\<forall>i < length U. term_variants_pred P (U ! i) (V ! i))"
+      using term_variants_P.hyps(1) 1(3) subst_term_list_obtain[OF IH] by metis
+    then obtain V where V: "length U = length V" "S = map (\<lambda>v. v \<cdot> \<delta>) V"
+                           "\<And>i. i < length U \<Longrightarrow> term_variants_pred P (U ! i) (V ! i)"
+      by moura
+
+    have "term_variants_pred P (Fun f U) (Fun g V)"
+      by (metis term_variants_pred.term_variants_P[OF V(1,3) term_variants_P.hyps(4)])
+    moreover have "Fun g S = Fun g V \<cdot> \<delta>" using V(2) by simp
+    ultimately show ?thesis using term_variants_P.hyps(1,4) Fun 1 by blast
+  qed
+next
+  case (term_variants_Fun T S P f t) show ?case
+  proof (cases t)
+    case (Var x)
+    hence "T = []" "P f = []" using term_variants_Fun.hyps(4) term_variants_Fun.prems by fastforce+
+    thus ?thesis using term_variants_pred_refl Var term_variants_Fun.hyps(1,4) by fastforce
+  next
+    case (Fun h U)
+    hence 1: "h = f" "T = map (\<lambda>s. s \<cdot> \<delta>) U" "length U = length T"
+      using term_variants_Fun.hyps(4) by simp_all
+    hence 2: "T ! i = U ! i \<cdot> \<delta>" when "i < length T" for i
+      using that by simp
+
+    have "\<forall>x \<in> fv (U ! i) \<union> fv (S ! i). (\<exists>y. \<delta> x = Var y) \<or> (\<exists>f. \<delta> x = Fun f [] \<and> P f = [])"
+      when "i < length U" for i
+      using that Fun term_variants_Fun.prems term_variants_Fun.hyps(1) 1(3)
+      by force
+    hence IH: "\<forall>i < length U. \<exists>u. term_variants_pred P (U ! i) u \<and> S ! i = u \<cdot> \<delta>"
+      by (metis 1(3) term_variants_Fun.hyps(3)[OF _ 2 ])
+
+    have "\<exists>V. length U = length V \<and> S = map (\<lambda>v. v \<cdot> \<delta>) V \<and>
+               (\<forall>i < length U. term_variants_pred P (U ! i) (V ! i))"
+      using term_variants_Fun.hyps(1) 1(3) subst_term_list_obtain[OF IH] by metis
+    then obtain V where V: "length U = length V" "S = map (\<lambda>v. v \<cdot> \<delta>) V"
+                           "\<And>i. i < length U \<Longrightarrow> term_variants_pred P (U ! i) (V ! i)"
+      by moura
+
+    have "term_variants_pred P (Fun f U) (Fun f V)"
+      by (metis term_variants_pred.term_variants_Fun[OF V(1,3)])
+    moreover have "Fun f S = Fun f V \<cdot> \<delta>" using V(2) by simp
+    ultimately show ?thesis using term_variants_Fun.hyps(1) Fun 1 by blast
+  qed
+qed
+
+lemma term_variants_pred_iff_in_term_variants:
+  fixes t::"('a,'b) term"
+  shows "term_variants_pred P t s \<longleftrightarrow> s \<in> set (term_variants P t)"
+    (is "?A t s \<longleftrightarrow> ?B t s")
+proof
+  define U where "U \<equiv> \<lambda>P (T::('a,'b) term list). product_lists (map (term_variants P) T)"
+
+  have a:
+      "g \<in> set (P f) \<Longrightarrow> set (map (Fun g) (U P T)) \<subseteq> set (term_variants P (Fun f T))"
+      "set (map (Fun f) (U P T)) \<subseteq> set (term_variants P (Fun f T))"
+    for f P g and T::"('a,'b) term list"
+    using term_variants.simps(2)[of P f T]
+    unfolding U_def Let_def by auto
+
+  have b: "\<exists>S \<in> set (U P T). s = Fun f S \<or> (\<exists>g \<in> set (P f). s = Fun g S)"
+    when "s \<in> set (term_variants P (Fun f T))" for P T f s
+    using that by (cases "P f") (auto simp add: U_def Let_def)
+
+  have c: "length T = length S" when "S \<in> set (U P T)" for S P T
+    using that unfolding U_def
+    by (simp add: in_set_product_lists_length)
+
+  show "?A t s \<Longrightarrow> ?B t s"
+  proof (induction P t s rule: term_variants_pred.induct)
+    case (term_variants_P T S P g f)
+    note hyps = term_variants_P.hyps
+    note IH = term_variants_P.IH
+
+    have "S \<in> set (U P T)"
+      using IH hyps(1) product_lists_in_set_nth'[of _ S]
+      unfolding U_def by simp
+    thus ?case using a(1)[of _ P, OF hyps(3)] by auto
+  next
+    case (term_variants_Fun T S P f)
+    note hyps = term_variants_Fun.hyps
+    note IH = term_variants_Fun.IH
+
+    have "S \<in> set (U P T)"
+      using IH hyps(1) product_lists_in_set_nth'[of _ S]
+      unfolding U_def by simp
+    thus ?case using a(2)[of f P T] by (cases "P f") auto
+  qed (simp add: term_variants_Var)
+
+  show "?B t s \<Longrightarrow> ?A t s"
+  proof (induction P t arbitrary: s rule: term_variants.induct)
+    case (2 P f T)
+    obtain S where S:
+        "s = Fun f S \<or> (\<exists>g \<in> set (P f). s = Fun g S)"
+        "S \<in> set (U P T)" "length T = length S"
+      using c b[OF "2.prems"] by moura
+
+    have "\<forall>i < length T. term_variants_pred P (T ! i) (S ! i)"
+      using "2.IH" S product_lists_in_set_nth by (fastforce simp add: U_def)
+    thus ?case using S by (auto intro: term_variants_pred.intros)
+  qed (simp add: term_variants_Var)
+qed
+
+lemma term_variants_pred_finite:
+  "finite {s. term_variants_pred P t s}"
+using term_variants_pred_iff_in_term_variants[of P t]
+by simp
+
+lemma term_variants_pred_fv_eq:
+  assumes "term_variants_pred P s t"
+  shows "fv s = fv t"
+using assms
+by (induct rule: term_variants_pred.induct)
+   (metis, metis fv_eq_FunI, metis fv_eq_FunI)
+
+lemma (in intruder_model) term_variants_pred_wf_trms:
+  assumes "term_variants_pred P s t"
+    and "\<And>f g. g \<in> set (P f) \<Longrightarrow> arity f = arity g"
+    and "wf\<^sub>t\<^sub>r\<^sub>m s"
+  shows "wf\<^sub>t\<^sub>r\<^sub>m t"
+using assms
+apply (induction rule: term_variants_pred.induct, simp)
+by (metis (no_types) wf_trmI wf_trm_arity in_set_conv_nth wf_trm_param_idx)+
+
+lemma term_variants_pred_funs_term:
+  assumes "term_variants_pred P s t"
+    and "f \<in> funs_term t"
+  shows "f \<in> funs_term s \<or> (\<exists>g \<in> funs_term s. f \<in> set (P g))"
+  using assms
+proof (induction rule: term_variants_pred.induct)
+  case (term_variants_P T S P g h) thus ?case
+  proof (cases "f = g")
+    case False
+    then obtain s where "s \<in> set S" "f \<in> funs_term s"
+      using funs_term_subterms_eq(1)[of "Fun g S"] term_variants_P.prems by auto
+    thus ?thesis
+      using term_variants_P.IH term_variants_P.hyps(1) in_set_conv_nth[of s S] by force
+  qed simp
+next
+  case (term_variants_Fun T S P h) thus ?case
+  proof (cases "f = h")
+    case False
+    then obtain s where "s \<in> set S" "f \<in> funs_term s"
+      using funs_term_subterms_eq(1)[of "Fun h S"] term_variants_Fun.prems by auto
+    thus ?thesis
+      using term_variants_Fun.IH term_variants_Fun.hyps(1) in_set_conv_nth[of s S] by force
+  qed simp
+qed fast
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/Transactions.thy b/Automated_Stateful_Protocol_Verification/Transactions.thy
new file mode 100644
index 0000000..1ec733e
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/Transactions.thy
@@ -0,0 +1,966 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      Transactions.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>Protocol Transactions\<close>
+theory Transactions
+  imports
+    Stateful_Protocol_Composition_and_Typing.Typed_Model
+    Stateful_Protocol_Composition_and_Typing.Labeled_Stateful_Strands 
+begin
+
+subsection \<open>Definitions\<close>
+datatype 'b prot_atom =
+  is_Atom: Atom 'b
+| Value
+| SetType
+| AttackType
+| Bottom
+| OccursSecType
+
+datatype ('a,'b,'c) prot_fun =
+  Fu (the_Fu: 'a)
+| Set (the_Set: 'c)
+| Val (the_Val: "nat \<times> bool")
+| Abs (the_Abs: "'c set")
+| Pair
+| Attack nat
+| PubConstAtom 'b nat
+| PubConstSetType nat
+| PubConstAttackType nat
+| PubConstBottom nat
+| PubConstOccursSecType nat
+| OccursFact
+| OccursSec
+
+definition "is_Fun_Set t \<equiv> is_Fun t \<and> args t = [] \<and> is_Set (the_Fun t)"
+
+abbreviation occurs where
+  "occurs t \<equiv> Fun OccursFact [Fun OccursSec [], t]"
+
+type_synonym ('a,'b,'c) prot_term_type = "(('a,'b,'c) prot_fun,'b prot_atom) term_type"
+
+type_synonym ('a,'b,'c) prot_var = "('a,'b,'c) prot_term_type \<times> nat"
+
+type_synonym ('a,'b,'c) prot_term = "(('a,'b,'c) prot_fun,('a,'b,'c) prot_var) term"
+type_synonym ('a,'b,'c) prot_terms = "('a,'b,'c) prot_term set"
+
+type_synonym ('a,'b,'c) prot_subst = "(('a,'b,'c) prot_fun, ('a,'b,'c) prot_var) subst"
+
+type_synonym ('a,'b,'c,'d) prot_strand_step =
+  "(('a,'b,'c) prot_fun, ('a,'b,'c) prot_var, 'd) labeled_stateful_strand_step"
+type_synonym ('a,'b,'c,'d) prot_strand = "('a,'b,'c,'d) prot_strand_step list"
+type_synonym ('a,'b,'c,'d) prot_constr = "('a,'b,'c,'d) prot_strand_step list"
+
+datatype ('a,'b,'c,'d) prot_transaction =
+  Transaction
+    (transaction_fresh:   "('a,'b,'c) prot_var list")
+    (transaction_receive: "('a,'b,'c,'d) prot_strand")
+    (transaction_selects: "('a,'b,'c,'d) prot_strand")
+    (transaction_checks:  "('a,'b,'c,'d) prot_strand")
+    (transaction_updates: "('a,'b,'c,'d) prot_strand")
+    (transaction_send:    "('a,'b,'c,'d) prot_strand")
+
+definition transaction_strand where
+  "transaction_strand T \<equiv>
+    transaction_receive T@transaction_selects T@transaction_checks T@
+    transaction_updates T@transaction_send T"
+
+fun transaction_proj where
+  "transaction_proj l (Transaction A B C D E F) = (
+  let f = proj l
+  in Transaction A (f B) (f C) (f D) (f E) (f F))"
+
+fun transaction_star_proj where
+  "transaction_star_proj (Transaction A B C D E F) = (
+  let f = filter is_LabelS
+  in Transaction A (f B) (f C) (f D) (f E) (f F))"
+
+abbreviation fv_transaction where
+  "fv_transaction T \<equiv> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)"
+
+abbreviation bvars_transaction where
+  "bvars_transaction T \<equiv> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)"
+
+abbreviation vars_transaction where
+  "vars_transaction T \<equiv> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)"
+
+abbreviation trms_transaction where
+  "trms_transaction T \<equiv> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)"
+
+abbreviation setops_transaction where
+  "setops_transaction T \<equiv> setops\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))"
+
+definition wellformed_transaction where
+  "wellformed_transaction T \<equiv>
+    list_all is_Receive (unlabel (transaction_receive T)) \<and>
+    list_all is_Assignment (unlabel (transaction_selects T)) \<and>
+    list_all is_Check (unlabel (transaction_checks T)) \<and>
+    list_all is_Update (unlabel (transaction_updates T)) \<and>
+    list_all is_Send (unlabel (transaction_send T)) \<and>
+    set (transaction_fresh T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<and>
+    set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {} \<and>
+    set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {} \<and>
+    fv_transaction T \<inter> bvars_transaction T = {} \<and>
+    fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<and>
+    fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) - set (transaction_fresh T)
+      \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<and>
+    (\<forall>x \<in> set (unlabel (transaction_selects T)).
+      is_Equality x \<longrightarrow> fv (the_rhs x) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T))"
+
+type_synonym ('a,'b,'c,'d) prot = "('a,'b,'c,'d) prot_transaction list"
+
+abbreviation Var_Value_term ("\<langle>_\<rangle>\<^sub>v") where
+  "\<langle>n\<rangle>\<^sub>v \<equiv> Var (Var Value, n)::('a,'b,'c) prot_term"
+
+abbreviation Fun_Fu_term ("\<langle>_ _\<rangle>\<^sub>t") where
+  "\<langle>f T\<rangle>\<^sub>t \<equiv> Fun (Fu f) T::('a,'b,'c) prot_term"
+
+abbreviation Fun_Fu_const_term ("\<langle>_\<rangle>\<^sub>c") where
+  "\<langle>c\<rangle>\<^sub>c \<equiv> Fun (Fu c) []::('a,'b,'c) prot_term"
+
+abbreviation Fun_Set_const_term ("\<langle>_\<rangle>\<^sub>s") where
+  "\<langle>f\<rangle>\<^sub>s \<equiv> Fun (Set f) []::('a,'b,'c) prot_term"
+
+abbreviation Fun_Abs_const_term ("\<langle>_\<rangle>\<^sub>a") where
+  "\<langle>a\<rangle>\<^sub>a \<equiv> Fun (Abs a) []::('a,'b,'c) prot_term"
+
+abbreviation Fun_Attack_const_term ("attack\<langle>_\<rangle>") where
+  "attack\<langle>n\<rangle> \<equiv> Fun (Attack n) []::('a,'b,'c) prot_term"
+
+abbreviation prot_transaction1 ("transaction\<^sub>1 _ _ new _ _ _") where
+  "transaction\<^sub>1 (S1::('a,'b,'c,'d) prot_strand) S2 new (B::('a,'b,'c) prot_term list) S3 S4
+  \<equiv> Transaction (map the_Var B) S1 [] S2 S3 S4"
+
+abbreviation prot_transaction2 ("transaction\<^sub>2 _ _  _ _") where
+  "transaction\<^sub>2 (S1::('a,'b,'c,'d) prot_strand) S2 S3 S4
+  \<equiv> Transaction [] S1 [] S2 S3 S4"
+
+
+subsection \<open>Lemmata\<close>
+
+lemma prot_atom_UNIV:
+  "(UNIV::'b prot_atom set) = range Atom \<union> {Value, SetType, AttackType, Bottom, OccursSecType}"
+proof -
+  have "a \<in> range Atom \<or> a = Value \<or> a = SetType \<or> a = AttackType \<or> a = Bottom \<or> a = OccursSecType"
+    for a::"'b prot_atom"
+    by (cases a) auto
+  thus ?thesis by auto
+qed
+
+instance prot_atom::(finite) finite
+by intro_classes (simp add: prot_atom_UNIV)
+
+instantiation prot_atom::(enum) enum
+begin
+definition "enum_prot_atom == map Atom enum_class.enum@[Value, SetType, AttackType, Bottom, OccursSecType]"
+definition "enum_all_prot_atom P == list_all P (map Atom enum_class.enum@[Value, SetType, AttackType, Bottom, OccursSecType])"
+definition "enum_ex_prot_atom P == list_ex P (map Atom enum_class.enum@[Value, SetType, AttackType, Bottom, OccursSecType])"
+
+instance
+proof intro_classes
+  have *: "set (map Atom (enum_class.enum::'a list)) = range Atom"
+          "distinct (enum_class.enum::'a list)"
+    using UNIV_enum enum_distinct by auto
+
+  show "(UNIV::'a prot_atom set) = set enum_class.enum"
+    using *(1) by (simp add: prot_atom_UNIV enum_prot_atom_def)
+
+  have "set (map Atom enum_class.enum) \<inter> set [Value, SetType, AttackType, Bottom, OccursSecType] = {}" by auto
+  moreover have "inj_on Atom (set (enum_class.enum::'a list))" unfolding inj_on_def by auto
+  hence "distinct (map Atom (enum_class.enum::'a list))" by (metis *(2) distinct_map)
+  ultimately show "distinct (enum_class.enum::'a prot_atom list)" by (simp add: enum_prot_atom_def)
+
+  have "Ball UNIV P \<longleftrightarrow> Ball (range Atom) P \<and> Ball {Value, SetType, AttackType, Bottom, OccursSecType} P"
+    for P::"'a prot_atom \<Rightarrow> bool"
+    by (metis prot_atom_UNIV UNIV_I UnE) 
+  thus "enum_class.enum_all P = Ball (UNIV::'a prot_atom set) P" for P
+    using *(1) Ball_set[of "map Atom enum_class.enum" P]
+    by (auto simp add: enum_all_prot_atom_def)
+
+  have "Bex UNIV P \<longleftrightarrow> Bex (range Atom) P \<or> Bex {Value, SetType, AttackType, Bottom, OccursSecType} P"
+    for P::"'a prot_atom \<Rightarrow> bool"
+    by (metis prot_atom_UNIV UNIV_I UnE) 
+  thus "enum_class.enum_ex P = Bex (UNIV::'a prot_atom set) P" for P
+    using *(1) Bex_set[of "map Atom enum_class.enum" P]
+    by (auto simp add: enum_ex_prot_atom_def)
+qed
+end
+
+lemma wellformed_transaction_cases:
+  assumes "wellformed_transaction T"
+  shows 
+      "(l,x) \<in> set (transaction_receive T) \<Longrightarrow> \<exists>t. x = receive\<langle>t\<rangle>" (is "?A \<Longrightarrow> ?A'")
+      "(l,x) \<in> set (transaction_selects T) \<Longrightarrow>
+             (\<exists>t s. x = \<langle>t := s\<rangle>) \<or> (\<exists>t s. x = select\<langle>t,s\<rangle>)" (is "?B \<Longrightarrow> ?B'")
+      "(l,x) \<in> set (transaction_checks T) \<Longrightarrow>
+              (\<exists>t s. x = \<langle>t == s\<rangle>) \<or> (\<exists>t s. x = \<langle>t in s\<rangle>) \<or> (\<exists>X F G. x = \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>)" (is "?C \<Longrightarrow> ?C'")
+      "(l,x) \<in> set (transaction_updates T) \<Longrightarrow>
+              (\<exists>t s. x = insert\<langle>t,s\<rangle>) \<or> (\<exists>t s. x = delete\<langle>t,s\<rangle>)" (is "?D \<Longrightarrow> ?D'")
+      "(l,x) \<in> set (transaction_send T) \<Longrightarrow> \<exists>t. x = send\<langle>t\<rangle>" (is "?E \<Longrightarrow> ?E'")
+proof -
+  have a:
+      "list_all is_Receive (unlabel (transaction_receive T))"
+      "list_all is_Assignment (unlabel (transaction_selects T))"
+      "list_all is_Check (unlabel (transaction_checks T))"
+      "list_all is_Update (unlabel (transaction_updates T))"
+      "list_all is_Send (unlabel (transaction_send T))"
+    using assms unfolding wellformed_transaction_def by metis+
+
+  note b = Ball_set unlabel_in
+  note c = stateful_strand_step.collapse
+
+  show "?A \<Longrightarrow> ?A'" by (metis (mono_tags, lifting) a(1) b c(2))
+  show "?B \<Longrightarrow> ?B'" by (metis (mono_tags, lifting) a(2) b c(3,6))
+  show "?C \<Longrightarrow> ?C'" by (metis (mono_tags, lifting) a(3) b c(3,6,7))
+  show "?D \<Longrightarrow> ?D'" by (metis (mono_tags, lifting) a(4) b c(4,5))
+  show "?E \<Longrightarrow> ?E'" by (metis (mono_tags, lifting) a(5) b c(1))
+qed
+
+lemma wellformed_transaction_unlabel_cases:
+  assumes "wellformed_transaction T"
+  shows 
+      "x \<in> set (unlabel (transaction_receive T)) \<Longrightarrow> \<exists>t. x = receive\<langle>t\<rangle>" (is "?A \<Longrightarrow> ?A'")
+      "x \<in> set (unlabel (transaction_selects T)) \<Longrightarrow>
+             (\<exists>t s. x = \<langle>t := s\<rangle>) \<or> (\<exists>t s. x = select\<langle>t,s\<rangle>)" (is "?B \<Longrightarrow> ?B'")
+      "x \<in> set (unlabel (transaction_checks T)) \<Longrightarrow>
+              (\<exists>t s. x = \<langle>t == s\<rangle>) \<or> (\<exists>t s. x = \<langle>t in s\<rangle>) \<or> (\<exists>X F G. x = \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>)"
+        (is "?C \<Longrightarrow> ?C'")
+      "x \<in> set (unlabel (transaction_updates T)) \<Longrightarrow>
+              (\<exists>t s. x = insert\<langle>t,s\<rangle>) \<or> (\<exists>t s. x = delete\<langle>t,s\<rangle>)" (is "?D \<Longrightarrow> ?D'")
+      "x \<in> set (unlabel (transaction_send T)) \<Longrightarrow> \<exists>t. x = send\<langle>t\<rangle>" (is "?E \<Longrightarrow> ?E'")
+proof -
+  have a:
+      "list_all is_Receive (unlabel (transaction_receive T))"
+      "list_all is_Assignment (unlabel (transaction_selects T))"
+      "list_all is_Check (unlabel (transaction_checks T))"
+      "list_all is_Update (unlabel (transaction_updates T))"
+      "list_all is_Send (unlabel (transaction_send T))"
+    using assms unfolding wellformed_transaction_def by metis+
+
+  note b = Ball_set
+  note c = stateful_strand_step.collapse
+
+  show "?A \<Longrightarrow> ?A'" by (metis (mono_tags, lifting) a(1) b c(2))
+  show "?B \<Longrightarrow> ?B'" by (metis (mono_tags, lifting) a(2) b c(3,6))
+  show "?C \<Longrightarrow> ?C'" by (metis (mono_tags, lifting) a(3) b c(3,6,7))
+  show "?D \<Longrightarrow> ?D'" by (metis (mono_tags, lifting) a(4) b c(4,5))
+  show "?E \<Longrightarrow> ?E'" by (metis (mono_tags, lifting) a(5) b c(1))
+qed
+
+lemma transaction_strand_subsets[simp]:
+  "set (transaction_receive T) \<subseteq> set (transaction_strand T)"
+  "set (transaction_selects T) \<subseteq> set (transaction_strand T)"
+  "set (transaction_checks T) \<subseteq> set (transaction_strand T)"
+  "set (transaction_updates T) \<subseteq> set (transaction_strand T)"
+  "set (transaction_send T) \<subseteq> set (transaction_strand T)"
+  "set (unlabel (transaction_receive T)) \<subseteq> set (unlabel (transaction_strand T))"
+  "set (unlabel (transaction_selects T)) \<subseteq> set (unlabel (transaction_strand T))"
+  "set (unlabel (transaction_checks T)) \<subseteq> set (unlabel (transaction_strand T))"
+  "set (unlabel (transaction_updates T)) \<subseteq> set (unlabel (transaction_strand T))"
+  "set (unlabel (transaction_send T)) \<subseteq> set (unlabel (transaction_strand T))"
+unfolding transaction_strand_def unlabel_def by force+
+
+lemma transaction_strand_subst_subsets[simp]:
+  "set (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<subseteq> set (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+  "set (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<subseteq> set (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+  "set (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<subseteq> set (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+  "set (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<subseteq> set (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+  "set (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<subseteq> set (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+  "set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<subseteq> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  "set (unlabel (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<subseteq> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  "set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<subseteq> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  "set (unlabel (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<subseteq> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+  "set (unlabel (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<subseteq> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+unfolding transaction_strand_def unlabel_def subst_apply_labeled_stateful_strand_def by force+
+
+lemma transaction_dual_subst_unfold:
+  "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) =
+    unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@
+    unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@
+    unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@
+    unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@
+    unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+by (simp add: transaction_strand_def unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append)
+
+lemma trms_transaction_unfold:
+  "trms_transaction T =
+      trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<union>
+      trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union>
+      trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
+by (metis trms\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def)
+
+lemma trms_transaction_subst_unfold:
+  "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) =
+      trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
+      trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
+      trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+by (metis trms\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def subst_lsst_append)
+
+lemma vars_transaction_unfold:
+  "vars_transaction T =
+      vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<union>
+      vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union>
+      vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
+by (metis vars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def)
+
+lemma vars_transaction_subst_unfold:
+  "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) =
+      vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
+      vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
+      vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+by (metis vars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def subst_lsst_append)
+
+lemma fv_transaction_unfold:
+  "fv_transaction T =
+      fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<union>
+      fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union>
+      fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
+by (metis fv\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def)
+
+lemma fv_transaction_subst_unfold:
+  "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) =
+      fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
+      fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
+      fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+by (metis fv\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def subst_lsst_append)
+
+lemma fv_wellformed_transaction_unfold:
+  assumes "wellformed_transaction T"
+  shows "fv_transaction T =
+    fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<union> set (transaction_fresh T)"
+proof -
+  let ?A = "set (transaction_fresh T)"
+  let ?B = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T)"
+  let ?C = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
+  let ?D = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
+  let ?E = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+  let ?F = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"
+
+  have "?A \<subseteq> ?B \<union> ?C" "?A \<inter> ?D = {}" "?A \<inter> ?E = {}" "?F \<subseteq> ?D \<union> ?E" "?B \<union> ?C - ?A \<subseteq> ?D \<union> ?E"
+    using assms unfolding wellformed_transaction_def by fast+
+  thus ?thesis using fv_transaction_unfold by blast
+qed
+
+lemma bvars_transaction_unfold:
+  "bvars_transaction T =
+      bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<union>
+      bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union>
+      bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
+by (metis bvars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def)
+
+lemma bvars_transaction_subst_unfold:
+  "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) =
+      bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
+      bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
+      bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+by (metis bvars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def subst_lsst_append)
+
+lemma bvars_wellformed_transaction_unfold:
+  assumes "wellformed_transaction T"
+  shows "bvars_transaction T = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?A)
+    and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}" (is ?B)
+    and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {}" (is ?C)
+    and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) = {}" (is ?D)
+    and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) = {}" (is ?E)
+proof -
+  have 0: "list_all is_Receive (unlabel (transaction_receive T))"
+          "list_all is_Assignment (unlabel (transaction_selects T))"
+          "list_all is_Update (unlabel (transaction_updates T))"
+          "list_all is_Send (unlabel (transaction_send T))"
+    using assms unfolding wellformed_transaction_def by metis+
+
+  have "filter is_NegChecks (unlabel (transaction_receive T)) = []"
+       "filter is_NegChecks (unlabel (transaction_selects T)) = []"
+       "filter is_NegChecks (unlabel (transaction_updates T)) = []"
+       "filter is_NegChecks (unlabel (transaction_send T)) = []"
+    using list_all_filter_nil[OF 0(1), of is_NegChecks]
+          list_all_filter_nil[OF 0(2), of is_NegChecks]
+          list_all_filter_nil[OF 0(3), of is_NegChecks]
+          list_all_filter_nil[OF 0(4), of is_NegChecks]
+          stateful_strand_step.distinct_disc(11,21,29,35,39,41)
+    by blast+
+  thus ?A ?B ?C ?D ?E
+    using bvars_transaction_unfold[of T]
+          bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks[of "unlabel (transaction_receive T)"]
+          bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks[of "unlabel (transaction_selects T)"]
+          bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks[of "unlabel (transaction_updates T)"]
+          bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks[of "unlabel (transaction_send T)"]
+    by (metis bvars\<^sub>s\<^sub>s\<^sub>t_def UnionE emptyE list.set(1) list.simps(8) subsetI subset_Un_eq sup_commute)+
+qed
+
+lemma transaction_strand_memberD[dest]:
+  assumes "x \<in> set (transaction_strand T)"
+  shows "x \<in> set (transaction_receive T) \<or> x \<in> set (transaction_selects T) \<or>
+         x \<in> set (transaction_checks T) \<or> x \<in> set (transaction_updates T) \<or>
+         x \<in> set (transaction_send T)"
+using assms by (simp add: transaction_strand_def)
+
+lemma transaction_strand_unlabel_memberD[dest]:
+  assumes "x \<in> set (unlabel (transaction_strand T))"
+  shows "x \<in> set (unlabel (transaction_receive T)) \<or> x \<in> set (unlabel (transaction_selects T)) \<or>
+         x \<in> set (unlabel (transaction_checks T)) \<or> x \<in> set (unlabel (transaction_updates T)) \<or>
+         x \<in> set (unlabel (transaction_send T))"
+using assms by (simp add: unlabel_def transaction_strand_def)
+
+lemma wellformed_transaction_strand_memberD[dest]:
+  assumes "wellformed_transaction T" and "(l,x) \<in> set (transaction_strand T)"
+  shows
+    "x = receive\<langle>t\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_receive T)" (is "?A \<Longrightarrow> ?A'")
+    "x = select\<langle>t,s\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_selects T)" (is "?B \<Longrightarrow> ?B'")
+    "x = \<langle>t == s\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_checks T)" (is "?C \<Longrightarrow> ?C'")
+    "x = \<langle>t in s\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_checks T)" (is "?D \<Longrightarrow> ?D'")
+    "x = \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>  \<Longrightarrow> (l,x) \<in> set (transaction_checks T)" (is "?E \<Longrightarrow> ?E'")
+    "x = insert\<langle>t,s\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_updates T)" (is "?F \<Longrightarrow> ?F'")
+    "x = delete\<langle>t,s\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_updates T)" (is "?G \<Longrightarrow> ?G'")
+    "x = send\<langle>t\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_send T)" (is "?H \<Longrightarrow> ?H'")
+proof -
+  have "(l,x) \<in> set (transaction_receive T) \<or> (l,x) \<in> set (transaction_selects T) \<or>
+        (l,x) \<in> set (transaction_checks T) \<or> (l,x) \<in> set (transaction_updates T) \<or>
+        (l,x) \<in> set (transaction_send T)"
+    using assms(2) by auto
+  thus "?A \<Longrightarrow> ?A'" "?B \<Longrightarrow> ?B'" "?C \<Longrightarrow> ?C'" "?D \<Longrightarrow> ?D'"
+       "?E \<Longrightarrow> ?E'" "?F \<Longrightarrow> ?F'" "?G \<Longrightarrow> ?G'" "?H \<Longrightarrow> ?H'"
+    using wellformed_transaction_cases[OF assms(1)] by fast+
+qed
+
+lemma wellformed_transaction_strand_unlabel_memberD[dest]:
+  assumes "wellformed_transaction T" and "x \<in> set (unlabel (transaction_strand T))"
+  shows
+    "x = receive\<langle>t\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_receive T))" (is "?A \<Longrightarrow> ?A'")
+    "x = select\<langle>t,s\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_selects T))" (is "?B \<Longrightarrow> ?B'")
+    "x = \<langle>t == s\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_checks T))" (is "?C \<Longrightarrow> ?C'")
+    "x = \<langle>t in s\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_checks T))" (is "?D \<Longrightarrow> ?D'")
+    "x = \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>  \<Longrightarrow> x \<in> set (unlabel (transaction_checks T))" (is "?E \<Longrightarrow> ?E'")
+    "x = insert\<langle>t,s\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_updates T))" (is "?F \<Longrightarrow> ?F'")
+    "x = delete\<langle>t,s\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_updates T))" (is "?G \<Longrightarrow> ?G'")
+    "x = send\<langle>t\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_send T))" (is "?H \<Longrightarrow> ?H'")
+proof -
+  have "x \<in> set (unlabel (transaction_receive T)) \<or> x \<in> set (unlabel (transaction_selects T)) \<or>
+        x \<in> set (unlabel (transaction_checks T)) \<or> x \<in> set (unlabel (transaction_updates T)) \<or>
+        x \<in> set (unlabel (transaction_send T))"
+    using assms(2) by auto
+  thus "?A \<Longrightarrow> ?A'" "?B \<Longrightarrow> ?B'" "?C \<Longrightarrow> ?C'" "?D \<Longrightarrow> ?D'"
+       "?E \<Longrightarrow> ?E'" "?F \<Longrightarrow> ?F'" "?G \<Longrightarrow> ?G'" "?H \<Longrightarrow> ?H'"
+    using wellformed_transaction_unlabel_cases[OF assms(1)] by fast+
+qed
+
+lemma wellformed_transaction_send_receive_trm_cases:
+  assumes T: "wellformed_transaction T"
+  shows "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<Longrightarrow> receive\<langle>t\<rangle> \<in> set (unlabel (transaction_receive T))"
+    and "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<Longrightarrow> send\<langle>t\<rangle> \<in> set (unlabel (transaction_send T))"
+using wellformed_transaction_unlabel_cases(1,5)[OF T]
+      trms\<^sub>s\<^sub>s\<^sub>t_in[of t "unlabel (transaction_receive T)"]
+      trms\<^sub>s\<^sub>s\<^sub>t_in[of t "unlabel (transaction_send T)"]
+by fastforce+
+
+lemma wellformed_transaction_send_receive_subst_trm_cases:
+  assumes T: "wellformed_transaction T"
+  shows "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<Longrightarrow> receive\<langle>t\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+    and "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<Longrightarrow> send\<langle>t\<rangle> \<in> set (unlabel (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+proof -
+  assume "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
+  then obtain s where s: "s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" "t = s \<cdot> \<theta>"
+    by blast
+  hence "receive\<langle>s\<rangle> \<in> set (unlabel (transaction_receive T))"
+    using wellformed_transaction_send_receive_trm_cases(1)[OF T] by simp
+  thus "receive\<langle>t\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+    by (metis s(2) unlabel_subst[of _ \<theta>] stateful_strand_step_subst_inI(2))
+next
+  assume "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
+  then obtain s where s: "s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "t = s \<cdot> \<theta>"
+    by blast
+  hence "send\<langle>s\<rangle> \<in> set (unlabel (transaction_send T))"
+    using wellformed_transaction_send_receive_trm_cases(2)[OF T] by simp
+  thus "send\<langle>t\<rangle> \<in> set (unlabel (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
+    by (metis s(2) unlabel_subst[of _ \<theta>] stateful_strand_step_subst_inI(1))
+qed
+
+lemma wellformed_transaction_send_receive_fv_subset:
+  assumes T: "wellformed_transaction T"
+  shows "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<Longrightarrow> fv t \<subseteq> fv_transaction T" (is "?A \<Longrightarrow> ?A'")
+    and "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<Longrightarrow> fv t \<subseteq> fv_transaction T" (is "?B \<Longrightarrow> ?B'")
+proof -
+  have "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<Longrightarrow> receive\<langle>t\<rangle> \<in> set (unlabel (transaction_strand T))"
+       "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<Longrightarrow> send\<langle>t\<rangle> \<in> set (unlabel (transaction_strand T))"
+    using wellformed_transaction_send_receive_trm_cases[OF T, of t]
+    unfolding transaction_strand_def by force+
+  thus "?A \<Longrightarrow> ?A'" "?B \<Longrightarrow> ?B'" by (induct "transaction_strand T") auto
+qed
+
+lemma dual_wellformed_transaction_ident_cases[dest]:
+  "list_all is_Assignment (unlabel S) \<Longrightarrow> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S = S"
+  "list_all is_Check (unlabel S) \<Longrightarrow> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S = S"
+  "list_all is_Update (unlabel S) \<Longrightarrow> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S = S"
+proof (induction S)
+  case (Cons s S)
+  obtain l x where s: "s = (l,x)" by moura
+  { case 1 thus ?case using Cons s unfolding unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by (cases x) auto }
+  { case 2 thus ?case using Cons s unfolding unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by (cases x) auto }
+  { case 3 thus ?case using Cons s unfolding unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by (cases x) auto }
+qed simp_all
+
+lemma wellformed_transaction_wf\<^sub>s\<^sub>s\<^sub>t:
+  fixes T::"('a, 'b, 'c, 'd) prot_transaction"
+  assumes T: "wellformed_transaction T"
+  shows "wf'\<^sub>s\<^sub>s\<^sub>t (set (transaction_fresh T)) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))" (is ?A)
+    and "fv_transaction T \<inter> bvars_transaction T = {}" (is ?B)
+    and "set (transaction_fresh T) \<inter> bvars_transaction T = {}" (is ?C)
+proof -
+  define T1 where "T1 \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T))"
+  define T2 where "T2 \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T))"
+  define T3 where "T3 \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T))"
+  define T4 where "T4 \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T))"
+  define T5 where "T5 \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))"
+
+  define X where "X \<equiv> set (transaction_fresh T)"
+  define Y where "Y \<equiv> X \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1"
+  define Z where "Z \<equiv> Y \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2"
+
+  define f where "f \<equiv> \<lambda>S::(('a,'b,'c) prot_fun, ('a,'b,'c) prot_var) stateful_strand.
+          \<Union>((\<lambda>x. case x of
+            Receive t \<Rightarrow> fv t
+          | Equality Assign _ t' \<Rightarrow> fv t'
+          | Insert t t' \<Rightarrow> fv t \<union> fv t'
+          | _ \<Rightarrow> {}) ` set S)"
+
+  note defs1 = T1_def T2_def T3_def T4_def T5_def
+  note defs2 = X_def Y_def Z_def
+  note defs3 = f_def
+
+  have 0: "wf'\<^sub>s\<^sub>s\<^sub>t V (S @ S')"
+    when "wf'\<^sub>s\<^sub>s\<^sub>t V S" "f S' \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S \<union> V" for V S S'
+    by (metis that wf\<^sub>s\<^sub>s\<^sub>t_append_suffix' f_def)
+
+  have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) = T1@T2@T3@T4@T5"
+    using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append unlabel_append unfolding transaction_strand_def defs1 by simp
+
+  have 2:
+      "\<forall>x \<in> set T1. is_Send x" "\<forall>x \<in> set T2. is_Assignment x" "\<forall>x \<in> set T3. is_Check x"
+      "\<forall>x \<in> set T4. is_Update x" "\<forall>x \<in> set T5. is_Receive x"
+      "fv\<^sub>s\<^sub>s\<^sub>t T3 \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t T1 \<union> fv\<^sub>s\<^sub>s\<^sub>t T2" "fv\<^sub>s\<^sub>s\<^sub>t T4 \<union> fv\<^sub>s\<^sub>s\<^sub>t T5 \<subseteq> X \<union> fv\<^sub>s\<^sub>s\<^sub>t T1 \<union> fv\<^sub>s\<^sub>s\<^sub>t T2"
+      "X \<inter> fv\<^sub>s\<^sub>s\<^sub>t T1 = {}" "X \<inter> fv\<^sub>s\<^sub>s\<^sub>t T2 = {}"
+      "\<forall>x \<in> set T2. is_Equality x \<longrightarrow> fv (the_rhs x) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t T1"
+    using T unfolding defs1 defs2 wellformed_transaction_def
+    by (auto simp add: Ball_set dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq simp del: fv\<^sub>s\<^sub>s\<^sub>t_def)
+
+  have 3: "wf'\<^sub>s\<^sub>s\<^sub>t X T1" using 2(1)
+  proof (induction T1 arbitrary: X)
+    case (Cons s T)
+    obtain t where "s = send\<langle>t\<rangle>" using Cons.prems by (cases s) moura+
+    thus ?case using Cons by auto
+  qed simp
+
+  have 4: "f T1 = {}" "fv\<^sub>s\<^sub>s\<^sub>t T1 = wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1" using 2(1)
+  proof (induction T1)
+    case (Cons s T)
+    { case 1 thus ?case using Cons unfolding defs3 by (cases s) auto }
+    { case 2 thus ?case using Cons unfolding defs3 wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def by (cases s) auto }
+  qed (simp_all add: defs3 wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def)
+
+  have 5: "f T2 \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1" "fv\<^sub>s\<^sub>s\<^sub>t T2 = f T2 \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2" using 2(2,10)
+  proof (induction T2)
+    case (Cons s T)
+    { case 1 thus ?case using Cons
+      proof (cases s)
+        case (Equality ac t t') thus ?thesis using 1 Cons 4(2) unfolding defs3 by (cases ac) auto
+      qed (simp_all add: defs3)
+    }
+    { case 2 thus ?case using Cons
+      proof (cases s)
+        case (Equality ac t t')
+        hence "ac = Assign" "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s = fv t' \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" "f (s#T) = fv t' \<union> f T"
+          using 2 unfolding defs3 by auto
+        moreover have "fv\<^sub>s\<^sub>s\<^sub>t T = f T \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T" using Cons.IH(2) 2 by auto
+        ultimately show ?thesis unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def by auto
+      next
+        case (InSet ac t t')
+        hence "ac = Assign" "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s = wfvarsoccs\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" "f (s#T) = f T"
+          using 2 unfolding defs3 by auto
+        moreover have "fv\<^sub>s\<^sub>s\<^sub>t T = f T \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T" using Cons.IH(2) 2 by auto
+        ultimately show ?thesis unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def by auto
+      qed (simp_all add: defs3)
+    }
+  qed (simp_all add: defs3 wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def)
+
+  have "f T \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t T" for T
+  proof
+    fix x show "x \<in> f T \<Longrightarrow> x \<in> fv\<^sub>s\<^sub>s\<^sub>t T"
+    proof (induction T)
+      case (Cons s T) thus ?case
+      proof (cases "x \<in> f T")
+        case False thus ?thesis
+          using Cons.prems unfolding defs3 fv\<^sub>s\<^sub>s\<^sub>t_def
+          by (auto split: stateful_strand_step.splits poscheckvariant.splits)
+      qed auto
+    qed (simp add: defs3 fv\<^sub>s\<^sub>s\<^sub>t_def)
+  qed
+  hence 6:
+      "f T3 \<subseteq> X \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1 \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2"
+      "f T4 \<subseteq> X \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1 \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2"
+      "f T5 \<subseteq> X \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1 \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2"
+    using 2(6,7) 4 5 by blast+
+
+  have 7:
+      "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T3 = {}"
+      "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T4 = {}"
+      "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T5 = {}"
+    using 2(3,4,5) unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def
+    by (auto split: stateful_strand_step.splits)
+
+  have 8:
+      "f T2 \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1 \<union> X"
+      "f T3 \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (T1@T2) \<union> X"
+      "f T4 \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t ((T1@T2)@T3) \<union> X"
+      "f T5 \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (((T1@T2)@T3)@T4) \<union> X"
+    using 4(1) 5(1) 6 7 wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_append[of T1 T2]
+          wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_append[of "T1@T2" T3]
+          wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_append[of "(T1@T2)@T3" T4]
+    by blast+
+  
+  have "wf'\<^sub>s\<^sub>s\<^sub>t X (T1@T2@T3@T4@T5)"
+    using 0[OF 0[OF 0[OF 0[OF 3 8(1)] 8(2)] 8(3)] 8(4)]
+    unfolding Y_def Z_def by simp
+  thus ?A using 1 unfolding defs1 defs2 by simp
+
+  have "set (transaction_fresh T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
+       "fv_transaction T \<inter> bvars_transaction T = {}"
+    using T unfolding wellformed_transaction_def by fast+
+  thus ?B ?C using fv_transaction_unfold[of T] bvars_transaction_unfold[of T] by blast+
+qed
+
+lemma dual_wellformed_transaction_ident_cases'[dest]:
+  assumes "wellformed_transaction T"
+  shows "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = transaction_selects T"
+        "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) = transaction_checks T"
+        "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) = transaction_updates T"
+using assms unfolding wellformed_transaction_def by auto
+
+lemma dual_transaction_strand:
+  assumes "wellformed_transaction T"
+  shows "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) =
+         dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)@transaction_selects T@transaction_checks T@
+         transaction_updates T@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
+using dual_wellformed_transaction_ident_cases'[OF assms] dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append
+unfolding transaction_strand_def by metis
+
+lemma dual_unlabel_transaction_strand:
+  assumes "wellformed_transaction T"
+  shows "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) =
+         (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)))@(unlabel (transaction_selects T))@
+         (unlabel (transaction_checks T))@(unlabel (transaction_updates T))@
+         (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)))"
+using dual_transaction_strand[OF assms] by (simp add: unlabel_def)
+
+lemma dual_transaction_strand_subst:
+  assumes "wellformed_transaction T"
+  shows "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
+         (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)@transaction_selects T@transaction_checks T@
+          transaction_updates T@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>"
+proof -
+  have "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>"
+    using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst by metis
+  thus ?thesis using dual_transaction_strand[OF assms] by argo
+qed
+
+lemma dual_transaction_ik_is_transaction_send:
+  assumes "wellformed_transaction T"
+  shows "ik\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))) = trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_send T))"
+    (is "?A = ?B")
+proof -
+  { fix t assume "t \<in> ?A"
+    hence "receive\<langle>t\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))" by (simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
+    hence "send\<langle>t\<rangle> \<in> set (unlabel (transaction_strand T))"
+      using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(1) by metis
+    hence "t \<in> ?B" using wellformed_transaction_strand_unlabel_memberD(8)[OF assms] by force
+  } moreover {
+    fix t assume "t \<in> ?B"
+    hence "send\<langle>t\<rangle> \<in> set (unlabel (transaction_send T))"
+      using wellformed_transaction_unlabel_cases(5)[OF assms] by fastforce
+    hence "receive\<langle>t\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)))"
+      using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(1) by metis
+    hence "receive\<langle>t\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))"
+      using dual_unlabel_transaction_strand[OF assms] by simp 
+    hence "t \<in> ?A" by (simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
+  } ultimately show "?A = ?B" by auto
+qed
+
+lemma dual_transaction_ik_is_transaction_send':
+  fixes \<delta>::"('a,'b,'c) prot_subst"
+  assumes "wellformed_transaction T"
+  shows "ik\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)))  =
+         trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>" (is "?A = ?B")
+using dual_transaction_ik_is_transaction_send[OF assms]
+      subst_lsst_unlabel[of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" \<delta>]
+      ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))" \<delta>]
+      dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" \<delta>]
+by auto
+
+lemma db\<^sub>s\<^sub>s\<^sub>t_transaction_prefix_eq:
+  assumes T: "wellformed_transaction T"
+    and S: "prefix S (transaction_receive T@transaction_selects T@transaction_checks T)"
+  shows "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>))"
+proof -
+  let ?T1 = "transaction_receive T"
+  let ?T2 = "transaction_selects T"
+  let ?T3 = "transaction_checks T"
+
+  have *: "prefix (unlabel S) (unlabel (?T1@?T2@?T3))" using S prefix_proj(1) by blast
+
+  have "list_all is_Receive (unlabel ?T1)"
+       "list_all is_Assignment (unlabel ?T2)"
+       "list_all is_Check (unlabel ?T3)"
+    using T by (simp_all add: wellformed_transaction_def)
+  hence "\<forall>b \<in> set (unlabel ?T1). \<not>is_Insert b \<and> \<not>is_Delete b"
+        "\<forall>b \<in> set (unlabel ?T2). \<not>is_Insert b \<and> \<not>is_Delete b"
+        "\<forall>b \<in> set (unlabel ?T3). \<not>is_Insert b \<and> \<not>is_Delete b"
+    by (metis (mono_tags, lifting) Ball_set stateful_strand_step.distinct_disc(16,18),
+        metis (mono_tags, lifting) Ball_set stateful_strand_step.distinct_disc(24,26,33,37),
+        metis (mono_tags, lifting) Ball_set stateful_strand_step.distinct_disc(24,26,33,35,37,39))
+  hence "\<forall>b \<in> set (unlabel (?T1@?T2@?T3)). \<not>is_Insert b \<and> \<not>is_Delete b"
+    by (auto simp add: unlabel_def)
+  hence "\<forall>b \<in> set (unlabel S). \<not>is_Insert b \<and> \<not>is_Delete b"
+    using * unfolding prefix_def by fastforce
+  hence "\<forall>b \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>). \<not>is_Insert b \<and> \<not>is_Delete b"
+  proof (induction S)
+    case (Cons a S)
+    then obtain l b where "a = (l,b)" by (metis surj_pair)
+    thus ?case
+      using Cons unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def unlabel_def subst_apply_stateful_strand_def
+      by (cases b) auto
+  qed simp
+  hence **: "\<forall>b \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>))). \<not>is_Insert b \<and> \<not>is_Delete b"
+    by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_unlabel)
+
+  show ?thesis 
+    using db\<^sub>s\<^sub>s\<^sub>t_no_upd_append[OF **] unlabel_append
+    unfolding db\<^sub>s\<^sub>s\<^sub>t_def by metis
+qed
+
+lemma db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_ex:
+   assumes "d \<in> set (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<I> D)"
+    "\<forall>t u. insert\<langle>t,u\<rangle> \<in> set (unlabel A) \<longrightarrow> (\<exists>s. u = Fun (Set s) [])"
+    "\<forall>t u. delete\<langle>t,u\<rangle> \<in> set (unlabel A) \<longrightarrow> (\<exists>s. u = Fun (Set s) [])"
+    "\<forall>d \<in> set D. \<exists>s. snd d = Fun (Set s) []"
+  shows "\<exists>s. snd d = Fun (Set s) []"
+  using assms
+proof (induction A arbitrary: D)
+  case (Cons a A)
+  obtain l b where a: "a = (l,b)" by (metis surj_pair)
+
+  have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = receive\<langle>t \<cdot> \<theta>\<rangle>#unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+    when "b = send\<langle>t\<rangle>" for t
+    by (simp add: a that subst_lsst_unlabel_cons)
+
+  have 2: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = send\<langle>t \<cdot> \<theta>\<rangle>#unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+    when "b = receive\<langle>t\<rangle>" for t
+    by (simp add: a that subst_lsst_unlabel_cons)
+
+  have 3: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)#unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
+    when "\<nexists>t. b = send\<langle>t\<rangle> \<or> b = receive\<langle>t\<rangle>"
+    using a that dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_Cons subst_lsst_unlabel_cons[of l b]
+    by (cases b) auto
+
+  show ?case using 1 2 3 a Cons by (cases b) fastforce+
+qed simp
+
+lemma is_Fun_SetE[elim]:
+  assumes t: "is_Fun_Set t"
+  obtains s where "t = Fun (Set s) []"
+proof (cases t)
+  case (Fun f T)
+  then obtain s where "f = Set s" using t unfolding is_Fun_Set_def by (cases f) moura+
+  moreover have "T = []" using Fun t unfolding is_Fun_Set_def by (cases T) auto
+  ultimately show ?thesis using Fun that by fast
+qed (use t is_Fun_Set_def in fast)
+
+lemma Fun_Set_InSet_iff:
+  "(u = \<langle>a: Var x \<in> Fun (Set s) []\<rangle>) \<longleftrightarrow>
+   (is_InSet u \<and> is_Var (the_elem_term u) \<and> is_Fun_Set (the_set_term u) \<and>
+    the_Set (the_Fun (the_set_term u)) = s \<and> the_Var (the_elem_term u) = x \<and> the_check u = a)"
+  (is "?A \<longleftrightarrow> ?B")
+proof
+  show "?A \<Longrightarrow> ?B" unfolding is_Fun_Set_def by auto
+
+  assume B: ?B
+  thus ?A
+  proof (cases u)
+    case (InSet b t t')
+    hence "b = a" "t = Var x" "t' = Fun (Set s) []"
+      using B by (simp, fastforce, fastforce)
+    thus ?thesis using InSet by fast
+  qed auto
+qed
+
+lemma Fun_Set_NotInSet_iff:
+  "(u = \<langle>Var x not in Fun (Set s) []\<rangle>) \<longleftrightarrow>
+   (is_NegChecks u \<and> bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p u = [] \<and> the_eqs u = [] \<and> length (the_ins u) = 1 \<and>
+    is_Var (fst (hd (the_ins u))) \<and> is_Fun_Set (snd (hd (the_ins u)))) \<and>
+    the_Set (the_Fun (snd (hd (the_ins u)))) = s \<and> the_Var (fst (hd (the_ins u))) = x"
+  (is "?A \<longleftrightarrow> ?B")
+proof
+  show "?A \<Longrightarrow> ?B" unfolding is_Fun_Set_def by auto
+
+  assume B: ?B
+  show ?A
+  proof (cases u)
+    case (NegChecks X F F')
+    hence "X = []" "F = []"
+      using B by auto
+    moreover have "fst (hd (the_ins u)) = Var x" "snd (hd (the_ins u)) = Fun (Set s) []"
+      using B is_Fun_SetE[of "snd (hd (the_ins u))"]
+      by (force, fastforce)
+    hence "F' = [(Var x, Fun (Set s) [])]"
+      using NegChecks B by (cases "the_ins u") auto
+    ultimately show ?thesis using NegChecks by fast
+  qed (use B in auto)
+qed
+
+lemma is_Fun_Set_exi: "is_Fun_Set x \<longleftrightarrow> (\<exists>s. x = Fun (Set s) [])"
+by (metis prot_fun.collapse(2) term.collapse(2) prot_fun.disc(15) term.disc(2)
+          term.sel(2,4) is_Fun_Set_def un_Fun1_def) 
+
+lemma is_Fun_Set_subst:
+  assumes "is_Fun_Set S'"
+  shows "is_Fun_Set (S' \<cdot> \<sigma>)"
+using assms by (fastforce simp add: is_Fun_Set_def)
+
+lemma is_Update_in_transaction_updates:
+  assumes tu: "is_Update t"
+  assumes t: "t \<in> set (unlabel (transaction_strand TT))"
+  assumes vt: "wellformed_transaction TT"
+  shows "t \<in> set (unlabel (transaction_updates TT))"
+using t tu vt unfolding transaction_strand_def wellformed_transaction_def list_all_iff
+by (auto simp add: unlabel_append)
+
+lemma transaction_fresh_vars_subset:
+  assumes "wellformed_transaction T"
+  shows "set (transaction_fresh T) \<subseteq> fv_transaction T"
+using assms fv_transaction_unfold[of T]
+unfolding wellformed_transaction_def
+by auto
+
+lemma transaction_fresh_vars_notin:
+  assumes T: "wellformed_transaction T"
+    and x: "x \<in> set (transaction_fresh T)"
+  shows "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" (is ?A)
+    and "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" (is ?B)
+    and "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?C)
+    and "x \<notin> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" (is ?D)
+    and "x \<notin> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" (is ?E)
+    and "x \<notin> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?F)
+    and "x \<notin> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" (is ?G)
+    and "x \<notin> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" (is ?H)
+    and "x \<notin> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?I)
+proof -
+  have 0:
+      "set (transaction_fresh T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
+      "set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}"
+      "set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {}"
+      "fv_transaction T \<inter> bvars_transaction T = {}"
+      "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+    using T unfolding wellformed_transaction_def
+    by fast+
+  
+  have 1: "set (transaction_fresh T) \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) = {}"
+    using 0(1,4) fv_transaction_unfold[of T] bvars_transaction_unfold[of T] by blast
+
+  have 2:
+      "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
+      "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
+      "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}"
+      "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {}"
+    using bvars_wellformed_transaction_unfold[OF T] bvars_transaction_unfold[of T]
+          vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_receive T)"]
+          vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_selects T)"]
+    by blast+
+  
+  show ?A ?B ?C ?D ?E ?G ?H ?I using 0 1 2 x by fast+
+
+  show ?F using 0(2,3,5) 1 x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_checks T)"] by fast
+qed
+
+
+lemma transaction_proj_member:
+  assumes "T \<in> set P"
+  shows "transaction_proj n T \<in> set (map (transaction_proj n) P)"
+using assms by simp
+
+lemma transaction_strand_proj:
+  "transaction_strand (transaction_proj n T) = proj n (transaction_strand T)"
+proof -
+  obtain A B C D E F where "T = Transaction A B C D E F" by (cases T) simp
+  thus ?thesis
+    using transaction_proj.simps[of n A B C D E F]
+    unfolding transaction_strand_def proj_def Let_def by auto
+qed
+
+lemma transaction_proj_fresh_eq:
+  "transaction_fresh (transaction_proj n T) = transaction_fresh T"
+proof -
+  obtain A B C D E F where "T = Transaction A B C D E F" by (cases T) simp
+  thus ?thesis
+    using transaction_proj.simps[of n A B C D E F]
+    unfolding transaction_fresh_def proj_def Let_def by auto
+qed
+
+lemma transaction_proj_trms_subset:
+  "trms_transaction (transaction_proj n T) \<subseteq> trms_transaction T"
+proof -
+  obtain A B C D E F where "T = Transaction A B C D E F" by (cases T) simp
+  thus ?thesis
+    using transaction_proj.simps[of n A B C D E F] trms\<^sub>s\<^sub>s\<^sub>t_proj_subset(1)[of n]
+    unfolding transaction_fresh_def Let_def transaction_strand_def by auto
+qed
+
+lemma transaction_proj_vars_subset:
+  "vars_transaction (transaction_proj n T) \<subseteq> vars_transaction T"
+proof -
+  obtain A B C D E F where "T = Transaction A B C D E F" by (cases T) simp
+  thus ?thesis
+    using transaction_proj.simps[of n A B C D E F]
+          sst_vars_proj_subset(3)[of n "transaction_strand T"]
+    unfolding transaction_fresh_def Let_def transaction_strand_def by simp
+qed
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/document/root.bib b/Automated_Stateful_Protocol_Verification/document/root.bib
new file mode 100644
index 0000000..18900b6
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/document/root.bib
@@ -0,0 +1,72 @@
+
+@InProceedings{	  brucker.ea:integrating:2009,
+  author	= {Achim D. Brucker and Sebastian M{\"{o}}dersheim},
+  editor	= {Pierpaolo Degano and Joshua D. Guttman},
+  title		= {{Integrating Automated and Interactive Protocol Verification}},
+  booktitle	= {Formal Aspects in Security and Trust, 6th International Workshop, {FAST} 2009, Eindhoven, The
+		  Netherlands, November 5-6, 2009, Revised Selected Papers},
+  series	= {Lecture Notes in Computer Science},
+  volume	= 5983,
+  pages		= {248--262},
+  publisher	= {Springer},
+  year		= 2009,
+  doi		= {10.1007/978-3-642-12459-4_18}
+}
+
+
+@InProceedings{	  hess.ea:formalizing:2017,
+  author	= {Andreas V. Hess and Sebastian M{\"{o}}dersheim},
+  title		= {{Formalizing and Proving a Typing Result for Security Protocols in Isabelle/HOL}},
+  booktitle	= {30th {IEEE} Computer Security Foundations Symposium, {CSF} 2017, Santa Barbara, CA, USA, August
+		  21-25, 2017},
+  pages		= {451--463},
+  publisher	= {{IEEE} Computer Society},
+  year		= 2017,
+  doi		= {10.1109/CSF.2017.27}
+}
+
+@InProceedings{	  hess.ea:typing:2018,
+  author	= {Andreas V. Hess and Sebastian M{\"{o}}dersheim},
+  title		= {{A Typing Result for Stateful Protocols}},
+  booktitle	= {31st {IEEE} Computer Security Foundations Symposium, {CSF} 2018, Oxford, United Kingdom, July 9-12,
+		  2018},
+  pages		= {374--388},
+  publisher	= {{IEEE} Computer Society},
+  year		= 2018,
+  doi		= {10.1109/CSF.2018.00034}
+}
+
+@InProceedings{	  hess.ea:stateful:2018,
+  author	= {Andreas V. Hess and Sebastian M{\"{o}}dersheim and Achim D. Brucker},
+  editor	= {Javier L{\'{o}}pez and Jianying Zhou and Miguel Soriano},
+  title		= {{Stateful Protocol Composition}},
+  booktitle	= {Computer Security - 23rd European Symposium on Research in Computer Security, {ESORICS} 2018,
+		  Barcelona, Spain, September 3-7, 2018, Proceedings, Part {I}},
+  series	= {Lecture Notes in Computer Science},
+  volume	= 11098,
+  pages		= {427--446},
+  publisher	= {Springer},
+  year		= 2018,
+  doi		= {10.1007/978-3-319-99073-6_21}
+}
+
+@PhDThesis{	  hess:typing:2018,
+  author    = {Andreas Viktor Hess},
+  title     = {Typing and Compositionality for Stateful Security Protocols},
+  year      = {2019},
+  url       = {https://orbit.dtu.dk/en/publications/typing-and-compositionality-for-stateful-security-protocols},
+  language  = {English},
+  series    = {TU Compute PHD-2018},
+  publisher = {DTU Compute}
+}
+
+@Article{	  hess.ea:stateful:2020,
+  author	= {Andreas V. Hess and Sebastian~M{\"o}dersheim and Achim~D.~Brucker},
+  title		= {{Stateful Protocol Composition and Typing}},
+  journal	= {Archive of Formal Proofs},
+  month		= apr,
+  year		= 2020,
+  note		= {\url{http://isa-afp.org/entries/Stateful_Protocol_Composition_and_Typing.html}, Formal proof
+		  development},
+  issn		= {2150-914x}
+}
diff --git a/Automated_Stateful_Protocol_Verification/document/root.tex b/Automated_Stateful_Protocol_Verification/document/root.tex
new file mode 100644
index 0000000..2a851b7
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/document/root.tex
@@ -0,0 +1,166 @@
+\documentclass[10pt,DIV16,a4paper,abstract=true,twoside=semi,openright]
+{scrreprt}
+\usepackage[USenglish]{babel}
+\usepackage[numbers, sort&compress]{natbib}
+\usepackage{isabelle,isabellesym}
+\usepackage{booktabs}
+\usepackage{paralist}
+\usepackage{graphicx}
+\usepackage{amssymb}
+\usepackage{xspace}
+\usepackage{xcolor}
+\usepackage{hyperref}
+
+
+\pagestyle{headings}
+\isabellestyle{default}
+\setcounter{tocdepth}{1}
+\newcommand{\ie}{i.\,e.\xspace}
+\newcommand{\eg}{e.\,g.\xspace}
+\newcommand{\thy}{\isabellecontext}
+\renewcommand{\isamarkupsection}[1]{%
+  \begingroup% 
+  \def\isacharunderscore{\textunderscore}%
+  \section{#1 (\thy)}%
+  \def\isacharunderscore{-}%
+  \expandafter\label{sec:\isabellecontext}%
+  \endgroup% 
+}
+
+\title{Automated Stateful Protocol Verification}
+\author{%
+\begin{minipage}{.8\textwidth}
+  \centering
+      \href{https://www.dtu.dk/english/service/phonebook/person?id=64207}{Andreas~V.~Hess}\footnotemark[1]
+      \qquad\qquad
+      \href{https://people.compute.dtu.dk/samo/}{Sebastian~M{\"o}dersheim}\footnotemark[1]
+      \\
+      \href{http://www.brucker.ch/}{Achim~D.~Brucker}\footnotemark[2]
+      \qquad\qquad
+      \href{https://people.compute.dtu.dk/andschl}{Anders~Schlichtkrull}
+     \end{minipage}
+}
+
+\publishers{%
+  \footnotemark[1]~DTU Compute, Technical University of Denmark, Lyngby, Denmark\texorpdfstring{\\}{, }
+   \texttt{\{avhe, samo, andschl\}@dtu.dk}\\[2em]
+  %
+  \footnotemark[2]~
+  Department of Computer Science, University of Exeter, Exeter, UK\texorpdfstring{\\}{, }
+  \texttt{a.brucker@exeter.ac.uk}
+  %
+}
+
+\begin{document}
+  \maketitle
+  \begin{abstract}
+    \begin{quote}
+      In protocol verification we observe a wide spectrum from fully
+      automated methods to interactive theorem proving with proof
+      assistants like Isabelle/HOL.
+      In this AFP entry, we present a fully-automated approach for
+      verifying stateful security protocols, i.e., protocols with mutable
+      state that may span several sessions.
+      The approach supports reachability goals like secrecy and
+      authentication.
+      We also include a simple user-friendly transaction-based
+      protocol specification language that is embedded into Isabelle.
+      
+    \bigskip
+    \noindent{\textbf{Keywords:}} 
+      Fully automated verification, stateful security protocols
+    \end{quote}
+  \end{abstract}
+
+
+\tableofcontents
+\cleardoublepage
+
+\chapter{Introduction}
+  In protocol verification we observe a wide spectrum from fully
+  automated methods to interactive theorem proving with proof
+  assistants like Isabelle/HOL. The latter provide overwhelmingly high
+  assurance of the correctness, which automated methods often cannot:
+  due to their complexity, bugs in such automated verification tools
+  are likely and thus the risk of erroneously verifying a flawed
+  protocol is non-negligible. There are a few works that try to
+  combine advantages from both ends of the spectrum: a high degree of
+  automation and assurance.
+
+  Inspired by~\cite{brucker.ea:integrating:2009}, we present here a
+  first step towards achieving this for a more challenging class of
+  protocols, namely those that work with a mutable long-term state. To
+  our knowledge this is the first approach that achieves fully
+  automated verification of stateful protocols in an LCF-style theorem
+  prover.  The approach also includes a simple user-friendly
+  transaction-based protocol specification language embedded into
+  Isabelle, and can also leverage a number of existing results such as
+  soundness of a typed model (see,
+  e.g.,~\cite{hess:typing:2018,hess.ea:formalizing:2017,hess.ea:typing:2018})
+  and compositionality (see,
+  e.g.,~\cite{hess:typing:2018,hess.ea:stateful:2018}). The Isabelle 
+  formalization extends the AFP entry on stateful protocol composition and 
+  typing~\cite{hess.ea:stateful:2020}.
+
+  \begin{figure}
+    \centering
+    \includegraphics[height=\textheight]{session_graph}
+    \caption{The Dependency Graph of the Isabelle Theories.\label{fig:session-graph}}
+  \end{figure}
+  The rest of this document is automatically generated from the
+  formalization in Isabelle/HOL, i.e., all content is checked by
+  Isabelle.  Overall, the structure of this document follows the
+  theory dependencies (see \autoref{fig:session-graph}): We start with
+  the formal framework for verifying stateful security protocols
+  (\autoref{cha:verification}). We continue with the setup for
+  supporting the high-level protocol specifications language for
+  security protocols (the Trac format) and the implementation of the
+  fully automated proof tactics (\autoref{cha:trac}). Finally, we
+  present examples (\autoref{cha:examples}).
+
+\paragraph{Acknowledgments}
+This work was supported by the Sapere-Aude project ``Composec: Secure Composition of Distributed Systems'', grant 4184-00334B of the Danish Council for Independent Research.
+
+\clearpage
+
+\chapter{Stateful Protocol Verification}
+\label{cha:verification}
+\input{Transactions.tex}
+\input{Term_Abstraction.tex}
+\input{Stateful_Protocol_Model.tex}
+\input{Term_Variants.tex}
+\input{Term_Implication.tex}
+\input{Stateful_Protocol_Verification.tex}
+
+\chapter{Trac Support and Automation}
+\label{cha:trac}
+\input{Eisbach_Protocol_Verification.tex}
+\input{ml_yacc_lib.tex}
+\input{trac_term.tex}
+\input{trac_fp_parser.tex}
+\input{trac_protocol_parser.tex}
+\input{trac.tex}
+
+\chapter{Examples}
+\label{cha:examples}
+\input{Keyserver.tex}
+\input{Keyserver2.tex}
+\input{Keyserver_Composition.tex}
+\input{PKCS_Model03.tex}
+\input{PKCS_Model07.tex}
+\input{PKCS_Model09.tex}
+
+% \input{session}
+
+
+{\small
+  \bibliographystyle{abbrvnat}
+  \bibliography{root}
+}
+\end{document}
+\endinput 
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: t
+%%% End:
+
diff --git a/Automated_Stateful_Protocol_Verification/examples/Keyserver.thy b/Automated_Stateful_Protocol_Verification/examples/Keyserver.thy
new file mode 100644
index 0000000..7c0898b
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/examples/Keyserver.thy
@@ -0,0 +1,133 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      Keyserver.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>The Keyserver Protocol\<close>
+theory Keyserver
+  imports "../PSPSP"
+begin
+
+declare [[code_timing]]
+
+trac\<open>
+Protocol: keyserver
+
+Types:
+honest = {a,b,c}
+server = {s}
+agents = honest ++ server
+
+Sets:
+ring/1 valid/2 revoked/2
+
+Functions:
+Public sign/2 crypt/2 pair/2
+Private inv/1
+
+Analysis:
+sign(X,Y) -> Y
+crypt(X,Y) ? inv(X) -> Y
+pair(X,Y) -> X,Y
+
+Transactions:
+# Out-of-band registration
+outOfBand(A:honest,S:server)
+  new NPK
+  insert NPK ring(A)
+  insert NPK valid(A,S)
+  send NPK.
+
+# User update key
+keyUpdateUser(A:honest,PK:value)
+  PK in ring(A)
+  new NPK
+  delete PK ring(A)
+  insert NPK ring(A)
+  send sign(inv(PK),pair(A,NPK)).
+
+# Server update key
+keyUpdateServer(A:honest,S:server,PK:value,NPK:value)
+  receive sign(inv(PK),pair(A,NPK))
+  PK in valid(A,S)
+  NPK notin valid(_)
+  NPK notin revoked(_)
+  delete PK valid(A,S)
+  insert PK revoked(A,S)
+  insert NPK valid(A,S)
+  send inv(PK).
+
+# Attack definition
+authAttack(A:honest,S:server,PK:value)
+  receive inv(PK)
+  PK in valid(A,S)
+  attack.
+\<close>\<open>
+val(ring(A)) where A:honest
+sign(inv(val(0)),pair(A,val(ring(A)))) where A:honest
+inv(val(revoked(A,S))) where A:honest S:server
+pair(A,val(ring(A))) where A:honest
+
+occurs(val(ring(A))) where A:honest
+
+timplies(val(ring(A)),val(ring(A),valid(A,S))) where A:honest S:server
+timplies(val(ring(A)),val(0)) where A:honest
+timplies(val(ring(A),valid(A,S)),val(valid(A,S))) where A:honest S:server
+timplies(val(0),val(valid(A,S))) where A:honest S:server
+timplies(val(valid(A,S)),val(revoked(A,S))) where A:honest S:server
+\<close>
+
+
+subsection \<open>Proof of security\<close>
+protocol_model_setup spm: keyserver
+compute_SMP [optimized] keyserver_protocol keyserver_SMP
+manual_protocol_security_proof ssp: keyserver
+  for keyserver_protocol keyserver_fixpoint keyserver_SMP
+  apply check_protocol_intro
+  subgoal by code_simp
+  subgoal by code_simp
+  subgoal by code_simp
+  subgoal by code_simp
+  subgoal by code_simp
+  done
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/examples/Keyserver2.thy b/Automated_Stateful_Protocol_Verification/examples/Keyserver2.thy
new file mode 100644
index 0000000..ddd7581
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/examples/Keyserver2.thy
@@ -0,0 +1,132 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      Keyserver2.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>A Variant of the Keyserver Protocol\<close>
+theory Keyserver2
+  imports "../PSPSP"
+begin
+
+declare [[code_timing]]
+
+trac\<open>
+Protocol: keyserver2
+
+Types:
+honest = {a,b,c}
+dishonest = {i}
+agent = honest ++ dishonest
+
+Sets:
+ring'/1 seen/1 pubkeys/0 valid/1
+
+Functions:
+Public h/1 sign/2 crypt/2 scrypt/2 pair/2 update/3
+Private inv/1 pw/1
+
+Analysis:
+sign(X,Y) -> Y
+crypt(X,Y) ? inv(X) -> Y
+scrypt(X,Y) ? X -> Y
+pair(X,Y) -> X,Y
+update(X,Y,Z) -> X,Y,Z
+
+Transactions:
+passwordGenD(A:dishonest)
+  send pw(A).
+
+pubkeysGen()
+  new PK
+  insert PK pubkeys
+  send PK.
+
+updateKeyPw(A:honest,PK:value)
+  PK in pubkeys
+  new NPK
+  insert NPK ring'(A)
+  send NPK
+  send crypt(PK,update(A,NPK,pw(A))).
+
+updateKeyServerPw(A:agent,PK:value,NPK:value)
+  receive crypt(PK,update(A,NPK,pw(A)))
+  PK in pubkeys
+  NPK notin pubkeys
+  NPK notin seen(_)
+  insert NPK valid(A)
+  insert NPK seen(A).
+
+authAttack2(A:honest,PK:value)
+  receive inv(PK)
+  PK in valid(A)
+  attack.
+\<close>
+
+
+subsection \<open>Proof of security \<close>
+protocol_model_setup spm: keyserver2
+compute_fixpoint keyserver2_protocol keyserver2_fixpoint
+protocol_security_proof ssp: keyserver2
+
+
+subsection \<open>The generated theorems and definitions\<close>
+thm ssp.protocol_secure
+
+thm keyserver2_enum_consts.nchotomy
+thm keyserver2_sets.nchotomy
+thm keyserver2_fun.nchotomy
+thm keyserver2_atom.nchotomy
+thm keyserver2_arity.simps
+thm keyserver2_public.simps
+thm keyserver2_\<Gamma>.simps
+thm keyserver2_Ana.simps
+
+thm keyserver2_transaction_passwordGenD_def
+thm keyserver2_transaction_pubkeysGen_def
+thm keyserver2_transaction_updateKeyPw_def
+thm keyserver2_transaction_updateKeyServerPw_def
+thm keyserver2_transaction_authAttack2_def
+thm keyserver2_protocol_def
+
+thm keyserver2_fixpoint_def
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/examples/Keyserver_Composition.thy b/Automated_Stateful_Protocol_Verification/examples/Keyserver_Composition.thy
new file mode 100644
index 0000000..6e5b2fa
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/examples/Keyserver_Composition.thy
@@ -0,0 +1,295 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      Keyserver_Composition.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>The Composition of the Two Keyserver Protocols\<close>
+theory Keyserver_Composition
+  imports "../PSPSP"
+begin
+
+declare [[code_timing]]
+
+trac\<open>
+Protocol: kscomp
+
+Types:
+honest = {a,b,c}
+dishonest = {i}
+agent = honest ++ dishonest
+
+Sets:
+ring/1 valid/1 revoked/1 deleted/1
+ring'/1 seen/1 pubkeys/0
+
+Functions:
+Public h/1 sign/2 crypt/2 scrypt/2 pair/2 update/3
+Private inv/1 pw/1
+
+Analysis:
+sign(X,Y) -> Y
+crypt(X,Y) ? inv(X) -> Y
+scrypt(X,Y) ? X -> Y
+pair(X,Y) -> X,Y
+update(X,Y,Z) -> X,Y,Z
+
+Transactions:
+### The signature-based keyserver protocol
+p1_outOfBand(A:honest)
+  new PK
+  insert PK ring(A)
+* insert PK valid(A)
+  send PK.
+
+p1_oufOfBandD(A:dishonest)
+  new PK
+* insert PK valid(A)
+  send PK
+  send inv(PK).
+
+p1_updateKey(A:honest,PK:value)
+  PK in ring(A)
+  new NPK
+  delete PK ring(A)
+  insert PK deleted(A)
+  insert NPK ring(A)
+  send sign(inv(PK),pair(A,NPK)).
+
+p1_updateKeyServer(A:agent,PK:value,NPK:value)
+  receive sign(inv(PK),pair(A,NPK))
+* PK in valid(A)
+* NPK notin valid(_)
+  NPK notin revoked(_)
+* delete PK valid(A)
+  insert PK revoked(A)
+* insert NPK valid(A)
+  send inv(PK).
+
+p1_authAttack(A:honest,PK:value)
+  receive inv(PK)
+* PK in valid(A)
+  attack.
+
+### The password-based keyserver protocol
+p2_passwordGenD(A:dishonest)
+  send pw(A).
+
+p2_pubkeysGen()
+  new PK
+  insert PK pubkeys
+  send PK.
+
+p2_updateKeyPw(A:honest,PK:value)
+  PK in pubkeys
+  new NPK
+# NOTE: The ring' sets are not used elsewhere, but we have to avoid that the fresh keys generated
+#       by this rule are abstracted to the empty abstraction, and so we insert them into a ring'
+#       set. Otherwise the two protocols would have too many abstractions in common (in particular,
+#       the empty abstraction) which leads to false attacks in the composed protocol (probably
+#       because the term implication graphs of the two protocols then become 'linked' through the
+#       empty abstraction)
+  insert NPK ring'(A)
+  send NPK
+  send crypt(PK,update(A,NPK,pw(A))).
+
+#Transactions of p2:
+p2_updateKeyServerPw(A:agent,PK:value,NPK:value)
+receive crypt(PK,update(A,NPK,pw(A)))
+  PK in pubkeys
+  NPK notin pubkeys
+  NPK notin seen(_)
+* insert NPK valid(A)
+  insert NPK seen(A).
+
+p2_authAttack2(A:honest,PK:value)
+  receive inv(PK)
+* PK in valid(A)
+  attack.
+\<close> \<open>
+sign(inv(val(deleted(A))),pair(A,val(ring(A)))) where A:honest
+sign(inv(val(deleted(A),valid(B))),pair(A,val(ring(A)))) where A:honest B:dishonest
+sign(inv(val(deleted(A),seen(B),valid(B))),pair(A,val(ring(A)))) where A:honest B:dishonest
+sign(inv(val(deleted(A),valid(A))),pair(A,val(ring(A)))) where A:honest B:dishonest
+sign(inv(val(deleted(A),seen(B),valid(B),valid(A))),pair(A,val(ring(A)))) where A:honest B:dishonest
+pair(A,val(ring(A))) where A:honest
+inv(val(deleted(A),revoked(A))) where A:honest
+inv(val(valid(A))) where A:dishonest
+inv(val(revoked(A))) where A:dishonest
+inv(val(revoked(A),seen(A))) where A:dishonest
+inv(val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest
+inv(val(revoked(A),deleted(A),seen(B),valid(B))) where A:honest B:dishonest
+occurs(val(ring(A))) where A:honest
+occurs(val(valid(A))) where A:dishonest
+occurs(val(ring'(A))) where A:honest
+occurs(val(pubkeys))
+occurs(val(valid(A),ring(A))) where A:honest
+pw(A) where A:dishonest
+crypt(val(pubkeys),update(A,val(ring'(A)),pw(A))) where A:honest
+val(ring(A)) where A:honest
+val(valid(A)) where A:dishonest
+val(ring'(A)) where A:honest
+val(pubkeys)
+val(valid(A),ring(A)) where A:honest
+
+timplies(val(pubkeys),val(valid(A),pubkeys)) where A:dishonest
+
+timplies(val(ring'(A)),val(ring'(A),valid(B))) where A:honest B:dishonest
+timplies(val(ring'(A)),val(ring'(A),valid(A),seen(A))) where A:honest
+timplies(val(ring'(A)),val(ring'(A),valid(A),seen(A),valid(B))) where A:honest B:dishonest
+timplies(val(ring'(A)),val(seen(B),valid(B),ring'(A))) where A:honest B:dishonest
+
+timplies(val(ring'(A),valid(B)),val(ring'(A),valid(A),seen(A),valid(B))) where A:honest B:dishonest
+timplies(val(ring'(A),valid(B)),val(seen(B),valid(B),ring'(A))) where A:honest B:dishonest
+
+timplies(val(ring(A)),val(ring(A),valid(A))) where A:honest
+timplies(val(ring(A)),val(ring(A),valid(B))) where A:honest B:dishonest
+timplies(val(ring(A)),val(deleted(A))) where A:honest
+timplies(val(ring(A)),val(revoked(A),deleted(A),seen(B),valid(B))) where A:honest B:dishonest
+timplies(val(ring(A)),val(revoked(A),deleted(A),seen(B),revoked(B))) where A:honest B:dishonest
+timplies(val(ring(A)),val(deleted(A),seen(B),valid(B))) where A:honest B:dishonest
+timplies(val(ring(A)),val(ring(A),seen(B),valid(B))) where A:honest B:dishonest
+timplies(val(ring(A)),val(valid(A),deleted(A),seen(B),valid(B))) where A:honest B:dishonest
+timplies(val(ring(A)),val(valid(A),ring(A),seen(B),valid(B))) where A:honest B:dishonest
+
+timplies(val(ring(A),valid(A)),val(deleted(A),valid(A))) where A:honest
+timplies(val(ring(A),valid(B)),val(deleted(A),valid(B))) where A:honest B:dishonest
+timplies(val(ring(A),valid(A)),val(deleted(A),revoked(A))) where A:honest
+
+timplies(val(deleted(A)),val(deleted(A),valid(A))) where A:honest
+timplies(val(deleted(A)),val(deleted(A),valid(B))) where A:honest B:dishonest
+timplies(val(deleted(A)),val(revoked(A),seen(B),valid(B),deleted(A))) where A:honest B:dishonest
+timplies(val(deleted(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest
+timplies(val(deleted(A)),val(seen(B),valid(B),deleted(A))) where A:honest B:dishonest
+timplies(val(deleted(A)),val(seen(B),valid(B),valid(A),deleted(A))) where A:honest B:dishonest
+
+timplies(val(revoked(A)),val(seen(A),revoked(A))) where A:dishonest
+timplies(val(revoked(A)),val(seen(A),revoked(A),valid(A))) where A:dishonest
+
+timplies(val(revoked(A),deleted(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest
+timplies(val(revoked(A),deleted(A)),val(seen(B),valid(B),revoked(A),deleted(A))) where A:honest B:dishonest
+
+timplies(val(seen(B),valid(B),deleted(A),valid(A)),val(revoked(A),seen(B),valid(B),deleted(A))) where A:honest B:dishonest
+timplies(val(seen(B),valid(B),deleted(A),valid(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest
+timplies(val(seen(B),valid(B),revoked(A),deleted(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest
+timplies(val(seen(A),valid(A)),val(revoked(A),seen(A))) where A:dishonest
+timplies(val(seen(A),valid(A),revoked(A)),val(seen(A),revoked(A))) where A:dishonest
+timplies(val(seen(B),valid(B),ring(A)),val(deleted(A),seen(B),valid(B))) where A:honest B:dishonest
+timplies(val(seen(B),valid(B),valid(A),ring(A)),val(deleted(A),seen(B),valid(B),valid(A))) where A:honest B:dishonest
+timplies(val(seen(B),valid(B),valid(A),ring(A)),val(revoked(A),seen(B),valid(B),deleted(A))) where A:honest B:dishonest
+timplies(val(seen(B),valid(B),valid(A),ring(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest
+
+timplies(val(valid(A)),val(revoked(A))) where A:dishonest
+
+timplies(val(valid(A),deleted(A)),val(deleted(A),revoked(A))) where A:honest
+timplies(val(valid(A),deleted(A)),val(revoked(A),seen(B),valid(B),deleted(A))) where A:honest B:dishonest
+timplies(val(valid(A),deleted(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest
+timplies(val(valid(A),deleted(A)),val(seen(B),valid(B),valid(A),deleted(A))) where A:honest B:dishonest
+
+timplies(val(ring(A),valid(A)),val(deleted(A),seen(B),valid(B),valid(A))) where A:honest B:dishonest
+timplies(val(ring(A),valid(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest
+timplies(val(ring(A),valid(A)),val(seen(B),valid(B),valid(A),ring(A))) where A:honest B:dishonest
+timplies(val(valid(B),deleted(A)),val(seen(B),valid(B),deleted(A))) where A:honest B:dishonest
+timplies(val(ring(A),valid(B)),val(deleted(A),seen(B),valid(B))) where A:honest B:dishonest
+timplies(val(ring(A),valid(B)),val(seen(B),valid(B),ring(A))) where A:honest B:dishonest
+
+timplies(val(valid(A)),val(seen(A),valid(A))) where A:dishonest
+\<close>
+
+subsection \<open>Proof: The composition of the two keyserver protocols is secure\<close>
+protocol_model_setup spm: kscomp
+setup_protocol_checks spm kscomp_protocol
+manual_protocol_security_proof ssp: kscomp
+  apply check_protocol_intro
+  subgoal by code_simp
+  subgoal
+    apply coverage_check_intro
+    subgoal by code_simp
+    subgoal by code_simp
+    subgoal by eval
+    subgoal by eval
+    subgoal by eval
+    subgoal by code_simp
+    subgoal by code_simp
+    subgoal by eval
+    subgoal by eval
+    subgoal by eval
+    done
+  subgoal by eval
+  subgoal by eval
+  subgoal
+    apply (unfold spm.wellformed_fixpoint_def Let_def case_prod_unfold; intro conjI)
+    subgoal by code_simp
+    subgoal by code_simp
+    subgoal by eval
+    subgoal by code_simp
+    subgoal by code_simp
+    done
+  done
+
+
+subsection \<open>The generated theorems and definitions\<close>
+thm ssp.protocol_secure
+
+thm kscomp_enum_consts.nchotomy
+thm kscomp_sets.nchotomy
+thm kscomp_fun.nchotomy
+thm kscomp_atom.nchotomy
+thm kscomp_arity.simps
+thm kscomp_public.simps
+thm kscomp_\<Gamma>.simps
+thm kscomp_Ana.simps
+
+thm kscomp_transaction_p1_outOfBand_def
+thm kscomp_transaction_p1_oufOfBandD_def
+thm kscomp_transaction_p1_updateKey_def
+thm kscomp_transaction_p1_updateKeyServer_def
+thm kscomp_transaction_p1_authAttack_def
+thm kscomp_transaction_p2_passwordGenD_def
+thm kscomp_transaction_p2_pubkeysGen_def
+thm kscomp_transaction_p2_updateKeyPw_def
+thm kscomp_transaction_p2_updateKeyServerPw_def
+thm kscomp_transaction_p2_authAttack2_def
+thm kscomp_protocol_def
+
+thm kscomp_fixpoint_def
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model03.thy b/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model03.thy
new file mode 100644
index 0000000..82a0b00
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model03.thy
@@ -0,0 +1,161 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      PKCS_Model03.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>The PKCS Model, Scenario 3\<close>
+theory PKCS_Model03
+  imports "../../PSPSP"
+
+begin
+
+declare [[code_timing]]
+
+trac\<open>
+Protocol: ATTACK_UNSET
+
+Types: 
+token   = {token1}
+
+Sets:
+extract/1 wrap/1 decrypt/1 sensitive/1
+
+Functions:
+Public  senc/2 h/1 
+Private inv/1
+
+Analysis:
+senc(M,K2) ? K2 -> M  #This analysis rule corresponds to the decrypt2 rule in the AIF-omega specification.
+                      #M was type untyped
+
+Transactions:
+
+iik1()
+new K1
+insert K1 sensitive(token1)
+insert K1 extract(token1)
+send h(K1).
+
+iik2()
+new K2
+insert K2 wrap(token1)
+send h(K2).
+
+# ======================wrap================
+wrap(K1:value,K2:value)
+receive h(K1)
+receive h(K2)
+K1 in extract(token1)
+K2 in wrap(token1)
+send senc(K1,K2).
+
+# ======================set wrap================
+setwrap(K2:value)
+receive h(K2)
+K2 notin decrypt(token1)
+insert K2 wrap(token1).
+
+# ======================set decrypt================
+setdecrypt(K2:value)
+receive h(K2)
+K2 notin wrap(token1)
+insert K2 decrypt(token1).
+
+# ======================decrypt================
+decrypt1(K2:value,M:value)  #M was untyped in the AIF-omega specification.
+receive h(K2)
+receive senc(M,K2)
+K2 in decrypt(token1)
+send M.
+
+# ======================attacks================
+attack1(K1:value)
+receive K1
+K1 in sensitive(token1)
+attack.
+\<close>
+
+subsection \<open>Protocol model setup\<close>
+protocol_model_setup spm: ATTACK_UNSET
+
+subsection \<open>Fixpoint computation\<close>
+compute_fixpoint ATTACK_UNSET_protocol ATTACK_UNSET_fixpoint
+compute_SMP [optimized] ATTACK_UNSET_protocol ATTACK_UNSET_SMP
+
+subsection \<open>Proof of security\<close>
+manual_protocol_security_proof ssp: ATTACK_UNSET
+  for ATTACK_UNSET_protocol ATTACK_UNSET_fixpoint ATTACK_UNSET_SMP
+  apply check_protocol_intro
+  subgoal by code_simp
+  subgoal by code_simp
+  subgoal by code_simp
+  subgoal by code_simp
+  subgoal by code_simp
+  done
+
+
+subsection \<open>The generated theorems and definitions\<close>
+thm ssp.protocol_secure
+
+thm ATTACK_UNSET_enum_consts.nchotomy
+thm ATTACK_UNSET_sets.nchotomy
+thm ATTACK_UNSET_fun.nchotomy
+thm ATTACK_UNSET_atom.nchotomy
+thm ATTACK_UNSET_arity.simps
+thm ATTACK_UNSET_public.simps
+thm ATTACK_UNSET_\<Gamma>.simps
+thm ATTACK_UNSET_Ana.simps
+
+thm ATTACK_UNSET_transaction_iik1_def
+thm ATTACK_UNSET_transaction_iik2_def 
+thm ATTACK_UNSET_transaction_wrap_def
+thm ATTACK_UNSET_transaction_setwrap_def
+thm ATTACK_UNSET_transaction_setdecrypt_def
+thm ATTACK_UNSET_transaction_decrypt1_def
+thm ATTACK_UNSET_transaction_attack1_def
+
+thm ATTACK_UNSET_protocol_def
+
+thm ATTACK_UNSET_fixpoint_def
+thm ATTACK_UNSET_SMP_def
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model07.thy b/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model07.thy
new file mode 100644
index 0000000..26cdf0d
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model07.thy
@@ -0,0 +1,221 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      PKCS_Model07.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>The PKCS Protocol, Scenario 7\<close>
+theory PKCS_Model07
+  imports "../../PSPSP"
+
+begin
+
+declare [[code_timing]]
+
+trac\<open>
+Protocol: RE_IMPORT_ATT
+
+Types: 
+token   = {token1}
+
+Sets:
+extract/1 wrap/1 unwrap/1 decrypt/1 sensitive/1
+
+Functions:
+Public  senc/2 h/2 bind/2
+Private inv/1
+
+Analysis:
+senc(M1,K2) ? K2 -> M1  #This analysis rule corresponds to the decrypt2 rule in the AIF-omega specification.
+                        #M1 was type untyped
+
+Transactions:
+
+iik1()
+new K1
+new N1
+insert N1 sensitive(token1)
+insert N1 extract(token1)
+insert K1 sensitive(token1)
+send h(N1,K1).
+
+iik2()
+new K2
+new N2
+insert N2 wrap(token1)
+insert N2 extract(token1)
+send h(N2,K2).
+
+# =====set wrap=====
+setwrap(N2:value,K2:value)
+receive h(N2,K2)
+N2 notin sensitive(token1)
+N2 notin decrypt(token1)
+insert N2 wrap(token1).
+
+# =====set unwrap===
+setunwrap(N2:value,K2:value)
+receive h(N2,K2)
+N2 notin sensitive(token1)
+insert N2 unwrap(token1).
+
+# =====unwrap, generate new handler======
+#-----------the senstive attr copy-------------
+unwrapsensitive(M2:value, K2:value, N1:value, N2:value) #M2 was untyped in the AIF-omega specification.
+receive senc(M2,K2)
+receive bind(N1,M2)
+receive h(N2,K2)
+N1 in sensitive(token1)
+N2 in unwrap(token1)
+new Nnew
+insert Nnew sensitive(token1)
+send h(Nnew,M2).
+
+#-----------the wrap attr copy-------------
+wrapattr(M2:value, K2:value, N1:value, N2:value) #M2 was untyped in the AIF-omega specification.
+receive senc(M2,K2)
+receive bind(N1,M2)
+receive h(N2,K2)
+N1 in wrap(token1)
+N2 in unwrap(token1)
+new Nnew
+insert Nnew wrap(token1)
+send h(Nnew,M2).
+
+#-----------the decrypt attr copy-------------
+decrypt1attr(M2:value,K2:value,N1:value,N2:value) #M2 was untyped in the AIF-omega specification.
+receive senc(M2,K2)
+receive bind(N1,M2)
+receive h(N2,K2)
+N1 in decrypt(token1)
+N2 in unwrap(token1)
+new Nnew
+insert Nnew decrypt(token1)
+send h(Nnew,M2).
+
+decrypt2attr(M2:value,K2:value,N1:value,N2:value) #M2 was untyped in the AIF-omega specification.
+receive senc(M2,K2)
+receive bind(N1,M2)
+receive h(N2,K2)
+N1 notin sensitive(token1)
+N1 notin wrap(token1)
+N1 notin decrypt(token1)
+N2 in unwrap(token1)
+new Nnew
+send h(Nnew,M2).
+
+# ======================wrap================
+wrap(N1:value,K1:value,N2:value,K2:value)
+receive h(N1,K1)
+receive h(N2,K2)
+N1 in extract(token1)
+N2 in wrap(token1)
+send senc(K1,K2)
+send bind(N1,K1).
+
+# =====set decrypt===
+setdecrypt(Nnew:value, K2:value)
+receive h(Nnew,K2) 
+Nnew notin wrap(token1)
+insert Nnew decrypt(token1).
+
+# ======================decrypt================
+decrypt1(Nnew:value, K2:value,M1:value) #M1 was untyped in the AIF-omega specification.
+receive h(Nnew,K2)
+receive senc(M1,K2)
+Nnew in decrypt(token1)
+delete Nnew decrypt(token1)
+send M1.
+
+# ======================attacks================
+attack1(K1:value)
+receive K1
+K1 in sensitive(token1)
+attack.
+\<close>
+
+
+
+subsection \<open>Protocol model setup\<close>
+protocol_model_setup spm: RE_IMPORT_ATT
+
+
+subsection \<open>Fixpoint computation\<close>
+compute_fixpoint RE_IMPORT_ATT_protocol RE_IMPORT_ATT_fixpoint
+compute_SMP [optimized] RE_IMPORT_ATT_protocol RE_IMPORT_ATT_SMP
+
+
+subsection \<open>Proof of security\<close>
+protocol_security_proof [unsafe] ssp: RE_IMPORT_ATT
+  for RE_IMPORT_ATT_protocol RE_IMPORT_ATT_fixpoint RE_IMPORT_ATT_SMP
+
+
+subsection \<open>The generated theorems and definitions\<close>
+thm ssp.protocol_secure
+
+thm RE_IMPORT_ATT_enum_consts.nchotomy
+thm RE_IMPORT_ATT_sets.nchotomy
+thm RE_IMPORT_ATT_fun.nchotomy
+thm RE_IMPORT_ATT_atom.nchotomy
+thm RE_IMPORT_ATT_arity.simps
+thm RE_IMPORT_ATT_public.simps
+thm RE_IMPORT_ATT_\<Gamma>.simps
+thm RE_IMPORT_ATT_Ana.simps
+
+thm RE_IMPORT_ATT_transaction_iik1_def
+thm RE_IMPORT_ATT_transaction_iik2_def
+thm RE_IMPORT_ATT_transaction_setwrap_def
+thm RE_IMPORT_ATT_transaction_setunwrap_def
+thm RE_IMPORT_ATT_transaction_unwrapsensitive_def
+thm RE_IMPORT_ATT_transaction_wrapattr_def
+thm RE_IMPORT_ATT_transaction_decrypt1attr_def
+thm RE_IMPORT_ATT_transaction_decrypt2attr_def
+thm RE_IMPORT_ATT_transaction_wrap_def
+thm RE_IMPORT_ATT_transaction_setdecrypt_def
+thm RE_IMPORT_ATT_transaction_decrypt1_def
+thm RE_IMPORT_ATT_transaction_attack1_def
+
+thm RE_IMPORT_ATT_protocol_def
+
+thm RE_IMPORT_ATT_fixpoint_def
+thm RE_IMPORT_ATT_SMP_def
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model09.thy b/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model09.thy
new file mode 100644
index 0000000..aaa9cb7
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model09.thy
@@ -0,0 +1,237 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      PKCS_Model09.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>The PKCS Protocol, Scenario 9\<close>
+theory PKCS_Model09
+  imports "../../PSPSP"
+
+begin
+
+declare [[code_timing]]
+
+trac\<open>
+Protocol: LOSS_KEY_ATT
+
+Types: 
+token   = {token1}
+
+Sets:
+extract/1 wrap/1 unwrap/1 decrypt/1 sensitive/1
+
+Functions:
+Public  senc/2 h/2 bind/3
+Private inv/1
+
+Analysis:
+senc(M1,K2) ? K2 -> M1  #This analysis rule corresponds to the decrypt2 rule in the AIF-omega specification.
+                        #M1 was type untyped
+
+Transactions:
+iik1()
+new K1
+new N1
+insert N1 sensitive(token1)
+insert N1 extract(token1)
+insert K1 sensitive(token1)
+send h(N1,K1).
+
+iik2()
+new K2
+new N2
+insert N2 wrap(token1)
+insert N2 extract(token1)
+send h(N2,K2).
+
+iik3()
+new K3
+new N3
+insert N3 extract(token1)
+insert N3 decrypt(token1)
+insert K3 decrypt(token1)
+send h(N3,K3)
+send K3.
+
+# =====set wrap=====
+setwrap(N2:value,K2:value) where N2 != K2
+receive h(N2,K2)
+N2 notin sensitive(token1)
+N2 notin decrypt(token1)
+insert N2 wrap(token1).
+
+# =====set unwrap===
+setunwrap(N2:value,K2:value) where N2 != K2
+receive h(N2,K2)
+N2 notin sensitive(token1)
+insert N2 unwrap(token1).
+
+# =====unwrap, generate new handler======
+#-----------add the wrap attr copy-------------
+unwrapWrap(M2:value,K2:value,N1:value,N2:value) where M2 != K2, M2 != N1, M2 != N2, K2 != N1, K2 != N2, N1 != N2 #M2 was untyped in the AIF-omega specification.
+receive senc(M2,K2)
+receive bind(N1,M2,K2)
+receive h(N2,K2)
+N1 in wrap(token1)
+N2 in unwrap(token1)
+new Nnew
+insert Nnew wrap(token1)
+send h(Nnew,M2).
+
+#-----------add the senstive attr copy-------------
+unwrapSens(M2:value,K2:value,N1:value,N2:value) where M2 != K2, M2 != N1, M2 != N2, K2 != N1, K2 != N2, N1 != N2 #M2 was untyped in the AIF-omega specification.
+receive senc(M2,K2)
+receive bind(N1,M2,K2)
+receive h(N2,K2)
+N1 in sensitive(token1)
+N2 in unwrap(token1)
+new Nnew
+insert Nnew sensitive(token1)
+send h(Nnew,M2).
+
+#-----------add the decrypt attr copy-------------
+decrypt1Attr(M2:value, K2:value,N1:value,N2:value) where M2 != K2, M2 != N1, M2 != N2, K2 != N1, K2 != N2, N1 != N2 #M2 was untyped in the AIF-omega specification.
+receive senc(M2,K2)
+receive bind(N1,M2,K2)
+receive h(N2,K2)
+N1 in decrypt(token1)
+N2 in unwrap(token1)
+new Nnew 
+insert Nnew decrypt(token1)
+send h(Nnew,M2).
+
+decrypt2Attr(M2:value, K2:value,N1:value,N2:value) where M2 != K2, M2 != N1, M2 != N2, K2 != N1, K2 != N2, N1 != N2 #M2 was untyped in the AIF-omega specification.
+receive senc(M2,K2)
+receive bind(N1,M2,K2)
+receive h(N2,K2)
+N1 notin wrap(token1)
+N1 notin sensitive(token1)
+N1 notin decrypt(token1)
+N2 in unwrap(token1)
+new Nnew 
+send h(Nnew,M2).
+
+# ======================wrap================
+wrap(N1:value,K1:value, N2:value, K2:value) where N1 != N2, N1 != K2, N1 != K1, N2 != K2, N2 != K1, K2 != K1
+receive h(N1,K1)
+receive h(N2,K2)
+N1 in extract(token1)
+N2 in wrap(token1)
+send senc(K1,K2)
+send bind(N1,K1,K2).
+
+# ======================bind generation================
+bind1(K3:value,N2:value,K2:value, K1:value) where K3 != N2, K3 != K2, K3 != K1, N2 != K2, N2 != K1, K2 != K1
+receive K3
+receive h(N2,K2)
+send bind(N2,K3,K3).
+
+bind2(K3:value,N2:value,K2:value, K1:value) where K3 != N2, K3 != K2, K3 != K1, N2 != K2, N2 != K1, K2 != K1
+receive K3
+receive K1
+receive h(N2,K2)
+send bind(N2,K1,K3)
+send bind(N2,K3,K1).
+
+# =====set decrypt===
+setdecrypt(Nnew:value,K2:value) where Nnew != K2
+receive h(Nnew,K2) 
+Nnew notin wrap(token1)
+insert Nnew decrypt(token1).
+
+# ======================decrypt================
+decrypt1(Nnew:value,K2:value,M1:value) where Nnew != K2, Nnew != M1, K2 != M1 #M1 was untyped in the AIF-omega specification.
+receive h(Nnew,K2)
+receive senc(M1,K2)
+Nnew in decrypt(token1)
+send M1.
+
+# ======================attacks================
+attack1(K1:value)
+receive K1
+K1 in sensitive(token1)
+attack.
+
+\<close>
+
+
+subsection \<open>Protocol model setup\<close>
+protocol_model_setup spm: LOSS_KEY_ATT
+
+
+subsection \<open>Fixpoint computation\<close>
+compute_fixpoint LOSS_KEY_ATT_protocol LOSS_KEY_ATT_fixpoint
+
+text \<open>The fixpoint contains an attack signal\<close>
+value "attack_notin_fixpoint LOSS_KEY_ATT_fixpoint"
+
+
+subsection \<open>The generated theorems and definitions\<close>
+thm LOSS_KEY_ATT_enum_consts.nchotomy
+thm LOSS_KEY_ATT_sets.nchotomy
+thm LOSS_KEY_ATT_fun.nchotomy
+thm LOSS_KEY_ATT_atom.nchotomy
+thm LOSS_KEY_ATT_arity.simps
+thm LOSS_KEY_ATT_public.simps
+thm LOSS_KEY_ATT_\<Gamma>.simps
+thm LOSS_KEY_ATT_Ana.simps
+
+thm LOSS_KEY_ATT_transaction_iik1_def
+thm LOSS_KEY_ATT_transaction_iik2_def
+thm LOSS_KEY_ATT_transaction_iik3_def
+thm LOSS_KEY_ATT_transaction_setwrap_def
+thm LOSS_KEY_ATT_transaction_setunwrap_def
+thm LOSS_KEY_ATT_transaction_unwrapWrap_def
+thm LOSS_KEY_ATT_transaction_unwrapSens_def
+thm LOSS_KEY_ATT_transaction_decrypt1Attr_def
+thm LOSS_KEY_ATT_transaction_decrypt2Attr_def
+thm LOSS_KEY_ATT_transaction_wrap_def
+thm LOSS_KEY_ATT_transaction_bind1_def
+thm LOSS_KEY_ATT_transaction_bind2_def
+thm LOSS_KEY_ATT_transaction_setdecrypt_def
+thm LOSS_KEY_ATT_transaction_decrypt1_def
+thm LOSS_KEY_ATT_transaction_attack1_def
+
+thm LOSS_KEY_ATT_protocol_def
+thm LOSS_KEY_ATT_fixpoint_def
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/trac/Makefile b/Automated_Stateful_Protocol_Verification/trac/Makefile
new file mode 100644
index 0000000..a441922
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/Makefile
@@ -0,0 +1,51 @@
+#!/bin/sh
+# (C) Copyright Andreas Viktor Hess, DTU, 2020
+# (C) Copyright Sebastian A. Mödersheim, DTU, 2020
+# (C) Copyright Achim D. Brucker, University of Exeter, 2020
+# (C) Copyright Anders Schlichtkrull, DTU, 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.
+
+ISABELLE=isabelle
+
+all: trac_parser/trac_fp.lex.sml trac_parser/trac_fp.grm.sig trac_parser/trac_protocol.lex.sml trac_parser/trac_protocol.grm.sig
+
+test:
+	isabelle build -c -D .
+
+clean:
+	rm -f trac_parser/*.lex.sml trac_parser/*.grm.sml trac_parser/*.grm.sig
+
+%.lex.sml: %.lex
+	bin/ml-lex-isa $< 
+%.grm.sig: %.grm
+	bin/ml-yacc-isa $< 
+
diff --git a/Automated_Stateful_Protocol_Verification/trac/README.md b/Automated_Stateful_Protocol_Verification/trac/README.md
new file mode 100644
index 0000000..6d008b0
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/README.md
@@ -0,0 +1,13 @@
+# Interface between Isabelle and trac specifications
+
+## Prerequisites 
+
+* For re-generating the parser, ml-lex and ml-yacc are required
+
+
+## License
+
+This project is licensed under a 2-clause BSD-style license.
+
+SPDX-License-Identifier: BSD-2-Clause
+
diff --git a/Automated_Stateful_Protocol_Verification/trac/bin/ml-lex-isa b/Automated_Stateful_Protocol_Verification/trac/bin/ml-lex-isa
new file mode 100755
index 0000000..cf1ea70
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/bin/ml-lex-isa
@@ -0,0 +1,42 @@
+#!/bin/bash
+# (C) Copyright Andreas Viktor Hess, DTU, 2020
+# (C) Copyright Sebastian A. Mödersheim, DTU, 2020
+# (C) Copyright Achim D. Brucker, University of Exeter, 2020
+# (C) Copyright Anders Schlichtkrull, DTU, 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.
+
+ml-lex "$1"
+sed -i -e '1s/^/ (***** GENERATED FILE -- DO NOT EDIT ****)\n/'\
+       -e "s/\\bref\\b/Unsynchronized.ref/g" \
+       -e "s/\\bUnsafe.\\b//g" \
+       -e "s/structure YYPosInt : INTEGER = Int/structure YYPosInt = Int/" \
+    "$1.sml"
diff --git a/Automated_Stateful_Protocol_Verification/trac/bin/ml-yacc-isa b/Automated_Stateful_Protocol_Verification/trac/bin/ml-yacc-isa
new file mode 100755
index 0000000..9f0ee7a
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/bin/ml-yacc-isa
@@ -0,0 +1,39 @@
+#!/bin/bash
+# (C) Copyright Andreas Viktor Hess, DTU, 2020
+# (C) Copyright Sebastian A. Mödersheim, DTU, 2020
+# (C) Copyright Achim D. Brucker, University of Exeter, 2020
+# (C) Copyright Anders Schlichtkrull, DTU, 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.
+
+ml-yacc "$1"
+sed -i -e '1s/^/ (***** GENERATED FILE -- DO NOT EDIT ****)\n/'\
+       -e "s/\\bref\\b/Unsynchronized.ref/g" "$1.sml"
diff --git a/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/base.sig b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/base.sig
new file mode 100644
index 0000000..ff95175
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/base.sig
@@ -0,0 +1,323 @@
+(******************************************************************************
+ * STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
+ * 
+ * Copyright (c) 1989-2002 by Lucent Technologies
+ * 
+ * Permission to use, copy, modify, and distribute this software and its
+ * documentation for any purpose and without fee is hereby granted,
+ * provided that the above copyright notice appear in all copies and that
+ * both the copyright notice and this permission notice and warranty
+ * disclaimer appear in supporting documentation, and that the name of
+ * Lucent Technologies, Bell Labs or any Lucent entity not be used in
+ * advertising or publicity pertaining to distribution of the software
+ * without specific, written prior permission.
+ * 
+ * Lucent disclaims all warranties with regard to this software,
+ * including all implied warranties of merchantability and fitness. In no
+ * event shall Lucent be liable for any special, indirect or
+ * consequential damages or any damages whatsoever resulting from loss of
+ * use, data or profits, whether in an action of contract, negligence or
+ * other tortious action, arising out of or in connection with the use
+ * or performance of this software.
+ ******************************************************************************)
+(* $Id$ *)
+
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
+
+(* base.sig: Base signature file for SML-Yacc.  This file contains signatures
+   that must be loaded before any of the files produced by ML-Yacc are loaded
+*)
+
+(* STREAM: signature for a lazy stream.*)
+
+signature STREAM =
+ sig type 'xa stream
+     val streamify : (unit -> '_a) -> '_a stream
+     val cons : '_a * '_a stream -> '_a stream
+     val get : '_a stream -> '_a * '_a stream
+ end
+
+(* LR_TABLE: signature for an LR Table.
+
+   The list of actions and gotos passed to mkLrTable must be ordered by state
+   number. The values for state 0 are the first in the list, the values for
+    state 1 are next, etc.
+*)
+
+signature LR_TABLE =
+    sig
+        datatype ('a,'b) pairlist = EMPTY | PAIR of 'a * 'b * ('a,'b) pairlist
+	datatype state = STATE of int
+	datatype term = T of int
+	datatype nonterm = NT of int
+	datatype action = SHIFT of state
+			| REDUCE of int
+			| ACCEPT
+			| ERROR
+	type table
+	
+	val numStates : table -> int
+	val numRules : table -> int
+	val describeActions : table -> state ->
+				(term,action) pairlist * action
+	val describeGoto : table -> state -> (nonterm,state) pairlist
+	val action : table -> state * term -> action
+	val goto : table -> state * nonterm -> state
+	val initialState : table -> state
+	exception Goto of state * nonterm
+
+	val mkLrTable : {actions : ((term,action) pairlist * action) array,
+			 gotos : (nonterm,state) pairlist array,
+			 numStates : int, numRules : int,
+			 initialState : state} -> table
+    end
+
+(* TOKEN: signature revealing the internal structure of a token. This signature
+   TOKEN distinct from the signature {parser name}_TOKENS produced by ML-Yacc.
+   The {parser name}_TOKENS structures contain some types and functions to
+    construct tokens from values and positions.
+
+   The representation of token was very carefully chosen here to allow the
+   polymorphic parser to work without knowing the types of semantic values
+   or line numbers.
+
+   This has had an impact on the TOKENS structure produced by SML-Yacc, which
+   is a structure parameter to lexer functors.  We would like to have some
+   type 'a token which functions to construct tokens would create.  A
+   constructor function for a integer token might be
+
+	  INT: int * 'a * 'a -> 'a token.
+ 
+   This is not possible because we need to have tokens with the representation
+   given below for the polymorphic parser.
+
+   Thus our constructur functions for tokens have the form:
+
+	  INT: int * 'a * 'a -> (svalue,'a) token
+
+   This in turn has had an impact on the signature that lexers for SML-Yacc
+   must match and the types that a user must declare in the user declarations
+   section of lexers.
+*)
+
+signature TOKEN =
+    sig
+	structure LrTable : LR_TABLE
+        datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
+	val sameToken : ('a,'b) token * ('a,'b) token -> bool
+    end
+
+(* LR_PARSER: signature for a polymorphic LR parser *)
+
+signature LR_PARSER =
+    sig
+	structure Stream: STREAM
+	structure LrTable : LR_TABLE
+	structure Token : TOKEN
+
+	sharing LrTable = Token.LrTable
+
+	exception ParseError
+
+	val parse : {table : LrTable.table,
+		     lexer : ('_b,'_c) Token.token Stream.stream,
+		     arg: 'arg,
+		     saction : int *
+			       '_c *
+				(LrTable.state * ('_b * '_c * '_c)) list * 
+				'arg ->
+				     LrTable.nonterm *
+				     ('_b * '_c * '_c) *
+				     ((LrTable.state *('_b * '_c * '_c)) list),
+		     void : '_b,
+		     ec : { is_keyword : LrTable.term -> bool,
+			    noShift : LrTable.term -> bool,
+			    preferred_change : (LrTable.term list * LrTable.term list) list,
+			    errtermvalue : LrTable.term -> '_b,
+			    showTerminal : LrTable.term -> string,
+			    terms: LrTable.term list,
+			    error : string * '_c * '_c -> unit
+			   },
+		     lookahead : int  (* max amount of lookahead used in *)
+				      (* error correction *)
+			} -> '_b *
+			     (('_b,'_c) Token.token Stream.stream)
+    end
+
+(* LEXER: a signature that most lexers produced for use with SML-Yacc's
+   output will match.  The user is responsible for declaring type token,
+   type pos, and type svalue in the UserDeclarations section of a lexer.
+
+   Note that type token is abstract in the lexer.  This allows SML-Yacc to
+   create a TOKENS signature for use with lexers produced by ML-Lex that
+   treats the type token abstractly.  Lexers that are functors parametrized by
+   a Tokens structure matching a TOKENS signature cannot examine the structure
+   of tokens.
+*)
+
+signature LEXER =
+   sig
+       structure UserDeclarations :
+	   sig
+	        type ('a,'b) token
+		type pos
+		type svalue
+	   end
+	val makeLexer : (int -> string) -> unit -> 
+         (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token
+   end
+
+(* ARG_LEXER: the %arg option of ML-Lex allows users to produce lexers which
+   also take an argument before yielding a function from unit to a token
+*)
+
+signature ARG_LEXER =
+   sig
+       structure UserDeclarations :
+	   sig
+	        type ('a,'b) token
+		type pos
+		type svalue
+		type arg
+	   end
+	val makeLexer : (int -> string) -> UserDeclarations.arg -> unit -> 
+         (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token
+   end
+
+(* PARSER_DATA: the signature of ParserData structures in {parser name}LrValsFun
+   produced by  SML-Yacc.  All such structures match this signature.  
+
+   The {parser name}LrValsFun produces a structure which contains all the values
+   except for the lexer needed to call the polymorphic parser mentioned
+   before.
+
+*)
+
+signature PARSER_DATA =
+   sig
+        (* the type of line numbers *)
+
+	type pos
+
+	(* the type of semantic values *)
+
+	type svalue
+
+         (* the type of the user-supplied argument to the parser *)
+ 	type arg
+ 
+	(* the intended type of the result of the parser.  This value is
+	   produced by applying extract from the structure Actions to the
+	   final semantic value resultiing from a parse.
+	 *)
+
+	type result
+
+	structure LrTable : LR_TABLE
+	structure Token : TOKEN
+	sharing Token.LrTable = LrTable
+
+	(* structure Actions contains the functions which mantain the
+	   semantic values stack in the parser.  Void is used to provide
+	   a default value for the semantic stack.
+	 *)
+
+	structure Actions : 
+	  sig
+	      val actions : int * pos *
+		   (LrTable.state * (svalue * pos * pos)) list * arg->
+		         LrTable.nonterm * (svalue * pos * pos) *
+			 ((LrTable.state *(svalue * pos * pos)) list)
+	      val void : svalue
+	      val extract : svalue -> result
+	  end
+
+	(* structure EC contains information used to improve error
+	   recovery in an error-correcting parser *)
+
+	structure EC :
+	   sig
+	     val is_keyword : LrTable.term -> bool
+	     val noShift : LrTable.term -> bool
+ 	     val preferred_change : (LrTable.term list * LrTable.term list) list
+	     val errtermvalue : LrTable.term -> svalue
+	     val showTerminal : LrTable.term -> string
+	     val terms: LrTable.term list
+	   end
+
+	(* table is the LR table for the parser *)
+
+	val table : LrTable.table
+    end
+
+(* signature PARSER is the signature that most user parsers created by 
+   SML-Yacc will match.
+*)
+
+signature PARSER =
+    sig
+        structure Token : TOKEN
+	structure Stream : STREAM
+	exception ParseError
+
+	(* type pos is the type of line numbers *)
+
+	type pos
+
+	(* type result is the type of the result from the parser *)
+
+	type result
+
+         (* the type of the user-supplied argument to the parser *)
+ 	type arg
+	
+	(* type svalue is the type of semantic values for the semantic value
+	   stack
+	 *)
+
+	type svalue
+
+	(* val makeLexer is used to create a stream of tokens for the parser *)
+
+	val makeLexer : (int -> string) ->
+			 (svalue,pos) Token.token Stream.stream
+
+	(* val parse takes a stream of tokens and a function to print
+	   errors and returns a value of type result and a stream containing
+	   the unused tokens
+	 *)
+
+	val parse : int * ((svalue,pos) Token.token Stream.stream) *
+		    (string * pos * pos -> unit) * arg ->
+				result * (svalue,pos) Token.token Stream.stream
+
+	val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
+				bool
+     end
+
+(* signature ARG_PARSER is the signature that will be matched by parsers whose
+    lexer takes an additional argument.
+*)
+
+signature ARG_PARSER = 
+    sig
+        structure Token : TOKEN
+	structure Stream : STREAM
+	exception ParseError
+
+	type arg
+	type lexarg
+	type pos
+	type result
+	type svalue
+
+	val makeLexer : (int -> string) -> lexarg ->
+			 (svalue,pos) Token.token Stream.stream
+	val parse : int * ((svalue,pos) Token.token Stream.stream) *
+		    (string * pos * pos -> unit) * arg ->
+				result * (svalue,pos) Token.token Stream.stream
+
+	val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
+				bool
+     end
+
diff --git a/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/copyright b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/copyright
new file mode 100644
index 0000000..c7ef2cf
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/copyright
@@ -0,0 +1,40 @@
+This package was debianized by Aaron Matthew Read <amread@nyx.net> on
+Fri, 25 Oct 2002 16:54:10 -0800.
+
+It was downloaded from http://smlnj.cs.uchicago.edu/dist/working
+
+Upstream Authors: The SML/NJ Team <smlnj-dev-list@lists.sourceforge.net>
+
+Copyright:	2003-2008	The SML/NJ Fellowship
+		1989-2002	Lucent Technologies
+		1991-2003	John Reppy
+		1996-1998,2000	YALE FLINT PROJECT
+		1992		Vrije Universiteit, The Netherlands
+		1989-1992	Andrew W. Appel, James S. Mattson, David R. Tarditi
+		1988		Evans & Sutherland Computer Corporation, Salt Lake City, Utah
+
+STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
+
+Copyright (c) 1989-2002 by Lucent Technologies
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both the copyright notice and this permission notice and warranty
+disclaimer appear in supporting documentation, and that the name of
+Lucent Technologies, Bell Labs or any Lucent entity not be used in
+advertising or publicity pertaining to distribution of the software
+without specific, written prior permission.
+
+Lucent disclaims all warranties with regard to this software,
+including all implied warranties of merchantability and fitness. In no
+event shall Lucent be liable for any special, indirect or
+consequential damages or any damages whatsoever resulting from loss of
+use, data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the use
+or performance of this software.
+
+
+The SML/NJ distribution also includes code licensed under the same
+terms as above, but with "David R. Tarditi Jr. and Andrew W. Appel",
+"Vrije Universiteit" or "Evans & Sutherland" instead of "Lucent".
diff --git a/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/join.sml b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/join.sml
new file mode 100644
index 0000000..a0c9985
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/join.sml
@@ -0,0 +1,118 @@
+(******************************************************************************
+ * STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
+ * 
+ * Copyright (c) 1989-2002 by Lucent Technologies
+ * 
+ * Permission to use, copy, modify, and distribute this software and its
+ * documentation for any purpose and without fee is hereby granted,
+ * provided that the above copyright notice appear in all copies and that
+ * both the copyright notice and this permission notice and warranty
+ * disclaimer appear in supporting documentation, and that the name of
+ * Lucent Technologies, Bell Labs or any Lucent entity not be used in
+ * advertising or publicity pertaining to distribution of the software
+ * without specific, written prior permission.
+ * 
+ * Lucent disclaims all warranties with regard to this software,
+ * including all implied warranties of merchantability and fitness. In no
+ * event shall Lucent be liable for any special, indirect or
+ * consequential damages or any damages whatsoever resulting from loss of
+ * use, data or profits, whether in an action of contract, negligence or
+ * other tortious action, arising out of or in connection with the use
+ * or performance of this software.
+ ******************************************************************************)
+(* $Id$ *)
+
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
+
+(* functor Join creates a user parser by putting together a Lexer structure,
+   an LrValues structure, and a polymorphic parser structure.  Note that
+   the Lexer and LrValues structure must share the type pos (i.e. the type
+   of line numbers), the type svalues for semantic values, and the type
+   of tokens.
+*)
+
+functor Join(structure Lex : LEXER
+	     structure ParserData: PARSER_DATA
+	     structure LrParser : LR_PARSER
+	     sharing ParserData.LrTable = LrParser.LrTable
+	     sharing ParserData.Token = LrParser.Token
+	     sharing type Lex.UserDeclarations.svalue = ParserData.svalue
+	     sharing type Lex.UserDeclarations.pos = ParserData.pos
+	     sharing type Lex.UserDeclarations.token = ParserData.Token.token)
+		 : PARSER =
+struct
+    structure Token = ParserData.Token
+    structure Stream = LrParser.Stream
+ 
+    exception ParseError = LrParser.ParseError
+
+    type arg = ParserData.arg
+    type pos = ParserData.pos
+    type result = ParserData.result
+    type svalue = ParserData.svalue
+    val makeLexer = LrParser.Stream.streamify o Lex.makeLexer
+    val parse = fn (lookahead,lexer,error,arg) =>
+	(fn (a,b) => (ParserData.Actions.extract a,b))
+     (LrParser.parse {table = ParserData.table,
+	        lexer=lexer,
+		lookahead=lookahead,
+		saction = ParserData.Actions.actions,
+		arg=arg,
+		void= ParserData.Actions.void,
+	        ec = {is_keyword = ParserData.EC.is_keyword,
+		      noShift = ParserData.EC.noShift,
+		      preferred_change = ParserData.EC.preferred_change,
+		      errtermvalue = ParserData.EC.errtermvalue,
+		      error=error,
+		      showTerminal = ParserData.EC.showTerminal,
+		      terms = ParserData.EC.terms}}
+      )
+     val sameToken = Token.sameToken
+end
+
+(* functor JoinWithArg creates a variant of the parser structure produced 
+   above.  In this case, the makeLexer take an additional argument before
+   yielding a value of type unit -> (svalue,pos) token
+ *)
+
+functor JoinWithArg(structure Lex : ARG_LEXER
+	     structure ParserData: PARSER_DATA
+	     structure LrParser : LR_PARSER
+	     sharing ParserData.LrTable = LrParser.LrTable
+	     sharing ParserData.Token = LrParser.Token
+	     sharing type Lex.UserDeclarations.svalue = ParserData.svalue
+	     sharing type Lex.UserDeclarations.pos = ParserData.pos
+	     sharing type Lex.UserDeclarations.token = ParserData.Token.token)
+		 : ARG_PARSER  =
+struct
+    structure Token = ParserData.Token
+    structure Stream = LrParser.Stream
+
+    exception ParseError = LrParser.ParseError
+
+    type arg = ParserData.arg
+    type lexarg = Lex.UserDeclarations.arg
+    type pos = ParserData.pos
+    type result = ParserData.result
+    type svalue = ParserData.svalue
+
+    val makeLexer = fn s => fn arg =>
+		 LrParser.Stream.streamify (Lex.makeLexer s arg)
+    val parse = fn (lookahead,lexer,error,arg) =>
+	(fn (a,b) => (ParserData.Actions.extract a,b))
+     (LrParser.parse {table = ParserData.table,
+	        lexer=lexer,
+		lookahead=lookahead,
+		saction = ParserData.Actions.actions,
+		arg=arg,
+		void= ParserData.Actions.void,
+	        ec = {is_keyword = ParserData.EC.is_keyword,
+		      noShift = ParserData.EC.noShift,
+		      preferred_change = ParserData.EC.preferred_change,
+		      errtermvalue = ParserData.EC.errtermvalue,
+		      error=error,
+		      showTerminal = ParserData.EC.showTerminal,
+		      terms = ParserData.EC.terms}}
+      )
+    val sameToken = Token.sameToken
+end;
diff --git a/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/lrtable.sml b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/lrtable.sml
new file mode 100644
index 0000000..833dd7c
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/lrtable.sml
@@ -0,0 +1,83 @@
+(******************************************************************************
+ * STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
+ * 
+ * Copyright (c) 1989-2002 by Lucent Technologies
+ * 
+ * Permission to use, copy, modify, and distribute this software and its
+ * documentation for any purpose and without fee is hereby granted,
+ * provided that the above copyright notice appear in all copies and that
+ * both the copyright notice and this permission notice and warranty
+ * disclaimer appear in supporting documentation, and that the name of
+ * Lucent Technologies, Bell Labs or any Lucent entity not be used in
+ * advertising or publicity pertaining to distribution of the software
+ * without specific, written prior permission.
+ * 
+ * Lucent disclaims all warranties with regard to this software,
+ * including all implied warranties of merchantability and fitness. In no
+ * event shall Lucent be liable for any special, indirect or
+ * consequential damages or any damages whatsoever resulting from loss of
+ * use, data or profits, whether in an action of contract, negligence or
+ * other tortious action, arising out of or in connection with the use
+ * or performance of this software.
+ ******************************************************************************)
+(* $Id$ *)
+
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
+structure LrTable : LR_TABLE = 
+    struct
+	open Array List
+	infix 9 sub
+	datatype ('a,'b) pairlist = EMPTY
+				  | PAIR of 'a * 'b * ('a,'b) pairlist
+	datatype term = T of int
+	datatype nonterm = NT of int
+	datatype state = STATE of int
+	datatype action = SHIFT of state
+			| REDUCE of int (* rulenum from grammar *)
+			| ACCEPT
+			| ERROR
+	exception Goto of state * nonterm
+	type table = {states: int, rules : int,initialState: state,
+		      action: ((term,action) pairlist * action) array,
+		      goto :  (nonterm,state) pairlist array}
+	val numStates = fn ({states,...} : table) => states
+	val numRules = fn ({rules,...} : table) => rules
+	val describeActions =
+	   fn ({action,...} : table) => 
+	           fn (STATE s) => action sub s
+	val describeGoto =
+	   fn ({goto,...} : table) =>
+	           fn (STATE s) => goto sub s
+	fun findTerm (T term,row,default) =
+	    let fun find (PAIR (T key,data,r)) =
+		       if key < term then find r
+		       else if key=term then data
+		       else default
+		   | find EMPTY = default
+	    in find row
+	    end
+	fun findNonterm (NT nt,row) =
+	    let fun find (PAIR (NT key,data,r)) =
+		       if key < nt then find r
+		       else if key=nt then SOME data
+		       else NONE
+		   | find EMPTY = NONE
+	    in find row
+	    end
+	val action = fn ({action,...} : table) =>
+		fn (STATE state,term) =>
+		  let val (row,default) = action sub state
+		  in findTerm(term,row,default)
+		  end
+	val goto = fn ({goto,...} : table) =>
+			fn (a as (STATE state,nonterm)) =>
+			  case findNonterm(nonterm,goto sub state)
+			  of SOME state => state
+			   | NONE => raise (Goto a)
+	val initialState = fn ({initialState,...} : table) => initialState
+	val mkLrTable = fn {actions,gotos,initialState,numStates,numRules} =>
+	     ({action=actions,goto=gotos,
+	       states=numStates,
+	       rules=numRules,
+               initialState=initialState} : table)
+end;
diff --git a/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/parser2.sml b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/parser2.sml
new file mode 100644
index 0000000..267d67e
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/parser2.sml
@@ -0,0 +1,567 @@
+(******************************************************************************
+ * STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
+ * 
+ * Copyright (c) 1989-2002 by Lucent Technologies
+ * 
+ * Permission to use, copy, modify, and distribute this software and its
+ * documentation for any purpose and without fee is hereby granted,
+ * provided that the above copyright notice appear in all copies and that
+ * both the copyright notice and this permission notice and warranty
+ * disclaimer appear in supporting documentation, and that the name of
+ * Lucent Technologies, Bell Labs or any Lucent entity not be used in
+ * advertising or publicity pertaining to distribution of the software
+ * without specific, written prior permission.
+ * 
+ * Lucent disclaims all warranties with regard to this software,
+ * including all implied warranties of merchantability and fitness. In no
+ * event shall Lucent be liable for any special, indirect or
+ * consequential damages or any damages whatsoever resulting from loss of
+ * use, data or profits, whether in an action of contract, negligence or
+ * other tortious action, arising out of or in connection with the use
+ * or performance of this software.
+ ******************************************************************************)
+(* $Id$ *)
+
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
+
+(* parser.sml:  This is a parser driver for LR tables with an error-recovery
+   routine added to it.  The routine used is described in detail in this
+   article:
+
+	'A Practical Method for LR and LL Syntactic Error Diagnosis and
+	 Recovery', by M. Burke and G. Fisher, ACM Transactions on
+	 Programming Langauges and Systems, Vol. 9, No. 2, April 1987,
+	 pp. 164-197.
+
+    This program is an implementation is the partial, deferred method discussed
+    in the article.  The algorithm and data structures used in the program
+    are described below.  
+
+    This program assumes that all semantic actions are delayed.  A semantic
+    action should produce a function from unit -> value instead of producing the
+    normal value.  The parser returns the semantic value on the top of the
+    stack when accept is encountered.  The user can deconstruct this value
+    and apply the unit -> value function in it to get the answer.
+
+    It also assumes that the lexer is a lazy stream.
+
+    Data Structures:
+    ----------------
+	
+	* The parser:
+
+	   The state stack has the type
+
+		 (state * (semantic value * line # * line #)) list
+
+	   The parser keeps a queue of (state stack * lexer pair).  A lexer pair
+	 consists of a terminal * value pair and a lexer.  This allows the 
+	 parser to reconstruct the states for terminals to the left of a
+	 syntax error, and attempt to make error corrections there.
+
+	   The queue consists of a pair of lists (x,y).  New additions to
+	 the queue are cons'ed onto y.  The first element of x is the top
+	 of the queue.  If x is nil, then y is reversed and used
+	 in place of x.
+
+    Algorithm:
+    ----------
+
+	* The steady-state parser:  
+
+	    This parser keeps the length of the queue of state stacks at
+	a steady state by always removing an element from the front when
+	another element is placed on the end.
+
+	    It has these arguments:
+
+	   stack: current stack
+	   queue: value of the queue
+	   lexPair ((terminal,value),lex stream)
+
+	When SHIFT is encountered, the state to shift to and the value are
+	are pushed onto the state stack.  The state stack and lexPair are
+	placed on the queue.  The front element of the queue is removed.
+
+	When REDUCTION is encountered, the rule is applied to the current
+	stack to yield a triple (nonterm,value,new stack).  A new
+	stack is formed by adding (goto(top state of stack,nonterm),value)
+	to the stack.
+
+	When ACCEPT is encountered, the top value from the stack and the
+	lexer are returned.
+
+	When an ERROR is encountered, fixError is called.  FixError
+	takes the arguments to the parser, fixes the error if possible and
+        returns a new set of arguments.
+
+	* The distance-parser:
+
+	This parser includes an additional argument distance.  It pushes
+	elements on the queue until it has parsed distance tokens, or an
+	ACCEPT or ERROR occurs.  It returns a stack, lexer, the number of
+	tokens left unparsed, a queue, and an action option.
+*)
+
+signature FIFO = 
+  sig type 'a queue
+      val empty : 'a queue
+      exception Empty
+      val get : 'a queue -> 'a * 'a queue
+      val put : 'a * 'a queue -> 'a queue
+  end
+
+(* drt (12/15/89) -- the functor should be used in development work, but
+   it wastes space in the release version.
+
+functor ParserGen(structure LrTable : LR_TABLE
+		  structure Stream : STREAM) : LR_PARSER =
+*)
+
+structure LrParser :> LR_PARSER =
+   struct
+      structure LrTable = LrTable
+      structure Stream = Stream
+
+      val print = warning (* fn s => TextIO.output(TextIO.stdOut,s) *)
+      fun eqT (LrTable.T i, LrTable.T i') = i = i'
+
+      structure Token : TOKEN =
+	struct
+	    structure LrTable = LrTable
+	    datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
+	    val sameToken = fn (TOKEN(t,_),TOKEN(t',_)) => eqT (t,t')
+        end
+
+      open LrTable
+      open Token
+
+      val DEBUG1 = false
+      val DEBUG2 = false
+      exception ParseError
+      exception ParseImpossible of int
+
+      structure Fifo :> FIFO =
+        struct
+	  type 'a queue = ('a list * 'a list)
+	  val empty = (nil,nil)
+	  exception Empty
+	  fun get(a::x, y) = (a, (x,y))
+	    | get(nil, nil) = raise Empty
+	    | get(nil, y) = get(rev y, nil)
+ 	  fun put(a,(x,y)) = (x,a::y)
+        end
+
+      type ('a,'b) elem = (state * ('a * 'b * 'b))
+      type ('a,'b) stack = ('a,'b) elem list
+      type ('a,'b) lexv = ('a,'b) token
+      type ('a,'b) lexpair = ('a,'b) lexv * (('a,'b) lexv Stream.stream)
+      type ('a,'b) distanceParse =
+		 ('a,'b) lexpair *
+		 ('a,'b) stack * 
+		 (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
+		 int ->
+		   ('a,'b) lexpair *
+		   ('a,'b) stack * 
+		   (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
+		   int *
+		   action option
+
+      type ('a,'b) ecRecord =
+	 {is_keyword : term -> bool,
+          preferred_change : (term list * term list) list,
+	  error : string * 'b * 'b -> unit,
+	  errtermvalue : term -> 'a,
+	  terms : term list,
+	  showTerminal : term -> string,
+	  noShift : term -> bool}
+
+      local 
+	 val print = warning (* fn s => TextIO.output(TextIO.stdOut,s) *)
+	 val println = fn s => (print s; print "\n")
+	 val showState = fn (STATE s) => "STATE " ^ (Int.toString s)
+      in
+        fun printStack(stack: ('a,'b) stack, n: int) =
+         case stack
+           of (state,_) :: rest =>
+                 (print("\t" ^ Int.toString n ^ ": ");
+                  println(showState state);
+                  printStack(rest, n+1))
+            | nil => ()
+                
+        fun prAction showTerminal
+		 (stack as (state,_) :: _, next as (TOKEN (term,_),_), action) =
+             (println "Parse: state stack:";
+              printStack(stack, 0);
+              print("       state="
+                         ^ showState state	
+                         ^ " next="
+                         ^ showTerminal term
+                         ^ " action="
+                        );
+              case action
+                of SHIFT state => println ("SHIFT " ^ (showState state))
+                 | REDUCE i => println ("REDUCE " ^ (Int.toString i))
+                 | ERROR => println "ERROR"
+		 | ACCEPT => println "ACCEPT")
+        | prAction _ (_,_,action) = ()
+     end
+
+    (* ssParse: parser which maintains the queue of (state * lexvalues) in a
+	steady-state.  It takes a table, showTerminal function, saction
+	function, and fixError function.  It parses until an ACCEPT is
+	encountered, or an exception is raised.  When an error is encountered,
+	fixError is called with the arguments of parseStep (lexv,stack,and
+	queue).  It returns the lexv, and a new stack and queue adjusted so
+	that the lexv can be parsed *)
+	
+    val ssParse =
+      fn (table,showTerminal,saction,fixError,arg) =>
+	let val prAction = prAction showTerminal
+	    val action = LrTable.action table
+	    val goto = LrTable.goto table
+	    fun parseStep(args as
+			 (lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
+				      lexer
+				      ),
+			  stack as (state,_) :: _,
+			  queue)) =
+	      let val nextAction = action (state,terminal)
+	          val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
+			  else ()
+	      in case nextAction
+		 of SHIFT s =>
+		  let val newStack = (s,value) :: stack
+		      val newLexPair = Stream.get lexer
+		      val (_,newQueue) =Fifo.get(Fifo.put((newStack,newLexPair),
+							    queue))
+		  in parseStep(newLexPair,(s,value)::stack,newQueue)
+		  end
+		 | REDUCE i =>
+		     (case saction(i,leftPos,stack,arg)
+		      of (nonterm,value,stack as (state,_) :: _) =>
+		          parseStep(lexPair,(goto(state,nonterm),value)::stack,
+				    queue)
+		       | _ => raise (ParseImpossible 197))
+		 | ERROR => parseStep(fixError args)
+		 | ACCEPT => 
+			(case stack
+			 of (_,(topvalue,_,_)) :: _ =>
+				let val (token,restLexer) = lexPair
+				in (topvalue,Stream.cons(token,restLexer))
+				end
+			  | _ => raise (ParseImpossible 202))
+	      end
+	    | parseStep _ = raise (ParseImpossible 204)
+	in parseStep
+	end
+
+    (*  distanceParse: parse until n tokens are shifted, or accept or
+	error are encountered.  Takes a table, showTerminal function, and
+	semantic action function.  Returns a parser which takes a lexPair
+	(lex result * lexer), a state stack, a queue, and a distance
+	(must be > 0) to parse.  The parser returns a new lex-value, a stack
+	with the nth token shifted on top, a queue, a distance, and action
+	option. *)
+
+    val distanceParse =
+      fn (table,showTerminal,saction,arg) =>
+	let val prAction = prAction showTerminal
+	    val action = LrTable.action table
+	    val goto = LrTable.goto table
+	    fun parseStep(lexPair,stack,queue,0) = (lexPair,stack,queue,0,NONE)
+	      | parseStep(lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
+				      lexer
+				     ),
+			  stack as (state,_) :: _,
+			  queue,distance) =
+	      let val nextAction = action(state,terminal)
+	          val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
+			  else ()
+	      in case nextAction
+		 of SHIFT s =>
+		  let val newStack = (s,value) :: stack
+		      val newLexPair = Stream.get lexer
+		  in parseStep(newLexPair,(s,value)::stack,
+			       Fifo.put((newStack,newLexPair),queue),distance-1)
+		  end
+		 | REDUCE i =>
+		    (case saction(i,leftPos,stack,arg)
+		      of (nonterm,value,stack as (state,_) :: _) =>
+		         parseStep(lexPair,(goto(state,nonterm),value)::stack,
+				 queue,distance)
+		      | _ => raise (ParseImpossible 240))
+		 | ERROR => (lexPair,stack,queue,distance,SOME nextAction)
+		 | ACCEPT => (lexPair,stack,queue,distance,SOME nextAction)
+	      end
+	   | parseStep _ = raise (ParseImpossible 242)
+	in parseStep : ('_a,'_b) distanceParse 
+	end
+
+(* mkFixError: function to create fixError function which adjusts parser state
+   so that parse may continue in the presence of an error *)
+
+fun mkFixError({is_keyword,terms,errtermvalue,
+	      preferred_change,noShift,
+	      showTerminal,error,...} : ('_a,'_b) ecRecord,
+	     distanceParse : ('_a,'_b) distanceParse,
+	     minAdvance,maxAdvance) 
+
+            (lexv as (TOKEN (term,value as (_,leftPos,_)),_),stack,queue) =
+    let val _ = if DEBUG2 then
+			error("syntax error found at " ^ (showTerminal term),
+			      leftPos,leftPos)
+		else ()
+
+        fun tokAt(t,p) = TOKEN(t,(errtermvalue t,p,p))
+
+	val minDelta = 3
+
+	(* pull all the state * lexv elements from the queue *)
+
+	val stateList = 
+	   let fun f q = let val (elem,newQueue) = Fifo.get q
+			 in elem :: (f newQueue)
+			 end handle Fifo.Empty => nil
+	   in f queue
+	   end
+
+	(* now number elements of stateList, giving distance from
+	   error token *)
+
+	val (_, numStateList) =
+	      List.foldr (fn (a,(num,r)) => (num+1,(a,num)::r)) (0, []) stateList
+
+	(* Represent the set of potential changes as a linked list.
+
+	   Values of datatype Change hold information about a potential change.
+
+	   oper = oper to be applied
+	   pos = the # of the element in stateList that would be altered.
+	   distance = the number of tokens beyond the error token which the
+	     change allows us to parse.
+	   new = new terminal * value pair at that point
+	   orig = original terminal * value pair at the point being changed.
+	 *)
+
+	datatype ('a,'b) change = CHANGE of
+	   {pos : int, distance : int, leftPos: 'b, rightPos: 'b,
+	    new : ('a,'b) lexv list, orig : ('a,'b) lexv list}
+
+
+         val showTerms = String.concat o map (fn TOKEN(t,_) => " " ^ showTerminal t)
+
+	 val printChange = fn c =>
+	  let val CHANGE {distance,new,orig,pos,...} = c
+	  in (print ("{distance= " ^ (Int.toString distance));
+	      print (",orig ="); print(showTerms orig);
+	      print (",new ="); print(showTerms new);
+	      print (",pos= " ^ (Int.toString pos));
+	      print "}\n")
+	  end
+
+	val printChangeList = app printChange
+
+(* parse: given a lexPair, a stack, and the distance from the error
+   token, return the distance past the error token that we are able to parse.*)
+
+	fun parse (lexPair,stack,queuePos : int) =
+	    case distanceParse(lexPair,stack,Fifo.empty,queuePos+maxAdvance+1)
+             of (_,_,_,distance,SOME ACCEPT) => 
+		        if maxAdvance-distance-1 >= 0 
+			    then maxAdvance 
+			    else maxAdvance-distance-1
+	      | (_,_,_,distance,_) => maxAdvance - distance - 1
+
+(* catList: String.concatenate results of scanning list *)
+
+	fun catList l f = List.foldr (fn(a,r)=> f a @ r) [] l
+
+        fun keywordsDelta new = if List.exists (fn(TOKEN(t,_))=>is_keyword t) new
+	               then minDelta else 0
+
+        fun tryChange{lex,stack,pos,leftPos,rightPos,orig,new} =
+	     let val lex' = List.foldr (fn (t',p)=>(t',Stream.cons p)) lex new
+		 val distance = parse(lex',stack,pos+length new-length orig)
+	      in if distance >= minAdvance + keywordsDelta new 
+		   then [CHANGE{pos=pos,leftPos=leftPos,rightPos=rightPos,
+				distance=distance,orig=orig,new=new}] 
+		   else []
+	     end
+
+
+(* tryDelete: Try to delete n terminals.
+              Return single-element [success] or nil.
+	      Do not delete unshiftable terminals. *)
+
+
+    fun tryDelete n ((stack,lexPair as (TOKEN(term,(_,l,r)),_)),qPos) =
+	let fun del(0,accum,left,right,lexPair) =
+	          tryChange{lex=lexPair,stack=stack,
+			    pos=qPos,leftPos=left,rightPos=right,
+			    orig=rev accum, new=[]}
+	      | del(n,accum,left,right,(tok as TOKEN(term,(_,_,r)),lexer)) =
+		   if noShift term then []
+		   else del(n-1,tok::accum,left,r,Stream.get lexer)
+         in del(n,[],l,r,lexPair)
+        end
+
+(* tryInsert: try to insert tokens before the current terminal;
+       return a list of the successes  *)
+
+        fun tryInsert((stack,lexPair as (TOKEN(_,(_,l,_)),_)),queuePos) =
+	       catList terms (fn t =>
+		 tryChange{lex=lexPair,stack=stack,
+			   pos=queuePos,orig=[],new=[tokAt(t,l)],
+			   leftPos=l,rightPos=l})
+			      
+(* trySubst: try to substitute tokens for the current terminal;
+       return a list of the successes  *)
+
+        fun trySubst ((stack,lexPair as (orig as TOKEN (term,(_,l,r)),lexer)),
+		      queuePos) =
+	      if noShift term then []
+	      else
+		  catList terms (fn t =>
+		      tryChange{lex=Stream.get lexer,stack=stack,
+				pos=queuePos,
+				leftPos=l,rightPos=r,orig=[orig],
+				new=[tokAt(t,r)]})
+
+     (* do_delete(toks,lexPair) tries to delete tokens "toks" from "lexPair".
+         If it succeeds, returns SOME(toks',l,r,lp), where
+	     toks' is the actual tokens (with positions and values) deleted,
+	     (l,r) are the (leftmost,rightmost) position of toks', 
+	     lp is what remains of the stream after deletion 
+     *)
+        fun do_delete(nil,lp as (TOKEN(_,(_,l,_)),_)) = SOME(nil,l,l,lp)
+          | do_delete([t],(tok as TOKEN(t',(_,l,r)),lp')) =
+	       if eqT (t, t')
+		   then SOME([tok],l,r,Stream.get lp')
+                   else NONE
+          | do_delete(t::rest,(tok as TOKEN(t',(_,l,r)),lp')) =
+	       if eqT (t,t')
+		   then case do_delete(rest,Stream.get lp')
+                         of SOME(deleted,l',r',lp'') =>
+			       SOME(tok::deleted,l,r',lp'')
+			  | NONE => NONE
+		   else NONE
+			     
+        fun tryPreferred((stack,lexPair),queuePos) =
+	    catList preferred_change (fn (delete,insert) =>
+	       if List.exists noShift delete then [] (* should give warning at
+						 parser-generation time *)
+               else case do_delete(delete,lexPair)
+                     of SOME(deleted,l,r,lp) => 
+			    tryChange{lex=lp,stack=stack,pos=queuePos,
+				      leftPos=l,rightPos=r,orig=deleted,
+				      new=map (fn t=>(tokAt(t,r))) insert}
+		      | NONE => [])
+
+	val changes = catList numStateList tryPreferred @
+	                catList numStateList tryInsert @
+			  catList numStateList trySubst @
+			    catList numStateList (tryDelete 1) @
+			      catList numStateList (tryDelete 2) @
+			        catList numStateList (tryDelete 3)
+
+	val findMaxDist = fn l => 
+	  List.foldr (fn (CHANGE {distance,...},high) => Int.max(distance,high)) 0 l
+
+(* maxDist: max distance past error taken that we could parse *)
+
+	val maxDist = findMaxDist changes
+
+(* remove changes which did not parse maxDist tokens past the error token *)
+
+        val changes = catList changes 
+	      (fn(c as CHANGE{distance,...}) => 
+		  if distance=maxDist then [c] else [])
+
+      in case changes 
+	  of (l as change :: _) =>
+	      let fun print_msg (CHANGE {new,orig,leftPos,rightPos,...}) =
+		  let val s = 
+		      case (orig,new)
+			  of (_::_,[]) => "deleting " ^ (showTerms orig)
+	                   | ([],_::_) => "inserting " ^ (showTerms new)
+			   | _ => "replacing " ^ (showTerms orig) ^
+				 " with " ^ (showTerms new)
+		  in error ("syntax error: " ^ s,leftPos,rightPos)
+		  end
+		   
+		  val _ = 
+		      (if length l > 1 andalso DEBUG2 then
+			   (print "multiple fixes possible; could fix it by:\n";
+			    app print_msg l;
+			    print "chosen correction:\n")
+		       else ();
+		       print_msg change)
+
+		  (* findNth: find nth queue entry from the error
+		   entry.  Returns the Nth queue entry and the  portion of
+		   the queue from the beginning to the nth-1 entry.  The
+		   error entry is at the end of the queue.
+
+		   Examples:
+
+		   queue = a b c d e
+		   findNth 0 = (e,a b c d)
+		   findNth 1 =  (d,a b c)
+		   *)
+
+		  val findNth = fn n =>
+		      let fun f (h::t,0) = (h,rev t)
+			    | f (h::t,n) = f(t,n-1)
+			    | f (nil,_) = let exception FindNth
+					  in raise FindNth
+					  end
+		      in f (rev stateList,n)
+		      end
+		
+		  val CHANGE {pos,orig,new,...} = change
+		  val (last,queueFront) = findNth pos
+		  val (stack,lexPair) = last
+
+		  val lp1 = List.foldl(fn (_,(_,r)) => Stream.get r) lexPair orig
+		  val lp2 = List.foldr(fn(t,r)=>(t,Stream.cons r)) lp1 new
+
+		  val restQueue = 
+		      Fifo.put((stack,lp2),
+			       List.foldl Fifo.put Fifo.empty queueFront)
+
+		  val (lexPair,stack,queue,_,_) =
+		      distanceParse(lp2,stack,restQueue,pos)
+
+	      in (lexPair,stack,queue)
+	      end
+	| nil => (error("syntax error found at " ^ (showTerminal term),
+			leftPos,leftPos); raise ParseError)
+    end
+
+   val parse = fn {arg,table,lexer,saction,void,lookahead,
+		   ec=ec as {showTerminal,...} : ('_a,'_b) ecRecord} =>
+	let val distance = 15   (* defer distance tokens *)
+	    val minAdvance = 1  (* must parse at least 1 token past error *)
+	    val maxAdvance = Int.max(lookahead,0)(* max distance for parse check *)
+	    val lexPair = Stream.get lexer
+	    val (TOKEN (_,(_,leftPos,_)),_) = lexPair
+	    val startStack = [(initialState table,(void,leftPos,leftPos))]
+	    val startQueue = Fifo.put((startStack,lexPair),Fifo.empty)
+	    val distanceParse = distanceParse(table,showTerminal,saction,arg)
+	    val fixError = mkFixError(ec,distanceParse,minAdvance,maxAdvance)
+	    val ssParse = ssParse(table,showTerminal,saction,fixError,arg)
+	    fun loop (lexPair,stack,queue,_,SOME ACCEPT) =
+		   ssParse(lexPair,stack,queue)
+	      | loop (lexPair,stack,queue,0,_) = ssParse(lexPair,stack,queue)
+	      | loop (lexPair,stack,queue,distance,SOME ERROR) =
+		 let val (lexPair,stack,queue) = fixError(lexPair,stack,queue)
+		 in loop (distanceParse(lexPair,stack,queue,distance))
+		 end
+	      | loop _ = let exception ParseInternal
+			 in raise ParseInternal
+			 end
+	in loop (distanceParse(lexPair,startStack,startQueue,distance))
+	end
+ end;
+
diff --git a/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/root.sml b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/root.sml
new file mode 100644
index 0000000..f3e496b
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/root.sml
@@ -0,0 +1,29 @@
+(******************************************************************************
+ * STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
+ * 
+ * Copyright (c) 1989-2002 by Lucent Technologies
+ * 
+ * Permission to use, copy, modify, and distribute this software and its
+ * documentation for any purpose and without fee is hereby granted,
+ * provided that the above copyright notice appear in all copies and that
+ * both the copyright notice and this permission notice and warranty
+ * disclaimer appear in supporting documentation, and that the name of
+ * Lucent Technologies, Bell Labs or any Lucent entity not be used in
+ * advertising or publicity pertaining to distribution of the software
+ * without specific, written prior permission.
+ * 
+ * Lucent disclaims all warranties with regard to this software,
+ * including all implied warranties of merchantability and fitness. In no
+ * event shall Lucent be liable for any special, indirect or
+ * consequential damages or any damages whatsoever resulting from loss of
+ * use, data or profits, whether in an action of contract, negligence or
+ * other tortious action, arising out of or in connection with the use
+ * or performance of this software.
+ ******************************************************************************)
+(* $Id$ *)
+
+use "base.sig";
+use "join.sml";
+use "lrtable.sml";
+use "stream.sml";
+use "parser2.sml";
diff --git a/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/stream.sml b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/stream.sml
new file mode 100644
index 0000000..3075d57
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/stream.sml
@@ -0,0 +1,43 @@
+(******************************************************************************
+ * STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
+ * 
+ * Copyright (c) 1989-2002 by Lucent Technologies
+ * 
+ * Permission to use, copy, modify, and distribute this software and its
+ * documentation for any purpose and without fee is hereby granted,
+ * provided that the above copyright notice appear in all copies and that
+ * both the copyright notice and this permission notice and warranty
+ * disclaimer appear in supporting documentation, and that the name of
+ * Lucent Technologies, Bell Labs or any Lucent entity not be used in
+ * advertising or publicity pertaining to distribution of the software
+ * without specific, written prior permission.
+ * 
+ * Lucent disclaims all warranties with regard to this software,
+ * including all implied warranties of merchantability and fitness. In no
+ * event shall Lucent be liable for any special, indirect or
+ * consequential damages or any damages whatsoever resulting from loss of
+ * use, data or profits, whether in an action of contract, negligence or
+ * other tortious action, arising out of or in connection with the use
+ * or performance of this software.
+ ******************************************************************************)
+(* $Id$ *)
+
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
+
+(* Stream: a structure implementing a lazy stream.  The signature STREAM
+   is found in base.sig *)
+
+structure Stream :> STREAM =
+struct
+   datatype 'a str = EVAL of 'a * 'a str Unsynchronized.ref | UNEVAL of (unit->'a)
+
+   type 'a stream = 'a str Unsynchronized.ref
+
+   fun get(Unsynchronized.ref(EVAL t)) = t
+     | get(s as Unsynchronized.ref(UNEVAL f)) = 
+	    let val t = (f(), Unsynchronized.ref(UNEVAL f)) in s := EVAL t; t end
+
+   fun streamify f = Unsynchronized.ref(UNEVAL f)
+   fun cons(a,s) = Unsynchronized.ref(EVAL(a,s))
+
+end;
diff --git a/Automated_Stateful_Protocol_Verification/trac/ml_yacc_lib.thy b/Automated_Stateful_Protocol_Verification/trac/ml_yacc_lib.thy
new file mode 100644
index 0000000..b854a07
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/ml_yacc_lib.thy
@@ -0,0 +1,101 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      ml_yacc_lib.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>ML Yacc Library\<close>
+theory
+  "ml_yacc_lib"
+  imports
+  Main
+begin
+ML_file "ml-yacc-lib/base.sig"
+ML_file "ml-yacc-lib/join.sml"
+ML_file "ml-yacc-lib/lrtable.sml"
+ML_file "ml-yacc-lib/stream.sml"
+ML_file "ml-yacc-lib/parser2.sml"
+
+(*
+
+The files in the directory "ml-yacc-lib" are part of the sml/NJ language 
+processing tools. It was modified to work with Isabelle/ML by Achim D. Brucker.
+
+It was downloaded from http://smlnj.cs.uchicago.edu/dist/working
+
+Upstream Authors: The SML/NJ Team <smlnj-dev-list@lists.sourceforge.net>
+
+Copyright:	2003-2008	The SML/NJ Fellowship
+		1989-2002	Lucent Technologies
+		1991-2003	John Reppy
+		1996-1998,2000	YALE FLINT PROJECT
+		1992		Vrije Universiteit, The Netherlands
+		1989-1992	Andrew W. Appel, James S. Mattson, David R. Tarditi
+		1988		Evans & Sutherland Computer Corporation, Salt Lake City, Utah
+
+STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
+
+Copyright (c) 1989-2002 by Lucent Technologies
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both the copyright notice and this permission notice and warranty
+disclaimer appear in supporting documentation, and that the name of
+Lucent Technologies, Bell Labs or any Lucent entity not be used in
+advertising or publicity pertaining to distribution of the software
+without specific, written prior permission.
+
+Lucent disclaims all warranties with regard to this software,
+including all implied warranties of merchantability and fitness. In no
+event shall Lucent be liable for any special, indirect or
+consequential damages or any damages whatsoever resulting from loss of
+use, data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the use
+or performance of this software.
+
+
+The SML/NJ distribution also includes code licensed under the same
+terms as above, but with "David R. Tarditi Jr. and Andrew W. Appel",
+"Vrije Universiteit" or "Evans & Sutherland" instead of "Lucent".
+
+*)
+end
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac.thy b/Automated_Stateful_Protocol_Verification/trac/trac.thy
new file mode 100644
index 0000000..27958b1
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac.thy
@@ -0,0 +1,1947 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      trac.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>Support for the Trac Format\<close>
+theory
+  "trac"
+  imports
+  trac_fp_parser
+  trac_protocol_parser
+keywords
+      "trac" :: thy_decl
+  and "trac_import" :: thy_decl
+  and "trac_trac" :: thy_decl
+  and "trac_import_trac" :: thy_decl
+  and "protocol_model_setup" :: thy_decl
+  and "protocol_security_proof" :: thy_decl
+  and "manual_protocol_model_setup" :: thy_decl
+  and "manual_protocol_security_proof" :: thy_decl
+  and "compute_fixpoint" :: thy_decl
+  and "compute_SMP" :: thy_decl
+  and "setup_protocol_model'" :: thy_decl
+  and "protocol_security_proof'" :: thy_decl
+  and "setup_protocol_checks" :: thy_decl
+begin
+
+ML \<open>
+(* Some of this is based on code from the following files distributed with Isabelle 2018:
+    * HOL/Tools/value_command.ML
+    * HOL/Code_Evaluation.thy
+    * Pure.thy
+*)
+
+fun protocol_model_interpretation_defs name = 
+  let
+    fun f s =
+      (Binding.empty_atts:Attrib.binding, ((Binding.name s, NoSyn), name ^ "." ^ s))
+  in
+    (map f [
+      "public", "arity", "Ana", "\<Gamma>", "\<Gamma>\<^sub>v", "timpls_transformable_to", "intruder_synth_mod_timpls",
+      "analyzed_closed_mod_timpls", "timpls_transformable_to'", "intruder_synth_mod_timpls'",
+      "analyzed_closed_mod_timpls'", "admissible_transaction_terms", "admissible_transaction",
+      "abs_substs_set", "abs_substs_fun", "in_trancl", "transaction_poschecks_comp",
+      "transaction_negchecks_comp", "transaction_check_comp", "transaction_check",
+      "transaction_check_pre", "transaction_check_post", "compute_fixpoint_fun'",
+      "compute_fixpoint_fun", "attack_notin_fixpoint", "protocol_covered_by_fixpoint",
+      "analyzed_fixpoint", "wellformed_protocol'", "wellformed_protocol", "wellformed_fixpoint",
+      "wellformed_composable_protocols", "composable_protocols"
+    ]):string Interpretation.defines
+ end
+
+fun protocol_model_interpretation_params name =
+  let
+    fun f s = name ^ "_" ^ s
+  in
+    map SOME  [f "arity", "\<lambda>_. 0", f "public", f "Ana", f "\<Gamma>", "0::nat", "1::nat"]
+  end
+
+fun declare_thm_attr attribute name print lthy =
+  let 
+    val arg = [(Facts.named name, [[Token.make_string (attribute, Position.none)]])]
+    val (_, lthy') = Specification.theorems_cmd "" [(Binding.empty_atts, arg)] [] print lthy
+  in
+    lthy'
+  end
+
+fun declare_def_attr attribute name = declare_thm_attr attribute (name ^ "_def")
+
+val declare_code_eqn = declare_def_attr "code"
+
+val declare_protocol_check = declare_def_attr "protocol_checks"
+
+fun declare_protocol_checks print =
+  declare_protocol_check "attack_notin_fixpoint" print #>
+  declare_protocol_check "protocol_covered_by_fixpoint" print #>
+  declare_protocol_check "analyzed_fixpoint" print #>
+  declare_protocol_check "wellformed_protocol'" print #>
+  declare_protocol_check "wellformed_protocol" print #>
+  declare_protocol_check "wellformed_fixpoint" print #>
+  declare_protocol_check "compute_fixpoint_fun" print
+
+fun eval_define (name, raw_t) lthy = 
+  let 
+    val t = Code_Evaluation.dynamic_value_strict lthy (Syntax.read_term lthy raw_t)
+    val arg = ((Binding.name name, NoSyn), ((Binding.name (name ^ "_def"),[]), t))
+    val (_, lthy') = Local_Theory.define arg lthy
+  in
+    (t, lthy')
+  end
+
+fun eval_define_declare (name, raw_t) print =
+  eval_define (name, raw_t) ##> declare_code_eqn name print
+
+val _ = Outer_Syntax.local_theory' @{command_keyword "compute_fixpoint"} 
+        "evaluate and define protocol fixpoint"
+        (Parse.name -- Parse.name >> (fn (protocol, fixpoint) => fn print =>
+          snd o eval_define_declare (fixpoint, "compute_fixpoint_fun " ^ protocol) print));
+
+val _ = Outer_Syntax.local_theory' @{command_keyword "compute_SMP"} 
+        "evaluate and define a finite representation of the sub-message patterns of a protocol"
+        ((Scan.optional (\<^keyword>\<open>[\<close> |-- Parse.name --| \<^keyword>\<open>]\<close>) "no_optimizations") --
+          Parse.name -- Parse.name >> (fn ((opt,protocol), smp) => fn print =>
+          let
+            val rmd = "List.remdups"
+            val f = "Stateful_Strands.trms_list\<^sub>s\<^sub>s\<^sub>t"
+            val g =
+              "(\<lambda>T. " ^ f ^ " T@map (pair' prot_fun.Pair) (Stateful_Strands.setops_list\<^sub>s\<^sub>s\<^sub>t T))"
+            fun s trms =
+              "(" ^ rmd ^ " (List.concat (List.map (" ^ trms ^
+              " \<circ> Labeled_Strands.unlabel \<circ> transaction_strand) " ^ protocol ^ ")))"
+            val opt1 = "remove_superfluous_terms \<Gamma>"
+            val opt2 = "generalize_terms \<Gamma> is_Var"
+            val gsmp_opt =
+              "generalize_terms \<Gamma> (\<lambda>t. is_Var t \<and> t \<noteq> TAtom AttackType \<and> " ^
+              "t \<noteq> TAtom SetType \<and> t \<noteq> TAtom OccursSecType \<and> \<not>is_Atom (the_Var t))"
+            val smp_fun = "SMP0 Ana \<Gamma>"
+            fun smp_fun' opts =
+              "(\<lambda>T. let T' = (" ^ rmd ^ " \<circ> " ^ opts ^ " \<circ> " ^ smp_fun ^
+              ") T in List.map (\<lambda>t. t \<cdot> Typed_Model.var_rename (Typed_Model.max_var_set " ^
+              "(Messages.fv\<^sub>s\<^sub>e\<^sub>t (set (T@T'))))) T')"
+            val cmd =
+              if opt = "no_optimizations" then smp_fun ^ " " ^ s f
+              else if opt = "optimized"
+              then smp_fun' (opt1 ^ " \<circ> " ^ opt2) ^ " " ^ s f
+              else if opt = "GSMP"
+              then smp_fun' (opt1 ^ " \<circ> " ^ gsmp_opt) ^ " " ^ s g
+              else error ("Invalid option: " ^ opt)
+          in
+            snd o eval_define_declare (smp, cmd) print
+          end));
+
+val _ = Outer_Syntax.local_theory' @{command_keyword "setup_protocol_checks"}
+        "setup protocol checks"
+        (Parse.name -- Parse.name >> (fn (protocol_model, protocol_name) => fn print =>
+          let
+            val a1 = "coverage_check_intro_lemmata"
+            val a2 = "coverage_check_unfold_lemmata"
+            val a3 = "coverage_check_unfold_protocol_lemma"
+          in
+            declare_protocol_checks print #>
+            declare_thm_attr a1 (protocol_model ^ ".protocol_covered_by_fixpoint_intros") print #>
+            declare_def_attr a2 (protocol_model ^ ".protocol_covered_by_fixpoint") print #>
+            declare_def_attr a3 protocol_name print
+          end
+        ));
+
+val _ =
+  Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>setup_protocol_model'\<close>
+    "prove interpretation of protocol model locale into global theory"
+    (Parse.!!! (Parse.name -- Parse_Spec.locale_expression) >> (fn (prefix,expr) => fn lthy =>
+    let
+      fun f x y z = ([(x,(y,(Expression.Positional z,[])))],[])
+      val (a,(b,c)) = nth (fst expr) 0
+      val name = fst b
+      val _ = case c of (Expression.Named [],[]) => () | _ => error "Invalid arguments"
+      val pexpr = f a b (protocol_model_interpretation_params prefix)
+      val pdefs = protocol_model_interpretation_defs name
+    in
+      if name = ""
+      then error "No name given"
+      else Interpretation.global_interpretation_cmd pexpr pdefs lthy
+  end));
+
+val _ =
+  Outer_Syntax.local_theory_to_proof' \<^command_keyword>\<open>protocol_security_proof'\<close>
+    "prove interpretation of secure protocol locale into global theory"
+    (Parse.!!! (Parse.name -- Parse_Spec.locale_expression) >> (fn (prefix,expr) => fn print =>
+    let
+      fun f x y z = ([(x,(y,(Expression.Positional z,[])))],[])
+      val (a,(b,c)) = nth (fst expr) 0
+      val d = case c of (Expression.Positional ps,[]) => ps | _ => error "Invalid arguments"
+      val pexpr = f a b (protocol_model_interpretation_params prefix@d)
+    in
+      declare_protocol_checks print #> Interpretation.global_interpretation_cmd pexpr []
+    end
+    ));
+\<close>
+
+ML\<open>
+structure ml_isar_wrapper = struct
+  fun define_constant_definition (constname, trm) lthy = 
+    let
+      val arg = ((Binding.name constname, NoSyn), ((Binding.name (constname^"_def"),[]), trm))
+      val ((_, (_ , thm)), lthy') = Local_Theory.define arg lthy
+    in
+      (thm, lthy')
+    end
+
+  fun define_constant_definition' (constname, trm) print lthy = 
+    let
+      val arg = ((Binding.name constname, NoSyn), ((Binding.name (constname^"_def"),[]), trm))
+      val ((_, (_ , thm)), lthy') = Local_Theory.define arg lthy
+      val lthy'' = declare_code_eqn constname print lthy'
+    in
+      (thm, lthy'')
+    end
+
+  fun define_simple_abbrev (constname, trm) lthy = 
+    let
+      val arg = ((Binding.name constname, NoSyn), trm)
+      val ((_, _), lthy') = Local_Theory.abbrev Syntax.mode_default arg lthy
+    in
+      lthy'
+    end
+
+  fun define_simple_type_synonym (name, typedecl) lthy = 
+    let
+      val (_, lthy') = Typedecl.abbrev_global (Binding.name name, [], NoSyn) typedecl lthy
+    in
+      lthy'
+    end
+
+  fun define_simple_datatype (dt_tyargs, dt_name) constructors =
+    let
+      val options = Plugin_Name.default_filter
+      fun lift_c (tyargs, name) =  (((Binding.empty, Binding.name name), map (fn t => (Binding.empty, t)) tyargs), NoSyn)
+      val c_spec = map lift_c constructors
+      val datatyp = ((map (fn ty => (NONE, ty)) dt_tyargs, Binding.name dt_name), NoSyn) 
+      val dtspec =
+        ((options,false),
+         [(((datatyp, c_spec), (Binding.empty, Binding.empty, Binding.empty)), [])])
+    in
+      BNF_FP_Def_Sugar.co_datatypes BNF_Util.Least_FP BNF_LFP.construct_lfp dtspec
+    end
+
+   fun define_simple_primrec pname precs lthy = 
+     let
+       val rec_eqs = map (fn (lhs,rhs) => (((Binding.empty,[]), HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs,rhs))),[],[])) precs 
+     in
+       snd (BNF_LFP_Rec_Sugar.primrec false [] [(Binding.name pname, NONE, NoSyn)] rec_eqs lthy)
+     end
+
+   fun define_simple_fun pname precs lthy = 
+     let
+       val rec_eqs = map (fn (lhs,rhs) => (((Binding.empty,[]), HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs,rhs))),[],[])) precs 
+     in
+       Function_Fun.add_fun [(Binding.name pname, NONE, NoSyn)] rec_eqs  Function_Common.default_config lthy
+     end
+
+   fun prove_simple name stmt tactic lthy = 
+     let
+       val thm = Goal.prove lthy [] [] stmt (fn {context, ...} => tactic context) 
+                 |> Goal.norm_result lthy
+                 |> Goal.check_finished lthy
+     in 
+       lthy |>
+       snd o  Local_Theory.note ((Binding.name name, []), [thm])
+     end
+
+    fun prove_state_simple method proof_state = 
+           Seq.the_result "error in proof state" ( (Proof.refine method proof_state))
+               |> Proof.global_done_proof 
+
+end
+\<close>
+
+ML\<open>
+
+structure trac_definitorial_package = struct
+  (* constant names *)
+  open Trac_Utils
+  val enum_constsN="enum_consts"
+  val setsN="sets"
+  val funN="fun"
+  val atomN="atom"
+  val arityN="arity"
+  val publicN = "public"
+  val gammaN = "\<Gamma>"
+  val anaN = "Ana"
+  val valN = "val"
+  val timpliesN = "timplies"
+  val occursN = "occurs"
+  val enumN = "enum"
+  val priv_fun_secN = "PrivFunSec"
+  val secret_typeN = "SecretType"
+  val enum_typeN = "EnumType"
+  val other_pubconsts_typeN = "PubConstType"
+
+  val types = [enum_typeN, secret_typeN]
+  val special_funs = ["occurs", "zero", valN, priv_fun_secN]
+
+  fun mk_listT T =  Type ("List.list", [T])
+  val mk_setT = HOLogic.mk_setT
+  val boolT = HOLogic.boolT
+  val natT = HOLogic.natT
+  val mk_tupleT =  HOLogic.mk_tupleT
+  val mk_prodT = HOLogic.mk_prodT
+
+  val mk_set = HOLogic.mk_set
+  val mk_list = HOLogic.mk_list
+  val mk_nat = HOLogic.mk_nat
+  val mk_eq = HOLogic.mk_eq
+  val mk_Trueprop = HOLogic.mk_Trueprop
+  val mk_tuple = HOLogic.mk_tuple
+  val mk_prod = HOLogic.mk_prod
+
+  fun mkN (a,b) = a^"_"^b
+
+  val info = Output.information
+
+  fun rm_special_funs sel l = list_minus (list_rm_pair sel) l special_funs
+
+  fun is_priv_fun (trac:TracProtocol.protocol) f = let
+    val funs = #private (Option.valOf (#function_spec trac))
+    in
+      (* not (List.find (fn g => fst g = f) funs = NONE) *)
+      List.exists (fn (g,n) => f = g andalso n <> "0") funs
+    end
+
+  fun full_name name lthy =
+    Local_Theory.full_name lthy (Binding.name name)
+
+  fun full_name' n (trac:TracProtocol.protocol) lthy = full_name (mkN (#name trac, n)) lthy
+
+  fun mk_prot_type name targs (trac:TracProtocol.protocol) lthy =
+    Term.Type (full_name' name trac lthy, targs)
+
+  val enum_constsT = mk_prot_type enum_constsN []
+
+  fun mk_enum_const a trac lthy =
+    Term.Const (full_name' enum_constsN trac lthy ^ "." ^ a, enum_constsT trac lthy)
+
+  val databaseT = mk_prot_type setsN []
+
+  val funT = mk_prot_type funN []
+
+  val atomT = mk_prot_type atomN []
+
+  fun messageT (trac:TracProtocol.protocol) lthy =
+    Term.Type ("Transactions.prot_term", [funT trac lthy, atomT trac lthy, databaseT trac lthy])
+
+  fun message_funT (trac:TracProtocol.protocol) lthy =
+    Term.Type ("Transactions.prot_fun", [funT trac lthy, atomT trac lthy, databaseT trac lthy])
+
+  fun message_varT (trac:TracProtocol.protocol) lthy =
+    Term.Type ("Transactions.prot_var", [funT trac lthy, atomT trac lthy, databaseT trac lthy])
+
+  fun message_term_typeT (trc:TracProtocol.protocol) lthy =
+    Term.Type ("Transactions.prot_term_type", [funT trc lthy, atomT trc lthy, databaseT trc lthy])
+
+  fun message_atomT (trac:TracProtocol.protocol) lthy =
+    Term.Type ("Transactions.prot_atom", [atomT trac lthy])
+
+  fun messageT' varT (trac:TracProtocol.protocol) lthy =
+    Term.Type ("Term.term", [message_funT trac lthy, varT])
+
+  fun message_listT (trac:TracProtocol.protocol) lthy =
+    mk_listT (messageT trac lthy)
+
+  fun message_listT' varT (trac:TracProtocol.protocol) lthy =
+    mk_listT (messageT' varT trac lthy)
+
+  fun absT (trac:TracProtocol.protocol) lthy =
+    mk_setT (databaseT trac lthy)
+
+  fun abssT (trac:TracProtocol.protocol) lthy =
+    mk_setT (absT trac lthy)
+
+  val poscheckvariantT =
+    Term.Type ("Strands_and_Constraints.poscheckvariant", [])
+
+  val strand_labelT =
+    Term.Type ("Labeled_Strands.strand_label", [natT])
+
+  fun strand_stepT (trac:TracProtocol.protocol) lthy =
+    Term.Type ("Stateful_Strands.stateful_strand_step",
+               [message_funT trac lthy, message_varT trac lthy])
+
+  fun labeled_strand_stepT (trac:TracProtocol.protocol) lthy =
+    mk_prodT (strand_labelT, strand_stepT trac lthy)
+
+  fun prot_strandT (trac:TracProtocol.protocol) lthy =
+    mk_listT (labeled_strand_stepT trac lthy)
+
+  fun prot_transactionT (trac:TracProtocol.protocol) lthy =
+    Term.Type ("Transactions.prot_transaction",
+               [funT trac lthy, atomT trac lthy, databaseT trac lthy, natT])
+
+  val mk_star_label =
+    Term.Const ("Labeled_Strands.strand_label.LabelS", strand_labelT)
+
+  fun mk_prot_label (lbl:int) =
+    Term.Const ("Labeled_Strands.strand_label.LabelN", natT --> strand_labelT) $
+      mk_nat lbl
+
+  fun mk_labeled_step (label:term) (step:term) =
+    mk_prod (label, step)
+
+  fun mk_Send_step (trac:TracProtocol.protocol) lthy (label:term) (msg:term) =
+    mk_labeled_step label
+      (Term.Const ("Stateful_Strands.stateful_strand_step.Send",
+                   messageT trac lthy --> strand_stepT trac lthy) $ msg)
+
+  fun mk_Receive_step (trac:TracProtocol.protocol) lthy (label:term) (msg:term) =
+    mk_labeled_step label
+      (Term.Const ("Stateful_Strands.stateful_strand_step.Receive",
+                   messageT trac lthy --> strand_stepT trac lthy) $ msg)
+
+  fun mk_InSet_step (trac:TracProtocol.protocol) lthy (label:term) (elem:term) (set:term) =
+    let
+      val psT = [poscheckvariantT, messageT trac lthy, messageT trac lthy]
+    in
+      mk_labeled_step label
+        (Term.Const ("Stateful_Strands.stateful_strand_step.InSet",
+                     psT ---> strand_stepT trac lthy) $
+         Term.Const ("Strands_and_Constraints.poscheckvariant.Check", poscheckvariantT) $
+         elem $ set)
+    end
+
+  fun mk_NotInSet_step (trac:TracProtocol.protocol) lthy (label:term) (elem:term) (set:term) =
+    let
+      val varT = message_varT trac lthy
+      val trm_prodT = mk_prodT (messageT trac lthy, messageT trac lthy)
+      val psT = [mk_listT varT, mk_listT trm_prodT, mk_listT trm_prodT]
+    in
+      mk_labeled_step label
+        (Term.Const ("Stateful_Strands.stateful_strand_step.NegChecks",
+                     psT ---> strand_stepT trac lthy) $
+         mk_list varT [] $
+         mk_list trm_prodT [] $
+         mk_list trm_prodT [mk_prod (elem,set)])
+    end
+
+  fun mk_Inequality_step (trac:TracProtocol.protocol) lthy (label:term) (t1:term) (t2:term) =
+    let
+      val varT = message_varT trac lthy
+      val trm_prodT = mk_prodT (messageT trac lthy, messageT trac lthy)
+      val psT = [mk_listT varT, mk_listT trm_prodT, mk_listT trm_prodT]
+    in
+      mk_labeled_step label
+        (Term.Const ("Stateful_Strands.stateful_strand_step.NegChecks",
+                     psT ---> strand_stepT trac lthy) $
+         mk_list varT [] $
+         mk_list trm_prodT [mk_prod (t1,t2)] $
+         mk_list trm_prodT [])
+    end
+
+  fun mk_Insert_step (trac:TracProtocol.protocol) lthy (label:term) (elem:term) (set:term) =
+    mk_labeled_step label
+      (Term.Const ("Stateful_Strands.stateful_strand_step.Insert",
+                   [messageT trac lthy, messageT trac lthy] ---> strand_stepT trac lthy) $
+       elem $ set)
+
+  fun mk_Delete_step (trac:TracProtocol.protocol) lthy (label:term) (elem:term) (set:term) =
+    mk_labeled_step label
+      (Term.Const ("Stateful_Strands.stateful_strand_step.Delete",
+                   [messageT trac lthy, messageT trac lthy] ---> strand_stepT trac lthy) $
+       elem $ set)
+
+  fun mk_Transaction (trac:TracProtocol.protocol) lthy S1 S2 S3 S4 S5 S6 =
+    let
+      val varT = message_varT trac lthy
+      val msgT = messageT trac lthy
+      val var_listT = mk_listT varT
+      val msg_listT = mk_listT msgT
+      val trT = prot_transactionT trac lthy
+      (* val decl_elemT = mk_prodT (varT, mk_listT msgT)
+      val declT = mk_listT decl_elemT *)
+      val stepT = labeled_strand_stepT trac lthy
+      val strandT = prot_strandT trac lthy
+      val strandsT = mk_listT strandT
+      val paramsT = [(* declT,  *)var_listT, strandT, strandT, strandT, strandT, strandT]
+    in
+      Term.Const ("Transactions.prot_transaction.Transaction", paramsT ---> trT) $
+      (* mk_list decl_elemT [] $ *)
+      (if null S4 then mk_list varT []
+       else (Term.Const (@{const_name "map"}, [msgT --> varT, msg_listT] ---> var_listT) $
+             Term.Const (@{const_name "the_Var"}, msgT --> varT) $
+             mk_list msgT S4)) $
+      mk_list stepT S1 $
+      mk_list stepT [] $
+      (if null S3 then mk_list stepT S2
+       else (Term.Const (@{const_name "append"}, [strandT,strandT] ---> strandT) $
+             mk_list stepT S2 $
+            (Term.Const (@{const_name "concat"}, strandsT --> strandT) $ mk_list strandT S3))) $
+      mk_list stepT S5 $
+      mk_list stepT S6
+    end
+
+  fun get_funs (trac:TracProtocol.protocol) =
+      let
+        fun append_sec fs = fs@[(priv_fun_secN, "0")]
+        val filter_funs = filter (fn (_,n) => n <> "0")
+        val filter_consts = filter (fn (_,n) => n = "0")
+        fun inc_ar (s,n) = (s, Int.toString (1+Option.valOf (Int.fromString n)))
+      in
+        case (#function_spec trac) of 
+             NONE => ([],[],[])
+           | SOME ({public=pub, private=priv}) =>
+              let
+                val pub_symbols = rm_special_funs fst (pub@map inc_ar (filter_funs priv))
+                val pub_funs = filter_funs pub_symbols
+                val pub_consts = filter_consts pub_symbols
+                val priv_consts = append_sec (rm_special_funs fst (filter_consts priv))
+              in
+                (pub_funs, pub_consts, priv_consts)
+              end
+      end 
+
+  fun get_set_spec (trac:TracProtocol.protocol) =
+    mk_unique (map (fn (s,n) => (s,Option.valOf (Int.fromString n))) (#set_spec trac))
+
+  fun set_arity (trac:TracProtocol.protocol) s =
+    case List.find (fn x => fst x = s) (get_set_spec trac) of
+      SOME (_,n) => SOME n
+    | NONE => NONE
+
+  fun get_enums (trac:TracProtocol.protocol) =
+    mk_unique (TracProtocol.extract_Consts (#type_spec trac))
+
+  fun flatten_type_spec (trac:TracProtocol.protocol) =
+    let
+      fun find_type taus tau =
+        case List.find (fn x => fst x = tau) taus of
+          SOME x => snd x
+        | NONE => error ("Type " ^ tau ^ " has not been declared")
+      fun step taus (s,e) =
+        case e of
+          TracProtocol.Union ts =>
+            let
+              val es = map (find_type taus) ts
+              fun f es' = mk_unique (List.concat (map TracProtocol.the_Consts es'))
+            in
+              if List.all TracProtocol.is_Consts es
+              then (s,TracProtocol.Consts (f es))
+              else (s,TracProtocol.Union ts)
+            end
+        | c => (s,c)
+      fun loop taus =
+        let
+          val taus' = map (step taus) taus
+        in
+          if taus = taus'
+          then taus
+          else loop taus'
+        end
+      val flat_type_spec =
+        let
+          val x = loop (#type_spec trac)
+          val errpre = "Couldn't flatten the enumeration types: "
+        in
+          if List.all (fn (_,e) => TracProtocol.is_Consts e) x
+          then
+            let
+              val y = map (fn (s,e) => (s,TracProtocol.the_Consts e)) x
+            in
+              if List.all (not o List.null o snd) y
+              then y
+              else error (errpre ^ "does every type have at least one value?")
+            end
+          else error (errpre ^ "have all types been declared?")
+        end
+    in
+      flat_type_spec
+    end
+
+  fun is_attack_transaction (tr:TracProtocol.cTransaction) =
+    not (null (#attack_actions tr))
+
+  fun get_transaction_name (tr:TracProtocol.cTransaction) =
+    #1 (#transaction tr)
+
+  fun get_fresh_value_variables (tr:TracProtocol.cTransaction) =
+    map_filter (TracProtocol.maybe_the_Fresh o snd) (#fresh_actions tr)
+
+  fun get_nonfresh_value_variables (tr:TracProtocol.cTransaction) =
+    map fst (filter (fn x => snd x = "value") (#2 (#transaction tr)))
+
+  fun get_value_variables (tr:TracProtocol.cTransaction) =
+    get_nonfresh_value_variables tr@get_fresh_value_variables tr
+
+  fun get_enum_variables (tr:TracProtocol.cTransaction) =
+    mk_unique (filter (fn x => snd x <> "value") (#2 (#transaction tr)))
+
+  fun get_variable_restrictions (tr:TracProtocol.cTransaction) =
+    let
+      val enum_vars = get_enum_variables tr
+      val value_vars = get_value_variables tr
+      fun enum_member x = List.exists (fn y => x = fst y)
+      fun value_member x = List.exists (fn y => x = y)
+      fun aux [] = ([],[])
+        | aux ((a,b)::rs) =
+            if enum_member a enum_vars andalso enum_member b enum_vars
+            then let val (es,vs) = aux rs in ((a,b)::es,vs) end
+            else if value_member a value_vars andalso value_member b value_vars
+            then let val (es,vs) = aux rs in (es,(a,b)::vs) end
+            else error ("Ill-formed or ill-typed variable restriction: " ^ a ^ " != " ^ b)
+    in
+      aux (#3 (#transaction tr))
+    end
+
+  fun conv_enum_consts trac (t:Trac_Term.cMsg) = 
+    let
+      open Trac_Term
+      val enums = get_enums trac
+      fun aux (cFun (f,ts)) =
+            if List.exists (fn x => x = f) enums
+            then if null ts
+                 then cEnum f
+                 else error ("Enum constant " ^ f ^ " should not have a parameter list")
+            else
+              cFun (f,map aux ts)
+        | aux (cConst c) =
+            if List.exists (fn x => x = c) enums
+            then cEnum c
+            else cConst c
+        | aux (cSet (s,ts)) = cSet (s,map aux ts)
+        | aux (cOccursFact bs) = cOccursFact (aux bs)
+        | aux t = t
+    in
+      aux t
+    end
+
+  fun val_to_abs_list vs =
+    let
+      open Trac_Term
+      fun aux t = case t of cEnum b => b | _ => error "Invalid val parameter list"
+    in
+      case vs of
+        [] => []
+      | (cConst "0"::ts) => val_to_abs_list ts
+      | (cFun (s,ps)::ts) => (s, map aux ps)::val_to_abs_list ts
+      | (cSet (s,ps)::ts) => (s, map aux ps)::val_to_abs_list ts
+      | _ => error "Invalid val parameter list"
+    end
+
+  fun val_to_abs (t:Trac_Term.cMsg) =
+    let
+      open Trac_Term
+      fun aux t = case t of cEnum b => b | _ => error "Invalid val parameter list"
+
+      fun val_to_abs_list [] = []
+      | val_to_abs_list (cConst "0"::ts) = val_to_abs_list ts
+      | val_to_abs_list (cFun (s,ps)::ts) = (s, map aux ps)::val_to_abs_list ts
+      | val_to_abs_list (cSet (s,ps)::ts) = (s, map aux ps)::val_to_abs_list ts
+      | val_to_abs_list _ = error "Invalid val parameter list"
+    in
+      case t of
+        cFun (f,ts) =>
+          if f = valN
+          then cAbs (val_to_abs_list ts)
+          else cFun (f,map val_to_abs ts)
+      | cSet (s,ts) =>
+          cSet (s,map val_to_abs ts)
+      | cOccursFact bs =>
+          cOccursFact (val_to_abs bs)
+      | t => t
+    end
+
+  fun occurs_enc t =
+    let
+      open Trac_Term
+      fun aux [cVar x] = cVar x
+        | aux [cAbs bs] = cAbs bs
+        | aux _ = error "Invalid occurs parameter list"
+      fun enc (cFun (f,ts)) = (
+            if f = occursN
+            then cOccursFact (aux ts)
+            else cFun (f,map enc ts))
+        | enc (cSet (s,ts)) =
+            cSet (s,map enc ts)
+        | enc (cOccursFact bs) =
+            cOccursFact (enc bs)
+        | enc t = t
+    in
+      enc t
+    end
+
+  fun priv_fun_enc trac (Trac_Term.cFun (f,ts)) = (
+        if is_priv_fun trac f andalso
+           (case ts of Trac_Term.cPrivFunSec::_ => false | _ => true)
+        then Trac_Term.cFun (f,Trac_Term.cPrivFunSec::map (priv_fun_enc trac) ts)
+        else Trac_Term.cFun (f,map (priv_fun_enc trac) ts))
+    | priv_fun_enc _ t = t
+
+  fun transform_cMsg trac =
+    priv_fun_enc trac o occurs_enc o val_to_abs o conv_enum_consts trac
+
+  fun check_no_vars_and_consts (fp:Trac_Term.cMsg list) =
+    let
+      open Trac_Term
+      fun aux (cVar _) = false
+        | aux (cConst _) = false
+        | aux (cFun (_,ts)) = List.all aux ts
+        | aux (cSet (_,ts)) = List.all aux ts
+        | aux (cOccursFact bs) = aux bs
+        | aux _ = true
+    in
+      if List.all aux fp
+      then fp
+      else error "There shouldn't be any cVars and cConsts at this point in the fixpoint translation"
+    end
+
+  fun split_fp (fp:Trac_Term.cMsg list) =
+    let
+      open Trac_Term
+      fun fa t = case t of cFun (s,_) => s <> timpliesN | _ => true
+      fun fb (t,ts) = case t of cOccursFact (cAbs bs) => bs::ts | _ => ts
+      fun fc (cFun (s, [cAbs bs, cAbs cs]),ts) =
+          if s = timpliesN
+          then (bs,cs)::ts
+          else ts
+        | fc (_,ts) = ts
+
+      val eq = eq_set (fn ((s,xs),(t,ys)) => s = t andalso eq_set (op =) (xs,ys))
+      fun eq_pairs ((a,b),(c,d)) = eq (a,c) andalso eq (b,d)
+
+      val timplies_trancl =
+        let
+          fun trans_step ts =
+            let
+              fun aux (s,t) = map (fn (_,u) => (s,u)) (filter (fn (v,_) => eq (t,v)) ts)
+            in
+              distinct eq_pairs (filter (not o eq) (ts@List.concat (map aux ts)))
+            end
+          fun loop ts =
+            let
+              val ts' = trans_step ts
+            in
+              if eq_set eq_pairs (ts,ts')
+              then ts
+              else loop ts'
+            end
+        in
+          loop
+        end
+
+      val ti = List.foldl fc [] fp
+    in
+      (filter fa fp, distinct eq (List.foldl fb [] fp@map snd ti), timplies_trancl ti)
+    end
+
+  fun mk_enum_substs trac (vars:(string * Trac_Term.VarType) list) =
+    let
+      open Trac_Term
+      val flat_type_spec = flatten_type_spec trac
+      val deltas =
+        let
+          fun f (s,EnumType tau) = (
+              case List.find (fn x => fst x = tau) flat_type_spec of
+                SOME x => map (fn c => (s,c)) (snd x)
+              | NONE => error ("Type " ^ tau ^ " was not found in the type specification"))
+            | f (s,_) = error ("Variable " ^ s ^ " is not of enum type")
+        in
+          list_product (map f vars)
+        end
+    in
+      map (fn d => map (fn (x,t) => (x,cEnum t)) d) deltas
+    end
+
+  fun ground_enum_variables trac (fp:Trac_Term.cMsg list) =
+    let
+      open Trac_Term
+      fun do_grounding t = map (fn d => subst_apply d t) (mk_enum_substs trac (fv_cMsg t))
+    in
+      List.concat (map do_grounding fp)
+    end
+
+  fun transform_fp trac (fp:Trac_Term.cMsg list) =
+    fp |> ground_enum_variables trac
+       |> map (transform_cMsg trac)
+       |> check_no_vars_and_consts
+       |> split_fp
+
+  fun database_to_hol (db:string * Trac_Term.cMsg list) (trac:TracProtocol.protocol) lthy =
+    let
+      open Trac_Term
+      val errmsg = "Invalid database parameter"
+      fun mkN' n = mkN (#name trac, n)
+      val s_prefix = full_name (mkN' setsN) lthy ^ "."
+      val e_prefix = full_name (mkN' enum_constsN) lthy ^ "."
+      val (s,es) = db
+      val tau = enum_constsT trac lthy
+      val databaseT = databaseT trac lthy
+      val a = Term.Const (s_prefix ^ s, map (fn _ => tau) es ---> databaseT)
+      fun param_to_hol (cVar (x,EnumType _)) = Term.Free (x, tau)
+        | param_to_hol (cVar (x,Untyped)) = Term.Free (x, tau)
+        | param_to_hol (cEnum e) = Term.Const (e_prefix ^ e, tau)
+        | param_to_hol (cConst c) = error (errmsg ^ ": cConst " ^ c)
+        | param_to_hol (cVar (x,ValueType)) = error (errmsg ^ ": cVar (" ^ x ^ ",ValueType)")
+        | param_to_hol _ = error errmsg
+    in
+      fold (fn e => fn b => b $ param_to_hol e) es a
+    end
+
+  fun abs_to_hol (bs:(string * string list) list) (trac:TracProtocol.protocol) lthy =
+    let
+      val databaseT = databaseT trac lthy
+      fun db_params_to_cEnum (a,cs) = (a, map Trac_Term.cEnum cs)
+    in
+      mk_set databaseT (map (fn db => database_to_hol (db_params_to_cEnum db) trac lthy) bs)
+    end
+
+  fun cMsg_to_hol (t:Trac_Term.cMsg) lbl varT var_map free_enum_var trac lthy =
+    let
+      open Trac_Term
+      val tT = messageT' varT trac lthy
+      val fT = message_funT trac lthy
+      val enum_constsT = enum_constsT trac lthy
+      val tsT = message_listT' varT trac lthy
+      val VarT = varT --> tT
+      val FunT = [fT, tsT] ---> tT
+      val absT = absT trac lthy
+      val databaseT = databaseT trac lthy
+      val AbsT = absT --> fT
+      val funT = funT trac lthy
+      val FuT = funT --> fT
+      val SetT = databaseT --> fT
+      val enumT = enum_constsT --> funT
+      val VarC = Term.Const (@{const_name "Var"}, VarT)
+      val FunC = Term.Const (@{const_name "Fun"}, FunT)
+      val NilC = Term.Const (@{const_name "Nil"}, tsT)
+      val prot_label = mk_nat lbl
+      fun full_name'' n = full_name' n trac lthy
+      fun mk_enum_const' a = mk_enum_const a trac lthy
+      fun mk_prot_fun_trm f tau = Term.Const ("Transactions.prot_fun." ^ f, tau)
+      fun mk_enum_trm etrm =
+            mk_prot_fun_trm "Fu" FuT $ (Term.Const (full_name'' funN ^ "." ^ enumN, enumT) $ etrm)
+      fun mk_Fu_trm f =
+            mk_prot_fun_trm "Fu" FuT $ Term.Const (full_name'' funN ^ "." ^ f, funT)
+      fun c_to_h s = cMsg_to_hol s lbl varT var_map free_enum_var trac lthy
+      fun c_list_to_h ts = mk_list tT (map c_to_h ts)
+    in
+      case t of
+        cVar x =>
+          if free_enum_var x
+          then FunC $ mk_enum_trm (Term.Free (fst x, enum_constsT)) $ NilC
+          else VarC $ var_map x
+      | cConst f =>
+          FunC $
+          mk_Fu_trm f $
+          NilC
+      | cFun (f,ts) =>
+          FunC $
+          mk_Fu_trm f $
+          c_list_to_h ts
+      | cSet (s,ts) =>
+          FunC $
+          (mk_prot_fun_trm "Set" SetT $ database_to_hol (s,ts) trac lthy) $
+          NilC
+      | cAttack =>
+          FunC $
+          (mk_prot_fun_trm "Attack" (natT --> fT) $ prot_label) $
+          NilC
+      | cAbs bs =>
+          FunC $
+          (mk_prot_fun_trm "Abs" AbsT $ abs_to_hol bs trac lthy) $
+          NilC
+      | cOccursFact bs =>
+          FunC $
+          mk_prot_fun_trm "OccursFact" fT $
+          mk_list tT [
+            FunC $ mk_prot_fun_trm "OccursSec" fT $ NilC,
+            c_to_h bs]
+      | cPrivFunSec =>
+          FunC $
+          mk_Fu_trm priv_fun_secN $
+          NilC
+      | cEnum a =>
+          FunC $
+          mk_enum_trm (mk_enum_const' a) $
+          NilC
+  end
+
+  fun ground_cMsg_to_hol t lbl trac lthy =
+    cMsg_to_hol t lbl (message_varT trac lthy) (fn _ => error "Term not ground")
+                (fn _ => false) trac lthy
+
+  fun ana_cMsg_to_hol inc_vars t (ana_var_map:string list) =
+    let
+      open Trac_Term
+      fun var_map (x,Untyped) = (
+            case list_find (fn y => x = y) ana_var_map of
+              SOME (_,n) => if inc_vars then mk_nat (1+n) else mk_nat n
+            | NONE => error ("Analysis variable " ^ x ^ " not found"))
+        | var_map _ = error "Analysis variables must be untyped"
+      val lbl = 0 (* There's no constants in analysis messages requiring labels anyway *)
+    in
+      cMsg_to_hol t lbl natT var_map (fn _ => false)
+    end
+
+  fun transaction_cMsg_to_hol t lbl (transaction_var_map:string list) trac lthy =
+    let
+      open Trac_Term
+      val varT = message_varT trac lthy
+      val atomT = message_atomT trac lthy
+      val term_typeT = message_term_typeT trac lthy
+      fun TAtom_Value_var n =
+        let
+          val a = Term.Const (@{const_name "Var"}, atomT --> term_typeT) $
+                  Term.Const ("Transactions.prot_atom.Value", atomT)
+        in
+          HOLogic.mk_prod (a, mk_nat n)
+        end
+
+      fun var_map_err_prefix x =
+        "Transaction variable " ^ x ^ " should be value typed but is actually "
+
+      fun var_map (x,ValueType) = (
+            case list_find (fn y => x = y) transaction_var_map of
+              SOME (_,n) => TAtom_Value_var n
+            | NONE => error ("Transaction variable " ^ x ^ " not found"))
+        | var_map (x,EnumType e) = error (var_map_err_prefix x ^ "of enum type " ^ e)
+        | var_map (x,Untyped) = error (var_map_err_prefix x ^ "untyped")
+    in
+      cMsg_to_hol t lbl varT var_map (fn (_,t) => case t of EnumType _ => true | _ => false)
+                  trac lthy
+    end
+
+  fun fp_triple_to_hol (fp,occ,ti) trac lthy =
+    let
+      val prot_label = 0
+      val tau_abs = absT trac lthy
+      val tau_fp_elem = messageT trac lthy
+      val tau_occ_elem = tau_abs
+      val tau_ti_elem = mk_prodT (tau_abs, tau_abs)
+      fun a_to_h bs = abs_to_hol bs trac lthy
+      fun c_to_h t = ground_cMsg_to_hol t prot_label trac lthy
+      val fp' = mk_list tau_fp_elem (map c_to_h fp)
+      val occ' = mk_list tau_occ_elem (map a_to_h occ)
+      val ti' = mk_list tau_ti_elem (map (mk_prod o map_prod a_to_h) ti)
+    in
+      mk_tuple [fp', occ', ti']
+    end
+
+  fun abstract_over_enum_vars enum_vars enum_ineqs trm flat_type_spec trac lthy =
+    let
+      val enum_constsT = enum_constsT trac lthy
+      fun enumlistelemT n = mk_tupleT (replicate n enum_constsT)
+      fun enumlistT n = mk_listT (enumlistelemT n)
+      fun mk_enum_const' a = mk_enum_const a trac lthy
+
+      fun absfreeprod xs trm =
+        let
+          val tau = enum_constsT
+          val tau_out = Term.fastype_of trm
+          fun absfree' x = absfree (x,enum_constsT)
+          fun aux _ [] = trm
+            | aux _ [x] = absfree' x trm
+            | aux len (x::y::xs) =
+                Term.Const (@{const_name "case_prod"},
+                       [[tau,mk_tupleT (replicate (len-1) tau)] ---> tau_out,
+                        mk_tupleT (replicate len tau)] ---> tau_out) $
+                absfree' x (aux (len-1) (y::xs))
+        in
+          aux (length xs) xs
+        end
+
+      fun mk_enum_neq (a,b) = (HOLogic.mk_not o HOLogic.mk_eq)
+        (Term.Free (a, enum_constsT), Term.Free (b, enum_constsT))
+
+      fun mk_enum_neqs_list [] = Term.Const (@{const_name "True"}, HOLogic.boolT)
+        | mk_enum_neqs_list [x] = mk_enum_neq x
+        | mk_enum_neqs_list (x::y::xs) = HOLogic.mk_conj (mk_enum_neq x, mk_enum_neqs_list (y::xs))
+
+      val enum_types =
+        let
+          fun aux t =
+            if t = ""
+            then get_enums trac
+            else case List.find (fn (s,_) => t = s) flat_type_spec of
+                SOME (_,cs) => cs
+              | NONE => error ("Not an enum type: " ^ t ^ "?")
+        in
+          map (aux o snd) enum_vars
+        end
+
+      val enumlist_product =
+        let
+          fun mk_enumlist ns = mk_list enum_constsT (map mk_enum_const' ns)
+
+          fun aux _ [] = mk_enumlist []
+            | aux _ [ns] = mk_enumlist ns
+            | aux len (ns::ms::elists) =
+                Term.Const ("List.product", [enumlistT 1, enumlistT (len-1)] ---> enumlistT len) $
+                mk_enumlist ns $ aux (len-1) (ms::elists)
+        in
+          aux (length enum_types) enum_types
+        end
+
+      val absfp = absfreeprod (map fst enum_vars) trm
+      val eptrm = enumlist_product
+      val typof = Term.fastype_of
+      val evseT = enumlistelemT (length enum_vars)
+      val evslT = enumlistT (length enum_vars)
+      val eneqs = absfreeprod (map fst enum_vars) (mk_enum_neqs_list enum_ineqs)
+    in
+      if null enum_vars
+      then mk_list (typof trm) [trm]
+      else if null enum_ineqs
+      then Term.Const(@{const_name "map"},
+                      [typof absfp, typof eptrm] ---> mk_listT (typof trm)) $
+           absfp $ eptrm
+      else Term.Const(@{const_name "map"},
+                      [typof absfp, typof eptrm] ---> mk_listT (typof trm)) $
+           absfp $ (Term.Const(@{const_name "filter"},
+                               [evseT --> HOLogic.boolT, evslT] ---> evslT) $
+                    eneqs $ eptrm)
+    end
+
+  fun mk_type_of_name lthy pname name ty_args
+      = Type(Local_Theory.full_name lthy (Binding.name (mkN(pname, name))), ty_args)
+
+  fun mk_mt_list t = Term.Const (@{const_name "Nil"}, mk_listT t)
+
+  fun name_of_typ (Type (s, _)) = s
+    | name_of_typ (TFree _)     = error "name_of_type: unexpected TFree"
+    | name_of_typ (TVar _ )     = error "name_of_type: unexpected TVAR"
+
+  fun prove_UNIV name typ elems thmsN lthy =
+    let 
+      val rhs = mk_set typ elems
+      val lhs = Const("Set.UNIV",mk_setT typ)
+      val stmt = mk_Trueprop (mk_eq (lhs,rhs))
+      val fq_tname = name_of_typ typ 
+                          
+      fun inst_and_prove_enum thy = 
+        let
+          val _ = writeln("Inst enum: "^name)
+          val lthy = Class.instantiation ([fq_tname], [], @{sort enum}) thy
+          val enum_eq = Const("Pure.eq",mk_listT typ --> mk_listT typ --> propT)
+                             $Const(@{const_name "enum_class.enum"},mk_listT typ)
+                             $(mk_list typ elems)
+
+          val ((_, (_, enum_def')), lthy) = Specification.definition NONE [] [] 
+                                                ((Binding.name ("enum_"^name),[]), enum_eq) lthy
+          val ctxt_thy = Proof_Context.init_global (Proof_Context.theory_of lthy)
+          val enum_def = singleton (Proof_Context.export lthy ctxt_thy) enum_def'
+
+          val enum_all_eq = Const("Pure.eq", boolT --> boolT --> propT)
+                             $(Const(@{const_name "enum_class.enum_all"},(typ --> boolT) --> boolT)
+                                                  $Free("P",typ --> boolT))
+                             $(Const(@{const_name "list_all"},(typ --> boolT) --> (mk_listT typ) --> boolT)
+                                    $Free("P",typ --> boolT)$(mk_list typ elems))
+          val ((_, (_, enum_all_def')), lthy) = Specification.definition NONE [] [] 
+                                                ((Binding.name ("enum_all_"^name),[]), enum_all_eq) lthy
+          val ctxt_thy = Proof_Context.init_global (Proof_Context.theory_of lthy)
+          val enum_all_def = singleton (Proof_Context.export lthy ctxt_thy) enum_all_def'
+
+          val enum_ex_eq = Const("Pure.eq", boolT --> boolT --> propT)
+                             $(Const(@{const_name "enum_class.enum_ex"},(typ --> boolT) --> boolT)
+                                                  $Free("P",typ --> boolT))
+                             $(Const(@{const_name "list_ex"},(typ --> boolT) --> (mk_listT typ) --> boolT)
+                                    $Free("P",typ --> boolT)$(mk_list typ elems))
+          val ((_, (_, enum_ex_def')), lthy) = Specification.definition NONE [] [] 
+                                                ((Binding.name ("enum_ex_"^name),[]), enum_ex_eq) lthy
+          val ctxt_thy = Proof_Context.init_global (Proof_Context.theory_of lthy)
+          val enum_ex_def = singleton (Proof_Context.export lthy ctxt_thy) enum_ex_def'
+        in
+          Class.prove_instantiation_exit (fn ctxt => 
+            (Class.intro_classes_tac ctxt [])  THEN
+               ALLGOALS (simp_tac (ctxt addsimps  [Proof_Context.get_thm ctxt (name^"_UNIV"),  
+                                                           enum_def, enum_all_def, enum_ex_def]) ) 
+            )lthy
+        end
+      fun inst_and_prove_finite thy = 
+        let
+          val lthy = Class.instantiation ([fq_tname], [], @{sort finite}) thy
+        in 
+          Class.prove_instantiation_exit (fn ctxt => 
+            (Class.intro_classes_tac ctxt []) THEN 
+             (simp_tac (ctxt addsimps[Proof_Context.get_thm ctxt (name^"_UNIV")])) 1) lthy
+        end
+    in 
+      lthy
+      |> ml_isar_wrapper.prove_simple (name^"_UNIV") stmt 
+         (fn c =>     (safe_tac c) 
+                 THEN (ALLGOALS(simp_tac c))
+                 THEN (ALLGOALS(Metis_Tactic.metis_tac ["full_types"] 
+                                   "combs"  c 
+                                   (map (Proof_Context.get_thm c) thmsN)))
+         )
+      |> Local_Theory.raw_theory inst_and_prove_finite 
+      |> Local_Theory.raw_theory inst_and_prove_enum  
+    end
+
+  fun def_types (trac:TracProtocol.protocol) lthy = 
+    let 
+      val pname = #name trac
+      val defname = mkN(pname, enum_constsN)
+      val _ = info("  Defining "^defname)
+      val tnames = get_enums trac
+      val types = map (fn x => ([],x)) tnames
+    in 
+      ([defname], ml_isar_wrapper.define_simple_datatype ([], defname) types lthy)
+    end
+
+  fun def_sets (trac:TracProtocol.protocol) lthy = 
+    let 
+      val pname = #name trac
+      val defname = mkN(pname, setsN)
+      val _ = info ("  Defining "^defname)
+
+      val sspec = get_set_spec trac
+      val tfqn = Local_Theory.full_name lthy (Binding.name (mkN(pname, enum_constsN)))
+      val ttyp = Type(tfqn, [])
+      val types = map (fn (x,n) => (replicate n ttyp,x)) sspec
+    in
+      lthy
+      |> ml_isar_wrapper.define_simple_datatype ([], defname) types
+    end
+
+  fun def_funs (trac:TracProtocol.protocol) lthy = 
+    let 
+      val pname = #name trac
+      val (pub_f, pub_c, priv) = get_funs trac
+      val pub = pub_f@pub_c
+
+      fun def_atom lthy = 
+        let 
+          val def_atomname = mkN(pname, atomN) 
+          val types =
+            if null pub_c
+            then types
+            else types@[other_pubconsts_typeN]
+          fun define_atom_dt lthy = 
+            let
+              val _ = info("  Defining "^def_atomname)
+            in
+              lthy
+              |> ml_isar_wrapper.define_simple_datatype ([], def_atomname) (map (fn x => ([],x)) types)
+            end
+          fun prove_UNIV_atom lthy =
+            let
+              val _ = info ("    Proving "^def_atomname^"_UNIV")
+              val thmsN = [def_atomname^".exhaust"]
+              val fqn = Local_Theory.full_name lthy (Binding.name (mkN(pname, atomN)))
+              val typ = Type(fqn, [])  
+            in
+              lthy 
+              |> prove_UNIV (def_atomname) typ (map (fn c => Const(fqn^"."^c,typ)) types) thmsN 
+            end 
+        in 
+           lthy
+           |> define_atom_dt
+           |> prove_UNIV_atom
+        end
+
+      fun def_fun_dt lthy = 
+        let
+          val def_funname = mkN(pname, funN)
+          val _ = info("  Defining "^def_funname) 
+          val types = map (fn x => ([],x)) (map fst (pub@priv))
+          val ctyp = Type(Local_Theory.full_name lthy (Binding.name (mkN(pname, enum_constsN))), [])
+        in
+          ml_isar_wrapper.define_simple_datatype ([], def_funname) (types@[([ctyp],enumN)]) lthy
+        end
+
+      fun def_fun_arity lthy = 
+        let 
+          val fqn_name = Local_Theory.full_name lthy (Binding.name (mkN(pname, funN)))
+          val ctyp = Type(fqn_name, [])
+
+          fun mk_rec_eq name (fname,arity) = (Free(name,ctyp --> natT)
+                                               $Const(fqn_name^"."^fname,ctyp),
+                                                mk_nat((Option.valOf o Int.fromString) arity))
+          val name = mkN(pname, arityN)
+          val _ = info("  Defining "^name) 
+          val ctyp' = Type(Local_Theory.full_name lthy (Binding.name (mkN(pname, enum_constsN))), [])
+        in
+          ml_isar_wrapper.define_simple_fun name
+              ((map (mk_rec_eq name) (pub@priv))@[
+                      (Free(name, ctyp --> natT)
+                           $(Const(fqn_name^"."^enumN, ctyp' --> ctyp)$(Term.dummy_pattern ctyp')),
+                             mk_nat(0))]) lthy
+        end
+
+      fun def_public lthy = 
+        let 
+          val fqn_name = Local_Theory.full_name lthy (Binding.name (mkN(pname, funN)))
+          val ctyp = Type(fqn_name, [])
+
+          fun mk_rec_eq name t fname = (Free(name, ctyp --> boolT)
+                                               $Const(fqn_name^"."^fname,ctyp), t)
+          val name = mkN(pname, publicN)
+          val _ = info("  Defining "^name) 
+          val ctyp' = Type(Local_Theory.full_name lthy (Binding.name (mkN(pname, enum_constsN))), [])
+        in
+          ml_isar_wrapper.define_simple_fun name
+              ((map (mk_rec_eq name (@{term "False"})) (map fst priv))
+              @(map (mk_rec_eq name (@{term "True"})) (map fst pub))
+              @[(Free(name, ctyp --> boolT)
+                          $(Const(fqn_name^"."^enumN, ctyp' --> ctyp)$(Term.dummy_pattern ctyp')),
+                             @{term "True"})]) lthy
+        end
+
+      fun def_gamma lthy = 
+        let 
+          fun optionT t = Type (@{type_name "option"}, [t])
+          fun mk_Some t = Const (@{const_name "Some"}, t --> optionT t)
+          fun mk_None t = Const (@{const_name "None"},  optionT t)
+
+          val fqn_name = Local_Theory.full_name lthy (Binding.name (mkN(pname, funN)))
+          val ctyp = Type(fqn_name, [])
+          val atomFQN = Local_Theory.full_name lthy (Binding.name (mkN(pname, atomN)))
+          val atomT = Type(atomFQN, [])
+
+          fun mk_rec_eq name t fname = (Free(name, ctyp --> optionT atomT)
+                                               $Const(fqn_name^"."^fname,ctyp), t)
+          val name = mkN(pname, gammaN)
+          val _ = info("  Defining "^name) 
+          val ctyp' = Type(Local_Theory.full_name lthy (Binding.name (mkN(pname, enum_constsN))), [])
+        in
+          ml_isar_wrapper.define_simple_fun name
+              ((map (mk_rec_eq name ((mk_Some atomT)$(Const(atomFQN^"."^secret_typeN, atomT)))) (map fst priv))
+               @(map (mk_rec_eq name ((mk_Some atomT)$(Const(atomFQN^"."^other_pubconsts_typeN, atomT)))) (map fst pub_c))
+               @[(Free(name, ctyp --> optionT atomT)
+                           $(Const(fqn_name^"."^enumN, ctyp' --> ctyp)$(Term.dummy_pattern ctyp')),
+                              (mk_Some atomT)$(Const(atomFQN^"."^enum_typeN,atomT)))]
+               @(map (mk_rec_eq name (mk_None atomT)) (map fst pub_f)) ) lthy
+        end
+
+      fun def_ana lthy = let
+        val pname = #name trac
+        val (pub_f, pub_c, priv) = get_funs trac
+        val pub = pub_f@pub_c
+  
+        val keyT = messageT' natT trac lthy
+  
+        val fqn_name = Local_Theory.full_name lthy (Binding.name (mkN(pname, funN)))
+        val ctyp = Type(fqn_name, [])
+    
+        val ana_outputT = mk_prodT (mk_listT keyT, mk_listT natT)
+  
+        val default_output = mk_prod (mk_list keyT [], mk_list natT [])
+  
+        fun mk_ana_output ks rs = mk_prod (mk_list keyT ks, mk_list natT rs)
+  
+        fun mk_rec_eq name t fname = (Free(name, ctyp --> ana_outputT)
+                                             $Term.Const(fqn_name^"."^fname,ctyp), t)
+        val name = mkN(pname, anaN)
+        val _ = info("  Defining "^name) 
+        val ctyp' = Type(Local_Theory.full_name lthy (Binding.name (mkN(pname, enum_constsN))), [])
+    
+        val ana_spec =
+          let
+            val toInt = Option.valOf o Int.fromString
+            fun ana_arity (f,n) = (if is_priv_fun trac f then (toInt n)-1 else toInt n)
+            fun check_valid_arity ((f,ps),ks,rs) =
+              case List.find (fn g => f = fst g) pub_f of
+                SOME (f',n) =>
+                  if length ps <> ana_arity (f',n)
+                  then error ("Invalid number of parameters in the analysis rule for " ^ f ^
+                              " (expected " ^ Int.toString (ana_arity (f',n)) ^
+                              " but got " ^ Int.toString (length ps) ^ ")")
+                  else ((f,ps),ks,rs)
+              | NONE => error (f ^ " is not a declared function symbol of arity greater than zero")
+            val transform_cMsg = transform_cMsg trac
+            val rm_special_funs = rm_special_funs (fn ((f,_),_,_) => f)
+            fun var_to_nat f xs x =
+              let
+                val n = snd (Option.valOf ((list_find (fn y => y = x) xs)))
+              in
+                if is_priv_fun trac f then mk_nat (1+n) else mk_nat n
+              end
+            fun c_to_h f xs t = ana_cMsg_to_hol (is_priv_fun trac f) t xs trac lthy
+            fun keys f ps ks = map (c_to_h f ps o transform_cMsg o Trac_Term.certifyMsg [] []) ks
+            fun results f ps rs = map (var_to_nat f ps) rs
+            fun aux ((f,ps),ks,rs) = (f, mk_ana_output (keys f ps ks) (results f ps rs))
+          in
+            map (aux o check_valid_arity) (rm_special_funs (#analysis_spec trac))
+          end
+
+        val other_funs =
+          filter (fn f => not (List.exists (fn g => f = g) (map fst ana_spec))) (map fst (pub@priv))
+      in
+        ml_isar_wrapper.define_simple_fun name
+            ((map (fn (f,out) => mk_rec_eq name out f) ana_spec)
+            @(map (mk_rec_eq name default_output) other_funs)
+            @[(Free(name, ctyp --> ana_outputT)
+                      $(Term.Const(fqn_name^"."^enumN, ctyp' --> ctyp)$(Term.dummy_pattern ctyp')),
+                         default_output)]) lthy
+      end
+
+    in
+      lthy |> def_atom 
+           |> def_fun_dt
+           |> def_fun_arity
+           |> def_public
+           |> def_gamma
+           |> def_ana
+    end
+
+  fun define_term_model (trac:TracProtocol.protocol) lthy =
+    let 
+      val _ = info("Defining term model")
+    in
+      lthy |> snd o def_types trac 
+           |> def_sets trac
+           |> def_funs trac
+    end
+  
+  fun define_fixpoint fp trac print lthy =
+    let
+      val fp_name = mkN (#name trac, "fixpoint")
+      val _ = info("Defining fixpoint")
+      val _ = info("  Defining "^fp_name)
+      val fp_triple = transform_fp trac fp
+      val fp_triple_trm = fp_triple_to_hol fp_triple trac lthy
+      val trac = TracProtocol.update_fixed_point trac (SOME fp_triple)
+    in
+      (trac, #2 (ml_isar_wrapper.define_constant_definition' (fp_name, fp_triple_trm) print lthy))
+    end
+
+  fun define_protocol print ((trac:TracProtocol.protocol), lthy) = let
+      val _ =
+        if length (#transaction_spec trac) > 1
+        then info("Defining protocols")
+        else info("Defining protocol")
+      val pname = #name trac
+
+      val flat_type_spec = flatten_type_spec trac
+
+      val mk_Transaction = mk_Transaction trac lthy
+
+      val mk_Send = mk_Send_step trac lthy
+      val mk_Receive = mk_Receive_step trac lthy
+      val mk_InSet = mk_InSet_step trac lthy
+      val mk_NotInSet = mk_NotInSet_step trac lthy
+      val mk_Inequality = mk_Inequality_step trac lthy
+      val mk_Insert = mk_Insert_step trac lthy
+      val mk_Delete = mk_Delete_step trac lthy
+
+      val star_label = mk_star_label
+      val prot_label = mk_prot_label
+
+      val certify_transation = TracProtocol.certifyTransaction
+
+      fun mk_tname i (tr:TracProtocol.transaction_name) =
+        let
+          val x = #1 tr
+          val y = case i of NONE => x | SOME n => mkN(n, x)
+          val z = mkN("transaction", y)
+        in mkN(pname, z)
+        end
+
+      fun def_transaction name_prefix prot_num (transaction:TracProtocol.cTransaction) lthy = let
+        val defname = mk_tname name_prefix (#transaction transaction)
+        val _ = info("  Defining "^defname)
+
+        val receives     = #receive_actions     transaction
+        val checkssingle = #checksingle_actions transaction
+        val checksall    = #checkall_actions    transaction
+        val updates      = #update_actions      transaction
+        val sends        = #send_actions        transaction
+        val fresh        = get_fresh_value_variables transaction
+        val attack_signals = #attack_actions transaction
+
+        val nonfresh_value_vars = get_nonfresh_value_variables transaction
+        val value_vars = get_value_variables transaction
+        val enum_vars  = get_enum_variables  transaction
+
+        val (enum_ineqs, value_ineqs) = get_variable_restrictions transaction
+
+        val transform_cMsg = transform_cMsg trac
+
+        fun c_to_h trm = transaction_cMsg_to_hol (transform_cMsg trm) prot_num value_vars trac lthy
+
+        val abstract_over_enum_vars = fn x => fn y => fn z =>
+          abstract_over_enum_vars x y z flat_type_spec trac lthy
+
+        fun mk_transaction_term (rcvs, chcksingle, chckall, upds, snds, frsh, atcks) =
+          let
+            open Trac_Term
+            fun action_filter f (lbl,a) = case f a of SOME x => SOME (lbl,x) | NONE => NONE
+
+            fun lbl_to_h (TracProtocol.LabelS) = star_label
+              | lbl_to_h (TracProtocol.LabelN) = prot_label prot_num
+
+            fun lbl_trm_to_h f (lbl,t) = f (lbl_to_h lbl) (c_to_h t)
+
+            val S1 = map (lbl_trm_to_h mk_Receive)
+                         (map_filter (action_filter TracProtocol.maybe_the_Receive) rcvs)
+
+            val S2 =
+              let
+                fun aux (lbl,TracProtocol.cInequality (x,y)) =
+                      SOME (mk_Inequality (lbl_to_h lbl) (c_to_h x) (c_to_h y))
+                  | aux (lbl,TracProtocol.cInSet (e,s)) =
+                      SOME (mk_InSet (lbl_to_h lbl) (c_to_h e) (c_to_h s))
+                  | aux (lbl,TracProtocol.cNotInSet (e,s)) =
+                      SOME (mk_NotInSet (lbl_to_h lbl) (c_to_h e) (c_to_h s))
+                  | aux _ = NONE
+              in
+                map_filter aux chcksingle
+              end
+
+            val S3 =
+              let
+                fun arity s = case set_arity trac s of
+                    SOME n => n
+                  | NONE => error ("Not a set family: " ^ s)
+
+                fun mk_evs s = map (fn n => ("X" ^ Int.toString n, "")) (0 upto ((arity s) -1))
+
+                fun mk_trm (lbl,e,s) =
+                  let
+                    val ps = map (fn x => cVar (x,Untyped)) (map fst (mk_evs s))
+                  in
+                    mk_NotInSet (lbl_to_h lbl) (c_to_h e) (c_to_h (cSet (s,ps)))
+                  end
+
+                fun mk_trms (lbl,(e,s)) =
+                  abstract_over_enum_vars (mk_evs s) [] (mk_trm (lbl,e,s))
+              in
+                map mk_trms (map_filter (action_filter TracProtocol.maybe_the_NotInAny) chckall)
+              end
+
+            val S4 = map (c_to_h o mk_Value_cVar) frsh
+
+            val S5 =
+              let
+                fun aux (lbl,TracProtocol.cInsert (e,s)) =
+                      SOME (mk_Insert (lbl_to_h lbl) (c_to_h e) (c_to_h s))
+                  | aux (lbl,TracProtocol.cDelete (e,s)) =
+                      SOME (mk_Delete (lbl_to_h lbl) (c_to_h e) (c_to_h s))
+                  | aux _ = NONE
+              in
+                map_filter aux upds
+              end
+
+            val S6 =
+              let val snds' = map_filter (action_filter TracProtocol.maybe_the_Send) snds
+              in map (lbl_trm_to_h mk_Send) (snds'@map (fn (lbl,_) => (lbl,cAttack)) atcks) end
+          in
+            abstract_over_enum_vars enum_vars enum_ineqs (mk_Transaction S1 S2 S3 S4 S5 S6)
+          end
+
+        fun def_trm trm print lthy =
+          #2 (ml_isar_wrapper.define_constant_definition' (defname, trm) print lthy)
+
+        val additional_value_ineqs =
+          let
+            open Trac_Term
+            open TracProtocol
+            val poschecks = map_filter (maybe_the_InSet o snd) checkssingle
+            val negchecks_single = map_filter (maybe_the_NotInSet o snd) checkssingle
+            val negchecks_all = map_filter (maybe_the_NotInAny o snd) checksall
+
+            fun aux' (cVar (x,ValueType),s) (cVar (y,ValueType),t) =
+                  if s = t then SOME (x,y) else NONE
+              | aux' _ _ = NONE
+
+            fun aux (x,cSet (s,ps)) = SOME (
+                  map_filter (aux' (x,cSet (s,ps))) negchecks_single@
+                  map_filter (aux' (x,s)) negchecks_all
+                )
+              | aux _ = NONE
+          in
+            List.concat (map_filter aux poschecks)
+          end
+
+        val all_value_ineqs = mk_unique (value_ineqs@additional_value_ineqs)
+
+        val valvarsprod =
+              filter (fn p => not (List.exists (fn q => p = q orelse swap p = q) all_value_ineqs))
+                     (list_triangle_product (fn x => fn y => (x,y)) nonfresh_value_vars)
+
+        val transaction_trm0 = mk_transaction_term
+                      (receives, checkssingle, checksall, updates, sends, fresh, attack_signals)
+      in
+        if null valvarsprod
+        then def_trm transaction_trm0 print lthy
+        else let
+          val partitions = list_partitions nonfresh_value_vars all_value_ineqs
+          val ps = filter (not o null) (map (filter (fn x => length x > 1)) partitions)
+
+          fun mk_subst ps =
+            let 
+              open Trac_Term
+              fun aux [] = NONE
+                | aux (x::xs) = SOME (map (fn y => (y,cVar (x,ValueType))) xs)
+            in
+              List.concat (map_filter aux ps)
+            end
+
+          fun apply d =
+            let
+              val ap = TracProtocol.subst_apply_actions d
+              fun f (TracProtocol.cInequality (x,y)) = x <> y
+                | f _ = true
+              val checksingle' = filter (f o snd) (ap checkssingle)
+            in
+              (ap receives, checksingle', ap checksall, ap updates, ap sends, fresh, attack_signals)
+            end
+
+          val transaction_trms = transaction_trm0::map (mk_transaction_term o apply o mk_subst) ps
+          val transaction_typ = Term.fastype_of transaction_trm0
+
+          fun mk_concat_trm tau trms =
+            Term.Const (@{const_name "concat"}, mk_listT tau --> tau) $ mk_list tau trms
+        in
+          def_trm (mk_concat_trm transaction_typ transaction_trms) print lthy
+        end
+      end
+
+      val def_transactions =
+        let
+          val prots = map (fn (n,pr) => map (fn tr => (n,tr)) pr) (#transaction_spec trac)
+          val lbls = list_upto (length prots)
+          val lbl_prots = List.concat (map (fn i => map (fn tr => (i,tr)) (nth prots i)) lbls)
+          val f = fold (fn (i,(n,tr)) => def_transaction n i (certify_transation tr))
+        in 
+          f lbl_prots
+        end
+
+      fun def_protocols lthy = let
+          fun mk_prot_def (name,trm) lthy =
+            let val _ = info("  Defining "^name)
+            in #2 (ml_isar_wrapper.define_constant_definition' (name,trm) print lthy)
+            end
+
+          val prots = #transaction_spec trac
+          val num_prots = length prots
+
+          val pdefname = mkN(pname, "protocol")
+
+          fun mk_tnames i =
+            let
+              val trs = case nth prots i of (j,prot) => map (fn tr => (j,tr)) prot
+            in map (fn (j,s) => full_name (mk_tname j (#transaction s)) lthy) trs
+            end
+
+          val tnames = List.concat (map mk_tnames (list_upto num_prots))
+
+          val pnames =
+            let
+              val f = fn i => (Int.toString i,nth prots i)
+              val g = fn (i,(n,_)) => case n of NONE => i | SOME m => m
+              val h = fn s => mkN (pdefname,s)
+            in map (h o g o f) (list_upto num_prots)
+            end
+
+          val trtyp = prot_transactionT trac lthy
+          val trstyp = mk_listT trtyp
+    
+          fun mk_prot_trm names =
+            Term.Const (@{const_name "concat"}, mk_listT trstyp --> trstyp) $
+            mk_list trstyp (map (fn x => Term.Const (x, trstyp)) names)
+    
+          val lthy =
+            if num_prots > 1
+            then fold (fn (i,pname) => mk_prot_def (pname, mk_prot_trm (mk_tnames i)))
+                      (map (fn i => (i, nth pnames i)) (list_upto num_prots))
+                      lthy
+            else lthy
+
+          val pnames' = map (fn n => full_name n lthy) pnames
+
+          fun mk_prot_trm_with_star i =
+            let
+              fun f j =
+                if j = i
+                then Term.Const (nth pnames' j, trstyp)
+                else (Term.Const (@{const_name "map"}, [trtyp --> trtyp, trstyp] ---> trstyp) $
+                      Term.Const ("Transactions.transaction_star_proj", trtyp --> trtyp) $
+                      Term.Const (nth pnames' j, trstyp))
+            in
+              Term.Const (@{const_name "concat"}, mk_listT trstyp --> trstyp) $
+              mk_list trstyp (map f (list_upto num_prots))
+            end
+
+          val lthy =
+            if num_prots > 1
+            then fold (fn (i,pname) => mk_prot_def (pname, mk_prot_trm_with_star i))
+                      (map (fn i => (i, nth pnames i ^ "_with_star")) (list_upto num_prots))
+                      lthy
+            else lthy
+      in
+        mk_prot_def (pdefname, mk_prot_trm (if num_prots > 1 then pnames' else tnames)) lthy
+      end
+    in
+      (trac, lthy |> def_transactions |> def_protocols)
+    end
+end
+\<close>
+
+ML\<open>
+structure trac = struct
+  open Trac_Term
+
+  val info = Output.information
+  (* Define global configuration option "trac" *)
+  (* val trac_fp_compute_binary_cfg = 
+      let
+        val (trac_fp_compute_path_config, trac_fp_compute_path_setup) =
+          Attrib.config_string (Binding.name "trac_fp_compute") (K "trac_fp_compute")
+      in
+        Context.>>(Context.map_theory trac_fp_compute_path_setup);
+        trac_fp_compute_path_config
+      end
+
+  val trac_eval_cfg =
+      let
+        val (trac_fp_compute_eval_config, trac_fp_compute_eval) =
+          Attrib.config_bool (Binding.name "trac_fp_compute_eval") (K false)
+      in
+        Context.>>(Context.map_theory trac_fp_compute_eval);
+        trac_fp_compute_eval_config
+      end *)
+
+  type hide_tvar_tab = (TracProtocol.protocol) Symtab.table
+  fun trac_eq (a, a') = (#name a) = (#name a')
+  fun merge_trac_tab (tab,tab') = Symtab.merge trac_eq (tab,tab')
+  structure Data = Generic_Data
+  (
+    type T = hide_tvar_tab
+    val empty  = Symtab.empty:hide_tvar_tab
+    val extend = I
+    fun merge(t1,t2)  = merge_trac_tab (t1, t2)
+  );
+
+  fun update  p thy = Context.theory_of 
+                        ((Data.map (fn tab => Symtab.update (#name p, p) tab) (Context.Theory thy)))
+  fun lookup name thy = (Symtab.lookup ((Data.get o Context.Theory) thy) name,thy)
+
+  fun mk_abs_filename thy filename =  
+      let
+        val filename = Path.explode filename
+        val master_dir = Resources.master_directory thy
+      in
+        Path.implode (if (Path.is_absolute filename)
+                      then filename
+                      else Path.append master_dir filename)   
+      end
+
+  (* fun exec {trac_path, error_detail}  filename = let 
+        open OS.FileSys OS.Process
+ 
+        val tmpname = tmpName()
+        val err_tmpname = tmpName()      
+        fun plural 1 = "" | plural _ = "s"
+        val trac = case trac_path of 
+                         SOME s => s
+                       | NONE   => raise error ("trac_fp_compute_path not specified")
+        val cmdline = trac ^ " \"" ^ filename ^ "\" > " ^ tmpname ^ " 2> " ^ err_tmpname
+      in
+        if isSuccess (system cmdline) then (OS.FileSys.remove err_tmpname; tmpname)
+        else let val _ = OS.FileSys.remove tmpname
+                 val (msg, rest) = File.read_lines (Path.explode err_tmpname) |> chop error_detail
+                 val _ = OS.FileSys.remove err_tmpname
+                 val _ = warning ("trac failed on " ^ filename ^ "\nCommand: " ^ cmdline ^
+                                  "\n\nOutput:\n" ^
+                                  cat_lines (msg @ (if null rest then [] else
+                                                    ["(... " ^ string_of_int (length rest) ^
+                                                     " more line" ^ plural (length rest) ^ ")"])))
+             in raise error ("trac failed on " ^ filename) end
+      end *)
+
+  fun lookup_trac (pname:string) lthy =
+    Option.valOf (fst (lookup pname (Proof_Context.theory_of lthy)))
+
+  fun def_fp fp_str print (trac, lthy) =
+    let
+      val fp = TracFpParser.parse_str fp_str
+      val (trac,lthy) = trac_definitorial_package.define_fixpoint fp trac print lthy
+      val lthy = Local_Theory.raw_theory (update trac) lthy
+    in
+      (trac, lthy)
+    end
+
+  fun def_fp_file filename print (trac, lthy) = let
+        val thy = Proof_Context.theory_of lthy
+        val abs_filename = mk_abs_filename thy filename
+        val fp = TracFpParser.parse_file abs_filename
+        val (trac,lthy) = trac_definitorial_package.define_fixpoint fp trac print lthy
+        val lthy = Local_Theory.raw_theory (update trac) lthy
+      in
+        (trac, lthy)
+      end
+
+  fun def_fp_trac fp_filename print (trac, lthy) = let
+        open OS.FileSys OS.Process
+        val _ = info("Checking protocol specification with trac.")
+        val thy = Proof_Context.theory_of lthy
+        (* val trac =  Config.get_global thy trac_binary_cfg *)
+        val abs_filename = mk_abs_filename thy fp_filename
+        (* val fp_file = exec {error_detail=10, trac_path = SOME trac} abs_filename *)
+        (* val fp_raw = File.read (Path.explode fp_file) *)
+        val fp_raw = File.read (Path.explode abs_filename)
+        val fp = TracFpParser.parse_str fp_raw
+        (* val _ = OS.FileSys.remove fp_file *)
+        val _ = if TracFpParser.attack fp 
+                then 
+                  error ("  ATTACK found, skipping generating of Isabelle/HOL definitions.\n\n")
+                else 
+                  info("  No attack found, continue with generating Isabelle/HOL definitions.")
+        val (trac,lthy) = trac_definitorial_package.define_fixpoint fp trac print lthy
+        val lthy = Local_Theory.raw_theory (update trac) lthy
+      in
+        (trac, lthy)
+      end
+
+  fun def_trac_term_model str lthy = let
+        val trac = TracProtocolParser.parse_str str
+        val lthy = Local_Theory.raw_theory (update trac) lthy
+        val lthy = trac_definitorial_package.define_term_model trac lthy
+      in
+        (trac, lthy)
+      end
+
+  val def_trac_protocol = trac_definitorial_package.define_protocol
+
+  fun def_trac str print = def_trac_protocol print o def_trac_term_model str
+
+  fun def_trac_file filename print lthy = let
+        val trac_raw = File.read (Path.explode filename)
+        val (trac,lthy) = def_trac trac_raw print lthy
+        val lthy = Local_Theory.raw_theory (update trac) lthy
+      in
+        (trac, lthy)
+      end
+
+  fun def_trac_fp_trac trac_str print lthy = let
+        open OS.FileSys OS.Process
+        val (trac,lthy) = def_trac trac_str print lthy
+        val tmpname = tmpName()
+        val _ = File.write (Path.explode tmpname) trac_str
+        val (trac,lthy) = def_fp_trac tmpname print (trac, lthy)
+        val _ = OS.FileSys.remove tmpname
+        val lthy = Local_Theory.raw_theory (update trac) lthy
+      in
+        lthy
+      end
+
+end
+\<close>
+
+ML\<open>
+  val fileNameP = Parse.name -- Parse.name
+
+  val _ = Outer_Syntax.local_theory' @{command_keyword "trac_import"} 
+          "Import protocol and fixpoint from trac files." 
+          (fileNameP >> (fn (trac_filename, fp_filename) => fn print =>
+             trac.def_trac_file trac_filename print #>
+             trac.def_fp_file fp_filename print #> snd));
+
+  val _ = Outer_Syntax.local_theory' @{command_keyword "trac_import_trac"}
+          "Import protocol from trac file and compute fixpoint with trac." 
+          (fileNameP >> (fn (trac_filename, fp_filename) => fn print =>
+              trac.def_trac trac_filename print #> trac.def_fp_trac fp_filename print #> snd));
+
+  val _ = Outer_Syntax.local_theory' @{command_keyword "trac_trac"}
+          "Define protocol using trac format and compute fixpoint with trac."
+          (Parse.cartouche >> (fn trac => fn print => trac.def_trac_fp_trac trac print));
+
+  val _ = Outer_Syntax.local_theory' @{command_keyword "trac"}
+          "Define protocol and (optionally) fixpoint using trac format."
+          (Parse.cartouche -- Scan.optional Parse.cartouche "" >> (fn (trac,fp) => fn print =>
+            if fp = ""
+            then trac.def_trac trac print #> snd
+            else trac.def_trac trac print #> trac.def_fp fp print #> snd));
+\<close>
+
+ML\<open>
+val name_prefix_parser = Parse.!!! (Parse.name --| Parse.$$$ ":" -- Parse.name)
+
+(* Original definition (opt_evaluator) copied from value_command.ml *)
+val opt_proof_method_choice =
+  Scan.optional (\<^keyword>\<open>[\<close> |-- Parse.name --| \<^keyword>\<open>]\<close>) "safe";
+
+(* Original definition (locale_expression) copied from parse_spec.ML *)
+val opt_defs_list = Scan.optional
+  (\<^keyword>\<open>for\<close> |-- Scan.repeat1 Parse.name >>
+      (fn xs => if length xs > 3 then error "Too many optional arguments" else xs))
+  [];
+
+val security_proof_locale_parser =
+  name_prefix_parser -- opt_defs_list
+
+val security_proof_locale_parser_with_method_choice =
+  opt_proof_method_choice -- name_prefix_parser -- opt_defs_list
+
+
+fun protocol_model_setup_proof_state name prefix lthy =
+  let
+    fun f x y z = ([((x,Position.none),((y,true),(Expression.Positional z,[])))],[])
+    val _ = if name = "" then error "No name given" else ()
+    val pexpr = f "stateful_protocol_model" name (protocol_model_interpretation_params prefix)
+    val pdefs = protocol_model_interpretation_defs name
+    val proof_state = Interpretation.global_interpretation_cmd pexpr pdefs lthy
+  in
+    proof_state
+  end
+
+fun protocol_security_proof_proof_state manual_proof name prefix opt_defs print lthy =
+  let
+    fun f x y z = ([((x,Position.none),((y,true),(Expression.Positional z,[])))],[])
+    val _ = if name = "" then error "No name given" else ()
+    val num_defs = length opt_defs
+    val pparams = protocol_model_interpretation_params prefix
+    val default_defs = [prefix ^ "_" ^ "protocol", prefix ^ "_" ^ "fixpoint"]
+    fun g locale_name extra_params = f locale_name name (pparams@map SOME extra_params)
+    val (prot_fp_smp_names, pexpr) = if manual_proof
+      then (case num_defs of
+        0 => (default_defs, g "secure_stateful_protocol'" default_defs)
+      | 1 => (opt_defs, g "secure_stateful_protocol''" opt_defs)
+      | 2 => (opt_defs, g "secure_stateful_protocol'" opt_defs)
+      | _ => (opt_defs, g "secure_stateful_protocol" opt_defs))
+      else (case num_defs of
+        0 => (default_defs, g "secure_stateful_protocol''''" default_defs)
+      | 1 => (opt_defs, g "secure_stateful_protocol''" opt_defs)
+      | 2 => (opt_defs, g "secure_stateful_protocol''''" opt_defs)
+      | _ => (opt_defs, g "secure_stateful_protocol'''" opt_defs))
+    val proof_state = lthy |> declare_protocol_checks print
+                           |> Interpretation.global_interpretation_cmd pexpr []
+  in
+    (prot_fp_smp_names, proof_state)
+  end
+
+val _ =
+  Outer_Syntax.local_theory \<^command_keyword>\<open>protocol_model_setup\<close>
+    "prove interpretation of protocol model locale into global theory"
+    (name_prefix_parser >> (fn (name,prefix) => fn lthy =>
+    let
+      val proof_state = protocol_model_setup_proof_state name prefix lthy
+      val meth =
+        let
+          val m = "protocol_model_interpretation"
+          val _ = Output.information (
+                    "Proving protocol model locale instance with proof method " ^ m)
+        in
+          Method.Source (Token.make_src (m, Position.none) [])
+        end
+    in
+      ml_isar_wrapper.prove_state_simple meth proof_state
+  end));
+
+val _ =
+  Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>manual_protocol_model_setup\<close>
+    "prove interpretation of protocol model locale into global theory"
+    (name_prefix_parser >> (fn (name,prefix) => fn lthy =>
+    let
+      val proof_state = protocol_model_setup_proof_state name prefix lthy
+      val subgoal_proof = "  subgoal by protocol_model_subgoal\n"
+      val _ = Output.information ("Example proof:\n" ^
+                Active.sendback_markup_command ("  apply unfold_locales\n"^
+                                                subgoal_proof^
+                                                subgoal_proof^
+                                                subgoal_proof^
+                                                subgoal_proof^
+                                                subgoal_proof^
+                                                "  done\n"))
+    in
+      proof_state
+  end));
+
+val _ =
+  Outer_Syntax.local_theory' \<^command_keyword>\<open>protocol_security_proof\<close>
+    "prove interpretation of secure protocol locale into global theory"
+    (security_proof_locale_parser_with_method_choice >> (fn params => fn print => fn lthy =>
+    let
+      val ((opt_meth_level,(name,prefix)),opt_defs) = params
+      val (defs, proof_state) =
+        protocol_security_proof_proof_state false name prefix opt_defs print lthy
+      val num_defs = length defs
+      val meth =
+        let
+          val m = case opt_meth_level of
+              "safe" => "check_protocol" ^ "'" (* (if num_defs = 1 then "'" else "") *)
+            | "unsafe" => "check_protocol_unsafe" ^ "'" (* (if num_defs = 1 then "'" else "") *)
+            | _ => error ("Invalid option: " ^ opt_meth_level)
+          val _ = Output.information (
+                    "Proving security of protocol " ^ nth defs 0 ^ " with proof method " ^ m)
+          val _ = if num_defs > 1 then Output.information ("Using fixpoint " ^ nth defs 1) else ()
+          val _ = if num_defs > 2 then Output.information ("Using SMP set " ^ nth defs 2) else ()
+        in
+          Method.Source (Token.make_src (m, Position.none) [])
+        end
+    in
+      ml_isar_wrapper.prove_state_simple meth proof_state
+    end
+    ));
+
+val _ =
+  Outer_Syntax.local_theory_to_proof' \<^command_keyword>\<open>manual_protocol_security_proof\<close>
+    "prove interpretation of secure protocol locale into global theory"
+    (security_proof_locale_parser >> (fn params => fn print => fn lthy =>
+    let
+      val ((name,prefix),opt_defs) = params
+      val (defs, proof_state) =
+        protocol_security_proof_proof_state true name prefix opt_defs print lthy
+      val subgoal_proof =
+        let
+          val m = "code_simp" (* case opt_meth_level of
+              "safe" => "code_simp"
+            | "unsafe" => "eval"
+            | _ => error ("Invalid option: " ^ opt_meth_level) *)
+        in
+          "  subgoal by " ^ m ^ "\n"
+        end
+      val _ = Output.information ("Example proof:\n" ^
+                Active.sendback_markup_command ("  apply check_protocol_intro\n"^
+                                                subgoal_proof^
+                                                (if length defs = 1 then ""
+                                                 else subgoal_proof^
+                                                      subgoal_proof^
+                                                      subgoal_proof^
+                                                      subgoal_proof)^
+                                                "  done\n"))
+    in
+      proof_state
+    end
+    ));
+\<close>
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_fp_parser.thy b/Automated_Stateful_Protocol_Verification/trac/trac_fp_parser.thy
new file mode 100644
index 0000000..30542bb
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_fp_parser.thy
@@ -0,0 +1,127 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      trac_fp_parser.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section\<open>Parser for Trac FP definitions\<close>
+theory
+  trac_fp_parser
+  imports
+    "trac_term"
+begin
+
+ML_file "trac_parser/trac_fp.grm.sig"
+ML_file "trac_parser/trac_fp.lex.sml"
+ML_file "trac_parser/trac_fp.grm.sml"
+
+ML\<open>
+structure TracFpParser : sig  
+		   val parse_file: string -> (Trac_Term.cMsg) list
+       val parse_str: string -> (Trac_Term.cMsg) list
+       (* val term_of_trac: Trac_Term.cMsg -> term *)
+       val attack: Trac_Term.cMsg list -> bool
+end = 
+struct
+
+  open Trac_Term
+
+  structure TracLrVals =
+    TracLrValsFun(structure Token = LrParser.Token)
+
+  structure TracLex =
+    TracLexFun(structure Tokens = TracLrVals.Tokens)
+
+  structure TracParser =
+    Join(structure LrParser = LrParser
+	 structure ParserData = TracLrVals.ParserData
+	 structure Lex = TracLex)
+  
+  fun invoke lexstream =
+      let fun print_error (s,i:(int * int * int),_) =
+	      TextIO.output(TextIO.stdOut,
+			    "Error, line .... " ^ (Int.toString (#1 i)) ^"."^(Int.toString (#2 i ))^ ", " ^ s ^ "\n")
+       in TracParser.parse(0,lexstream,print_error,())
+      end
+
+ fun parse_fp lexer =  let
+	  val dummyEOF = TracLrVals.Tokens.EOF((0,0,0),(0,0,0))
+    fun certify (m,t) = Trac_Term.certifyMsg t [] m 
+	  fun loop lexer =
+	      let 
+		  val _ = (TracLex.UserDeclarations.pos := (0,0,0);())
+		  val (res,lexer) = invoke lexer
+		  val (nextToken,lexer) = TracParser.Stream.get lexer
+	       in if TracParser.sameToken(nextToken,dummyEOF) then ((),res)
+		  else loop lexer
+	      end
+       in  map certify (#2(loop lexer))
+      end
+
+ fun parse_file tracFile = let
+	     val infile = TextIO.openIn tracFile
+	     val lexer = TracParser.makeLexer  (fn _ => case ((TextIO.inputLine) infile) of
+                                                   SOME s => s
+                                                 | NONE   => "")
+     in
+       parse_fp lexer
+     end
+
+ fun parse_str trac_fp_str = let  
+       val parsed = Unsynchronized.ref false 
+       fun input_string _  = if !parsed then "" else (parsed := true ;trac_fp_str)
+	     val lexer = TracParser.makeLexer input_string
+     in
+       parse_fp lexer
+     end
+  fun attack fp = List.exists (fn e => e = cAttack) fp 
+
+(*   fun term_of_trac (Trac_Term.cVar (n,t)) = @{const "cVar"}$(HOLogic.mk_tuple[HOLogic.mk_string n,
+                                                                                HOLogic.mk_string t])
+    | term_of_trac (Trac_Term.cConst n)   = @{const "cConst"}$HOLogic.mk_string n
+    | term_of_trac (Trac_Term.cFun (n,l))   = @{const "cFun"}
+                           $(HOLogic.mk_tuple[HOLogic.mk_string n, HOLogic.mk_list @{typ "cMsg"} 
+                              (map term_of_trac l)]) *)
+end
+\<close>
+
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm
new file mode 100644
index 0000000..88096f5
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm
@@ -0,0 +1,126 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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.
+*)
+
+open Trac_Term
+
+exception NotYetSupported of string 
+
+
+%%
+
+%eop EOF 
+
+%left 
+
+%name Trac
+
+%term EOF
+    | COMMA of string
+    | FIXEDPOINT of string
+    | WHERE of string
+    | COLON of string
+    | PAREN_OPEN of string
+    | PAREN_CLOSE of string
+    | ASTERISK of string
+    | DOUBLE_ASTERISK of string
+    | DOUBLE_RARROW of string
+    | STRING_LITERAL of string
+    | UPPER_STRING_LITERAL of string
+    | LOWER_STRING_LITERAL of string
+    | INTEGER_LITERAL of string
+    | ONE of string
+    | ZERO of string
+    | ATTACK of string              
+         
+%nonterm START of (Msg * TypeDecl list) list
+       | trac_file of (Msg * TypeDecl list) list   
+       | symfact_list_exp of (Msg * TypeDecl list) list    
+       | symfact_exp of Msg * TypeDecl list  
+       | rule_exp of Msg   
+       | arg_list_exp of Msg list
+       | arg_exp  of Msg 
+       | type_list_exp of TypeDecl list
+       | type_exp of TypeDecl
+       | string_literal of string
+       | upper_literal of string
+       | lower_literal of string
+       | int_literal of string
+
+%pos (int * int * int)
+
+%noshift EOF
+
+%%
+
+START:               trac_file                                             (trac_file)
+trac_file:          FIXEDPOINT symfact_list_exp                            (symfact_list_exp)
+                   | symfact_list_exp                                       (symfact_list_exp)
+symfact_list_exp:    symfact_exp                                            ([symfact_exp])                 
+                   | symfact_exp symfact_list_exp                           ([symfact_exp]@symfact_list_exp)
+
+symfact_exp:         DOUBLE_RARROW ATTACK                                                 ((Attack,[])) 
+                   | rule_exp WHERE type_list_exp                           ((rule_exp,type_list_exp))
+                   | DOUBLE_RARROW rule_exp WHERE type_list_exp             ((rule_exp,type_list_exp))
+                   | DOUBLE_ASTERISK DOUBLE_RARROW rule_exp WHERE type_list_exp ((rule_exp,type_list_exp))
+                   | rule_exp                                               ((rule_exp,[]))
+                   | DOUBLE_RARROW rule_exp                                 ((rule_exp,[]))
+                   | DOUBLE_ASTERISK DOUBLE_RARROW rule_exp                 ((rule_exp,[]))
+
+rule_exp:            upper_literal                                          (Var (upper_literal))
+                   | lower_literal                                          (Fun (lower_literal,[]))
+                   | lower_literal PAREN_OPEN arg_list_exp PAREN_CLOSE      (Fun (lower_literal,arg_list_exp)) 
+arg_list_exp:        arg_exp                                                ([arg_exp])
+                   | arg_exp COMMA arg_list_exp                             ([arg_exp]@arg_list_exp)
+arg_exp:             rule_exp                                               (rule_exp)
+                   | ASTERISK int_literal                                   (Var (int_literal))
+                   | int_literal                                            (Const (int_literal))
+                                 
+type_list_exp:       type_exp                                               ([type_exp])
+                   | type_exp type_list_exp                                 ([type_exp]@type_list_exp)
+type_exp:            ASTERISK int_literal COLON string_literal              ((int_literal,string_literal))
+                   | upper_literal COLON string_literal                     ((upper_literal,string_literal))
+
+upper_literal:       UPPER_STRING_LITERAL                               (UPPER_STRING_LITERAL)
+lower_literal:       LOWER_STRING_LITERAL                               (LOWER_STRING_LITERAL)
+string_literal:      upper_literal                                      (upper_literal)
+                   | lower_literal                                      (lower_literal)
+int_literal:         INTEGER_LITERAL                                    (INTEGER_LITERAL)
+                   | ZERO                                               ("0")
+                   | ONE                                                ("1")
+
+
+                     
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sig b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sig
new file mode 100644
index 0000000..5777bec
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sig
@@ -0,0 +1,29 @@
+signature Trac_TOKENS =
+sig
+type ('a,'b) token
+type svalue
+val ATTACK: (string) *  'a * 'a -> (svalue,'a) token
+val ZERO: (string) *  'a * 'a -> (svalue,'a) token
+val ONE: (string) *  'a * 'a -> (svalue,'a) token
+val INTEGER_LITERAL: (string) *  'a * 'a -> (svalue,'a) token
+val LOWER_STRING_LITERAL: (string) *  'a * 'a -> (svalue,'a) token
+val UPPER_STRING_LITERAL: (string) *  'a * 'a -> (svalue,'a) token
+val STRING_LITERAL: (string) *  'a * 'a -> (svalue,'a) token
+val DOUBLE_RARROW: (string) *  'a * 'a -> (svalue,'a) token
+val DOUBLE_ASTERISK: (string) *  'a * 'a -> (svalue,'a) token
+val ASTERISK: (string) *  'a * 'a -> (svalue,'a) token
+val PAREN_CLOSE: (string) *  'a * 'a -> (svalue,'a) token
+val PAREN_OPEN: (string) *  'a * 'a -> (svalue,'a) token
+val COLON: (string) *  'a * 'a -> (svalue,'a) token
+val WHERE: (string) *  'a * 'a -> (svalue,'a) token
+val FIXEDPOINT: (string) *  'a * 'a -> (svalue,'a) token
+val COMMA: (string) *  'a * 'a -> (svalue,'a) token
+val EOF:  'a * 'a -> (svalue,'a) token
+end
+signature Trac_LRVALS=
+sig
+structure Tokens : Trac_TOKENS
+structure ParserData:PARSER_DATA
+sharing type ParserData.Token.token = Tokens.token
+sharing type ParserData.svalue = Tokens.svalue
+end
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sml b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sml
new file mode 100644
index 0000000..9d54dfc
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sml
@@ -0,0 +1,678 @@
+ (***** GENERATED FILE -- DO NOT EDIT ****)
+functor TracLrValsFun(structure Token : TOKEN)
+ : sig structure ParserData : PARSER_DATA
+       structure Tokens : Trac_TOKENS
+   end
+ = 
+struct
+structure ParserData=
+struct
+structure Header = 
+struct
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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.
+*)
+
+open Trac_Term
+
+exception NotYetSupported of string 
+
+
+
+end
+structure LrTable = Token.LrTable
+structure Token = Token
+local open LrTable in 
+val table=let val actionRows =
+"\
+\\001\000\001\000\000\000\000\000\
+\\001\000\003\000\013\000\009\000\012\000\010\000\011\000\012\000\010\000\
+\\013\000\009\000\000\000\
+\\001\000\005\000\038\000\000\000\
+\\001\000\005\000\047\000\000\000\
+\\001\000\007\000\036\000\000\000\
+\\001\000\008\000\028\000\012\000\010\000\013\000\009\000\014\000\027\000\
+\\015\000\026\000\016\000\025\000\000\000\
+\\001\000\008\000\032\000\012\000\010\000\000\000\
+\\001\000\009\000\012\000\010\000\011\000\012\000\010\000\013\000\009\000\000\000\
+\\001\000\010\000\019\000\000\000\
+\\001\000\012\000\010\000\013\000\009\000\000\000\
+\\001\000\012\000\010\000\013\000\009\000\017\000\018\000\000\000\
+\\001\000\014\000\027\000\015\000\026\000\016\000\025\000\000\000\
+\\051\000\000\000\
+\\052\000\000\000\
+\\053\000\000\000\
+\\054\000\009\000\012\000\010\000\011\000\012\000\010\000\013\000\009\000\000\000\
+\\055\000\000\000\
+\\056\000\000\000\
+\\057\000\000\000\
+\\058\000\000\000\
+\\059\000\000\000\
+\\060\000\004\000\015\000\000\000\
+\\061\000\004\000\033\000\000\000\
+\\062\000\004\000\042\000\000\000\
+\\063\000\000\000\
+\\064\000\006\000\014\000\000\000\
+\\065\000\000\000\
+\\066\000\002\000\035\000\000\000\
+\\067\000\000\000\
+\\068\000\000\000\
+\\069\000\000\000\
+\\070\000\000\000\
+\\071\000\008\000\032\000\012\000\010\000\000\000\
+\\072\000\000\000\
+\\073\000\000\000\
+\\074\000\000\000\
+\\075\000\000\000\
+\\076\000\000\000\
+\\077\000\000\000\
+\\078\000\000\000\
+\\079\000\000\000\
+\\080\000\000\000\
+\\081\000\000\000\
+\"
+val actionRowNumbers =
+"\001\000\025\000\024\000\021\000\
+\\015\000\014\000\012\000\037\000\
+\\036\000\010\000\008\000\007\000\
+\\005\000\006\000\016\000\022\000\
+\\017\000\009\000\013\000\031\000\
+\\027\000\004\000\029\000\041\000\
+\\042\000\040\000\011\000\002\000\
+\\032\000\018\000\011\000\006\000\
+\\023\000\005\000\026\000\030\000\
+\\009\000\033\000\003\000\019\000\
+\\006\000\028\000\039\000\038\000\
+\\035\000\009\000\020\000\034\000\
+\\000\000"
+val gotoT =
+"\
+\\001\000\048\000\002\000\006\000\003\000\005\000\004\000\004\000\
+\\005\000\003\000\011\000\002\000\012\000\001\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\003\000\014\000\004\000\004\000\005\000\003\000\011\000\002\000\
+\\012\000\001\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\005\000\015\000\011\000\002\000\012\000\001\000\000\000\
+\\000\000\
+\\003\000\018\000\004\000\004\000\005\000\003\000\011\000\002\000\
+\\012\000\001\000\000\000\
+\\005\000\022\000\006\000\021\000\007\000\020\000\011\000\002\000\
+\\012\000\001\000\013\000\019\000\000\000\
+\\008\000\029\000\009\000\028\000\011\000\027\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\005\000\032\000\011\000\002\000\012\000\001\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\013\000\035\000\000\000\
+\\000\000\
+\\008\000\037\000\009\000\028\000\011\000\027\000\000\000\
+\\000\000\
+\\013\000\038\000\000\000\
+\\008\000\039\000\009\000\028\000\011\000\027\000\000\000\
+\\000\000\
+\\005\000\022\000\006\000\041\000\007\000\020\000\011\000\002\000\
+\\012\000\001\000\013\000\019\000\000\000\
+\\000\000\
+\\000\000\
+\\010\000\044\000\011\000\043\000\012\000\042\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\008\000\046\000\009\000\028\000\011\000\027\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\010\000\047\000\011\000\043\000\012\000\042\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\"
+val numstates = 49
+val numrules = 31
+val s = Unsynchronized.ref "" and index = Unsynchronized.ref 0
+val string_to_int = fn () => 
+let val i = !index
+in index := i+2; Char.ord(String.sub(!s,i)) + Char.ord(String.sub(!s,i+1)) * 256
+end
+val string_to_list = fn s' =>
+    let val len = String.size s'
+        fun f () =
+           if !index < len then string_to_int() :: f()
+           else nil
+   in index := 0; s := s'; f ()
+   end
+val string_to_pairlist = fn (conv_key,conv_entry) =>
+     let fun f () =
+         case string_to_int()
+         of 0 => EMPTY
+          | n => PAIR(conv_key (n-1),conv_entry (string_to_int()),f())
+     in f
+     end
+val string_to_pairlist_default = fn (conv_key,conv_entry) =>
+    let val conv_row = string_to_pairlist(conv_key,conv_entry)
+    in fn () =>
+       let val default = conv_entry(string_to_int())
+           val row = conv_row()
+       in (row,default)
+       end
+   end
+val string_to_table = fn (convert_row,s') =>
+    let val len = String.size s'
+        fun f ()=
+           if !index < len then convert_row() :: f()
+           else nil
+     in (s := s'; index := 0; f ())
+     end
+local
+  val memo = Array.array(numstates+numrules,ERROR)
+  val _ =let fun g i=(Array.update(memo,i,REDUCE(i-numstates)); g(i+1))
+       fun f i =
+            if i=numstates then g i
+            else (Array.update(memo,i,SHIFT (STATE i)); f (i+1))
+          in f 0 handle General.Subscript => ()
+          end
+in
+val entry_to_action = fn 0 => ACCEPT | 1 => ERROR | j => Array.sub(memo,(j-2))
+end
+val gotoT=Array.fromList(string_to_table(string_to_pairlist(NT,STATE),gotoT))
+val actionRows=string_to_table(string_to_pairlist_default(T,entry_to_action),actionRows)
+val actionRowNumbers = string_to_list actionRowNumbers
+val actionT = let val actionRowLookUp=
+let val a=Array.fromList(actionRows) in fn i=>Array.sub(a,i) end
+in Array.fromList(List.map actionRowLookUp actionRowNumbers)
+end
+in LrTable.mkLrTable {actions=actionT,gotos=gotoT,numRules=numrules,
+numStates=numstates,initialState=STATE 0}
+end
+end
+local open Header in
+type pos =  ( int * int * int ) 
+type arg = unit
+structure MlyValue = 
+struct
+datatype svalue = VOID | ntVOID of unit ->  unit
+ | ATTACK of unit ->  (string) | ZERO of unit ->  (string)
+ | ONE of unit ->  (string) | INTEGER_LITERAL of unit ->  (string)
+ | LOWER_STRING_LITERAL of unit ->  (string)
+ | UPPER_STRING_LITERAL of unit ->  (string)
+ | STRING_LITERAL of unit ->  (string)
+ | DOUBLE_RARROW of unit ->  (string)
+ | DOUBLE_ASTERISK of unit ->  (string)
+ | ASTERISK of unit ->  (string) | PAREN_CLOSE of unit ->  (string)
+ | PAREN_OPEN of unit ->  (string) | COLON of unit ->  (string)
+ | WHERE of unit ->  (string) | FIXEDPOINT of unit ->  (string)
+ | COMMA of unit ->  (string) | int_literal of unit ->  (string)
+ | lower_literal of unit ->  (string)
+ | upper_literal of unit ->  (string)
+ | string_literal of unit ->  (string)
+ | type_exp of unit ->  (TypeDecl)
+ | type_list_exp of unit ->  (TypeDecl list)
+ | arg_exp of unit ->  (Msg) | arg_list_exp of unit ->  (Msg list)
+ | rule_exp of unit ->  (Msg)
+ | symfact_exp of unit ->  (Msg*TypeDecl list)
+ | symfact_list_exp of unit ->  ( ( Msg * TypeDecl list )  list)
+ | trac_file of unit ->  ( ( Msg * TypeDecl list )  list)
+ | START of unit ->  ( ( Msg * TypeDecl list )  list)
+end
+type svalue = MlyValue.svalue
+type result =  ( Msg * TypeDecl list )  list
+end
+structure EC=
+struct
+open LrTable
+infix 5 $$
+fun x $$ y = y::x
+val is_keyword =
+fn _ => false
+val preferred_change : (term list * term list) list = 
+nil
+val noShift = 
+fn (T 0) => true | _ => false
+val showTerminal =
+fn (T 0) => "EOF"
+  | (T 1) => "COMMA"
+  | (T 2) => "FIXEDPOINT"
+  | (T 3) => "WHERE"
+  | (T 4) => "COLON"
+  | (T 5) => "PAREN_OPEN"
+  | (T 6) => "PAREN_CLOSE"
+  | (T 7) => "ASTERISK"
+  | (T 8) => "DOUBLE_ASTERISK"
+  | (T 9) => "DOUBLE_RARROW"
+  | (T 10) => "STRING_LITERAL"
+  | (T 11) => "UPPER_STRING_LITERAL"
+  | (T 12) => "LOWER_STRING_LITERAL"
+  | (T 13) => "INTEGER_LITERAL"
+  | (T 14) => "ONE"
+  | (T 15) => "ZERO"
+  | (T 16) => "ATTACK"
+  | _ => "bogus-term"
+local open Header in
+val errtermvalue=
+fn _ => MlyValue.VOID
+end
+val terms : term list = nil
+ $$ (T 0)end
+structure Actions =
+struct 
+exception mlyAction of int
+local open Header in
+val actions = 
+fn (i392,defaultPos,stack,
+    (()):arg) =>
+case (i392,stack)
+of  ( 0, ( ( _, ( MlyValue.trac_file trac_file1, trac_file1left, 
+trac_file1right)) :: rest671)) => let val  result = MlyValue.START (fn
+ _ => let val  (trac_file as trac_file1) = trac_file1 ()
+ in (trac_file)
+end)
+ in ( LrTable.NT 0, ( result, trac_file1left, trac_file1right), 
+rest671)
+end
+|  ( 1, ( ( _, ( MlyValue.symfact_list_exp symfact_list_exp1, _, 
+symfact_list_exp1right)) :: ( _, ( MlyValue.FIXEDPOINT FIXEDPOINT1, 
+FIXEDPOINT1left, _)) :: rest671)) => let val  result = 
+MlyValue.trac_file (fn _ => let val  FIXEDPOINT1 = FIXEDPOINT1 ()
+ val  (symfact_list_exp as symfact_list_exp1) = symfact_list_exp1 ()
+ in (symfact_list_exp)
+end)
+ in ( LrTable.NT 1, ( result, FIXEDPOINT1left, symfact_list_exp1right)
+, rest671)
+end
+|  ( 2, ( ( _, ( MlyValue.symfact_list_exp symfact_list_exp1, 
+symfact_list_exp1left, symfact_list_exp1right)) :: rest671)) => let
+ val  result = MlyValue.trac_file (fn _ => let val  (symfact_list_exp
+ as symfact_list_exp1) = symfact_list_exp1 ()
+ in (symfact_list_exp)
+end)
+ in ( LrTable.NT 1, ( result, symfact_list_exp1left, 
+symfact_list_exp1right), rest671)
+end
+|  ( 3, ( ( _, ( MlyValue.symfact_exp symfact_exp1, symfact_exp1left, 
+symfact_exp1right)) :: rest671)) => let val  result = 
+MlyValue.symfact_list_exp (fn _ => let val  (symfact_exp as 
+symfact_exp1) = symfact_exp1 ()
+ in ([symfact_exp])
+end)
+ in ( LrTable.NT 2, ( result, symfact_exp1left, symfact_exp1right), 
+rest671)
+end
+|  ( 4, ( ( _, ( MlyValue.symfact_list_exp symfact_list_exp1, _, 
+symfact_list_exp1right)) :: ( _, ( MlyValue.symfact_exp symfact_exp1, 
+symfact_exp1left, _)) :: rest671)) => let val  result = 
+MlyValue.symfact_list_exp (fn _ => let val  (symfact_exp as 
+symfact_exp1) = symfact_exp1 ()
+ val  (symfact_list_exp as symfact_list_exp1) = symfact_list_exp1 ()
+ in ([symfact_exp]@symfact_list_exp)
+end)
+ in ( LrTable.NT 2, ( result, symfact_exp1left, symfact_list_exp1right
+), rest671)
+end
+|  ( 5, ( ( _, ( MlyValue.ATTACK ATTACK1, _, ATTACK1right)) :: ( _, ( 
+MlyValue.DOUBLE_RARROW DOUBLE_RARROW1, DOUBLE_RARROW1left, _)) :: 
+rest671)) => let val  result = MlyValue.symfact_exp (fn _ => let val  
+DOUBLE_RARROW1 = DOUBLE_RARROW1 ()
+ val  ATTACK1 = ATTACK1 ()
+ in ((Attack,[]))
+end)
+ in ( LrTable.NT 3, ( result, DOUBLE_RARROW1left, ATTACK1right), 
+rest671)
+end
+|  ( 6, ( ( _, ( MlyValue.type_list_exp type_list_exp1, _, 
+type_list_exp1right)) :: ( _, ( MlyValue.WHERE WHERE1, _, _)) :: ( _, 
+( MlyValue.rule_exp rule_exp1, rule_exp1left, _)) :: rest671)) => let
+ val  result = MlyValue.symfact_exp (fn _ => let val  (rule_exp as 
+rule_exp1) = rule_exp1 ()
+ val  WHERE1 = WHERE1 ()
+ val  (type_list_exp as type_list_exp1) = type_list_exp1 ()
+ in ((rule_exp,type_list_exp))
+end)
+ in ( LrTable.NT 3, ( result, rule_exp1left, type_list_exp1right), 
+rest671)
+end
+|  ( 7, ( ( _, ( MlyValue.type_list_exp type_list_exp1, _, 
+type_list_exp1right)) :: ( _, ( MlyValue.WHERE WHERE1, _, _)) :: ( _, 
+( MlyValue.rule_exp rule_exp1, _, _)) :: ( _, ( MlyValue.DOUBLE_RARROW
+ DOUBLE_RARROW1, DOUBLE_RARROW1left, _)) :: rest671)) => let val  
+result = MlyValue.symfact_exp (fn _ => let val  DOUBLE_RARROW1 = 
+DOUBLE_RARROW1 ()
+ val  (rule_exp as rule_exp1) = rule_exp1 ()
+ val  WHERE1 = WHERE1 ()
+ val  (type_list_exp as type_list_exp1) = type_list_exp1 ()
+ in ((rule_exp,type_list_exp))
+end)
+ in ( LrTable.NT 3, ( result, DOUBLE_RARROW1left, type_list_exp1right)
+, rest671)
+end
+|  ( 8, ( ( _, ( MlyValue.type_list_exp type_list_exp1, _, 
+type_list_exp1right)) :: ( _, ( MlyValue.WHERE WHERE1, _, _)) :: ( _, 
+( MlyValue.rule_exp rule_exp1, _, _)) :: ( _, ( MlyValue.DOUBLE_RARROW
+ DOUBLE_RARROW1, _, _)) :: ( _, ( MlyValue.DOUBLE_ASTERISK 
+DOUBLE_ASTERISK1, DOUBLE_ASTERISK1left, _)) :: rest671)) => let val  
+result = MlyValue.symfact_exp (fn _ => let val  DOUBLE_ASTERISK1 = 
+DOUBLE_ASTERISK1 ()
+ val  DOUBLE_RARROW1 = DOUBLE_RARROW1 ()
+ val  (rule_exp as rule_exp1) = rule_exp1 ()
+ val  WHERE1 = WHERE1 ()
+ val  (type_list_exp as type_list_exp1) = type_list_exp1 ()
+ in ((rule_exp,type_list_exp))
+end)
+ in ( LrTable.NT 3, ( result, DOUBLE_ASTERISK1left, 
+type_list_exp1right), rest671)
+end
+|  ( 9, ( ( _, ( MlyValue.rule_exp rule_exp1, rule_exp1left, 
+rule_exp1right)) :: rest671)) => let val  result = 
+MlyValue.symfact_exp (fn _ => let val  (rule_exp as rule_exp1) = 
+rule_exp1 ()
+ in ((rule_exp,[]))
+end)
+ in ( LrTable.NT 3, ( result, rule_exp1left, rule_exp1right), rest671)
+
+end
+|  ( 10, ( ( _, ( MlyValue.rule_exp rule_exp1, _, rule_exp1right)) :: 
+( _, ( MlyValue.DOUBLE_RARROW DOUBLE_RARROW1, DOUBLE_RARROW1left, _))
+ :: rest671)) => let val  result = MlyValue.symfact_exp (fn _ => let
+ val  DOUBLE_RARROW1 = DOUBLE_RARROW1 ()
+ val  (rule_exp as rule_exp1) = rule_exp1 ()
+ in ((rule_exp,[]))
+end)
+ in ( LrTable.NT 3, ( result, DOUBLE_RARROW1left, rule_exp1right), 
+rest671)
+end
+|  ( 11, ( ( _, ( MlyValue.rule_exp rule_exp1, _, rule_exp1right)) :: 
+( _, ( MlyValue.DOUBLE_RARROW DOUBLE_RARROW1, _, _)) :: ( _, ( 
+MlyValue.DOUBLE_ASTERISK DOUBLE_ASTERISK1, DOUBLE_ASTERISK1left, _))
+ :: rest671)) => let val  result = MlyValue.symfact_exp (fn _ => let
+ val  DOUBLE_ASTERISK1 = DOUBLE_ASTERISK1 ()
+ val  DOUBLE_RARROW1 = DOUBLE_RARROW1 ()
+ val  (rule_exp as rule_exp1) = rule_exp1 ()
+ in ((rule_exp,[]))
+end)
+ in ( LrTable.NT 3, ( result, DOUBLE_ASTERISK1left, rule_exp1right), 
+rest671)
+end
+|  ( 12, ( ( _, ( MlyValue.upper_literal upper_literal1, 
+upper_literal1left, upper_literal1right)) :: rest671)) => let val  
+result = MlyValue.rule_exp (fn _ => let val  (upper_literal as 
+upper_literal1) = upper_literal1 ()
+ in (Var (upper_literal))
+end)
+ in ( LrTable.NT 4, ( result, upper_literal1left, upper_literal1right)
+, rest671)
+end
+|  ( 13, ( ( _, ( MlyValue.lower_literal lower_literal1, 
+lower_literal1left, lower_literal1right)) :: rest671)) => let val  
+result = MlyValue.rule_exp (fn _ => let val  (lower_literal as 
+lower_literal1) = lower_literal1 ()
+ in (Fun (lower_literal,[]))
+end)
+ in ( LrTable.NT 4, ( result, lower_literal1left, lower_literal1right)
+, rest671)
+end
+|  ( 14, ( ( _, ( MlyValue.PAREN_CLOSE PAREN_CLOSE1, _, 
+PAREN_CLOSE1right)) :: ( _, ( MlyValue.arg_list_exp arg_list_exp1, _,
+ _)) :: ( _, ( MlyValue.PAREN_OPEN PAREN_OPEN1, _, _)) :: ( _, ( 
+MlyValue.lower_literal lower_literal1, lower_literal1left, _)) :: 
+rest671)) => let val  result = MlyValue.rule_exp (fn _ => let val  (
+lower_literal as lower_literal1) = lower_literal1 ()
+ val  PAREN_OPEN1 = PAREN_OPEN1 ()
+ val  (arg_list_exp as arg_list_exp1) = arg_list_exp1 ()
+ val  PAREN_CLOSE1 = PAREN_CLOSE1 ()
+ in (Fun (lower_literal,arg_list_exp))
+end)
+ in ( LrTable.NT 4, ( result, lower_literal1left, PAREN_CLOSE1right), 
+rest671)
+end
+|  ( 15, ( ( _, ( MlyValue.arg_exp arg_exp1, arg_exp1left, 
+arg_exp1right)) :: rest671)) => let val  result = 
+MlyValue.arg_list_exp (fn _ => let val  (arg_exp as arg_exp1) = 
+arg_exp1 ()
+ in ([arg_exp])
+end)
+ in ( LrTable.NT 5, ( result, arg_exp1left, arg_exp1right), rest671)
+
+end
+|  ( 16, ( ( _, ( MlyValue.arg_list_exp arg_list_exp1, _, 
+arg_list_exp1right)) :: ( _, ( MlyValue.COMMA COMMA1, _, _)) :: ( _, (
+ MlyValue.arg_exp arg_exp1, arg_exp1left, _)) :: rest671)) => let val 
+ result = MlyValue.arg_list_exp (fn _ => let val  (arg_exp as arg_exp1
+) = arg_exp1 ()
+ val  COMMA1 = COMMA1 ()
+ val  (arg_list_exp as arg_list_exp1) = arg_list_exp1 ()
+ in ([arg_exp]@arg_list_exp)
+end)
+ in ( LrTable.NT 5, ( result, arg_exp1left, arg_list_exp1right), 
+rest671)
+end
+|  ( 17, ( ( _, ( MlyValue.rule_exp rule_exp1, rule_exp1left, 
+rule_exp1right)) :: rest671)) => let val  result = MlyValue.arg_exp
+ (fn _ => let val  (rule_exp as rule_exp1) = rule_exp1 ()
+ in (rule_exp)
+end)
+ in ( LrTable.NT 6, ( result, rule_exp1left, rule_exp1right), rest671)
+
+end
+|  ( 18, ( ( _, ( MlyValue.int_literal int_literal1, _, 
+int_literal1right)) :: ( _, ( MlyValue.ASTERISK ASTERISK1, 
+ASTERISK1left, _)) :: rest671)) => let val  result = MlyValue.arg_exp
+ (fn _ => let val  ASTERISK1 = ASTERISK1 ()
+ val  (int_literal as int_literal1) = int_literal1 ()
+ in (Var (int_literal))
+end)
+ in ( LrTable.NT 6, ( result, ASTERISK1left, int_literal1right), 
+rest671)
+end
+|  ( 19, ( ( _, ( MlyValue.int_literal int_literal1, int_literal1left,
+ int_literal1right)) :: rest671)) => let val  result = 
+MlyValue.arg_exp (fn _ => let val  (int_literal as int_literal1) = 
+int_literal1 ()
+ in (Const (int_literal))
+end)
+ in ( LrTable.NT 6, ( result, int_literal1left, int_literal1right), 
+rest671)
+end
+|  ( 20, ( ( _, ( MlyValue.type_exp type_exp1, type_exp1left, 
+type_exp1right)) :: rest671)) => let val  result = 
+MlyValue.type_list_exp (fn _ => let val  (type_exp as type_exp1) = 
+type_exp1 ()
+ in ([type_exp])
+end)
+ in ( LrTable.NT 7, ( result, type_exp1left, type_exp1right), rest671)
+
+end
+|  ( 21, ( ( _, ( MlyValue.type_list_exp type_list_exp1, _, 
+type_list_exp1right)) :: ( _, ( MlyValue.type_exp type_exp1, 
+type_exp1left, _)) :: rest671)) => let val  result = 
+MlyValue.type_list_exp (fn _ => let val  (type_exp as type_exp1) = 
+type_exp1 ()
+ val  (type_list_exp as type_list_exp1) = type_list_exp1 ()
+ in ([type_exp]@type_list_exp)
+end)
+ in ( LrTable.NT 7, ( result, type_exp1left, type_list_exp1right), 
+rest671)
+end
+|  ( 22, ( ( _, ( MlyValue.string_literal string_literal1, _, 
+string_literal1right)) :: ( _, ( MlyValue.COLON COLON1, _, _)) :: ( _,
+ ( MlyValue.int_literal int_literal1, _, _)) :: ( _, ( 
+MlyValue.ASTERISK ASTERISK1, ASTERISK1left, _)) :: rest671)) => let
+ val  result = MlyValue.type_exp (fn _ => let val  ASTERISK1 = 
+ASTERISK1 ()
+ val  (int_literal as int_literal1) = int_literal1 ()
+ val  COLON1 = COLON1 ()
+ val  (string_literal as string_literal1) = string_literal1 ()
+ in ((int_literal,string_literal))
+end)
+ in ( LrTable.NT 8, ( result, ASTERISK1left, string_literal1right), 
+rest671)
+end
+|  ( 23, ( ( _, ( MlyValue.string_literal string_literal1, _, 
+string_literal1right)) :: ( _, ( MlyValue.COLON COLON1, _, _)) :: ( _,
+ ( MlyValue.upper_literal upper_literal1, upper_literal1left, _)) :: 
+rest671)) => let val  result = MlyValue.type_exp (fn _ => let val  (
+upper_literal as upper_literal1) = upper_literal1 ()
+ val  COLON1 = COLON1 ()
+ val  (string_literal as string_literal1) = string_literal1 ()
+ in ((upper_literal,string_literal))
+end)
+ in ( LrTable.NT 8, ( result, upper_literal1left, string_literal1right
+), rest671)
+end
+|  ( 24, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1,
+ UPPER_STRING_LITERAL1left, UPPER_STRING_LITERAL1right)) :: rest671))
+ => let val  result = MlyValue.upper_literal (fn _ => let val  (
+UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1
+ ()
+ in (UPPER_STRING_LITERAL)
+end)
+ in ( LrTable.NT 10, ( result, UPPER_STRING_LITERAL1left, 
+UPPER_STRING_LITERAL1right), rest671)
+end
+|  ( 25, ( ( _, ( MlyValue.LOWER_STRING_LITERAL LOWER_STRING_LITERAL1,
+ LOWER_STRING_LITERAL1left, LOWER_STRING_LITERAL1right)) :: rest671))
+ => let val  result = MlyValue.lower_literal (fn _ => let val  (
+LOWER_STRING_LITERAL as LOWER_STRING_LITERAL1) = LOWER_STRING_LITERAL1
+ ()
+ in (LOWER_STRING_LITERAL)
+end)
+ in ( LrTable.NT 11, ( result, LOWER_STRING_LITERAL1left, 
+LOWER_STRING_LITERAL1right), rest671)
+end
+|  ( 26, ( ( _, ( MlyValue.upper_literal upper_literal1, 
+upper_literal1left, upper_literal1right)) :: rest671)) => let val  
+result = MlyValue.string_literal (fn _ => let val  (upper_literal as 
+upper_literal1) = upper_literal1 ()
+ in (upper_literal)
+end)
+ in ( LrTable.NT 9, ( result, upper_literal1left, upper_literal1right)
+, rest671)
+end
+|  ( 27, ( ( _, ( MlyValue.lower_literal lower_literal1, 
+lower_literal1left, lower_literal1right)) :: rest671)) => let val  
+result = MlyValue.string_literal (fn _ => let val  (lower_literal as 
+lower_literal1) = lower_literal1 ()
+ in (lower_literal)
+end)
+ in ( LrTable.NT 9, ( result, lower_literal1left, lower_literal1right)
+, rest671)
+end
+|  ( 28, ( ( _, ( MlyValue.INTEGER_LITERAL INTEGER_LITERAL1, 
+INTEGER_LITERAL1left, INTEGER_LITERAL1right)) :: rest671)) => let val 
+ result = MlyValue.int_literal (fn _ => let val  (INTEGER_LITERAL as 
+INTEGER_LITERAL1) = INTEGER_LITERAL1 ()
+ in (INTEGER_LITERAL)
+end)
+ in ( LrTable.NT 12, ( result, INTEGER_LITERAL1left, 
+INTEGER_LITERAL1right), rest671)
+end
+|  ( 29, ( ( _, ( MlyValue.ZERO ZERO1, ZERO1left, ZERO1right)) :: 
+rest671)) => let val  result = MlyValue.int_literal (fn _ => let val  
+ZERO1 = ZERO1 ()
+ in ("0")
+end)
+ in ( LrTable.NT 12, ( result, ZERO1left, ZERO1right), rest671)
+end
+|  ( 30, ( ( _, ( MlyValue.ONE ONE1, ONE1left, ONE1right)) :: rest671)
+) => let val  result = MlyValue.int_literal (fn _ => let val  ONE1 = 
+ONE1 ()
+ in ("1")
+end)
+ in ( LrTable.NT 12, ( result, ONE1left, ONE1right), rest671)
+end
+| _ => raise (mlyAction i392)
+end
+val void = MlyValue.VOID
+val extract = fn a => (fn MlyValue.START x => x
+| _ => let exception ParseInternal
+	in raise ParseInternal end) a ()
+end
+end
+structure Tokens : Trac_TOKENS =
+struct
+type svalue = ParserData.svalue
+type ('a,'b) token = ('a,'b) Token.token
+fun EOF (p1,p2) = Token.TOKEN (ParserData.LrTable.T 0,(
+ParserData.MlyValue.VOID,p1,p2))
+fun COMMA (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 1,(
+ParserData.MlyValue.COMMA (fn () => i),p1,p2))
+fun FIXEDPOINT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 2,(
+ParserData.MlyValue.FIXEDPOINT (fn () => i),p1,p2))
+fun WHERE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 3,(
+ParserData.MlyValue.WHERE (fn () => i),p1,p2))
+fun COLON (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 4,(
+ParserData.MlyValue.COLON (fn () => i),p1,p2))
+fun PAREN_OPEN (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 5,(
+ParserData.MlyValue.PAREN_OPEN (fn () => i),p1,p2))
+fun PAREN_CLOSE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 6,(
+ParserData.MlyValue.PAREN_CLOSE (fn () => i),p1,p2))
+fun ASTERISK (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 7,(
+ParserData.MlyValue.ASTERISK (fn () => i),p1,p2))
+fun DOUBLE_ASTERISK (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 8,(
+ParserData.MlyValue.DOUBLE_ASTERISK (fn () => i),p1,p2))
+fun DOUBLE_RARROW (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 9,(
+ParserData.MlyValue.DOUBLE_RARROW (fn () => i),p1,p2))
+fun STRING_LITERAL (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 10,(
+ParserData.MlyValue.STRING_LITERAL (fn () => i),p1,p2))
+fun UPPER_STRING_LITERAL (i,p1,p2) = Token.TOKEN (
+ParserData.LrTable.T 11,(ParserData.MlyValue.UPPER_STRING_LITERAL
+ (fn () => i),p1,p2))
+fun LOWER_STRING_LITERAL (i,p1,p2) = Token.TOKEN (
+ParserData.LrTable.T 12,(ParserData.MlyValue.LOWER_STRING_LITERAL
+ (fn () => i),p1,p2))
+fun INTEGER_LITERAL (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 13,(
+ParserData.MlyValue.INTEGER_LITERAL (fn () => i),p1,p2))
+fun ONE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 14,(
+ParserData.MlyValue.ONE (fn () => i),p1,p2))
+fun ZERO (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 15,(
+ParserData.MlyValue.ZERO (fn () => i),p1,p2))
+fun ATTACK (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 16,(
+ParserData.MlyValue.ATTACK (fn () => i),p1,p2))
+end
+end
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex
new file mode 100644
index 0000000..887c971
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex
@@ -0,0 +1,103 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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.
+*)
+
+structure Tokens = Tokens
+open Trac_Term
+  
+type pos = int * int * int
+type svalue = Tokens.svalue
+
+type ('a,'b) token = ('a,'b) Tokens.token
+type lexresult= (svalue,pos) token
+
+
+val pos = ref (0,0,0)
+
+  fun eof () = Tokens.EOF((!pos,!pos))
+  fun error (e,p : (int * int * int),_) = TextIO.output (TextIO.stdOut, 
+							 String.concat[
+								       "line ", (Int.toString (#1 p)), "/",
+								       (Int.toString (#2 p - #3 p)),": ", e, "\n"
+								       ])
+  
+ fun inputPos yypos = ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))),
+		     (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))) 
+ fun inputPos_half yypos = (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))
+
+
+
+%%
+%header (functor TracLexFun(structure Tokens: Trac_TOKENS));
+alpha=[A-Za-z_];
+upper=[A-Z];
+lower=[a-z];
+digit=[0-9];
+ws = [\ \t];
+%%
+
+\n       => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos  ); lex());
+{ws}+    => (pos := (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))); lex()); 
+
+(#)[^\n]*\n                    => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos  ); lex());
+
+"/*""/"*([^*/]|[^*]"/"|"*"[^/])*"*"*"*/" => (lex());
+
+
+","          => (Tokens.COMMA(yytext,inputPos_half yypos,inputPos_half yypos));
+"Fixedpoint" => (Tokens.FIXEDPOINT(yytext,inputPos_half yypos,inputPos_half yypos));
+"where"      => (Tokens.WHERE(yytext,inputPos_half yypos,inputPos_half yypos));
+":"          => (Tokens.COLON(yytext,inputPos_half yypos,inputPos_half yypos));
+"("          => (Tokens.PAREN_OPEN(yytext,inputPos_half yypos,inputPos_half yypos));
+")"          => (Tokens.PAREN_CLOSE(yytext,inputPos_half yypos,inputPos_half yypos));
+"**"         => (Tokens.DOUBLE_ASTERISK(yytext,inputPos_half yypos,inputPos_half yypos));
+"*"          => (Tokens.ASTERISK(yytext,inputPos_half yypos,inputPos_half yypos));
+"=>"         => (Tokens.DOUBLE_RARROW(yytext,inputPos_half yypos,inputPos_half yypos));
+"one"        => (Tokens.ONE(yytext,inputPos_half yypos,inputPos_half yypos));
+"zero"       => (Tokens.ZERO(yytext,inputPos_half yypos,inputPos_half yypos));
+"attack"       => (Tokens.ATTACK(yytext,inputPos_half yypos,inputPos_half yypos));
+
+
+{digit}+                          => (Tokens.INTEGER_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos));
+"'"({alpha}|{ws}|{digit})*(("."|"_"|"/"|"-")*({alpha}|{ws}|{digit})*)*"'"  => (Tokens.STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos));
+{upper}({alpha}|{digit})*("'")*   => (Tokens.UPPER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos));
+{lower}({alpha}|{digit})*("'")*   => (Tokens.LOWER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos));
+
+
+.      => (error ("ignoring bad character "^yytext,
+		    ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))),
+		    ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))));
+             lex());
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex.sml b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex.sml
new file mode 100644
index 0000000..f44f6f4
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex.sml
@@ -0,0 +1,728 @@
+ (***** GENERATED FILE -- DO NOT EDIT ****)
+functor TracLexFun(structure Tokens: Trac_TOKENS)=
+   struct
+    structure UserDeclarations =
+      struct
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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.
+*)
+
+structure Tokens = Tokens
+open Trac_Term
+  
+type pos = int * int * int
+type svalue = Tokens.svalue
+
+type ('a,'b) token = ('a,'b) Tokens.token
+type lexresult= (svalue,pos) token
+
+
+val pos = Unsynchronized.ref (0,0,0)
+
+  fun eof () = Tokens.EOF((!pos,!pos))
+  fun error (e,p : (int * int * int),_) = TextIO.output (TextIO.stdOut, 
+							 String.concat[
+								       "line ", (Int.toString (#1 p)), "/",
+								       (Int.toString (#2 p - #3 p)),": ", e, "\n"
+								       ])
+  
+ fun inputPos yypos = ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))),
+		     (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))) 
+ fun inputPos_half yypos = (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))
+
+
+
+end (* end of user routines *)
+exception LexError (* raised if illegal leaf action tried *)
+structure Internal =
+	struct
+
+datatype yyfinstate = N of int
+type statedata = {fin : yyfinstate list, trans: string}
+(* transition & final state table *)
+val tab = let
+val s = [ 
+ (0, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (1, 
+"\003\003\003\003\003\003\003\003\003\065\067\003\003\003\003\003\
+\\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\
+\\065\003\003\062\003\003\003\058\057\056\054\003\053\003\003\043\
+\\041\041\041\041\041\041\041\041\041\041\040\003\003\038\003\003\
+\\003\025\025\025\025\025\028\025\025\025\025\025\025\025\025\025\
+\\025\025\025\025\025\025\025\025\025\025\025\003\003\003\003\003\
+\\003\019\010\010\010\010\010\010\010\010\010\010\010\010\010\016\
+\\010\010\010\010\010\010\010\011\010\010\004\003\003\003\003\003\
+\\003"
+),
+ (4, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\007\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (5, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (6, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (7, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\008\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (8, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\009\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (11, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\005\005\005\012\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (12, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\013\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (13, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\014\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (14, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\015\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (16, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\017\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (17, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\018\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (19, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\020\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (20, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\021\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (21, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\022\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (22, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\023\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (23, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
+\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\
+\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\
+\\000\005\005\005\005\005\005\005\005\005\005\024\005\005\005\005\
+\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\
+\\000"
+),
+ (25, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\
+\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\
+\\000"
+),
+ (27, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (28, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\
+\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
+\\000\026\026\026\026\026\026\026\026\029\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\
+\\000"
+),
+ (29, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\
+\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\030\026\026\000\000\000\000\000\
+\\000"
+),
+ (30, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\
+\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
+\\000\026\026\026\026\031\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\
+\\000"
+),
+ (31, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\
+\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
+\\000\026\026\026\032\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\
+\\000"
+),
+ (32, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\
+\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\033\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\
+\\000"
+),
+ (33, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\
+\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\034\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\
+\\000"
+),
+ (34, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\
+\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
+\\000\026\026\026\026\026\026\026\026\035\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\
+\\000"
+),
+ (35, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\
+\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\036\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\
+\\000"
+),
+ (36, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\
+\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
+\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
+\\026\026\026\026\037\026\026\026\026\026\026\000\000\000\000\000\
+\\000"
+),
+ (38, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\039\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (41, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\042\042\042\042\042\042\042\042\042\042\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (43, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\044\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (44, 
+"\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\046\045\045\045\045\052\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045"
+),
+ (45, 
+"\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\046\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045"
+),
+ (46, 
+"\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
+\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
+\\047\047\047\047\047\047\047\047\047\047\050\047\047\047\047\049\
+\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
+\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
+\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
+\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
+\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
+\\047"
+),
+ (47, 
+"\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\046\045\045\045\045\048\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045"
+),
+ (48, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\047\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (50, 
+"\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\046\045\045\045\045\051\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\
+\\045"
+),
+ (54, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\055\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (58, 
+"\000\000\000\000\000\000\000\000\000\059\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\059\000\000\000\000\000\000\061\000\000\000\000\000\060\060\060\
+\\059\059\059\059\059\059\059\059\059\059\000\000\000\000\000\000\
+\\000\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\
+\\059\059\059\059\059\059\059\059\059\059\059\000\000\000\000\059\
+\\000\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\
+\\059\059\059\059\059\059\059\059\059\059\059\000\000\000\000\000\
+\\000"
+),
+ (60, 
+"\000\000\000\000\000\000\000\000\000\060\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\060\000\000\000\000\000\000\061\000\000\000\000\000\060\060\060\
+\\060\060\060\060\060\060\060\060\060\060\000\000\000\000\000\000\
+\\000\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\
+\\060\060\060\060\060\060\060\060\060\060\060\000\000\000\000\060\
+\\000\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\
+\\060\060\060\060\060\060\060\060\060\060\060\000\000\000\000\000\
+\\000"
+),
+ (62, 
+"\063\063\063\063\063\063\063\063\063\063\064\063\063\063\063\063\
+\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\
+\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\
+\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\
+\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\
+\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\
+\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\
+\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\
+\\063"
+),
+ (65, 
+"\000\000\000\000\000\000\000\000\000\066\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\066\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+(0, "")]
+fun f x = x 
+val s = List.map f (List.rev (tl (List.rev s))) 
+exception LexHackingError 
+fun look ((j,x)::r, i: int) = if i = j then x else look(r, i) 
+  | look ([], i) = raise LexHackingError
+fun g {fin=x, trans=i} = {fin=x, trans=look(s,i)} 
+in Vector.fromList(List.map g 
+[{fin = [], trans = 0},
+{fin = [], trans = 1},
+{fin = [], trans = 1},
+{fin = [(N 97)], trans = 0},
+{fin = [(N 95),(N 97)], trans = 4},
+{fin = [(N 95)], trans = 5},
+{fin = [(N 95)], trans = 6},
+{fin = [(N 95)], trans = 7},
+{fin = [(N 95)], trans = 8},
+{fin = [(N 62),(N 95)], trans = 5},
+{fin = [(N 95),(N 97)], trans = 5},
+{fin = [(N 95),(N 97)], trans = 11},
+{fin = [(N 95)], trans = 12},
+{fin = [(N 95)], trans = 13},
+{fin = [(N 95)], trans = 14},
+{fin = [(N 39),(N 95)], trans = 5},
+{fin = [(N 95),(N 97)], trans = 16},
+{fin = [(N 95)], trans = 17},
+{fin = [(N 57),(N 95)], trans = 5},
+{fin = [(N 95),(N 97)], trans = 19},
+{fin = [(N 95)], trans = 20},
+{fin = [(N 95)], trans = 21},
+{fin = [(N 95)], trans = 22},
+{fin = [(N 95)], trans = 23},
+{fin = [(N 69),(N 95)], trans = 5},
+{fin = [(N 90),(N 97)], trans = 25},
+{fin = [(N 90)], trans = 25},
+{fin = [(N 90)], trans = 27},
+{fin = [(N 90),(N 97)], trans = 28},
+{fin = [(N 90)], trans = 29},
+{fin = [(N 90)], trans = 30},
+{fin = [(N 90)], trans = 31},
+{fin = [(N 90)], trans = 32},
+{fin = [(N 90)], trans = 33},
+{fin = [(N 90)], trans = 34},
+{fin = [(N 90)], trans = 35},
+{fin = [(N 90)], trans = 36},
+{fin = [(N 33),(N 90)], trans = 25},
+{fin = [(N 97)], trans = 38},
+{fin = [(N 53)], trans = 0},
+{fin = [(N 41),(N 97)], trans = 0},
+{fin = [(N 72),(N 97)], trans = 41},
+{fin = [(N 72)], trans = 41},
+{fin = [(N 97)], trans = 43},
+{fin = [], trans = 44},
+{fin = [], trans = 45},
+{fin = [], trans = 46},
+{fin = [], trans = 47},
+{fin = [], trans = 48},
+{fin = [(N 20)], trans = 0},
+{fin = [], trans = 50},
+{fin = [(N 20)], trans = 48},
+{fin = [], trans = 44},
+{fin = [(N 22),(N 97)], trans = 0},
+{fin = [(N 50),(N 97)], trans = 54},
+{fin = [(N 48)], trans = 0},
+{fin = [(N 45),(N 97)], trans = 0},
+{fin = [(N 43),(N 97)], trans = 0},
+{fin = [(N 97)], trans = 58},
+{fin = [], trans = 58},
+{fin = [], trans = 60},
+{fin = [(N 85)], trans = 0},
+{fin = [(N 97)], trans = 62},
+{fin = [], trans = 62},
+{fin = [(N 8)], trans = 0},
+{fin = [(N 4),(N 97)], trans = 65},
+{fin = [(N 4)], trans = 65},
+{fin = [(N 1)], trans = 0}])
+end
+structure StartStates =
+	struct
+	datatype yystartstate = STARTSTATE of int
+
+(* start state definitions *)
+
+val INITIAL = STARTSTATE 1;
+
+end
+type result = UserDeclarations.lexresult
+	exception LexerError (* raised if illegal leaf action tried *)
+end
+
+fun makeLexer yyinput =
+let	val yygone0=1
+	val yyb = Unsynchronized.ref "\n" 		(* buffer *)
+	val yybl = Unsynchronized.ref 1		(*buffer length *)
+	val yybufpos = Unsynchronized.ref 1		(* location of next character to use *)
+	val yygone = Unsynchronized.ref yygone0	(* position in file of beginning of buffer *)
+	val yydone = Unsynchronized.ref false		(* eof found yet? *)
+	val yybegin = Unsynchronized.ref 1		(*Current 'start state' for lexer *)
+
+	val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>
+		 yybegin := x
+
+fun lex () : Internal.result =
+let fun continue() = lex() in
+  let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0) =
+	let fun action (i,nil) = raise LexError
+	| action (i,nil::l) = action (i-1,l)
+	| action (i,(node::acts)::l) =
+		case node of
+		    Internal.N yyk => 
+			(let fun yymktext() = String.substring(!yyb,i0,i-i0)
+			     val yypos = i0+ !yygone
+			open UserDeclarations Internal.StartStates
+ in (yybufpos := i; case yyk of 
+
+			(* Application actions *)
+
+  1 => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos  ); lex())
+| 20 => (lex())
+| 22 => let val yytext=yymktext() in Tokens.COMMA(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 33 => let val yytext=yymktext() in Tokens.FIXEDPOINT(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 39 => let val yytext=yymktext() in Tokens.WHERE(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 4 => (pos := (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))); lex())
+| 41 => let val yytext=yymktext() in Tokens.COLON(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 43 => let val yytext=yymktext() in Tokens.PAREN_OPEN(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 45 => let val yytext=yymktext() in Tokens.PAREN_CLOSE(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 48 => let val yytext=yymktext() in Tokens.DOUBLE_ASTERISK(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 50 => let val yytext=yymktext() in Tokens.ASTERISK(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 53 => let val yytext=yymktext() in Tokens.DOUBLE_RARROW(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 57 => let val yytext=yymktext() in Tokens.ONE(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 62 => let val yytext=yymktext() in Tokens.ZERO(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 69 => let val yytext=yymktext() in Tokens.ATTACK(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 72 => let val yytext=yymktext() in Tokens.INTEGER_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 8 => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos  ); lex())
+| 85 => let val yytext=yymktext() in Tokens.STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 90 => let val yytext=yymktext() in Tokens.UPPER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 95 => let val yytext=yymktext() in Tokens.LOWER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 97 => let val yytext=yymktext() in error ("ignoring bad character "^yytext,
+		    ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))),
+		    ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))));
+             lex() end
+| _ => raise Internal.LexerError
+
+		) end )
+
+	val {fin,trans} = Vector.sub(Internal.tab, s)
+	val NewAcceptingLeaves = fin::AcceptingLeaves
+	in if l = !yybl then
+	     if trans = #trans(Vector.sub(Internal.tab,0))
+	       then action(l,NewAcceptingLeaves
+) else	    let val newchars= if !yydone then "" else yyinput 1024
+	    in if (String.size newchars)=0
+		  then (yydone := true;
+		        if (l=i0) then UserDeclarations.eof ()
+		                  else action(l,NewAcceptingLeaves))
+		  else (if i0=l then yyb := newchars
+		     else yyb := String.substring(!yyb,i0,l-i0)^newchars;
+		     yygone := !yygone+i0;
+		     yybl := String.size (!yyb);
+		     scan (s,AcceptingLeaves,l-i0,0))
+	    end
+	  else let val NewChar = Char.ord(CharVector.sub(!yyb,l))
+		val NewChar = if NewChar<128 then NewChar else 128
+		val NewState = Char.ord(CharVector.sub(trans,NewChar))
+		in if NewState=0 then action(l,NewAcceptingLeaves)
+		else scan(NewState,NewAcceptingLeaves,l+1,i0)
+	end
+	end
+(*
+	val start= if String.substring(!yyb,!yybufpos-1,1)="\n"
+then !yybegin+1 else !yybegin
+*)
+	in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos)
+    end
+end
+  in lex
+  end
+end
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm
new file mode 100644
index 0000000..699e13e
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm
@@ -0,0 +1,287 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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.
+*)
+
+open Trac_Term
+ 
+exception NotYetSupported of string 
+
+
+%%
+
+%verbose
+
+%eop EOF 
+
+%left 
+
+%name TracTransaction
+
+%term EOF
+    | OPENP of string
+    | CLOSEP of string
+    | OPENB of string
+    | CLOSEB of string
+    | OPENSCRYPT of string
+    | CLOSESCRYPT of string
+    | COLON of string
+    | SEMICOLON of string
+    | SECCH of string
+    | AUTHCH of string
+    | CONFCH of string
+    | INSECCH of string
+    | FAUTHCH of string
+    | FSECCH of string
+    | PERCENT of string
+    | UNEQUAL of string
+    | EXCLAM  of string
+    | DOT of string
+    | COMMA of string
+    | OPENSQB of string
+    | CLOSESQB of string
+    | UNION of string
+    | PROTOCOL of string
+    | KNOWLEDGE of string
+    | WHERE of string
+    | ACTIONS of string
+    | ABSTRACTION of string
+    | GOALS of string
+    | AUTHENTICATES of string
+    | WEAKLY of string
+    | ON of string
+    | TSECRET of string
+    | TBETWEEN of string
+    | Sets of string
+    | FUNCTIONS of string
+    | PUBLIC of string
+    | PRIVATE of string
+    | RECEIVE of string
+    | SEND of string
+    | IN of string
+    | NOTIN of string
+    | INSERT of string
+    | DELETE of string
+    | NEW of string
+    | ATTACK of string
+    | slash of string
+    | QUESTION of string
+    | equal of string
+    | TYPES of string
+    | SETS of string
+    | ARROW of string
+    | ANALYSIS of string
+    | TRANSACTIONS of string
+    | STRING_LITERAL of string
+    | UPPER_STRING_LITERAL of string
+    | LOWER_STRING_LITERAL of string
+    | UNDERSCORE of string
+    | INTEGER_LITERAL of string
+    | STAR of string
+    | OF of string
+                   
+%nonterm START of TracProtocol.protocol
+       | name of string 
+       | arity of string 
+       | uident of string 
+       | lident of string 
+       | ident of string 
+       | trac_protocol of TracProtocol.protocol
+       | protocol_spec of TracProtocol.protocol
+       | type_union of (string list)
+       | type_spec of (string * TracProtocol.type_spec_elem) 
+       | type_specs of (string * TracProtocol.type_spec_elem) list
+       | idents of string list
+       | uidents of string list
+       | lidents of string list
+       | set_specs of TracProtocol.set_spec list      
+       | set_spec of TracProtocol.set_spec     
+       | priv_or_pub_fun_spec of TracProtocol.fun_spec      
+       | fun_specs of TracProtocol.funT list 
+       | fun_spec of TracProtocol.funT     
+       | priv_fun_spec of TracProtocol.funT list 
+       | pub_fun_spec of TracProtocol.funT list     
+       | analysis_spec of TracProtocol.anaT
+       | transaction_spec_head of string option
+       | transaction_spec of TracProtocol.transaction list
+       | rule of TracProtocol.ruleT
+       | head of string * string list
+       | head_params of string list 
+       | keys of Trac_Term.Msg list
+       | result of string list
+       | msg of Trac_Term.Msg
+       | msgs of Trac_Term.Msg list
+       | setexp of string * Trac_Term.Msg list
+       | action of TracProtocol.prot_label * TracProtocol.action  
+       | actions of (TracProtocol.prot_label * TracProtocol.action) list
+       | ineq_aux of string
+       | ineq of string * string
+       | ineqs of (string * string) list
+       | transaction of TracProtocol.transaction_name
+       | typ of string                                             
+       | parameter of string * string
+       | parameters of (string * string) list 
+                     
+%pos (int * int * int)
+
+%noshift EOF
+
+%%
+
+START:         trac_protocol                                    (trac_protocol)
+trac_protocol: PROTOCOL COLON name protocol_spec                (TracProtocol.update_name protocol_spec name)
+
+protocol_spec: TYPES COLON type_specs protocol_spec              (TracProtocol.update_type_spec protocol_spec type_specs)
+             | SETS COLON  set_specs protocol_spec               (TracProtocol.update_sets protocol_spec set_specs)
+             | FUNCTIONS COLON priv_or_pub_fun_spec protocol_spec       (TracProtocol.update_functions protocol_spec (SOME priv_or_pub_fun_spec))
+             | ANALYSIS COLON analysis_spec protocol_spec        (TracProtocol.update_analysis protocol_spec analysis_spec)
+             | transaction_spec_head COLON transaction_spec protocol_spec (TracProtocol.update_transactions transaction_spec_head protocol_spec transaction_spec)
+             |                                                   (TracProtocol.empty)
+
+type_union:    ident                                             ([ident])
+             | ident UNION type_union                            (ident::type_union)
+             
+type_specs:    type_spec                                         ([type_spec])
+             | type_spec type_specs                              (type_spec::type_specs)
+type_spec:     ident equal OPENB lidents CLOSEB                   ((ident, TracProtocol.Consts lidents))
+             | ident equal type_union                            ((ident, TracProtocol.Union type_union))
+
+
+set_specs:     set_spec                                          ([set_spec])
+             | set_spec set_specs                                (set_spec::set_specs)
+set_spec:      ident slash arity                                 ((ident, arity))
+                            
+priv_or_pub_fun_spec: pub_fun_spec priv_or_pub_fun_spec       (TracProtocol.update_fun_public priv_or_pub_fun_spec pub_fun_spec)
+                    | priv_fun_spec priv_or_pub_fun_spec      (TracProtocol.update_fun_private priv_or_pub_fun_spec priv_fun_spec)   
+                    |                                         (TracProtocol.fun_empty)
+pub_fun_spec: PUBLIC fun_specs             (fun_specs)
+priv_fun_spec: PRIVATE fun_specs           (fun_specs)
+fun_specs: fun_spec ([fun_spec])
+                    | fun_spec fun_specs (fun_spec::fun_specs)
+fun_spec:      ident slash arity              ((ident, arity))
+
+analysis_spec: rule                        	              ([rule])
+             | rule analysis_spec                         (rule::analysis_spec)
+             
+rule: head ARROW result                                   ((head,[],result)) 
+    | head QUESTION keys ARROW result                     ((head,keys,result)) 
+
+head: LOWER_STRING_LITERAL OPENP head_params CLOSEP       ((LOWER_STRING_LITERAL,head_params))
+
+head_params: UPPER_STRING_LITERAL                         ([UPPER_STRING_LITERAL])
+           | UPPER_STRING_LITERAL COMMA head_params       ([UPPER_STRING_LITERAL]@head_params)
+
+keys: msgs                                                (msgs)
+
+result: UPPER_STRING_LITERAL                              ([UPPER_STRING_LITERAL])
+      | UPPER_STRING_LITERAL COMMA result                 ([UPPER_STRING_LITERAL]@result)
+
+
+transaction_spec_head: TRANSACTIONS                       (NONE)
+                     | TRANSACTIONS OF LOWER_STRING_LITERAL (SOME LOWER_STRING_LITERAL)
+
+transaction_spec: transaction actions DOT               ([TracProtocol.mkTransaction transaction actions])
+                | transaction actions DOT transaction_spec ((TracProtocol.mkTransaction transaction actions)::transaction_spec)
+
+ineq_aux: UNEQUAL UPPER_STRING_LITERAL                    (UPPER_STRING_LITERAL)
+
+ineq: UPPER_STRING_LITERAL ineq_aux                       ((UPPER_STRING_LITERAL,ineq_aux))
+
+ineqs: ineq                                               ([ineq])
+     | ineq COMMA ineqs                                   ([ineq]@ineqs)
+                       
+transaction: ident OPENP parameters CLOSEP WHERE ineqs    ((ident,parameters,ineqs))
+           | ident OPENP parameters CLOSEP                ((ident,parameters,[]))
+           | ident OPENP CLOSEP                           ((ident,[],[]))
+
+parameters: parameter                                   ([parameter])
+          | parameter COMMA parameters                  (parameter::parameters)
+                  
+parameter: ident COLON typ                              ((ident, typ))
+
+typ: UPPER_STRING_LITERAL                               (UPPER_STRING_LITERAL)                                                
+   | LOWER_STRING_LITERAL                               (LOWER_STRING_LITERAL)                                                
+                                                
+actions: action                                         ([action])
+       | action actions                                 (action::actions)
+
+action: RECEIVE msg                                     ((TracProtocol.LabelN,TracProtocol.RECEIVE(msg)))
+      | SEND msg                                        ((TracProtocol.LabelN,TracProtocol.SEND(msg)))
+      | msg IN setexp                                   ((TracProtocol.LabelN,TracProtocol.IN(msg,setexp)))
+      | msg NOTIN setexp                                ((TracProtocol.LabelN,TracProtocol.NOTIN(msg,setexp)))
+      | msg NOTIN lident OPENP UNDERSCORE CLOSEP        ((TracProtocol.LabelN,TracProtocol.NOTINANY(msg,lident)))
+      | INSERT msg setexp                               ((TracProtocol.LabelN,TracProtocol.INSERT(msg,setexp)))
+      | DELETE msg setexp                               ((TracProtocol.LabelN,TracProtocol.DELETE(msg,setexp)))
+      | NEW uident                                      ((TracProtocol.LabelS,TracProtocol.NEW(uident)))
+      | ATTACK                                          ((TracProtocol.LabelN,TracProtocol.ATTACK))
+      | STAR RECEIVE msg                                ((TracProtocol.LabelS,TracProtocol.RECEIVE(msg)))
+      | STAR SEND msg                                   ((TracProtocol.LabelS,TracProtocol.SEND(msg)))
+      | STAR msg IN setexp                              ((TracProtocol.LabelS,TracProtocol.IN(msg,setexp)))
+      | STAR msg NOTIN setexp                           ((TracProtocol.LabelS,TracProtocol.NOTIN(msg,setexp)))
+      | STAR msg NOTIN lident OPENP UNDERSCORE CLOSEP   ((TracProtocol.LabelS,TracProtocol.NOTINANY(msg,lident)))
+      | STAR INSERT msg setexp                          ((TracProtocol.LabelS,TracProtocol.INSERT(msg,setexp)))
+      | STAR DELETE msg setexp                          ((TracProtocol.LabelS,TracProtocol.DELETE(msg,setexp)))
+
+setexp: lident                                          ((lident,[]))
+      | lident OPENP msgs CLOSEP                        ((lident,msgs))
+
+msg: uident                                             (Var uident)
+   | lident                                             (Const lident)
+   | lident OPENP msgs CLOSEP                           (Fun (lident,msgs))
+
+msgs: msg                                               ([msg])
+    | msg COMMA msgs                                    (msg::msgs)
+
+name: UPPER_STRING_LITERAL                              (UPPER_STRING_LITERAL)                         
+    | LOWER_STRING_LITERAL                              (LOWER_STRING_LITERAL) 
+
+uident: UPPER_STRING_LITERAL                            (UPPER_STRING_LITERAL)
+
+uidents: uident                                         ([uident])
+       | uident COMMA uidents                           (uident::uidents)
+
+lident: LOWER_STRING_LITERAL                            (LOWER_STRING_LITERAL)
+
+lidents: lident                                         ([lident])
+       | lident COMMA lidents                           (lident::lidents)
+
+ident: uident                                           (uident)
+     | lident                                           (lident)
+
+idents: ident                                           ([ident])
+      | ident COMMA idents                              (ident::idents)
+
+arity: INTEGER_LITERAL                                  (INTEGER_LITERAL)
+
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sig b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sig
new file mode 100644
index 0000000..faac26d
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sig
@@ -0,0 +1,73 @@
+signature TracTransaction_TOKENS =
+sig
+type ('a,'b) token
+type svalue
+val OF: (string) *  'a * 'a -> (svalue,'a) token
+val STAR: (string) *  'a * 'a -> (svalue,'a) token
+val INTEGER_LITERAL: (string) *  'a * 'a -> (svalue,'a) token
+val UNDERSCORE: (string) *  'a * 'a -> (svalue,'a) token
+val LOWER_STRING_LITERAL: (string) *  'a * 'a -> (svalue,'a) token
+val UPPER_STRING_LITERAL: (string) *  'a * 'a -> (svalue,'a) token
+val STRING_LITERAL: (string) *  'a * 'a -> (svalue,'a) token
+val TRANSACTIONS: (string) *  'a * 'a -> (svalue,'a) token
+val ANALYSIS: (string) *  'a * 'a -> (svalue,'a) token
+val ARROW: (string) *  'a * 'a -> (svalue,'a) token
+val SETS: (string) *  'a * 'a -> (svalue,'a) token
+val TYPES: (string) *  'a * 'a -> (svalue,'a) token
+val equal: (string) *  'a * 'a -> (svalue,'a) token
+val QUESTION: (string) *  'a * 'a -> (svalue,'a) token
+val slash: (string) *  'a * 'a -> (svalue,'a) token
+val ATTACK: (string) *  'a * 'a -> (svalue,'a) token
+val NEW: (string) *  'a * 'a -> (svalue,'a) token
+val DELETE: (string) *  'a * 'a -> (svalue,'a) token
+val INSERT: (string) *  'a * 'a -> (svalue,'a) token
+val NOTIN: (string) *  'a * 'a -> (svalue,'a) token
+val IN: (string) *  'a * 'a -> (svalue,'a) token
+val SEND: (string) *  'a * 'a -> (svalue,'a) token
+val RECEIVE: (string) *  'a * 'a -> (svalue,'a) token
+val PRIVATE: (string) *  'a * 'a -> (svalue,'a) token
+val PUBLIC: (string) *  'a * 'a -> (svalue,'a) token
+val FUNCTIONS: (string) *  'a * 'a -> (svalue,'a) token
+val Sets: (string) *  'a * 'a -> (svalue,'a) token
+val TBETWEEN: (string) *  'a * 'a -> (svalue,'a) token
+val TSECRET: (string) *  'a * 'a -> (svalue,'a) token
+val ON: (string) *  'a * 'a -> (svalue,'a) token
+val WEAKLY: (string) *  'a * 'a -> (svalue,'a) token
+val AUTHENTICATES: (string) *  'a * 'a -> (svalue,'a) token
+val GOALS: (string) *  'a * 'a -> (svalue,'a) token
+val ABSTRACTION: (string) *  'a * 'a -> (svalue,'a) token
+val ACTIONS: (string) *  'a * 'a -> (svalue,'a) token
+val WHERE: (string) *  'a * 'a -> (svalue,'a) token
+val KNOWLEDGE: (string) *  'a * 'a -> (svalue,'a) token
+val PROTOCOL: (string) *  'a * 'a -> (svalue,'a) token
+val UNION: (string) *  'a * 'a -> (svalue,'a) token
+val CLOSESQB: (string) *  'a * 'a -> (svalue,'a) token
+val OPENSQB: (string) *  'a * 'a -> (svalue,'a) token
+val COMMA: (string) *  'a * 'a -> (svalue,'a) token
+val DOT: (string) *  'a * 'a -> (svalue,'a) token
+val EXCLAM: (string) *  'a * 'a -> (svalue,'a) token
+val UNEQUAL: (string) *  'a * 'a -> (svalue,'a) token
+val PERCENT: (string) *  'a * 'a -> (svalue,'a) token
+val FSECCH: (string) *  'a * 'a -> (svalue,'a) token
+val FAUTHCH: (string) *  'a * 'a -> (svalue,'a) token
+val INSECCH: (string) *  'a * 'a -> (svalue,'a) token
+val CONFCH: (string) *  'a * 'a -> (svalue,'a) token
+val AUTHCH: (string) *  'a * 'a -> (svalue,'a) token
+val SECCH: (string) *  'a * 'a -> (svalue,'a) token
+val SEMICOLON: (string) *  'a * 'a -> (svalue,'a) token
+val COLON: (string) *  'a * 'a -> (svalue,'a) token
+val CLOSESCRYPT: (string) *  'a * 'a -> (svalue,'a) token
+val OPENSCRYPT: (string) *  'a * 'a -> (svalue,'a) token
+val CLOSEB: (string) *  'a * 'a -> (svalue,'a) token
+val OPENB: (string) *  'a * 'a -> (svalue,'a) token
+val CLOSEP: (string) *  'a * 'a -> (svalue,'a) token
+val OPENP: (string) *  'a * 'a -> (svalue,'a) token
+val EOF:  'a * 'a -> (svalue,'a) token
+end
+signature TracTransaction_LRVALS=
+sig
+structure Tokens : TracTransaction_TOKENS
+structure ParserData:PARSER_DATA
+sharing type ParserData.Token.token = Tokens.token
+sharing type ParserData.svalue = Tokens.svalue
+end
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sml b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sml
new file mode 100644
index 0000000..39f1ade
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sml
@@ -0,0 +1,1720 @@
+ (***** GENERATED FILE -- DO NOT EDIT ****)
+functor TracTransactionLrValsFun(structure Token : TOKEN)
+ : sig structure ParserData : PARSER_DATA
+       structure Tokens : TracTransaction_TOKENS
+   end
+ = 
+struct
+structure ParserData=
+struct
+structure Header = 
+struct
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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.
+*)
+
+open Trac_Term
+ 
+exception NotYetSupported of string 
+
+
+
+end
+structure LrTable = Token.LrTable
+structure Token = Token
+local open LrTable in 
+val table=let val actionRows =
+"\
+\\001\000\001\000\000\000\000\000\
+\\001\000\002\000\058\000\000\000\
+\\001\000\002\000\063\000\000\000\
+\\001\000\003\000\095\000\056\000\028\000\057\000\027\000\000\000\
+\\001\000\003\000\124\000\000\000\
+\\001\000\003\000\130\000\000\000\
+\\001\000\003\000\138\000\000\000\
+\\001\000\003\000\163\000\000\000\
+\\001\000\003\000\164\000\000\000\
+\\001\000\003\000\169\000\000\000\
+\\001\000\004\000\107\000\056\000\028\000\057\000\027\000\000\000\
+\\001\000\005\000\154\000\000\000\
+\\001\000\008\000\005\000\000\000\
+\\001\000\008\000\016\000\000\000\
+\\001\000\008\000\018\000\000\000\
+\\001\000\008\000\019\000\000\000\
+\\001\000\008\000\020\000\000\000\
+\\001\000\008\000\021\000\000\000\
+\\001\000\008\000\126\000\000\000\
+\\001\000\017\000\168\000\000\000\
+\\001\000\019\000\077\000\000\000\
+\\001\000\024\000\004\000\000\000\
+\\001\000\039\000\056\000\040\000\055\000\043\000\054\000\044\000\053\000\
+\\045\000\052\000\046\000\051\000\056\000\028\000\057\000\027\000\
+\\060\000\050\000\000\000\
+\\001\000\039\000\086\000\040\000\085\000\043\000\084\000\044\000\083\000\
+\\056\000\028\000\057\000\027\000\000\000\
+\\001\000\041\000\080\000\042\000\079\000\000\000\
+\\001\000\041\000\117\000\042\000\116\000\000\000\
+\\001\000\047\000\066\000\000\000\
+\\001\000\047\000\109\000\000\000\
+\\001\000\048\000\060\000\052\000\059\000\000\000\
+\\001\000\049\000\069\000\000\000\
+\\001\000\052\000\129\000\000\000\
+\\001\000\056\000\008\000\057\000\007\000\000\000\
+\\001\000\056\000\028\000\000\000\
+\\001\000\056\000\028\000\057\000\027\000\000\000\
+\\001\000\056\000\028\000\057\000\027\000\058\000\157\000\000\000\
+\\001\000\056\000\028\000\057\000\027\000\058\000\165\000\000\000\
+\\001\000\056\000\097\000\000\000\
+\\001\000\056\000\102\000\000\000\
+\\001\000\056\000\148\000\057\000\147\000\000\000\
+\\001\000\056\000\161\000\000\000\
+\\001\000\056\000\171\000\000\000\
+\\001\000\057\000\027\000\000\000\
+\\001\000\057\000\029\000\000\000\
+\\001\000\057\000\033\000\000\000\
+\\001\000\059\000\104\000\000\000\
+\\173\000\000\000\
+\\174\000\000\000\
+\\175\000\000\000\
+\\176\000\000\000\
+\\177\000\000\000\
+\\178\000\000\000\
+\\179\000\000\000\
+\\180\000\036\000\015\000\050\000\014\000\051\000\013\000\053\000\012\000\
+\\054\000\011\000\000\000\
+\\181\000\023\000\132\000\000\000\
+\\182\000\000\000\
+\\183\000\056\000\028\000\057\000\027\000\000\000\
+\\184\000\000\000\
+\\185\000\000\000\
+\\186\000\000\000\
+\\187\000\056\000\028\000\057\000\027\000\000\000\
+\\188\000\000\000\
+\\189\000\000\000\
+\\190\000\000\000\
+\\191\000\000\000\
+\\192\000\037\000\044\000\038\000\043\000\000\000\
+\\193\000\000\000\
+\\194\000\000\000\
+\\195\000\056\000\028\000\057\000\027\000\000\000\
+\\196\000\000\000\
+\\197\000\000\000\
+\\198\000\057\000\033\000\000\000\
+\\199\000\000\000\
+\\200\000\000\000\
+\\201\000\000\000\
+\\202\000\000\000\
+\\203\000\020\000\131\000\000\000\
+\\204\000\000\000\
+\\205\000\000\000\
+\\206\000\020\000\127\000\000\000\
+\\207\000\000\000\
+\\208\000\061\000\017\000\000\000\
+\\209\000\000\000\
+\\210\000\056\000\028\000\057\000\027\000\000\000\
+\\211\000\000\000\
+\\212\000\000\000\
+\\213\000\000\000\
+\\214\000\020\000\166\000\000\000\
+\\215\000\000\000\
+\\216\000\000\000\
+\\217\000\026\000\144\000\000\000\
+\\218\000\000\000\
+\\219\000\020\000\125\000\000\000\
+\\220\000\000\000\
+\\221\000\000\000\
+\\222\000\000\000\
+\\223\000\000\000\
+\\224\000\039\000\056\000\040\000\055\000\043\000\054\000\044\000\053\000\
+\\045\000\052\000\046\000\051\000\056\000\028\000\057\000\027\000\
+\\060\000\050\000\000\000\
+\\225\000\000\000\
+\\226\000\000\000\
+\\227\000\000\000\
+\\228\000\000\000\
+\\229\000\000\000\
+\\230\000\000\000\
+\\231\000\000\000\
+\\232\000\000\000\
+\\233\000\000\000\
+\\234\000\000\000\
+\\235\000\000\000\
+\\236\000\000\000\
+\\237\000\000\000\
+\\238\000\000\000\
+\\239\000\000\000\
+\\240\000\000\000\
+\\241\000\000\000\
+\\242\000\002\000\136\000\000\000\
+\\242\000\002\000\137\000\000\000\
+\\242\000\002\000\158\000\000\000\
+\\243\000\000\000\
+\\244\000\000\000\
+\\245\000\002\000\081\000\000\000\
+\\246\000\000\000\
+\\247\000\020\000\128\000\000\000\
+\\248\000\000\000\
+\\249\000\000\000\
+\\250\000\000\000\
+\\251\000\000\000\
+\\254\000\000\000\
+\\255\000\020\000\155\000\000\000\
+\\000\001\000\000\
+\\001\001\000\000\
+\\002\001\000\000\
+\\005\001\000\000\
+\"
+val actionRowNumbers =
+"\021\000\045\000\012\000\031\000\
+\\052\000\124\000\123\000\013\000\
+\\046\000\080\000\014\000\015\000\
+\\016\000\017\000\033\000\042\000\
+\\043\000\033\000\033\000\064\000\
+\\022\000\052\000\001\000\130\000\
+\\129\000\126\000\125\000\081\000\
+\\028\000\070\000\052\000\002\000\
+\\059\000\052\000\026\000\052\000\
+\\055\000\029\000\064\000\064\000\
+\\052\000\033\000\033\000\020\000\
+\\096\000\024\000\119\000\118\000\
+\\023\000\106\000\032\000\033\000\
+\\033\000\033\000\033\000\051\000\
+\\003\000\036\000\033\000\071\000\
+\\050\000\037\000\060\000\048\000\
+\\044\000\047\000\056\000\010\000\
+\\062\000\063\000\049\000\067\000\
+\\066\000\027\000\065\000\082\000\
+\\097\000\041\000\041\000\033\000\
+\\025\000\033\000\033\000\033\000\
+\\033\000\105\000\041\000\041\000\
+\\099\000\098\000\004\000\091\000\
+\\018\000\090\000\072\000\078\000\
+\\077\000\121\000\030\000\005\000\
+\\075\000\061\000\131\000\058\000\
+\\053\000\041\000\068\000\044\000\
+\\083\000\101\000\114\000\100\000\
+\\115\000\006\000\041\000\041\000\
+\\041\000\041\000\108\000\107\000\
+\\104\000\103\000\089\000\033\000\
+\\038\000\036\000\033\000\036\000\
+\\074\000\037\000\033\000\011\000\
+\\127\000\069\000\034\000\033\000\
+\\120\000\110\000\116\000\109\000\
+\\113\000\112\000\039\000\092\000\
+\\093\000\095\000\094\000\079\000\
+\\122\000\073\000\076\000\054\000\
+\\057\000\041\000\007\000\008\000\
+\\035\000\088\000\086\000\019\000\
+\\128\000\117\000\102\000\009\000\
+\\039\000\085\000\040\000\111\000\
+\\087\000\084\000\000\000"
+val gotoT =
+"\
+\\001\000\170\000\007\000\001\000\000\000\
+\\000\000\
+\\000\000\
+\\002\000\004\000\000\000\
+\\008\000\008\000\023\000\007\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\004\000\024\000\005\000\023\000\006\000\022\000\024\000\021\000\
+\\038\000\020\000\000\000\
+\\000\000\
+\\022\000\030\000\025\000\029\000\026\000\028\000\000\000\
+\\004\000\024\000\005\000\023\000\006\000\034\000\015\000\033\000\
+\\016\000\032\000\000\000\
+\\004\000\024\000\005\000\023\000\006\000\037\000\010\000\036\000\
+\\011\000\035\000\000\000\
+\\017\000\040\000\020\000\039\000\021\000\038\000\000\000\
+\\004\000\047\000\005\000\046\000\030\000\045\000\033\000\044\000\
+\\034\000\043\000\000\000\
+\\008\000\055\000\023\000\007\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\022\000\059\000\025\000\029\000\026\000\028\000\000\000\
+\\008\000\060\000\023\000\007\000\000\000\
+\\000\000\
+\\004\000\024\000\005\000\023\000\006\000\034\000\015\000\062\000\
+\\016\000\032\000\000\000\
+\\008\000\063\000\023\000\007\000\000\000\
+\\000\000\
+\\008\000\065\000\023\000\007\000\000\000\
+\\004\000\024\000\005\000\023\000\006\000\037\000\010\000\036\000\
+\\011\000\066\000\000\000\
+\\000\000\
+\\017\000\068\000\020\000\039\000\021\000\038\000\000\000\
+\\017\000\069\000\020\000\039\000\021\000\038\000\000\000\
+\\008\000\070\000\023\000\007\000\000\000\
+\\004\000\024\000\005\000\023\000\006\000\073\000\018\000\072\000\
+\\019\000\071\000\000\000\
+\\004\000\024\000\005\000\023\000\006\000\073\000\018\000\074\000\
+\\019\000\071\000\000\000\
+\\000\000\
+\\004\000\047\000\005\000\046\000\030\000\045\000\033\000\044\000\
+\\034\000\076\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\004\000\047\000\005\000\046\000\030\000\080\000\000\000\
+\\000\000\
+\\004\000\085\000\000\000\
+\\004\000\047\000\005\000\046\000\030\000\086\000\000\000\
+\\004\000\047\000\005\000\046\000\030\000\087\000\000\000\
+\\004\000\047\000\005\000\046\000\030\000\088\000\000\000\
+\\004\000\047\000\005\000\046\000\030\000\089\000\000\000\
+\\000\000\
+\\004\000\024\000\005\000\023\000\006\000\092\000\040\000\091\000\
+\\041\000\090\000\000\000\
+\\029\000\094\000\000\000\
+\\004\000\047\000\005\000\046\000\028\000\098\000\030\000\097\000\
+\\031\000\096\000\000\000\
+\\000\000\
+\\000\000\
+\\027\000\099\000\000\000\
+\\000\000\
+\\000\000\
+\\003\000\101\000\000\000\
+\\000\000\
+\\000\000\
+\\004\000\024\000\005\000\023\000\006\000\104\000\009\000\103\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\004\000\024\000\005\000\023\000\006\000\073\000\018\000\106\000\
+\\019\000\071\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\004\000\024\000\005\000\023\000\006\000\022\000\024\000\108\000\
+\\038\000\020\000\000\000\
+\\000\000\
+\\005\000\110\000\032\000\109\000\000\000\
+\\005\000\112\000\032\000\111\000\000\000\
+\\004\000\047\000\005\000\046\000\030\000\097\000\031\000\113\000\000\000\
+\\000\000\
+\\004\000\047\000\005\000\046\000\030\000\116\000\000\000\
+\\004\000\047\000\005\000\046\000\030\000\117\000\000\000\
+\\004\000\047\000\005\000\046\000\030\000\118\000\000\000\
+\\004\000\047\000\005\000\046\000\030\000\119\000\000\000\
+\\000\000\
+\\005\000\112\000\032\000\120\000\000\000\
+\\005\000\112\000\032\000\121\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\005\000\132\000\014\000\131\000\000\000\
+\\000\000\
+\\003\000\133\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\005\000\138\000\032\000\137\000\000\000\
+\\005\000\112\000\032\000\139\000\000\000\
+\\005\000\112\000\032\000\140\000\000\000\
+\\005\000\112\000\032\000\141\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\004\000\024\000\005\000\023\000\006\000\092\000\040\000\091\000\
+\\041\000\143\000\000\000\
+\\039\000\144\000\000\000\
+\\029\000\147\000\000\000\
+\\004\000\047\000\005\000\046\000\030\000\097\000\031\000\148\000\000\000\
+\\029\000\149\000\000\000\
+\\000\000\
+\\027\000\150\000\000\000\
+\\004\000\024\000\005\000\023\000\006\000\104\000\009\000\151\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\004\000\047\000\005\000\046\000\030\000\097\000\031\000\154\000\000\000\
+\\004\000\047\000\005\000\046\000\030\000\097\000\031\000\154\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\036\000\158\000\037\000\157\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\005\000\132\000\014\000\160\000\000\000\
+\\000\000\
+\\000\000\
+\\004\000\047\000\005\000\046\000\030\000\097\000\031\000\154\000\000\000\
+\\000\000\
+\\000\000\
+\\035\000\165\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\036\000\158\000\037\000\168\000\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\\000\000\
+\"
+val numstates = 171
+val numrules = 89
+val s = Unsynchronized.ref "" and index = Unsynchronized.ref 0
+val string_to_int = fn () => 
+let val i = !index
+in index := i+2; Char.ord(String.sub(!s,i)) + Char.ord(String.sub(!s,i+1)) * 256
+end
+val string_to_list = fn s' =>
+    let val len = String.size s'
+        fun f () =
+           if !index < len then string_to_int() :: f()
+           else nil
+   in index := 0; s := s'; f ()
+   end
+val string_to_pairlist = fn (conv_key,conv_entry) =>
+     let fun f () =
+         case string_to_int()
+         of 0 => EMPTY
+          | n => PAIR(conv_key (n-1),conv_entry (string_to_int()),f())
+     in f
+     end
+val string_to_pairlist_default = fn (conv_key,conv_entry) =>
+    let val conv_row = string_to_pairlist(conv_key,conv_entry)
+    in fn () =>
+       let val default = conv_entry(string_to_int())
+           val row = conv_row()
+       in (row,default)
+       end
+   end
+val string_to_table = fn (convert_row,s') =>
+    let val len = String.size s'
+        fun f ()=
+           if !index < len then convert_row() :: f()
+           else nil
+     in (s := s'; index := 0; f ())
+     end
+local
+  val memo = Array.array(numstates+numrules,ERROR)
+  val _ =let fun g i=(Array.update(memo,i,REDUCE(i-numstates)); g(i+1))
+       fun f i =
+            if i=numstates then g i
+            else (Array.update(memo,i,SHIFT (STATE i)); f (i+1))
+          in f 0 handle General.Subscript => ()
+          end
+in
+val entry_to_action = fn 0 => ACCEPT | 1 => ERROR | j => Array.sub(memo,(j-2))
+end
+val gotoT=Array.fromList(string_to_table(string_to_pairlist(NT,STATE),gotoT))
+val actionRows=string_to_table(string_to_pairlist_default(T,entry_to_action),actionRows)
+val actionRowNumbers = string_to_list actionRowNumbers
+val actionT = let val actionRowLookUp=
+let val a=Array.fromList(actionRows) in fn i=>Array.sub(a,i) end
+in Array.fromList(List.map actionRowLookUp actionRowNumbers)
+end
+in LrTable.mkLrTable {actions=actionT,gotos=gotoT,numRules=numrules,
+numStates=numstates,initialState=STATE 0}
+end
+end
+local open Header in
+type pos =  ( int * int * int ) 
+type arg = unit
+structure MlyValue = 
+struct
+datatype svalue = VOID | ntVOID of unit ->  unit
+ | OF of unit ->  (string) | STAR of unit ->  (string)
+ | INTEGER_LITERAL of unit ->  (string)
+ | UNDERSCORE of unit ->  (string)
+ | LOWER_STRING_LITERAL of unit ->  (string)
+ | UPPER_STRING_LITERAL of unit ->  (string)
+ | STRING_LITERAL of unit ->  (string)
+ | TRANSACTIONS of unit ->  (string) | ANALYSIS of unit ->  (string)
+ | ARROW of unit ->  (string) | SETS of unit ->  (string)
+ | TYPES of unit ->  (string) | equal of unit ->  (string)
+ | QUESTION of unit ->  (string) | slash of unit ->  (string)
+ | ATTACK of unit ->  (string) | NEW of unit ->  (string)
+ | DELETE of unit ->  (string) | INSERT of unit ->  (string)
+ | NOTIN of unit ->  (string) | IN of unit ->  (string)
+ | SEND of unit ->  (string) | RECEIVE of unit ->  (string)
+ | PRIVATE of unit ->  (string) | PUBLIC of unit ->  (string)
+ | FUNCTIONS of unit ->  (string) | Sets of unit ->  (string)
+ | TBETWEEN of unit ->  (string) | TSECRET of unit ->  (string)
+ | ON of unit ->  (string) | WEAKLY of unit ->  (string)
+ | AUTHENTICATES of unit ->  (string) | GOALS of unit ->  (string)
+ | ABSTRACTION of unit ->  (string) | ACTIONS of unit ->  (string)
+ | WHERE of unit ->  (string) | KNOWLEDGE of unit ->  (string)
+ | PROTOCOL of unit ->  (string) | UNION of unit ->  (string)
+ | CLOSESQB of unit ->  (string) | OPENSQB of unit ->  (string)
+ | COMMA of unit ->  (string) | DOT of unit ->  (string)
+ | EXCLAM of unit ->  (string) | UNEQUAL of unit ->  (string)
+ | PERCENT of unit ->  (string) | FSECCH of unit ->  (string)
+ | FAUTHCH of unit ->  (string) | INSECCH of unit ->  (string)
+ | CONFCH of unit ->  (string) | AUTHCH of unit ->  (string)
+ | SECCH of unit ->  (string) | SEMICOLON of unit ->  (string)
+ | COLON of unit ->  (string) | CLOSESCRYPT of unit ->  (string)
+ | OPENSCRYPT of unit ->  (string) | CLOSEB of unit ->  (string)
+ | OPENB of unit ->  (string) | CLOSEP of unit ->  (string)
+ | OPENP of unit ->  (string)
+ | parameters of unit ->  ( ( string * string )  list)
+ | parameter of unit ->  (string*string) | typ of unit ->  (string)
+ | transaction of unit ->  (TracProtocol.transaction_name)
+ | ineqs of unit ->  ( ( string * string )  list)
+ | ineq of unit ->  (string*string) | ineq_aux of unit ->  (string)
+ | actions of unit ->  ( ( TracProtocol.prot_label * TracProtocol.action )  list)
+ | action of unit ->  (TracProtocol.prot_label*TracProtocol.action)
+ | setexp of unit ->  (string*Trac_Term.Msg list)
+ | msgs of unit ->  (Trac_Term.Msg list)
+ | msg of unit ->  (Trac_Term.Msg) | result of unit ->  (string list)
+ | keys of unit ->  (Trac_Term.Msg list)
+ | head_params of unit ->  (string list)
+ | head of unit ->  (string*string list)
+ | rule of unit ->  (TracProtocol.ruleT)
+ | transaction_spec of unit ->  (TracProtocol.transaction list)
+ | transaction_spec_head of unit ->  (string option)
+ | analysis_spec of unit ->  (TracProtocol.anaT)
+ | pub_fun_spec of unit ->  (TracProtocol.funT list)
+ | priv_fun_spec of unit ->  (TracProtocol.funT list)
+ | fun_spec of unit ->  (TracProtocol.funT)
+ | fun_specs of unit ->  (TracProtocol.funT list)
+ | priv_or_pub_fun_spec of unit ->  (TracProtocol.fun_spec)
+ | set_spec of unit ->  (TracProtocol.set_spec)
+ | set_specs of unit ->  (TracProtocol.set_spec list)
+ | lidents of unit ->  (string list)
+ | uidents of unit ->  (string list)
+ | idents of unit ->  (string list)
+ | type_specs of unit ->  ( ( string * TracProtocol.type_spec_elem )  list)
+ | type_spec of unit ->  ( ( string * TracProtocol.type_spec_elem ) )
+ | type_union of unit ->  ( ( string list ) )
+ | protocol_spec of unit ->  (TracProtocol.protocol)
+ | trac_protocol of unit ->  (TracProtocol.protocol)
+ | ident of unit ->  (string) | lident of unit ->  (string)
+ | uident of unit ->  (string) | arity of unit ->  (string)
+ | name of unit ->  (string)
+ | START of unit ->  (TracProtocol.protocol)
+end
+type svalue = MlyValue.svalue
+type result = TracProtocol.protocol
+end
+structure EC=
+struct
+open LrTable
+infix 5 $$
+fun x $$ y = y::x
+val is_keyword =
+fn _ => false
+val preferred_change : (term list * term list) list = 
+nil
+val noShift = 
+fn (T 0) => true | _ => false
+val showTerminal =
+fn (T 0) => "EOF"
+  | (T 1) => "OPENP"
+  | (T 2) => "CLOSEP"
+  | (T 3) => "OPENB"
+  | (T 4) => "CLOSEB"
+  | (T 5) => "OPENSCRYPT"
+  | (T 6) => "CLOSESCRYPT"
+  | (T 7) => "COLON"
+  | (T 8) => "SEMICOLON"
+  | (T 9) => "SECCH"
+  | (T 10) => "AUTHCH"
+  | (T 11) => "CONFCH"
+  | (T 12) => "INSECCH"
+  | (T 13) => "FAUTHCH"
+  | (T 14) => "FSECCH"
+  | (T 15) => "PERCENT"
+  | (T 16) => "UNEQUAL"
+  | (T 17) => "EXCLAM"
+  | (T 18) => "DOT"
+  | (T 19) => "COMMA"
+  | (T 20) => "OPENSQB"
+  | (T 21) => "CLOSESQB"
+  | (T 22) => "UNION"
+  | (T 23) => "PROTOCOL"
+  | (T 24) => "KNOWLEDGE"
+  | (T 25) => "WHERE"
+  | (T 26) => "ACTIONS"
+  | (T 27) => "ABSTRACTION"
+  | (T 28) => "GOALS"
+  | (T 29) => "AUTHENTICATES"
+  | (T 30) => "WEAKLY"
+  | (T 31) => "ON"
+  | (T 32) => "TSECRET"
+  | (T 33) => "TBETWEEN"
+  | (T 34) => "Sets"
+  | (T 35) => "FUNCTIONS"
+  | (T 36) => "PUBLIC"
+  | (T 37) => "PRIVATE"
+  | (T 38) => "RECEIVE"
+  | (T 39) => "SEND"
+  | (T 40) => "IN"
+  | (T 41) => "NOTIN"
+  | (T 42) => "INSERT"
+  | (T 43) => "DELETE"
+  | (T 44) => "NEW"
+  | (T 45) => "ATTACK"
+  | (T 46) => "slash"
+  | (T 47) => "QUESTION"
+  | (T 48) => "equal"
+  | (T 49) => "TYPES"
+  | (T 50) => "SETS"
+  | (T 51) => "ARROW"
+  | (T 52) => "ANALYSIS"
+  | (T 53) => "TRANSACTIONS"
+  | (T 54) => "STRING_LITERAL"
+  | (T 55) => "UPPER_STRING_LITERAL"
+  | (T 56) => "LOWER_STRING_LITERAL"
+  | (T 57) => "UNDERSCORE"
+  | (T 58) => "INTEGER_LITERAL"
+  | (T 59) => "STAR"
+  | (T 60) => "OF"
+  | _ => "bogus-term"
+local open Header in
+val errtermvalue=
+fn _ => MlyValue.VOID
+end
+val terms : term list = nil
+ $$ (T 0)end
+structure Actions =
+struct 
+exception mlyAction of int
+local open Header in
+val actions = 
+fn (i392,defaultPos,stack,
+    (()):arg) =>
+case (i392,stack)
+of  ( 0, ( ( _, ( MlyValue.trac_protocol trac_protocol1, 
+trac_protocol1left, trac_protocol1right)) :: rest671)) => let val  
+result = MlyValue.START (fn _ => let val  (trac_protocol as 
+trac_protocol1) = trac_protocol1 ()
+ in (trac_protocol)
+end)
+ in ( LrTable.NT 0, ( result, trac_protocol1left, trac_protocol1right)
+, rest671)
+end
+|  ( 1, ( ( _, ( MlyValue.protocol_spec protocol_spec1, _, 
+protocol_spec1right)) :: ( _, ( MlyValue.name name1, _, _)) :: ( _, ( 
+MlyValue.COLON COLON1, _, _)) :: ( _, ( MlyValue.PROTOCOL PROTOCOL1, 
+PROTOCOL1left, _)) :: rest671)) => let val  result = 
+MlyValue.trac_protocol (fn _ => let val  PROTOCOL1 = PROTOCOL1 ()
+ val  COLON1 = COLON1 ()
+ val  (name as name1) = name1 ()
+ val  (protocol_spec as protocol_spec1) = protocol_spec1 ()
+ in (TracProtocol.update_name protocol_spec name)
+end)
+ in ( LrTable.NT 6, ( result, PROTOCOL1left, protocol_spec1right), 
+rest671)
+end
+|  ( 2, ( ( _, ( MlyValue.protocol_spec protocol_spec1, _, 
+protocol_spec1right)) :: ( _, ( MlyValue.type_specs type_specs1, _, _)
+) :: ( _, ( MlyValue.COLON COLON1, _, _)) :: ( _, ( MlyValue.TYPES 
+TYPES1, TYPES1left, _)) :: rest671)) => let val  result = 
+MlyValue.protocol_spec (fn _ => let val  TYPES1 = TYPES1 ()
+ val  COLON1 = COLON1 ()
+ val  (type_specs as type_specs1) = type_specs1 ()
+ val  (protocol_spec as protocol_spec1) = protocol_spec1 ()
+ in (TracProtocol.update_type_spec protocol_spec type_specs)
+end)
+ in ( LrTable.NT 7, ( result, TYPES1left, protocol_spec1right), 
+rest671)
+end
+|  ( 3, ( ( _, ( MlyValue.protocol_spec protocol_spec1, _, 
+protocol_spec1right)) :: ( _, ( MlyValue.set_specs set_specs1, _, _))
+ :: ( _, ( MlyValue.COLON COLON1, _, _)) :: ( _, ( MlyValue.SETS SETS1
+, SETS1left, _)) :: rest671)) => let val  result = 
+MlyValue.protocol_spec (fn _ => let val  SETS1 = SETS1 ()
+ val  COLON1 = COLON1 ()
+ val  (set_specs as set_specs1) = set_specs1 ()
+ val  (protocol_spec as protocol_spec1) = protocol_spec1 ()
+ in (TracProtocol.update_sets protocol_spec set_specs)
+end)
+ in ( LrTable.NT 7, ( result, SETS1left, protocol_spec1right), rest671
+)
+end
+|  ( 4, ( ( _, ( MlyValue.protocol_spec protocol_spec1, _, 
+protocol_spec1right)) :: ( _, ( MlyValue.priv_or_pub_fun_spec 
+priv_or_pub_fun_spec1, _, _)) :: ( _, ( MlyValue.COLON COLON1, _, _))
+ :: ( _, ( MlyValue.FUNCTIONS FUNCTIONS1, FUNCTIONS1left, _)) :: 
+rest671)) => let val  result = MlyValue.protocol_spec (fn _ => let
+ val  FUNCTIONS1 = FUNCTIONS1 ()
+ val  COLON1 = COLON1 ()
+ val  (priv_or_pub_fun_spec as priv_or_pub_fun_spec1) = 
+priv_or_pub_fun_spec1 ()
+ val  (protocol_spec as protocol_spec1) = protocol_spec1 ()
+ in (
+TracProtocol.update_functions protocol_spec (SOME priv_or_pub_fun_spec)
+)
+end)
+ in ( LrTable.NT 7, ( result, FUNCTIONS1left, protocol_spec1right), 
+rest671)
+end
+|  ( 5, ( ( _, ( MlyValue.protocol_spec protocol_spec1, _, 
+protocol_spec1right)) :: ( _, ( MlyValue.analysis_spec analysis_spec1,
+ _, _)) :: ( _, ( MlyValue.COLON COLON1, _, _)) :: ( _, ( 
+MlyValue.ANALYSIS ANALYSIS1, ANALYSIS1left, _)) :: rest671)) => let
+ val  result = MlyValue.protocol_spec (fn _ => let val  ANALYSIS1 = 
+ANALYSIS1 ()
+ val  COLON1 = COLON1 ()
+ val  (analysis_spec as analysis_spec1) = analysis_spec1 ()
+ val  (protocol_spec as protocol_spec1) = protocol_spec1 ()
+ in (TracProtocol.update_analysis protocol_spec analysis_spec)
+end)
+ in ( LrTable.NT 7, ( result, ANALYSIS1left, protocol_spec1right), 
+rest671)
+end
+|  ( 6, ( ( _, ( MlyValue.protocol_spec protocol_spec1, _, 
+protocol_spec1right)) :: ( _, ( MlyValue.transaction_spec 
+transaction_spec1, _, _)) :: ( _, ( MlyValue.COLON COLON1, _, _)) :: (
+ _, ( MlyValue.transaction_spec_head transaction_spec_head1, 
+transaction_spec_head1left, _)) :: rest671)) => let val  result = 
+MlyValue.protocol_spec (fn _ => let val  (transaction_spec_head as 
+transaction_spec_head1) = transaction_spec_head1 ()
+ val  COLON1 = COLON1 ()
+ val  (transaction_spec as transaction_spec1) = transaction_spec1 ()
+ val  (protocol_spec as protocol_spec1) = protocol_spec1 ()
+ in (
+TracProtocol.update_transactions transaction_spec_head protocol_spec transaction_spec
+)
+end)
+ in ( LrTable.NT 7, ( result, transaction_spec_head1left, 
+protocol_spec1right), rest671)
+end
+|  ( 7, ( rest671)) => let val  result = MlyValue.protocol_spec (fn _
+ => (TracProtocol.empty))
+ in ( LrTable.NT 7, ( result, defaultPos, defaultPos), rest671)
+end
+|  ( 8, ( ( _, ( MlyValue.ident ident1, ident1left, ident1right)) :: 
+rest671)) => let val  result = MlyValue.type_union (fn _ => let val  (
+ident as ident1) = ident1 ()
+ in ([ident])
+end)
+ in ( LrTable.NT 8, ( result, ident1left, ident1right), rest671)
+end
+|  ( 9, ( ( _, ( MlyValue.type_union type_union1, _, type_union1right)
+) :: ( _, ( MlyValue.UNION UNION1, _, _)) :: ( _, ( MlyValue.ident 
+ident1, ident1left, _)) :: rest671)) => let val  result = 
+MlyValue.type_union (fn _ => let val  (ident as ident1) = ident1 ()
+ val  UNION1 = UNION1 ()
+ val  (type_union as type_union1) = type_union1 ()
+ in (ident::type_union)
+end)
+ in ( LrTable.NT 8, ( result, ident1left, type_union1right), rest671)
+
+end
+|  ( 10, ( ( _, ( MlyValue.type_spec type_spec1, type_spec1left, 
+type_spec1right)) :: rest671)) => let val  result = 
+MlyValue.type_specs (fn _ => let val  (type_spec as type_spec1) = 
+type_spec1 ()
+ in ([type_spec])
+end)
+ in ( LrTable.NT 10, ( result, type_spec1left, type_spec1right), 
+rest671)
+end
+|  ( 11, ( ( _, ( MlyValue.type_specs type_specs1, _, type_specs1right
+)) :: ( _, ( MlyValue.type_spec type_spec1, type_spec1left, _)) :: 
+rest671)) => let val  result = MlyValue.type_specs (fn _ => let val  (
+type_spec as type_spec1) = type_spec1 ()
+ val  (type_specs as type_specs1) = type_specs1 ()
+ in (type_spec::type_specs)
+end)
+ in ( LrTable.NT 10, ( result, type_spec1left, type_specs1right), 
+rest671)
+end
+|  ( 12, ( ( _, ( MlyValue.CLOSEB CLOSEB1, _, CLOSEB1right)) :: ( _, (
+ MlyValue.lidents lidents1, _, _)) :: ( _, ( MlyValue.OPENB OPENB1, _,
+ _)) :: ( _, ( MlyValue.equal equal1, _, _)) :: ( _, ( MlyValue.ident 
+ident1, ident1left, _)) :: rest671)) => let val  result = 
+MlyValue.type_spec (fn _ => let val  (ident as ident1) = ident1 ()
+ val  equal1 = equal1 ()
+ val  OPENB1 = OPENB1 ()
+ val  (lidents as lidents1) = lidents1 ()
+ val  CLOSEB1 = CLOSEB1 ()
+ in ((ident, TracProtocol.Consts lidents))
+end)
+ in ( LrTable.NT 9, ( result, ident1left, CLOSEB1right), rest671)
+end
+|  ( 13, ( ( _, ( MlyValue.type_union type_union1, _, type_union1right
+)) :: ( _, ( MlyValue.equal equal1, _, _)) :: ( _, ( MlyValue.ident 
+ident1, ident1left, _)) :: rest671)) => let val  result = 
+MlyValue.type_spec (fn _ => let val  (ident as ident1) = ident1 ()
+ val  equal1 = equal1 ()
+ val  (type_union as type_union1) = type_union1 ()
+ in ((ident, TracProtocol.Union type_union))
+end)
+ in ( LrTable.NT 9, ( result, ident1left, type_union1right), rest671)
+
+end
+|  ( 14, ( ( _, ( MlyValue.set_spec set_spec1, set_spec1left, 
+set_spec1right)) :: rest671)) => let val  result = MlyValue.set_specs
+ (fn _ => let val  (set_spec as set_spec1) = set_spec1 ()
+ in ([set_spec])
+end)
+ in ( LrTable.NT 14, ( result, set_spec1left, set_spec1right), rest671
+)
+end
+|  ( 15, ( ( _, ( MlyValue.set_specs set_specs1, _, set_specs1right))
+ :: ( _, ( MlyValue.set_spec set_spec1, set_spec1left, _)) :: rest671)
+) => let val  result = MlyValue.set_specs (fn _ => let val  (set_spec
+ as set_spec1) = set_spec1 ()
+ val  (set_specs as set_specs1) = set_specs1 ()
+ in (set_spec::set_specs)
+end)
+ in ( LrTable.NT 14, ( result, set_spec1left, set_specs1right), 
+rest671)
+end
+|  ( 16, ( ( _, ( MlyValue.arity arity1, _, arity1right)) :: ( _, ( 
+MlyValue.slash slash1, _, _)) :: ( _, ( MlyValue.ident ident1, 
+ident1left, _)) :: rest671)) => let val  result = MlyValue.set_spec
+ (fn _ => let val  (ident as ident1) = ident1 ()
+ val  slash1 = slash1 ()
+ val  (arity as arity1) = arity1 ()
+ in ((ident, arity))
+end)
+ in ( LrTable.NT 15, ( result, ident1left, arity1right), rest671)
+end
+|  ( 17, ( ( _, ( MlyValue.priv_or_pub_fun_spec priv_or_pub_fun_spec1,
+ _, priv_or_pub_fun_spec1right)) :: ( _, ( MlyValue.pub_fun_spec 
+pub_fun_spec1, pub_fun_spec1left, _)) :: rest671)) => let val  result
+ = MlyValue.priv_or_pub_fun_spec (fn _ => let val  (pub_fun_spec as 
+pub_fun_spec1) = pub_fun_spec1 ()
+ val  (priv_or_pub_fun_spec as priv_or_pub_fun_spec1) = 
+priv_or_pub_fun_spec1 ()
+ in (TracProtocol.update_fun_public priv_or_pub_fun_spec pub_fun_spec)
+
+end)
+ in ( LrTable.NT 16, ( result, pub_fun_spec1left, 
+priv_or_pub_fun_spec1right), rest671)
+end
+|  ( 18, ( ( _, ( MlyValue.priv_or_pub_fun_spec priv_or_pub_fun_spec1,
+ _, priv_or_pub_fun_spec1right)) :: ( _, ( MlyValue.priv_fun_spec 
+priv_fun_spec1, priv_fun_spec1left, _)) :: rest671)) => let val  
+result = MlyValue.priv_or_pub_fun_spec (fn _ => let val  (
+priv_fun_spec as priv_fun_spec1) = priv_fun_spec1 ()
+ val  (priv_or_pub_fun_spec as priv_or_pub_fun_spec1) = 
+priv_or_pub_fun_spec1 ()
+ in (
+TracProtocol.update_fun_private priv_or_pub_fun_spec priv_fun_spec)
+
+end)
+ in ( LrTable.NT 16, ( result, priv_fun_spec1left, 
+priv_or_pub_fun_spec1right), rest671)
+end
+|  ( 19, ( rest671)) => let val  result = 
+MlyValue.priv_or_pub_fun_spec (fn _ => (TracProtocol.fun_empty))
+ in ( LrTable.NT 16, ( result, defaultPos, defaultPos), rest671)
+end
+|  ( 20, ( ( _, ( MlyValue.fun_specs fun_specs1, _, fun_specs1right))
+ :: ( _, ( MlyValue.PUBLIC PUBLIC1, PUBLIC1left, _)) :: rest671)) =>
+ let val  result = MlyValue.pub_fun_spec (fn _ => let val  PUBLIC1 = 
+PUBLIC1 ()
+ val  (fun_specs as fun_specs1) = fun_specs1 ()
+ in (fun_specs)
+end)
+ in ( LrTable.NT 20, ( result, PUBLIC1left, fun_specs1right), rest671)
+
+end
+|  ( 21, ( ( _, ( MlyValue.fun_specs fun_specs1, _, fun_specs1right))
+ :: ( _, ( MlyValue.PRIVATE PRIVATE1, PRIVATE1left, _)) :: rest671))
+ => let val  result = MlyValue.priv_fun_spec (fn _ => let val  
+PRIVATE1 = PRIVATE1 ()
+ val  (fun_specs as fun_specs1) = fun_specs1 ()
+ in (fun_specs)
+end)
+ in ( LrTable.NT 19, ( result, PRIVATE1left, fun_specs1right), rest671
+)
+end
+|  ( 22, ( ( _, ( MlyValue.fun_spec fun_spec1, fun_spec1left, 
+fun_spec1right)) :: rest671)) => let val  result = MlyValue.fun_specs
+ (fn _ => let val  (fun_spec as fun_spec1) = fun_spec1 ()
+ in ([fun_spec])
+end)
+ in ( LrTable.NT 17, ( result, fun_spec1left, fun_spec1right), rest671
+)
+end
+|  ( 23, ( ( _, ( MlyValue.fun_specs fun_specs1, _, fun_specs1right))
+ :: ( _, ( MlyValue.fun_spec fun_spec1, fun_spec1left, _)) :: rest671)
+) => let val  result = MlyValue.fun_specs (fn _ => let val  (fun_spec
+ as fun_spec1) = fun_spec1 ()
+ val  (fun_specs as fun_specs1) = fun_specs1 ()
+ in (fun_spec::fun_specs)
+end)
+ in ( LrTable.NT 17, ( result, fun_spec1left, fun_specs1right), 
+rest671)
+end
+|  ( 24, ( ( _, ( MlyValue.arity arity1, _, arity1right)) :: ( _, ( 
+MlyValue.slash slash1, _, _)) :: ( _, ( MlyValue.ident ident1, 
+ident1left, _)) :: rest671)) => let val  result = MlyValue.fun_spec
+ (fn _ => let val  (ident as ident1) = ident1 ()
+ val  slash1 = slash1 ()
+ val  (arity as arity1) = arity1 ()
+ in ((ident, arity))
+end)
+ in ( LrTable.NT 18, ( result, ident1left, arity1right), rest671)
+end
+|  ( 25, ( ( _, ( MlyValue.rule rule1, rule1left, rule1right)) :: 
+rest671)) => let val  result = MlyValue.analysis_spec (fn _ => let
+ val  (rule as rule1) = rule1 ()
+ in ([rule])
+end)
+ in ( LrTable.NT 21, ( result, rule1left, rule1right), rest671)
+end
+|  ( 26, ( ( _, ( MlyValue.analysis_spec analysis_spec1, _, 
+analysis_spec1right)) :: ( _, ( MlyValue.rule rule1, rule1left, _)) ::
+ rest671)) => let val  result = MlyValue.analysis_spec (fn _ => let
+ val  (rule as rule1) = rule1 ()
+ val  (analysis_spec as analysis_spec1) = analysis_spec1 ()
+ in (rule::analysis_spec)
+end)
+ in ( LrTable.NT 21, ( result, rule1left, analysis_spec1right), 
+rest671)
+end
+|  ( 27, ( ( _, ( MlyValue.result result1, _, result1right)) :: ( _, (
+ MlyValue.ARROW ARROW1, _, _)) :: ( _, ( MlyValue.head head1, 
+head1left, _)) :: rest671)) => let val  result = MlyValue.rule (fn _
+ => let val  (head as head1) = head1 ()
+ val  ARROW1 = ARROW1 ()
+ val  (result as result1) = result1 ()
+ in ((head,[],result))
+end)
+ in ( LrTable.NT 24, ( result, head1left, result1right), rest671)
+end
+|  ( 28, ( ( _, ( MlyValue.result result1, _, result1right)) :: ( _, (
+ MlyValue.ARROW ARROW1, _, _)) :: ( _, ( MlyValue.keys keys1, _, _))
+ :: ( _, ( MlyValue.QUESTION QUESTION1, _, _)) :: ( _, ( MlyValue.head
+ head1, head1left, _)) :: rest671)) => let val  result = MlyValue.rule
+ (fn _ => let val  (head as head1) = head1 ()
+ val  QUESTION1 = QUESTION1 ()
+ val  (keys as keys1) = keys1 ()
+ val  ARROW1 = ARROW1 ()
+ val  (result as result1) = result1 ()
+ in ((head,keys,result))
+end)
+ in ( LrTable.NT 24, ( result, head1left, result1right), rest671)
+end
+|  ( 29, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, (
+ MlyValue.head_params head_params1, _, _)) :: ( _, ( MlyValue.OPENP 
+OPENP1, _, _)) :: ( _, ( MlyValue.LOWER_STRING_LITERAL 
+LOWER_STRING_LITERAL1, LOWER_STRING_LITERAL1left, _)) :: rest671)) =>
+ let val  result = MlyValue.head (fn _ => let val  (
+LOWER_STRING_LITERAL as LOWER_STRING_LITERAL1) = LOWER_STRING_LITERAL1
+ ()
+ val  OPENP1 = OPENP1 ()
+ val  (head_params as head_params1) = head_params1 ()
+ val  CLOSEP1 = CLOSEP1 ()
+ in ((LOWER_STRING_LITERAL,head_params))
+end)
+ in ( LrTable.NT 25, ( result, LOWER_STRING_LITERAL1left, CLOSEP1right
+), rest671)
+end
+|  ( 30, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1,
+ UPPER_STRING_LITERAL1left, UPPER_STRING_LITERAL1right)) :: rest671))
+ => let val  result = MlyValue.head_params (fn _ => let val  (
+UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1
+ ()
+ in ([UPPER_STRING_LITERAL])
+end)
+ in ( LrTable.NT 26, ( result, UPPER_STRING_LITERAL1left, 
+UPPER_STRING_LITERAL1right), rest671)
+end
+|  ( 31, ( ( _, ( MlyValue.head_params head_params1, _, 
+head_params1right)) :: ( _, ( MlyValue.COMMA COMMA1, _, _)) :: ( _, ( 
+MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1, 
+UPPER_STRING_LITERAL1left, _)) :: rest671)) => let val  result = 
+MlyValue.head_params (fn _ => let val  (UPPER_STRING_LITERAL as 
+UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1 ()
+ val  COMMA1 = COMMA1 ()
+ val  (head_params as head_params1) = head_params1 ()
+ in ([UPPER_STRING_LITERAL]@head_params)
+end)
+ in ( LrTable.NT 26, ( result, UPPER_STRING_LITERAL1left, 
+head_params1right), rest671)
+end
+|  ( 32, ( ( _, ( MlyValue.msgs msgs1, msgs1left, msgs1right)) :: 
+rest671)) => let val  result = MlyValue.keys (fn _ => let val  (msgs
+ as msgs1) = msgs1 ()
+ in (msgs)
+end)
+ in ( LrTable.NT 27, ( result, msgs1left, msgs1right), rest671)
+end
+|  ( 33, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1,
+ UPPER_STRING_LITERAL1left, UPPER_STRING_LITERAL1right)) :: rest671))
+ => let val  result = MlyValue.result (fn _ => let val  (
+UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1
+ ()
+ in ([UPPER_STRING_LITERAL])
+end)
+ in ( LrTable.NT 28, ( result, UPPER_STRING_LITERAL1left, 
+UPPER_STRING_LITERAL1right), rest671)
+end
+|  ( 34, ( ( _, ( MlyValue.result result1, _, result1right)) :: ( _, (
+ MlyValue.COMMA COMMA1, _, _)) :: ( _, ( MlyValue.UPPER_STRING_LITERAL
+ UPPER_STRING_LITERAL1, UPPER_STRING_LITERAL1left, _)) :: rest671)) =>
+ let val  result = MlyValue.result (fn _ => let val  (
+UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1
+ ()
+ val  COMMA1 = COMMA1 ()
+ val  (result as result1) = result1 ()
+ in ([UPPER_STRING_LITERAL]@result)
+end)
+ in ( LrTable.NT 28, ( result, UPPER_STRING_LITERAL1left, result1right
+), rest671)
+end
+|  ( 35, ( ( _, ( MlyValue.TRANSACTIONS TRANSACTIONS1, 
+TRANSACTIONS1left, TRANSACTIONS1right)) :: rest671)) => let val  
+result = MlyValue.transaction_spec_head (fn _ => let val  
+TRANSACTIONS1 = TRANSACTIONS1 ()
+ in (NONE)
+end)
+ in ( LrTable.NT 22, ( result, TRANSACTIONS1left, TRANSACTIONS1right),
+ rest671)
+end
+|  ( 36, ( ( _, ( MlyValue.LOWER_STRING_LITERAL LOWER_STRING_LITERAL1,
+ _, LOWER_STRING_LITERAL1right)) :: ( _, ( MlyValue.OF OF1, _, _)) :: 
+( _, ( MlyValue.TRANSACTIONS TRANSACTIONS1, TRANSACTIONS1left, _)) :: 
+rest671)) => let val  result = MlyValue.transaction_spec_head (fn _ =>
+ let val  TRANSACTIONS1 = TRANSACTIONS1 ()
+ val  OF1 = OF1 ()
+ val  (LOWER_STRING_LITERAL as LOWER_STRING_LITERAL1) = 
+LOWER_STRING_LITERAL1 ()
+ in (SOME LOWER_STRING_LITERAL)
+end)
+ in ( LrTable.NT 22, ( result, TRANSACTIONS1left, 
+LOWER_STRING_LITERAL1right), rest671)
+end
+|  ( 37, ( ( _, ( MlyValue.DOT DOT1, _, DOT1right)) :: ( _, ( 
+MlyValue.actions actions1, _, _)) :: ( _, ( MlyValue.transaction 
+transaction1, transaction1left, _)) :: rest671)) => let val  result = 
+MlyValue.transaction_spec (fn _ => let val  (transaction as 
+transaction1) = transaction1 ()
+ val  (actions as actions1) = actions1 ()
+ val  DOT1 = DOT1 ()
+ in ([TracProtocol.mkTransaction transaction actions])
+end)
+ in ( LrTable.NT 23, ( result, transaction1left, DOT1right), rest671)
+
+end
+|  ( 38, ( ( _, ( MlyValue.transaction_spec transaction_spec1, _, 
+transaction_spec1right)) :: ( _, ( MlyValue.DOT DOT1, _, _)) :: ( _, (
+ MlyValue.actions actions1, _, _)) :: ( _, ( MlyValue.transaction 
+transaction1, transaction1left, _)) :: rest671)) => let val  result = 
+MlyValue.transaction_spec (fn _ => let val  (transaction as 
+transaction1) = transaction1 ()
+ val  (actions as actions1) = actions1 ()
+ val  DOT1 = DOT1 ()
+ val  (transaction_spec as transaction_spec1) = transaction_spec1 ()
+ in (
+(TracProtocol.mkTransaction transaction actions)::transaction_spec)
+
+end)
+ in ( LrTable.NT 23, ( result, transaction1left, 
+transaction_spec1right), rest671)
+end
+|  ( 39, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1,
+ _, UPPER_STRING_LITERAL1right)) :: ( _, ( MlyValue.UNEQUAL UNEQUAL1, 
+UNEQUAL1left, _)) :: rest671)) => let val  result = MlyValue.ineq_aux
+ (fn _ => let val  UNEQUAL1 = UNEQUAL1 ()
+ val  (UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = 
+UPPER_STRING_LITERAL1 ()
+ in (UPPER_STRING_LITERAL)
+end)
+ in ( LrTable.NT 34, ( result, UNEQUAL1left, 
+UPPER_STRING_LITERAL1right), rest671)
+end
+|  ( 40, ( ( _, ( MlyValue.ineq_aux ineq_aux1, _, ineq_aux1right)) :: 
+( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1, 
+UPPER_STRING_LITERAL1left, _)) :: rest671)) => let val  result = 
+MlyValue.ineq (fn _ => let val  (UPPER_STRING_LITERAL as 
+UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1 ()
+ val  (ineq_aux as ineq_aux1) = ineq_aux1 ()
+ in ((UPPER_STRING_LITERAL,ineq_aux))
+end)
+ in ( LrTable.NT 35, ( result, UPPER_STRING_LITERAL1left, 
+ineq_aux1right), rest671)
+end
+|  ( 41, ( ( _, ( MlyValue.ineq ineq1, ineq1left, ineq1right)) :: 
+rest671)) => let val  result = MlyValue.ineqs (fn _ => let val  (ineq
+ as ineq1) = ineq1 ()
+ in ([ineq])
+end)
+ in ( LrTable.NT 36, ( result, ineq1left, ineq1right), rest671)
+end
+|  ( 42, ( ( _, ( MlyValue.ineqs ineqs1, _, ineqs1right)) :: ( _, ( 
+MlyValue.COMMA COMMA1, _, _)) :: ( _, ( MlyValue.ineq ineq1, ineq1left
+, _)) :: rest671)) => let val  result = MlyValue.ineqs (fn _ => let
+ val  (ineq as ineq1) = ineq1 ()
+ val  COMMA1 = COMMA1 ()
+ val  (ineqs as ineqs1) = ineqs1 ()
+ in ([ineq]@ineqs)
+end)
+ in ( LrTable.NT 36, ( result, ineq1left, ineqs1right), rest671)
+end
+|  ( 43, ( ( _, ( MlyValue.ineqs ineqs1, _, ineqs1right)) :: ( _, ( 
+MlyValue.WHERE WHERE1, _, _)) :: ( _, ( MlyValue.CLOSEP CLOSEP1, _, _)
+) :: ( _, ( MlyValue.parameters parameters1, _, _)) :: ( _, ( 
+MlyValue.OPENP OPENP1, _, _)) :: ( _, ( MlyValue.ident ident1, 
+ident1left, _)) :: rest671)) => let val  result = MlyValue.transaction
+ (fn _ => let val  (ident as ident1) = ident1 ()
+ val  OPENP1 = OPENP1 ()
+ val  (parameters as parameters1) = parameters1 ()
+ val  CLOSEP1 = CLOSEP1 ()
+ val  WHERE1 = WHERE1 ()
+ val  (ineqs as ineqs1) = ineqs1 ()
+ in ((ident,parameters,ineqs))
+end)
+ in ( LrTable.NT 37, ( result, ident1left, ineqs1right), rest671)
+end
+|  ( 44, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, (
+ MlyValue.parameters parameters1, _, _)) :: ( _, ( MlyValue.OPENP 
+OPENP1, _, _)) :: ( _, ( MlyValue.ident ident1, ident1left, _)) :: 
+rest671)) => let val  result = MlyValue.transaction (fn _ => let val 
+ (ident as ident1) = ident1 ()
+ val  OPENP1 = OPENP1 ()
+ val  (parameters as parameters1) = parameters1 ()
+ val  CLOSEP1 = CLOSEP1 ()
+ in ((ident,parameters,[]))
+end)
+ in ( LrTable.NT 37, ( result, ident1left, CLOSEP1right), rest671)
+end
+|  ( 45, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, (
+ MlyValue.OPENP OPENP1, _, _)) :: ( _, ( MlyValue.ident ident1, 
+ident1left, _)) :: rest671)) => let val  result = MlyValue.transaction
+ (fn _ => let val  (ident as ident1) = ident1 ()
+ val  OPENP1 = OPENP1 ()
+ val  CLOSEP1 = CLOSEP1 ()
+ in ((ident,[],[]))
+end)
+ in ( LrTable.NT 37, ( result, ident1left, CLOSEP1right), rest671)
+end
+|  ( 46, ( ( _, ( MlyValue.parameter parameter1, parameter1left, 
+parameter1right)) :: rest671)) => let val  result = 
+MlyValue.parameters (fn _ => let val  (parameter as parameter1) = 
+parameter1 ()
+ in ([parameter])
+end)
+ in ( LrTable.NT 40, ( result, parameter1left, parameter1right), 
+rest671)
+end
+|  ( 47, ( ( _, ( MlyValue.parameters parameters1, _, parameters1right
+)) :: ( _, ( MlyValue.COMMA COMMA1, _, _)) :: ( _, ( 
+MlyValue.parameter parameter1, parameter1left, _)) :: rest671)) => let
+ val  result = MlyValue.parameters (fn _ => let val  (parameter as 
+parameter1) = parameter1 ()
+ val  COMMA1 = COMMA1 ()
+ val  (parameters as parameters1) = parameters1 ()
+ in (parameter::parameters)
+end)
+ in ( LrTable.NT 40, ( result, parameter1left, parameters1right), 
+rest671)
+end
+|  ( 48, ( ( _, ( MlyValue.typ typ1, _, typ1right)) :: ( _, ( 
+MlyValue.COLON COLON1, _, _)) :: ( _, ( MlyValue.ident ident1, 
+ident1left, _)) :: rest671)) => let val  result = MlyValue.parameter
+ (fn _ => let val  (ident as ident1) = ident1 ()
+ val  COLON1 = COLON1 ()
+ val  (typ as typ1) = typ1 ()
+ in ((ident, typ))
+end)
+ in ( LrTable.NT 39, ( result, ident1left, typ1right), rest671)
+end
+|  ( 49, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1,
+ UPPER_STRING_LITERAL1left, UPPER_STRING_LITERAL1right)) :: rest671))
+ => let val  result = MlyValue.typ (fn _ => let val  (
+UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1
+ ()
+ in (UPPER_STRING_LITERAL)
+end)
+ in ( LrTable.NT 38, ( result, UPPER_STRING_LITERAL1left, 
+UPPER_STRING_LITERAL1right), rest671)
+end
+|  ( 50, ( ( _, ( MlyValue.LOWER_STRING_LITERAL LOWER_STRING_LITERAL1,
+ LOWER_STRING_LITERAL1left, LOWER_STRING_LITERAL1right)) :: rest671))
+ => let val  result = MlyValue.typ (fn _ => let val  (
+LOWER_STRING_LITERAL as LOWER_STRING_LITERAL1) = LOWER_STRING_LITERAL1
+ ()
+ in (LOWER_STRING_LITERAL)
+end)
+ in ( LrTable.NT 38, ( result, LOWER_STRING_LITERAL1left, 
+LOWER_STRING_LITERAL1right), rest671)
+end
+|  ( 51, ( ( _, ( MlyValue.action action1, action1left, action1right))
+ :: rest671)) => let val  result = MlyValue.actions (fn _ => let val 
+ (action as action1) = action1 ()
+ in ([action])
+end)
+ in ( LrTable.NT 33, ( result, action1left, action1right), rest671)
+
+end
+|  ( 52, ( ( _, ( MlyValue.actions actions1, _, actions1right)) :: ( _
+, ( MlyValue.action action1, action1left, _)) :: rest671)) => let val 
+ result = MlyValue.actions (fn _ => let val  (action as action1) = 
+action1 ()
+ val  (actions as actions1) = actions1 ()
+ in (action::actions)
+end)
+ in ( LrTable.NT 33, ( result, action1left, actions1right), rest671)
+
+end
+|  ( 53, ( ( _, ( MlyValue.msg msg1, _, msg1right)) :: ( _, ( 
+MlyValue.RECEIVE RECEIVE1, RECEIVE1left, _)) :: rest671)) => let val  
+result = MlyValue.action (fn _ => let val  (RECEIVE as RECEIVE1) = 
+RECEIVE1 ()
+ val  (msg as msg1) = msg1 ()
+ in ((TracProtocol.LabelN,TracProtocol.RECEIVE(msg)))
+end)
+ in ( LrTable.NT 32, ( result, RECEIVE1left, msg1right), rest671)
+end
+|  ( 54, ( ( _, ( MlyValue.msg msg1, _, msg1right)) :: ( _, ( 
+MlyValue.SEND SEND1, SEND1left, _)) :: rest671)) => let val  result = 
+MlyValue.action (fn _ => let val  (SEND as SEND1) = SEND1 ()
+ val  (msg as msg1) = msg1 ()
+ in ((TracProtocol.LabelN,TracProtocol.SEND(msg)))
+end)
+ in ( LrTable.NT 32, ( result, SEND1left, msg1right), rest671)
+end
+|  ( 55, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, (
+ MlyValue.IN IN1, _, _)) :: ( _, ( MlyValue.msg msg1, msg1left, _)) ::
+ rest671)) => let val  result = MlyValue.action (fn _ => let val  (msg
+ as msg1) = msg1 ()
+ val  (IN as IN1) = IN1 ()
+ val  (setexp as setexp1) = setexp1 ()
+ in ((TracProtocol.LabelN,TracProtocol.IN(msg,setexp)))
+end)
+ in ( LrTable.NT 32, ( result, msg1left, setexp1right), rest671)
+end
+|  ( 56, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, (
+ MlyValue.NOTIN NOTIN1, _, _)) :: ( _, ( MlyValue.msg msg1, msg1left,
+ _)) :: rest671)) => let val  result = MlyValue.action (fn _ => let
+ val  (msg as msg1) = msg1 ()
+ val  (NOTIN as NOTIN1) = NOTIN1 ()
+ val  (setexp as setexp1) = setexp1 ()
+ in ((TracProtocol.LabelN,TracProtocol.NOTIN(msg,setexp)))
+end)
+ in ( LrTable.NT 32, ( result, msg1left, setexp1right), rest671)
+end
+|  ( 57, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, (
+ MlyValue.UNDERSCORE UNDERSCORE1, _, _)) :: ( _, ( MlyValue.OPENP 
+OPENP1, _, _)) :: ( _, ( MlyValue.lident lident1, _, _)) :: ( _, ( 
+MlyValue.NOTIN NOTIN1, _, _)) :: ( _, ( MlyValue.msg msg1, msg1left, _
+)) :: rest671)) => let val  result = MlyValue.action (fn _ => let val 
+ (msg as msg1) = msg1 ()
+ val  NOTIN1 = NOTIN1 ()
+ val  (lident as lident1) = lident1 ()
+ val  OPENP1 = OPENP1 ()
+ val  UNDERSCORE1 = UNDERSCORE1 ()
+ val  CLOSEP1 = CLOSEP1 ()
+ in ((TracProtocol.LabelN,TracProtocol.NOTINANY(msg,lident)))
+end)
+ in ( LrTable.NT 32, ( result, msg1left, CLOSEP1right), rest671)
+end
+|  ( 58, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, (
+ MlyValue.msg msg1, _, _)) :: ( _, ( MlyValue.INSERT INSERT1, 
+INSERT1left, _)) :: rest671)) => let val  result = MlyValue.action (fn
+ _ => let val  (INSERT as INSERT1) = INSERT1 ()
+ val  (msg as msg1) = msg1 ()
+ val  (setexp as setexp1) = setexp1 ()
+ in ((TracProtocol.LabelN,TracProtocol.INSERT(msg,setexp)))
+end)
+ in ( LrTable.NT 32, ( result, INSERT1left, setexp1right), rest671)
+
+end
+|  ( 59, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, (
+ MlyValue.msg msg1, _, _)) :: ( _, ( MlyValue.DELETE DELETE1, 
+DELETE1left, _)) :: rest671)) => let val  result = MlyValue.action (fn
+ _ => let val  (DELETE as DELETE1) = DELETE1 ()
+ val  (msg as msg1) = msg1 ()
+ val  (setexp as setexp1) = setexp1 ()
+ in ((TracProtocol.LabelN,TracProtocol.DELETE(msg,setexp)))
+end)
+ in ( LrTable.NT 32, ( result, DELETE1left, setexp1right), rest671)
+
+end
+|  ( 60, ( ( _, ( MlyValue.uident uident1, _, uident1right)) :: ( _, (
+ MlyValue.NEW NEW1, NEW1left, _)) :: rest671)) => let val  result = 
+MlyValue.action (fn _ => let val  (NEW as NEW1) = NEW1 ()
+ val  (uident as uident1) = uident1 ()
+ in ((TracProtocol.LabelS,TracProtocol.NEW(uident)))
+end)
+ in ( LrTable.NT 32, ( result, NEW1left, uident1right), rest671)
+end
+|  ( 61, ( ( _, ( MlyValue.ATTACK ATTACK1, ATTACK1left, ATTACK1right))
+ :: rest671)) => let val  result = MlyValue.action (fn _ => let val  (
+ATTACK as ATTACK1) = ATTACK1 ()
+ in ((TracProtocol.LabelN,TracProtocol.ATTACK))
+end)
+ in ( LrTable.NT 32, ( result, ATTACK1left, ATTACK1right), rest671)
+
+end
+|  ( 62, ( ( _, ( MlyValue.msg msg1, _, msg1right)) :: ( _, ( 
+MlyValue.RECEIVE RECEIVE1, _, _)) :: ( _, ( MlyValue.STAR STAR1, 
+STAR1left, _)) :: rest671)) => let val  result = MlyValue.action (fn _
+ => let val  STAR1 = STAR1 ()
+ val  (RECEIVE as RECEIVE1) = RECEIVE1 ()
+ val  (msg as msg1) = msg1 ()
+ in ((TracProtocol.LabelS,TracProtocol.RECEIVE(msg)))
+end)
+ in ( LrTable.NT 32, ( result, STAR1left, msg1right), rest671)
+end
+|  ( 63, ( ( _, ( MlyValue.msg msg1, _, msg1right)) :: ( _, ( 
+MlyValue.SEND SEND1, _, _)) :: ( _, ( MlyValue.STAR STAR1, STAR1left,
+ _)) :: rest671)) => let val  result = MlyValue.action (fn _ => let
+ val  STAR1 = STAR1 ()
+ val  (SEND as SEND1) = SEND1 ()
+ val  (msg as msg1) = msg1 ()
+ in ((TracProtocol.LabelS,TracProtocol.SEND(msg)))
+end)
+ in ( LrTable.NT 32, ( result, STAR1left, msg1right), rest671)
+end
+|  ( 64, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, (
+ MlyValue.IN IN1, _, _)) :: ( _, ( MlyValue.msg msg1, _, _)) :: ( _, (
+ MlyValue.STAR STAR1, STAR1left, _)) :: rest671)) => let val  result =
+ MlyValue.action (fn _ => let val  STAR1 = STAR1 ()
+ val  (msg as msg1) = msg1 ()
+ val  (IN as IN1) = IN1 ()
+ val  (setexp as setexp1) = setexp1 ()
+ in ((TracProtocol.LabelS,TracProtocol.IN(msg,setexp)))
+end)
+ in ( LrTable.NT 32, ( result, STAR1left, setexp1right), rest671)
+end
+|  ( 65, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, (
+ MlyValue.NOTIN NOTIN1, _, _)) :: ( _, ( MlyValue.msg msg1, _, _)) :: 
+( _, ( MlyValue.STAR STAR1, STAR1left, _)) :: rest671)) => let val  
+result = MlyValue.action (fn _ => let val  STAR1 = STAR1 ()
+ val  (msg as msg1) = msg1 ()
+ val  (NOTIN as NOTIN1) = NOTIN1 ()
+ val  (setexp as setexp1) = setexp1 ()
+ in ((TracProtocol.LabelS,TracProtocol.NOTIN(msg,setexp)))
+end)
+ in ( LrTable.NT 32, ( result, STAR1left, setexp1right), rest671)
+end
+|  ( 66, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, (
+ MlyValue.UNDERSCORE UNDERSCORE1, _, _)) :: ( _, ( MlyValue.OPENP 
+OPENP1, _, _)) :: ( _, ( MlyValue.lident lident1, _, _)) :: ( _, ( 
+MlyValue.NOTIN NOTIN1, _, _)) :: ( _, ( MlyValue.msg msg1, _, _)) :: (
+ _, ( MlyValue.STAR STAR1, STAR1left, _)) :: rest671)) => let val  
+result = MlyValue.action (fn _ => let val  STAR1 = STAR1 ()
+ val  (msg as msg1) = msg1 ()
+ val  NOTIN1 = NOTIN1 ()
+ val  (lident as lident1) = lident1 ()
+ val  OPENP1 = OPENP1 ()
+ val  UNDERSCORE1 = UNDERSCORE1 ()
+ val  CLOSEP1 = CLOSEP1 ()
+ in ((TracProtocol.LabelS,TracProtocol.NOTINANY(msg,lident)))
+end)
+ in ( LrTable.NT 32, ( result, STAR1left, CLOSEP1right), rest671)
+end
+|  ( 67, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, (
+ MlyValue.msg msg1, _, _)) :: ( _, ( MlyValue.INSERT INSERT1, _, _))
+ :: ( _, ( MlyValue.STAR STAR1, STAR1left, _)) :: rest671)) => let
+ val  result = MlyValue.action (fn _ => let val  STAR1 = STAR1 ()
+ val  (INSERT as INSERT1) = INSERT1 ()
+ val  (msg as msg1) = msg1 ()
+ val  (setexp as setexp1) = setexp1 ()
+ in ((TracProtocol.LabelS,TracProtocol.INSERT(msg,setexp)))
+end)
+ in ( LrTable.NT 32, ( result, STAR1left, setexp1right), rest671)
+end
+|  ( 68, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, (
+ MlyValue.msg msg1, _, _)) :: ( _, ( MlyValue.DELETE DELETE1, _, _))
+ :: ( _, ( MlyValue.STAR STAR1, STAR1left, _)) :: rest671)) => let
+ val  result = MlyValue.action (fn _ => let val  STAR1 = STAR1 ()
+ val  (DELETE as DELETE1) = DELETE1 ()
+ val  (msg as msg1) = msg1 ()
+ val  (setexp as setexp1) = setexp1 ()
+ in ((TracProtocol.LabelS,TracProtocol.DELETE(msg,setexp)))
+end)
+ in ( LrTable.NT 32, ( result, STAR1left, setexp1right), rest671)
+end
+|  ( 69, ( ( _, ( MlyValue.lident lident1, lident1left, lident1right))
+ :: rest671)) => let val  result = MlyValue.setexp (fn _ => let val  (
+lident as lident1) = lident1 ()
+ in ((lident,[]))
+end)
+ in ( LrTable.NT 31, ( result, lident1left, lident1right), rest671)
+
+end
+|  ( 70, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, (
+ MlyValue.msgs msgs1, _, _)) :: ( _, ( MlyValue.OPENP OPENP1, _, _))
+ :: ( _, ( MlyValue.lident lident1, lident1left, _)) :: rest671)) =>
+ let val  result = MlyValue.setexp (fn _ => let val  (lident as 
+lident1) = lident1 ()
+ val  OPENP1 = OPENP1 ()
+ val  (msgs as msgs1) = msgs1 ()
+ val  CLOSEP1 = CLOSEP1 ()
+ in ((lident,msgs))
+end)
+ in ( LrTable.NT 31, ( result, lident1left, CLOSEP1right), rest671)
+
+end
+|  ( 71, ( ( _, ( MlyValue.uident uident1, uident1left, uident1right))
+ :: rest671)) => let val  result = MlyValue.msg (fn _ => let val  (
+uident as uident1) = uident1 ()
+ in (Var uident)
+end)
+ in ( LrTable.NT 29, ( result, uident1left, uident1right), rest671)
+
+end
+|  ( 72, ( ( _, ( MlyValue.lident lident1, lident1left, lident1right))
+ :: rest671)) => let val  result = MlyValue.msg (fn _ => let val  (
+lident as lident1) = lident1 ()
+ in (Const lident)
+end)
+ in ( LrTable.NT 29, ( result, lident1left, lident1right), rest671)
+
+end
+|  ( 73, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, (
+ MlyValue.msgs msgs1, _, _)) :: ( _, ( MlyValue.OPENP OPENP1, _, _))
+ :: ( _, ( MlyValue.lident lident1, lident1left, _)) :: rest671)) =>
+ let val  result = MlyValue.msg (fn _ => let val  (lident as lident1)
+ = lident1 ()
+ val  OPENP1 = OPENP1 ()
+ val  (msgs as msgs1) = msgs1 ()
+ val  CLOSEP1 = CLOSEP1 ()
+ in (Fun (lident,msgs))
+end)
+ in ( LrTable.NT 29, ( result, lident1left, CLOSEP1right), rest671)
+
+end
+|  ( 74, ( ( _, ( MlyValue.msg msg1, msg1left, msg1right)) :: rest671)
+) => let val  result = MlyValue.msgs (fn _ => let val  (msg as msg1) =
+ msg1 ()
+ in ([msg])
+end)
+ in ( LrTable.NT 30, ( result, msg1left, msg1right), rest671)
+end
+|  ( 75, ( ( _, ( MlyValue.msgs msgs1, _, msgs1right)) :: ( _, ( 
+MlyValue.COMMA COMMA1, _, _)) :: ( _, ( MlyValue.msg msg1, msg1left, _
+)) :: rest671)) => let val  result = MlyValue.msgs (fn _ => let val  (
+msg as msg1) = msg1 ()
+ val  COMMA1 = COMMA1 ()
+ val  (msgs as msgs1) = msgs1 ()
+ in (msg::msgs)
+end)
+ in ( LrTable.NT 30, ( result, msg1left, msgs1right), rest671)
+end
+|  ( 76, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1,
+ UPPER_STRING_LITERAL1left, UPPER_STRING_LITERAL1right)) :: rest671))
+ => let val  result = MlyValue.name (fn _ => let val  (
+UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1
+ ()
+ in (UPPER_STRING_LITERAL)
+end)
+ in ( LrTable.NT 1, ( result, UPPER_STRING_LITERAL1left, 
+UPPER_STRING_LITERAL1right), rest671)
+end
+|  ( 77, ( ( _, ( MlyValue.LOWER_STRING_LITERAL LOWER_STRING_LITERAL1,
+ LOWER_STRING_LITERAL1left, LOWER_STRING_LITERAL1right)) :: rest671))
+ => let val  result = MlyValue.name (fn _ => let val  (
+LOWER_STRING_LITERAL as LOWER_STRING_LITERAL1) = LOWER_STRING_LITERAL1
+ ()
+ in (LOWER_STRING_LITERAL)
+end)
+ in ( LrTable.NT 1, ( result, LOWER_STRING_LITERAL1left, 
+LOWER_STRING_LITERAL1right), rest671)
+end
+|  ( 78, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1,
+ UPPER_STRING_LITERAL1left, UPPER_STRING_LITERAL1right)) :: rest671))
+ => let val  result = MlyValue.uident (fn _ => let val  (
+UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1
+ ()
+ in (UPPER_STRING_LITERAL)
+end)
+ in ( LrTable.NT 3, ( result, UPPER_STRING_LITERAL1left, 
+UPPER_STRING_LITERAL1right), rest671)
+end
+|  ( 79, ( ( _, ( MlyValue.uident uident1, uident1left, uident1right))
+ :: rest671)) => let val  result = MlyValue.uidents (fn _ => let val 
+ (uident as uident1) = uident1 ()
+ in ([uident])
+end)
+ in ( LrTable.NT 12, ( result, uident1left, uident1right), rest671)
+
+end
+|  ( 80, ( ( _, ( MlyValue.uidents uidents1, _, uidents1right)) :: ( _
+, ( MlyValue.COMMA COMMA1, _, _)) :: ( _, ( MlyValue.uident uident1, 
+uident1left, _)) :: rest671)) => let val  result = MlyValue.uidents
+ (fn _ => let val  (uident as uident1) = uident1 ()
+ val  COMMA1 = COMMA1 ()
+ val  (uidents as uidents1) = uidents1 ()
+ in (uident::uidents)
+end)
+ in ( LrTable.NT 12, ( result, uident1left, uidents1right), rest671)
+
+end
+|  ( 81, ( ( _, ( MlyValue.LOWER_STRING_LITERAL LOWER_STRING_LITERAL1,
+ LOWER_STRING_LITERAL1left, LOWER_STRING_LITERAL1right)) :: rest671))
+ => let val  result = MlyValue.lident (fn _ => let val  (
+LOWER_STRING_LITERAL as LOWER_STRING_LITERAL1) = LOWER_STRING_LITERAL1
+ ()
+ in (LOWER_STRING_LITERAL)
+end)
+ in ( LrTable.NT 4, ( result, LOWER_STRING_LITERAL1left, 
+LOWER_STRING_LITERAL1right), rest671)
+end
+|  ( 82, ( ( _, ( MlyValue.lident lident1, lident1left, lident1right))
+ :: rest671)) => let val  result = MlyValue.lidents (fn _ => let val 
+ (lident as lident1) = lident1 ()
+ in ([lident])
+end)
+ in ( LrTable.NT 13, ( result, lident1left, lident1right), rest671)
+
+end
+|  ( 83, ( ( _, ( MlyValue.lidents lidents1, _, lidents1right)) :: ( _
+, ( MlyValue.COMMA COMMA1, _, _)) :: ( _, ( MlyValue.lident lident1, 
+lident1left, _)) :: rest671)) => let val  result = MlyValue.lidents
+ (fn _ => let val  (lident as lident1) = lident1 ()
+ val  COMMA1 = COMMA1 ()
+ val  (lidents as lidents1) = lidents1 ()
+ in (lident::lidents)
+end)
+ in ( LrTable.NT 13, ( result, lident1left, lidents1right), rest671)
+
+end
+|  ( 84, ( ( _, ( MlyValue.uident uident1, uident1left, uident1right))
+ :: rest671)) => let val  result = MlyValue.ident (fn _ => let val  (
+uident as uident1) = uident1 ()
+ in (uident)
+end)
+ in ( LrTable.NT 5, ( result, uident1left, uident1right), rest671)
+end
+|  ( 85, ( ( _, ( MlyValue.lident lident1, lident1left, lident1right))
+ :: rest671)) => let val  result = MlyValue.ident (fn _ => let val  (
+lident as lident1) = lident1 ()
+ in (lident)
+end)
+ in ( LrTable.NT 5, ( result, lident1left, lident1right), rest671)
+end
+|  ( 86, ( ( _, ( MlyValue.ident ident1, ident1left, ident1right)) :: 
+rest671)) => let val  result = MlyValue.idents (fn _ => let val  (
+ident as ident1) = ident1 ()
+ in ([ident])
+end)
+ in ( LrTable.NT 11, ( result, ident1left, ident1right), rest671)
+end
+|  ( 87, ( ( _, ( MlyValue.idents idents1, _, idents1right)) :: ( _, (
+ MlyValue.COMMA COMMA1, _, _)) :: ( _, ( MlyValue.ident ident1, 
+ident1left, _)) :: rest671)) => let val  result = MlyValue.idents (fn
+ _ => let val  (ident as ident1) = ident1 ()
+ val  COMMA1 = COMMA1 ()
+ val  (idents as idents1) = idents1 ()
+ in (ident::idents)
+end)
+ in ( LrTable.NT 11, ( result, ident1left, idents1right), rest671)
+end
+|  ( 88, ( ( _, ( MlyValue.INTEGER_LITERAL INTEGER_LITERAL1, 
+INTEGER_LITERAL1left, INTEGER_LITERAL1right)) :: rest671)) => let val 
+ result = MlyValue.arity (fn _ => let val  (INTEGER_LITERAL as 
+INTEGER_LITERAL1) = INTEGER_LITERAL1 ()
+ in (INTEGER_LITERAL)
+end)
+ in ( LrTable.NT 2, ( result, INTEGER_LITERAL1left, 
+INTEGER_LITERAL1right), rest671)
+end
+| _ => raise (mlyAction i392)
+end
+val void = MlyValue.VOID
+val extract = fn a => (fn MlyValue.START x => x
+| _ => let exception ParseInternal
+	in raise ParseInternal end) a ()
+end
+end
+structure Tokens : TracTransaction_TOKENS =
+struct
+type svalue = ParserData.svalue
+type ('a,'b) token = ('a,'b) Token.token
+fun EOF (p1,p2) = Token.TOKEN (ParserData.LrTable.T 0,(
+ParserData.MlyValue.VOID,p1,p2))
+fun OPENP (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 1,(
+ParserData.MlyValue.OPENP (fn () => i),p1,p2))
+fun CLOSEP (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 2,(
+ParserData.MlyValue.CLOSEP (fn () => i),p1,p2))
+fun OPENB (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 3,(
+ParserData.MlyValue.OPENB (fn () => i),p1,p2))
+fun CLOSEB (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 4,(
+ParserData.MlyValue.CLOSEB (fn () => i),p1,p2))
+fun OPENSCRYPT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 5,(
+ParserData.MlyValue.OPENSCRYPT (fn () => i),p1,p2))
+fun CLOSESCRYPT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 6,(
+ParserData.MlyValue.CLOSESCRYPT (fn () => i),p1,p2))
+fun COLON (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 7,(
+ParserData.MlyValue.COLON (fn () => i),p1,p2))
+fun SEMICOLON (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 8,(
+ParserData.MlyValue.SEMICOLON (fn () => i),p1,p2))
+fun SECCH (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 9,(
+ParserData.MlyValue.SECCH (fn () => i),p1,p2))
+fun AUTHCH (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 10,(
+ParserData.MlyValue.AUTHCH (fn () => i),p1,p2))
+fun CONFCH (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 11,(
+ParserData.MlyValue.CONFCH (fn () => i),p1,p2))
+fun INSECCH (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 12,(
+ParserData.MlyValue.INSECCH (fn () => i),p1,p2))
+fun FAUTHCH (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 13,(
+ParserData.MlyValue.FAUTHCH (fn () => i),p1,p2))
+fun FSECCH (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 14,(
+ParserData.MlyValue.FSECCH (fn () => i),p1,p2))
+fun PERCENT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 15,(
+ParserData.MlyValue.PERCENT (fn () => i),p1,p2))
+fun UNEQUAL (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 16,(
+ParserData.MlyValue.UNEQUAL (fn () => i),p1,p2))
+fun EXCLAM (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 17,(
+ParserData.MlyValue.EXCLAM (fn () => i),p1,p2))
+fun DOT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 18,(
+ParserData.MlyValue.DOT (fn () => i),p1,p2))
+fun COMMA (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 19,(
+ParserData.MlyValue.COMMA (fn () => i),p1,p2))
+fun OPENSQB (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 20,(
+ParserData.MlyValue.OPENSQB (fn () => i),p1,p2))
+fun CLOSESQB (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 21,(
+ParserData.MlyValue.CLOSESQB (fn () => i),p1,p2))
+fun UNION (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 22,(
+ParserData.MlyValue.UNION (fn () => i),p1,p2))
+fun PROTOCOL (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 23,(
+ParserData.MlyValue.PROTOCOL (fn () => i),p1,p2))
+fun KNOWLEDGE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 24,(
+ParserData.MlyValue.KNOWLEDGE (fn () => i),p1,p2))
+fun WHERE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 25,(
+ParserData.MlyValue.WHERE (fn () => i),p1,p2))
+fun ACTIONS (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 26,(
+ParserData.MlyValue.ACTIONS (fn () => i),p1,p2))
+fun ABSTRACTION (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 27,(
+ParserData.MlyValue.ABSTRACTION (fn () => i),p1,p2))
+fun GOALS (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 28,(
+ParserData.MlyValue.GOALS (fn () => i),p1,p2))
+fun AUTHENTICATES (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 29,(
+ParserData.MlyValue.AUTHENTICATES (fn () => i),p1,p2))
+fun WEAKLY (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 30,(
+ParserData.MlyValue.WEAKLY (fn () => i),p1,p2))
+fun ON (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 31,(
+ParserData.MlyValue.ON (fn () => i),p1,p2))
+fun TSECRET (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 32,(
+ParserData.MlyValue.TSECRET (fn () => i),p1,p2))
+fun TBETWEEN (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 33,(
+ParserData.MlyValue.TBETWEEN (fn () => i),p1,p2))
+fun Sets (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 34,(
+ParserData.MlyValue.Sets (fn () => i),p1,p2))
+fun FUNCTIONS (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 35,(
+ParserData.MlyValue.FUNCTIONS (fn () => i),p1,p2))
+fun PUBLIC (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 36,(
+ParserData.MlyValue.PUBLIC (fn () => i),p1,p2))
+fun PRIVATE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 37,(
+ParserData.MlyValue.PRIVATE (fn () => i),p1,p2))
+fun RECEIVE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 38,(
+ParserData.MlyValue.RECEIVE (fn () => i),p1,p2))
+fun SEND (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 39,(
+ParserData.MlyValue.SEND (fn () => i),p1,p2))
+fun IN (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 40,(
+ParserData.MlyValue.IN (fn () => i),p1,p2))
+fun NOTIN (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 41,(
+ParserData.MlyValue.NOTIN (fn () => i),p1,p2))
+fun INSERT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 42,(
+ParserData.MlyValue.INSERT (fn () => i),p1,p2))
+fun DELETE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 43,(
+ParserData.MlyValue.DELETE (fn () => i),p1,p2))
+fun NEW (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 44,(
+ParserData.MlyValue.NEW (fn () => i),p1,p2))
+fun ATTACK (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 45,(
+ParserData.MlyValue.ATTACK (fn () => i),p1,p2))
+fun slash (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 46,(
+ParserData.MlyValue.slash (fn () => i),p1,p2))
+fun QUESTION (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 47,(
+ParserData.MlyValue.QUESTION (fn () => i),p1,p2))
+fun equal (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 48,(
+ParserData.MlyValue.equal (fn () => i),p1,p2))
+fun TYPES (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 49,(
+ParserData.MlyValue.TYPES (fn () => i),p1,p2))
+fun SETS (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 50,(
+ParserData.MlyValue.SETS (fn () => i),p1,p2))
+fun ARROW (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 51,(
+ParserData.MlyValue.ARROW (fn () => i),p1,p2))
+fun ANALYSIS (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 52,(
+ParserData.MlyValue.ANALYSIS (fn () => i),p1,p2))
+fun TRANSACTIONS (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 53,(
+ParserData.MlyValue.TRANSACTIONS (fn () => i),p1,p2))
+fun STRING_LITERAL (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 54,(
+ParserData.MlyValue.STRING_LITERAL (fn () => i),p1,p2))
+fun UPPER_STRING_LITERAL (i,p1,p2) = Token.TOKEN (
+ParserData.LrTable.T 55,(ParserData.MlyValue.UPPER_STRING_LITERAL
+ (fn () => i),p1,p2))
+fun LOWER_STRING_LITERAL (i,p1,p2) = Token.TOKEN (
+ParserData.LrTable.T 56,(ParserData.MlyValue.LOWER_STRING_LITERAL
+ (fn () => i),p1,p2))
+fun UNDERSCORE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 57,(
+ParserData.MlyValue.UNDERSCORE (fn () => i),p1,p2))
+fun INTEGER_LITERAL (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 58,(
+ParserData.MlyValue.INTEGER_LITERAL (fn () => i),p1,p2))
+fun STAR (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 59,(
+ParserData.MlyValue.STAR (fn () => i),p1,p2))
+fun OF (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 60,(
+ParserData.MlyValue.OF (fn () => i),p1,p2))
+end
+end
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex
new file mode 100644
index 0000000..6d7ef15
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex
@@ -0,0 +1,139 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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.
+*)
+
+structure Tokens = Tokens
+open TracProtocol
+  
+type pos = int * int * int
+type svalue = Tokens.svalue
+
+type ('a,'b) token = ('a,'b) Tokens.token
+type lexresult= (svalue,pos) token
+
+
+val pos = ref (0,0,0)
+
+  fun eof () = Tokens.EOF((!pos,!pos))
+  fun error (e,p : (int * int * int),_) = TextIO.output (TextIO.stdOut, 
+							 String.concat[
+								       "Line ", (Int.toString (#1 p)), "/",
+								       (Int.toString (#2 p - #3 p)),": ", e, "\n"
+								       ])
+  
+ fun inputPos yypos = ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))),
+		     (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))) 
+ fun inputPos_half yypos = (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))
+
+
+
+%%
+%header (functor TracTransactionLexFun(structure Tokens: TracTransaction_TOKENS));
+alpha=[A-Za-z_];
+upper=[A-Z];
+lower=[a-z];
+digit=[0-9];
+ws = [\ \t];
+%%
+
+\n       => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos  ); lex());
+{ws}+    => (pos := (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))); lex()); 
+
+(#)[^\n]*\n                    => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos  ); lex());
+
+"/*""/"*([^*/]|[^*]"/"|"*"[^/])*"*"*"*/" => (lex());
+
+"("             => (Tokens.OPENP(yytext,inputPos_half yypos,inputPos_half yypos));
+")"             => (Tokens.CLOSEP(yytext,inputPos_half yypos,inputPos_half yypos));
+"{"             => (Tokens.OPENB(yytext,inputPos_half yypos,inputPos_half yypos));
+"}"             => (Tokens.CLOSEB(yytext,inputPos_half yypos,inputPos_half yypos));
+"{|"            => (Tokens.OPENSCRYPT(yytext,inputPos_half yypos,inputPos_half yypos));
+"|}"            => (Tokens.CLOSESCRYPT(yytext,inputPos_half yypos,inputPos_half yypos));
+":"             => (Tokens.COLON(yytext,inputPos_half yypos,inputPos_half yypos));
+";"             => (Tokens.SEMICOLON(yytext,inputPos_half yypos,inputPos_half yypos));
+"->"            => (Tokens.ARROW(yytext,inputPos_half yypos,inputPos_half yypos));
+"%"             => (Tokens.PERCENT(yytext,inputPos_half yypos,inputPos_half yypos));
+"!="            => (Tokens.UNEQUAL(yytext,inputPos_half yypos,inputPos_half yypos));
+"!"             => (Tokens.EXCLAM (yytext,inputPos_half yypos,inputPos_half yypos));
+"."             => (Tokens.DOT(yytext,inputPos_half yypos,inputPos_half yypos));
+","             => (Tokens.COMMA(yytext,inputPos_half yypos,inputPos_half yypos));
+"["             => (Tokens.OPENSQB(yytext,inputPos_half yypos,inputPos_half yypos));
+"]"             => (Tokens.CLOSESQB(yytext,inputPos_half yypos,inputPos_half yypos));
+"++"            => (Tokens.UNION(yytext,inputPos_half yypos,inputPos_half yypos));
+"Protocol"      => (Tokens.PROTOCOL(yytext,inputPos_half yypos,inputPos_half yypos));
+"Knowledge"     => (Tokens.KNOWLEDGE(yytext,inputPos_half yypos,inputPos_half yypos));
+"where"         => (Tokens.WHERE(yytext,inputPos_half yypos,inputPos_half yypos));
+"Types"         => (Tokens.TYPES(yytext,inputPos_half yypos,inputPos_half yypos));
+"Actions"       => (Tokens.ACTIONS(yytext,inputPos_half yypos,inputPos_half yypos));
+"Abstraction"   => (Tokens.ABSTRACTION(yytext,inputPos_half yypos,inputPos_half yypos));
+"Goals"         => (Tokens.GOALS(yytext,inputPos_half yypos,inputPos_half yypos));
+"authenticates" => (Tokens.AUTHENTICATES(yytext,inputPos_half yypos,inputPos_half yypos));
+"weakly"        => (Tokens.WEAKLY(yytext,inputPos_half yypos,inputPos_half yypos));
+"on"            => (Tokens.ON(yytext,inputPos_half yypos,inputPos_half yypos));
+"secret"        => (Tokens.TSECRET(yytext,inputPos_half yypos,inputPos_half yypos));
+"between"       => (Tokens.TBETWEEN(yytext,inputPos_half yypos,inputPos_half yypos));
+"Sets"          => (Tokens.SETS(yytext,inputPos_half yypos,inputPos_half yypos));
+"Functions"     => (Tokens.FUNCTIONS(yytext,inputPos_half yypos,inputPos_half yypos));
+"Public"        => (Tokens.PUBLIC(yytext,inputPos_half yypos,inputPos_half yypos));
+"Private"       => (Tokens.PRIVATE(yytext,inputPos_half yypos,inputPos_half yypos));
+"Analysis"      => (Tokens.ANALYSIS(yytext,inputPos_half yypos,inputPos_half yypos));
+"Transactions"  => (Tokens.TRANSACTIONS(yytext,inputPos_half yypos,inputPos_half yypos));
+"receive"       => (Tokens.RECEIVE(yytext,inputPos_half yypos,inputPos_half yypos));
+"send"          => (Tokens.SEND(yytext,inputPos_half yypos,inputPos_half yypos));
+"in"            => (Tokens.IN(yytext,inputPos_half yypos,inputPos_half yypos));
+"notin"         => (Tokens.NOTIN(yytext,inputPos_half yypos,inputPos_half yypos));
+"insert"        => (Tokens.INSERT(yytext,inputPos_half yypos,inputPos_half yypos));
+"delete"        => (Tokens.DELETE(yytext,inputPos_half yypos,inputPos_half yypos));
+"new"           => (Tokens.NEW(yytext,inputPos_half yypos,inputPos_half yypos));
+"attack"        => (Tokens.ATTACK(yytext,inputPos_half yypos,inputPos_half yypos));
+"/"             => (Tokens.slash(yytext,inputPos_half yypos,inputPos_half yypos));
+"?"             => (Tokens.QUESTION(yytext,inputPos_half yypos,inputPos_half yypos));
+"="             => (Tokens.equal(yytext,inputPos_half yypos,inputPos_half yypos));
+"_"             => (Tokens.UNDERSCORE(yytext,inputPos_half yypos,inputPos_half yypos));
+"*"             => (Tokens.STAR(yytext,inputPos_half yypos,inputPos_half yypos));
+"of"           => (Tokens.OF(yytext,inputPos_half yypos,inputPos_half yypos));
+
+
+{digit}+                          => (Tokens.INTEGER_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos));
+"'"({alpha}|{ws}|{digit})*(("."|"_"|"/"|"-")*({alpha}|{ws}|{digit})*)*"'"  => (Tokens.STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos));
+{lower}({alpha}|{digit})*("'")*   => (Tokens.LOWER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos));
+{upper}({alpha}|{digit})*("'")*   => (Tokens.UPPER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos));
+
+
+.      => (error ("ignoring bad character "^yytext,
+		    ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))),
+		    ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))));
+             lex());
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex.sml b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex.sml
new file mode 100644
index 0000000..e357ca1
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex.sml
@@ -0,0 +1,2131 @@
+ (***** GENERATED FILE -- DO NOT EDIT ****)
+functor TracTransactionLexFun(structure Tokens: TracTransaction_TOKENS)=
+   struct
+    structure UserDeclarations =
+      struct
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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.
+*)
+
+structure Tokens = Tokens
+open TracProtocol
+  
+type pos = int * int * int
+type svalue = Tokens.svalue
+
+type ('a,'b) token = ('a,'b) Tokens.token
+type lexresult= (svalue,pos) token
+
+
+val pos = Unsynchronized.ref (0,0,0)
+
+  fun eof () = Tokens.EOF((!pos,!pos))
+  fun error (e,p : (int * int * int),_) = TextIO.output (TextIO.stdOut, 
+							 String.concat[
+								       "Line ", (Int.toString (#1 p)), "/",
+								       (Int.toString (#2 p - #3 p)),": ", e, "\n"
+								       ])
+  
+ fun inputPos yypos = ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))),
+		     (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))) 
+ fun inputPos_half yypos = (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))
+
+
+
+end (* end of user routines *)
+exception LexError (* raised if illegal leaf action tried *)
+structure Internal =
+	struct
+
+datatype yyfinstate = N of int
+type statedata = {fin : yyfinstate list, trans: string}
+(* transition & final state table *)
+val tab = let
+val s = [ 
+ (0, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (1, 
+"\003\003\003\003\003\003\003\003\003\210\212\003\003\003\003\003\
+\\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\
+\\210\208\003\205\003\204\003\200\199\198\197\195\194\192\191\181\
+\\179\179\179\179\179\179\179\179\179\179\178\177\003\176\003\175\
+\\003\151\087\087\087\087\142\137\087\087\087\128\087\087\087\087\
+\\110\087\087\106\090\087\087\087\087\087\087\086\003\085\003\084\
+\\003\066\059\009\053\009\009\009\009\047\009\009\009\009\040\037\
+\\009\009\030\022\009\009\009\012\009\009\009\007\005\004\003\003\
+\\003"
+),
+ (5, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\000\
+\\000"
+),
+ (7, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\
+\\000"
+),
+ (9, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (11, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (12, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\017\010\010\013\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (13, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\014\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (14, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\015\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (15, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\016\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (17, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\018\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (18, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\019\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (19, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\020\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (20, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\021\010\000\000\000\000\000\
+\\000"
+),
+ (22, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\023\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (23, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\026\010\010\010\010\010\010\010\010\010\010\024\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (24, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\025\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (26, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\027\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (27, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\028\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (28, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\029\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (30, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\031\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (31, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\032\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (32, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\033\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (33, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\034\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (34, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\035\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (35, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\036\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (37, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\039\010\010\010\010\010\010\010\038\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (40, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\045\010\010\010\010\010\010\010\010\010\041\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (41, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\042\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (42, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\043\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (43, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\044\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (45, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\046\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (47, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\048\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (48, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\049\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (49, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\050\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (50, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\051\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (51, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\052\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (53, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\054\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (54, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\055\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (55, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\056\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (56, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\057\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (57, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\058\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (59, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\060\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (60, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\061\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (61, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\062\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (62, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\063\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (63, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\064\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (64, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\065\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (66, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\079\067\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (67, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\068\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (68, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\069\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (69, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\070\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (70, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\071\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (71, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\072\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (72, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\073\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (73, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\074\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (74, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\075\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (75, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\076\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (76, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\077\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (77, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\078\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (79, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\080\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (80, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\081\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (81, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\082\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (82, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
+\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\
+\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\
+\\000\010\010\010\010\010\010\010\010\010\010\083\010\010\010\010\
+\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\
+\\000"
+),
+ (87, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (89, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (90, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\095\088\088\088\088\088\088\091\088\000\000\000\000\000\
+\\000"
+),
+ (91, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\092\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (92, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\093\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (93, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\094\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (95, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\096\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (96, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\097\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (97, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\098\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (98, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\099\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (99, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\100\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (100, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\101\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (101, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\102\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (102, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\103\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (103, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\104\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (104, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\105\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (106, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\107\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (107, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\108\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (108, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\109\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (110, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\116\088\088\111\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (111, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\112\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (112, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\113\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (113, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\114\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (114, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\115\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (116, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\123\088\088\088\088\088\117\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (117, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\118\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (118, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\119\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (119, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\120\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (120, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\121\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (121, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\122\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (123, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\124\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (124, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\125\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (125, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\126\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (126, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\127\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (128, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\129\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (129, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\130\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (130, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\131\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (131, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\132\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (132, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\133\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (133, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\134\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (134, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\135\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (135, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\136\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (137, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\138\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (138, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\139\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (139, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\140\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (140, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\141\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (142, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\143\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (143, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\144\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (144, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\145\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (145, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\146\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (146, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\147\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (147, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\148\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (148, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\149\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (149, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\150\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (151, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\165\159\088\088\088\088\088\088\088\088\088\088\152\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (152, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\153\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (153, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\154\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (154, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\155\088\000\000\000\000\000\
+\\000"
+),
+ (155, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\156\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (156, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\157\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (157, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\158\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (159, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\160\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (160, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\161\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (161, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\162\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (162, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\163\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (163, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\164\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (165, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\166\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (166, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\167\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (167, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\168\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (168, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\169\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (169, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\170\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (170, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\171\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (171, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\172\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (172, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\173\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (173, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\
+\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\
+\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\174\088\
+\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\
+\\000"
+),
+ (179, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\180\180\180\180\180\180\180\180\180\180\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (181, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\182\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (182, 
+"\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\184\183\183\183\183\190\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183"
+),
+ (183, 
+"\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\184\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183"
+),
+ (184, 
+"\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\
+\\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\
+\\185\185\185\185\185\185\185\185\185\185\188\185\185\185\185\187\
+\\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\
+\\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\
+\\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\
+\\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\
+\\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\
+\\185"
+),
+ (185, 
+"\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\184\183\183\183\183\186\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183"
+),
+ (186, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\185\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (188, 
+"\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\184\183\183\183\183\189\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\
+\\183"
+),
+ (192, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\193\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (195, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\196\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (200, 
+"\000\000\000\000\000\000\000\000\000\201\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\201\000\000\000\000\000\000\203\000\000\000\000\000\202\202\202\
+\\201\201\201\201\201\201\201\201\201\201\000\000\000\000\000\000\
+\\000\201\201\201\201\201\201\201\201\201\201\201\201\201\201\201\
+\\201\201\201\201\201\201\201\201\201\201\201\000\000\000\000\201\
+\\000\201\201\201\201\201\201\201\201\201\201\201\201\201\201\201\
+\\201\201\201\201\201\201\201\201\201\201\201\000\000\000\000\000\
+\\000"
+),
+ (202, 
+"\000\000\000\000\000\000\000\000\000\202\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\202\000\000\000\000\000\000\203\000\000\000\000\000\202\202\202\
+\\202\202\202\202\202\202\202\202\202\202\000\000\000\000\000\000\
+\\000\202\202\202\202\202\202\202\202\202\202\202\202\202\202\202\
+\\202\202\202\202\202\202\202\202\202\202\202\000\000\000\000\202\
+\\000\202\202\202\202\202\202\202\202\202\202\202\202\202\202\202\
+\\202\202\202\202\202\202\202\202\202\202\202\000\000\000\000\000\
+\\000"
+),
+ (205, 
+"\206\206\206\206\206\206\206\206\206\206\207\206\206\206\206\206\
+\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\
+\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\
+\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\
+\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\
+\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\
+\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\
+\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\
+\\206"
+),
+ (208, 
+"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\209\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+ (210, 
+"\000\000\000\000\000\000\000\000\000\211\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\211\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+\\000"
+),
+(0, "")]
+fun f x = x 
+val s = List.map f (List.rev (tl (List.rev s))) 
+exception LexHackingError 
+fun look ((j,x)::r, i: int) = if i = j then x else look(r, i) 
+  | look ([], i) = raise LexHackingError
+fun g {fin=x, trans=i} = {fin=x, trans=look(s,i)} 
+in Vector.fromList(List.map g 
+[{fin = [], trans = 0},
+{fin = [], trans = 1},
+{fin = [], trans = 1},
+{fin = [(N 295)], trans = 0},
+{fin = [(N 28),(N 295)], trans = 0},
+{fin = [(N 295)], trans = 5},
+{fin = [(N 34)], trans = 0},
+{fin = [(N 26),(N 295)], trans = 7},
+{fin = [(N 31)], trans = 0},
+{fin = [(N 288),(N 295)], trans = 9},
+{fin = [(N 288)], trans = 9},
+{fin = [(N 288)], trans = 11},
+{fin = [(N 288),(N 295)], trans = 12},
+{fin = [(N 288)], trans = 13},
+{fin = [(N 288)], trans = 14},
+{fin = [(N 288)], trans = 15},
+{fin = [(N 84),(N 288)], trans = 9},
+{fin = [(N 288)], trans = 17},
+{fin = [(N 288)], trans = 18},
+{fin = [(N 288)], trans = 19},
+{fin = [(N 288)], trans = 20},
+{fin = [(N 137),(N 288)], trans = 9},
+{fin = [(N 288),(N 295)], trans = 22},
+{fin = [(N 288)], trans = 23},
+{fin = [(N 288)], trans = 24},
+{fin = [(N 220),(N 288)], trans = 9},
+{fin = [(N 288)], trans = 26},
+{fin = [(N 288)], trans = 27},
+{fin = [(N 288)], trans = 28},
+{fin = [(N 147),(N 288)], trans = 9},
+{fin = [(N 288),(N 295)], trans = 30},
+{fin = [(N 288)], trans = 31},
+{fin = [(N 288)], trans = 32},
+{fin = [(N 288)], trans = 33},
+{fin = [(N 288)], trans = 34},
+{fin = [(N 288)], trans = 35},
+{fin = [(N 215),(N 288)], trans = 9},
+{fin = [(N 288),(N 295)], trans = 37},
+{fin = [(N 140),(N 288)], trans = 9},
+{fin = [(N 267),(N 288)], trans = 9},
+{fin = [(N 288),(N 295)], trans = 40},
+{fin = [(N 288)], trans = 41},
+{fin = [(N 288)], trans = 42},
+{fin = [(N 288)], trans = 43},
+{fin = [(N 229),(N 288)], trans = 9},
+{fin = [(N 288)], trans = 45},
+{fin = [(N 247),(N 288)], trans = 9},
+{fin = [(N 288),(N 295)], trans = 47},
+{fin = [(N 223),(N 288)], trans = 48},
+{fin = [(N 288)], trans = 49},
+{fin = [(N 288)], trans = 50},
+{fin = [(N 288)], trans = 51},
+{fin = [(N 236),(N 288)], trans = 9},
+{fin = [(N 288),(N 295)], trans = 53},
+{fin = [(N 288)], trans = 54},
+{fin = [(N 288)], trans = 55},
+{fin = [(N 288)], trans = 56},
+{fin = [(N 288)], trans = 57},
+{fin = [(N 243),(N 288)], trans = 9},
+{fin = [(N 288),(N 295)], trans = 59},
+{fin = [(N 288)], trans = 60},
+{fin = [(N 288)], trans = 61},
+{fin = [(N 288)], trans = 62},
+{fin = [(N 288)], trans = 63},
+{fin = [(N 288)], trans = 64},
+{fin = [(N 155),(N 288)], trans = 9},
+{fin = [(N 288),(N 295)], trans = 66},
+{fin = [(N 288)], trans = 67},
+{fin = [(N 288)], trans = 68},
+{fin = [(N 288)], trans = 69},
+{fin = [(N 288)], trans = 70},
+{fin = [(N 288)], trans = 71},
+{fin = [(N 288)], trans = 72},
+{fin = [(N 288)], trans = 73},
+{fin = [(N 288)], trans = 74},
+{fin = [(N 288)], trans = 75},
+{fin = [(N 288)], trans = 76},
+{fin = [(N 288)], trans = 77},
+{fin = [(N 130),(N 288)], trans = 9},
+{fin = [(N 288)], trans = 79},
+{fin = [(N 288)], trans = 80},
+{fin = [(N 288)], trans = 81},
+{fin = [(N 288)], trans = 82},
+{fin = [(N 254),(N 288)], trans = 9},
+{fin = [(N 262),(N 295)], trans = 0},
+{fin = [(N 56),(N 295)], trans = 0},
+{fin = [(N 54),(N 295)], trans = 0},
+{fin = [(N 293),(N 295)], trans = 87},
+{fin = [(N 293)], trans = 87},
+{fin = [(N 293)], trans = 89},
+{fin = [(N 293),(N 295)], trans = 90},
+{fin = [(N 293)], trans = 91},
+{fin = [(N 293)], trans = 92},
+{fin = [(N 293)], trans = 93},
+{fin = [(N 90),(N 293)], trans = 87},
+{fin = [(N 293)], trans = 95},
+{fin = [(N 293)], trans = 96},
+{fin = [(N 293)], trans = 97},
+{fin = [(N 293)], trans = 98},
+{fin = [(N 293)], trans = 99},
+{fin = [(N 293)], trans = 100},
+{fin = [(N 293)], trans = 101},
+{fin = [(N 293)], trans = 102},
+{fin = [(N 293)], trans = 103},
+{fin = [(N 293)], trans = 104},
+{fin = [(N 207),(N 293)], trans = 87},
+{fin = [(N 293),(N 295)], trans = 106},
+{fin = [(N 293)], trans = 107},
+{fin = [(N 293)], trans = 108},
+{fin = [(N 160),(N 293)], trans = 87},
+{fin = [(N 293),(N 295)], trans = 110},
+{fin = [(N 293)], trans = 111},
+{fin = [(N 293)], trans = 112},
+{fin = [(N 293)], trans = 113},
+{fin = [(N 293)], trans = 114},
+{fin = [(N 177),(N 293)], trans = 87},
+{fin = [(N 293)], trans = 116},
+{fin = [(N 293)], trans = 117},
+{fin = [(N 293)], trans = 118},
+{fin = [(N 293)], trans = 119},
+{fin = [(N 293)], trans = 120},
+{fin = [(N 293)], trans = 121},
+{fin = [(N 68),(N 293)], trans = 87},
+{fin = [(N 293)], trans = 123},
+{fin = [(N 293)], trans = 124},
+{fin = [(N 293)], trans = 125},
+{fin = [(N 293)], trans = 126},
+{fin = [(N 185),(N 293)], trans = 87},
+{fin = [(N 293),(N 295)], trans = 128},
+{fin = [(N 293)], trans = 129},
+{fin = [(N 293)], trans = 130},
+{fin = [(N 293)], trans = 131},
+{fin = [(N 293)], trans = 132},
+{fin = [(N 293)], trans = 133},
+{fin = [(N 293)], trans = 134},
+{fin = [(N 293)], trans = 135},
+{fin = [(N 78),(N 293)], trans = 87},
+{fin = [(N 293),(N 295)], trans = 137},
+{fin = [(N 293)], trans = 138},
+{fin = [(N 293)], trans = 139},
+{fin = [(N 293)], trans = 140},
+{fin = [(N 116),(N 293)], trans = 87},
+{fin = [(N 293),(N 295)], trans = 142},
+{fin = [(N 293)], trans = 143},
+{fin = [(N 293)], trans = 144},
+{fin = [(N 293)], trans = 145},
+{fin = [(N 293)], trans = 146},
+{fin = [(N 293)], trans = 147},
+{fin = [(N 293)], trans = 148},
+{fin = [(N 293)], trans = 149},
+{fin = [(N 170),(N 293)], trans = 87},
+{fin = [(N 293),(N 295)], trans = 151},
+{fin = [(N 293)], trans = 152},
+{fin = [(N 293)], trans = 153},
+{fin = [(N 293)], trans = 154},
+{fin = [(N 293)], trans = 155},
+{fin = [(N 293)], trans = 156},
+{fin = [(N 293)], trans = 157},
+{fin = [(N 194),(N 293)], trans = 87},
+{fin = [(N 293)], trans = 159},
+{fin = [(N 293)], trans = 160},
+{fin = [(N 293)], trans = 161},
+{fin = [(N 293)], trans = 162},
+{fin = [(N 293)], trans = 163},
+{fin = [(N 98),(N 293)], trans = 87},
+{fin = [(N 293)], trans = 165},
+{fin = [(N 293)], trans = 166},
+{fin = [(N 293)], trans = 167},
+{fin = [(N 293)], trans = 168},
+{fin = [(N 293)], trans = 169},
+{fin = [(N 293)], trans = 170},
+{fin = [(N 293)], trans = 171},
+{fin = [(N 293)], trans = 172},
+{fin = [(N 293)], trans = 173},
+{fin = [(N 110),(N 293)], trans = 87},
+{fin = [(N 258),(N 295)], trans = 0},
+{fin = [(N 260),(N 295)], trans = 0},
+{fin = [(N 38),(N 295)], trans = 0},
+{fin = [(N 36),(N 295)], trans = 0},
+{fin = [(N 270),(N 295)], trans = 179},
+{fin = [(N 270)], trans = 179},
+{fin = [(N 256),(N 295)], trans = 181},
+{fin = [], trans = 182},
+{fin = [], trans = 183},
+{fin = [], trans = 184},
+{fin = [], trans = 185},
+{fin = [], trans = 186},
+{fin = [(N 20)], trans = 0},
+{fin = [], trans = 188},
+{fin = [(N 20)], trans = 186},
+{fin = [], trans = 182},
+{fin = [(N 50),(N 295)], trans = 0},
+{fin = [(N 295)], trans = 192},
+{fin = [(N 41)], trans = 0},
+{fin = [(N 52),(N 295)], trans = 0},
+{fin = [(N 295)], trans = 195},
+{fin = [(N 59)], trans = 0},
+{fin = [(N 264),(N 295)], trans = 0},
+{fin = [(N 24),(N 295)], trans = 0},
+{fin = [(N 22),(N 295)], trans = 0},
+{fin = [(N 295)], trans = 200},
+{fin = [], trans = 200},
+{fin = [], trans = 202},
+{fin = [(N 283)], trans = 0},
+{fin = [(N 43),(N 295)], trans = 0},
+{fin = [(N 295)], trans = 205},
+{fin = [], trans = 205},
+{fin = [(N 8)], trans = 0},
+{fin = [(N 48),(N 295)], trans = 208},
+{fin = [(N 46)], trans = 0},
+{fin = [(N 4),(N 295)], trans = 210},
+{fin = [(N 4)], trans = 210},
+{fin = [(N 1)], trans = 0}])
+end
+structure StartStates =
+	struct
+	datatype yystartstate = STARTSTATE of int
+
+(* start state definitions *)
+
+val INITIAL = STARTSTATE 1;
+
+end
+type result = UserDeclarations.lexresult
+	exception LexerError (* raised if illegal leaf action tried *)
+end
+
+fun makeLexer yyinput =
+let	val yygone0=1
+	val yyb = Unsynchronized.ref "\n" 		(* buffer *)
+	val yybl = Unsynchronized.ref 1		(*buffer length *)
+	val yybufpos = Unsynchronized.ref 1		(* location of next character to use *)
+	val yygone = Unsynchronized.ref yygone0	(* position in file of beginning of buffer *)
+	val yydone = Unsynchronized.ref false		(* eof found yet? *)
+	val yybegin = Unsynchronized.ref 1		(*Current 'start state' for lexer *)
+
+	val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>
+		 yybegin := x
+
+fun lex () : Internal.result =
+let fun continue() = lex() in
+  let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0) =
+	let fun action (i,nil) = raise LexError
+	| action (i,nil::l) = action (i-1,l)
+	| action (i,(node::acts)::l) =
+		case node of
+		    Internal.N yyk => 
+			(let fun yymktext() = String.substring(!yyb,i0,i-i0)
+			     val yypos = i0+ !yygone
+			open UserDeclarations Internal.StartStates
+ in (yybufpos := i; case yyk of 
+
+			(* Application actions *)
+
+  1 => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos  ); lex())
+| 110 => let val yytext=yymktext() in Tokens.ABSTRACTION(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 116 => let val yytext=yymktext() in Tokens.GOALS(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 130 => let val yytext=yymktext() in Tokens.AUTHENTICATES(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 137 => let val yytext=yymktext() in Tokens.WEAKLY(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 140 => let val yytext=yymktext() in Tokens.ON(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 147 => let val yytext=yymktext() in Tokens.TSECRET(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 155 => let val yytext=yymktext() in Tokens.TBETWEEN(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 160 => let val yytext=yymktext() in Tokens.SETS(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 170 => let val yytext=yymktext() in Tokens.FUNCTIONS(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 177 => let val yytext=yymktext() in Tokens.PUBLIC(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 185 => let val yytext=yymktext() in Tokens.PRIVATE(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 194 => let val yytext=yymktext() in Tokens.ANALYSIS(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 20 => (lex())
+| 207 => let val yytext=yymktext() in Tokens.TRANSACTIONS(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 215 => let val yytext=yymktext() in Tokens.RECEIVE(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 22 => let val yytext=yymktext() in Tokens.OPENP(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 220 => let val yytext=yymktext() in Tokens.SEND(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 223 => let val yytext=yymktext() in Tokens.IN(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 229 => let val yytext=yymktext() in Tokens.NOTIN(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 236 => let val yytext=yymktext() in Tokens.INSERT(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 24 => let val yytext=yymktext() in Tokens.CLOSEP(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 243 => let val yytext=yymktext() in Tokens.DELETE(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 247 => let val yytext=yymktext() in Tokens.NEW(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 254 => let val yytext=yymktext() in Tokens.ATTACK(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 256 => let val yytext=yymktext() in Tokens.slash(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 258 => let val yytext=yymktext() in Tokens.QUESTION(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 26 => let val yytext=yymktext() in Tokens.OPENB(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 260 => let val yytext=yymktext() in Tokens.equal(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 262 => let val yytext=yymktext() in Tokens.UNDERSCORE(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 264 => let val yytext=yymktext() in Tokens.STAR(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 267 => let val yytext=yymktext() in Tokens.OF(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 270 => let val yytext=yymktext() in Tokens.INTEGER_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 28 => let val yytext=yymktext() in Tokens.CLOSEB(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 283 => let val yytext=yymktext() in Tokens.STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 288 => let val yytext=yymktext() in Tokens.LOWER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 293 => let val yytext=yymktext() in Tokens.UPPER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 295 => let val yytext=yymktext() in error ("ignoring bad character "^yytext,
+		    ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))),
+		    ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))));
+             lex() end
+| 31 => let val yytext=yymktext() in Tokens.OPENSCRYPT(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 34 => let val yytext=yymktext() in Tokens.CLOSESCRYPT(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 36 => let val yytext=yymktext() in Tokens.COLON(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 38 => let val yytext=yymktext() in Tokens.SEMICOLON(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 4 => (pos := (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))); lex())
+| 41 => let val yytext=yymktext() in Tokens.ARROW(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 43 => let val yytext=yymktext() in Tokens.PERCENT(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 46 => let val yytext=yymktext() in Tokens.UNEQUAL(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 48 => let val yytext=yymktext() in Tokens.EXCLAM (yytext,inputPos_half yypos,inputPos_half yypos) end
+| 50 => let val yytext=yymktext() in Tokens.DOT(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 52 => let val yytext=yymktext() in Tokens.COMMA(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 54 => let val yytext=yymktext() in Tokens.OPENSQB(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 56 => let val yytext=yymktext() in Tokens.CLOSESQB(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 59 => let val yytext=yymktext() in Tokens.UNION(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 68 => let val yytext=yymktext() in Tokens.PROTOCOL(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 78 => let val yytext=yymktext() in Tokens.KNOWLEDGE(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 8 => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos  ); lex())
+| 84 => let val yytext=yymktext() in Tokens.WHERE(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 90 => let val yytext=yymktext() in Tokens.TYPES(yytext,inputPos_half yypos,inputPos_half yypos) end
+| 98 => let val yytext=yymktext() in Tokens.ACTIONS(yytext,inputPos_half yypos,inputPos_half yypos) end
+| _ => raise Internal.LexerError
+
+		) end )
+
+	val {fin,trans} = Vector.sub(Internal.tab, s)
+	val NewAcceptingLeaves = fin::AcceptingLeaves
+	in if l = !yybl then
+	     if trans = #trans(Vector.sub(Internal.tab,0))
+	       then action(l,NewAcceptingLeaves
+) else	    let val newchars= if !yydone then "" else yyinput 1024
+	    in if (String.size newchars)=0
+		  then (yydone := true;
+		        if (l=i0) then UserDeclarations.eof ()
+		                  else action(l,NewAcceptingLeaves))
+		  else (if i0=l then yyb := newchars
+		     else yyb := String.substring(!yyb,i0,l-i0)^newchars;
+		     yygone := !yygone+i0;
+		     yybl := String.size (!yyb);
+		     scan (s,AcceptingLeaves,l-i0,0))
+	    end
+	  else let val NewChar = Char.ord(CharVector.sub(!yyb,l))
+		val NewChar = if NewChar<128 then NewChar else 128
+		val NewState = Char.ord(CharVector.sub(trans,NewChar))
+		in if NewState=0 then action(l,NewAcceptingLeaves)
+		else scan(NewState,NewAcceptingLeaves,l+1,i0)
+	end
+	end
+(*
+	val start= if String.substring(!yyb,!yybufpos-1,1)="\n"
+then !yybegin+1 else !yybegin
+*)
+	in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos)
+    end
+end
+  in lex
+  end
+end
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_protocol_parser.thy b/Automated_Stateful_Protocol_Verification/trac/trac_protocol_parser.thy
new file mode 100644
index 0000000..0ad95c4
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_protocol_parser.thy
@@ -0,0 +1,118 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      trac_protocol_parser.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section \<open>Parser for the Trac Format\<close>
+theory
+  trac_protocol_parser
+  imports
+    "trac_term"
+begin
+
+ML_file "trac_parser/trac_protocol.grm.sig"
+ML_file "trac_parser/trac_protocol.lex.sml"
+ML_file "trac_parser/trac_protocol.grm.sml"
+
+ML\<open>
+structure TracProtocolParser : sig  
+		   val parse_file: string -> TracProtocol.protocol
+       val parse_str: string ->  TracProtocol.protocol
+end = 
+struct
+
+  structure TracLrVals =
+    TracTransactionLrValsFun(structure Token = LrParser.Token)
+
+  structure TracLex =
+    TracTransactionLexFun(structure Tokens = TracLrVals.Tokens)
+
+  structure TracParser =
+    Join(structure LrParser = LrParser
+	 structure ParserData = TracLrVals.ParserData
+	 structure Lex = TracLex)
+  
+  fun invoke lexstream =
+      let fun print_error (s,i:(int * int * int),_) =
+	      error("Error, line .... " ^ (Int.toString (#1 i)) ^"."^(Int.toString (#2 i ))^ ", " ^ s ^ "\n")
+       in TracParser.parse(0,lexstream,print_error,())
+      end
+
+ fun parse_fp lexer =  let
+	  val dummyEOF = TracLrVals.Tokens.EOF((0,0,0),(0,0,0))
+	  fun loop lexer =
+	      let 
+		  val _ = (TracLex.UserDeclarations.pos := (0,0,0);())
+		  val (res,lexer) = invoke lexer
+		  val (nextToken,lexer) = TracParser.Stream.get lexer
+	       in if TracParser.sameToken(nextToken,dummyEOF) then ((),res)
+		  else loop lexer
+	      end
+       in  (#2(loop lexer))
+      end
+
+ fun parse_file tracFile = 
+     let
+	        val infile = TextIO.openIn tracFile
+	        val lexer = TracParser.makeLexer  (fn _ => case ((TextIO.inputLine) infile) of
+                                                           SOME s => s
+                                                          | NONE   => "")
+     in
+       parse_fp lexer
+      handle LrParser.ParseError => TracProtocol.empty 
+     end
+
+ fun parse_str str = 
+     let
+          val parsed = Unsynchronized.ref false 
+          fun input_string _  = if !parsed then "" else (parsed := true ;str)
+	        val lexer = TracParser.makeLexer input_string
+     in
+       parse_fp lexer
+      handle LrParser.ParseError => TracProtocol.empty 
+     end
+
+end
+\<close>
+
+
+end
diff --git a/Automated_Stateful_Protocol_Verification/trac/trac_term.thy b/Automated_Stateful_Protocol_Verification/trac/trac_term.thy
new file mode 100644
index 0000000..5319527
--- /dev/null
+++ b/Automated_Stateful_Protocol_Verification/trac/trac_term.thy
@@ -0,0 +1,565 @@
+(*
+(C) Copyright Andreas Viktor Hess, DTU, 2020
+(C) Copyright Sebastian A. Mödersheim, DTU, 2020
+(C) Copyright Achim D. Brucker, University of Exeter, 2020
+(C) Copyright Anders Schlichtkrull, DTU, 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:      trac_term.thy
+    Author:     Andreas Viktor Hess, DTU
+    Author:     Sebastian A. Mödersheim, DTU
+    Author:     Achim D. Brucker, University of Exeter
+    Author:     Anders Schlichtkrull, DTU
+*)
+
+section \<open>Abstract Syntax for Trac Terms\<close>
+theory
+  trac_term
+  imports
+    "First_Order_Terms.Term"
+    "ml_yacc_lib"
+    (* Alternatively (provides, as a side-effect,  ml-yacc-lib):
+      "HOL-TPTP.TPTP_Parser" 
+    *)
+begin
+datatype cMsg = cVar "string * string"
+              | cConst string
+              | cFun "string * cMsg list"
+
+ML\<open>
+structure Trac_Utils = 
+struct
+  
+  fun list_find p ts =
+    let
+      fun aux _ [] = NONE
+        | aux n (t::ts) =
+            if p t
+            then SOME (t,n)
+            else aux (n+1) ts
+    in
+      aux 0 ts
+    end
+  
+  fun map_prod f (a,b) = (f a, f b)
+  
+  
+  
+  fun list_product [] = [[]]
+    | list_product (xs::xss) =
+        List.concat (map (fn x => map (fn ys => x::ys) (list_product xss)) xs)
+  
+  fun list_toString elem_toString xs =
+    let
+      fun aux [] = ""
+        | aux [x] = elem_toString x
+        | aux (x::y::xs) = elem_toString x ^ ", " ^ aux (y::xs)
+    in
+      "[" ^ aux xs ^ "]"
+    end
+  
+  val list_to_str = list_toString (fn x => x)
+  
+  fun list_triangle_product _ [] = []
+    | list_triangle_product f (x::xs) = map (f x) xs@list_triangle_product f xs
+  
+  fun list_subseqs [] = [[]]
+    | list_subseqs (x::xs) = let val xss = list_subseqs xs in map (cons x) xss@xss end
+  
+  fun list_intersect xs ys =
+      List.exists (fn x => member (op =) ys x) xs orelse
+      List.exists (fn y => member (op =) xs y) ys
+  
+  fun list_partitions xs constrs =
+    let
+      val peq = eq_set (op =)
+      val pseq = eq_set peq
+      val psseq = eq_set pseq
+  
+      fun illegal p q =
+        let
+          val pq = union (op =) p q
+          fun f (a,b) = member (op =) pq a andalso member (op =) pq b
+        in
+          List.exists f constrs
+        end
+  
+      fun merges _ [] = []
+        | merges q (p::ps) =
+            if illegal p q then map (cons p) (merges q ps)
+            else (union (op =) p q::ps)::(map (cons p) (merges q ps))
+  
+      fun merges_all [] = []
+        | merges_all (p::ps) = merges p ps@map (cons p) (merges_all ps)
+  
+      fun step pss = fold (union pseq) (map merges_all pss) []
+  
+      fun loop pss pssprev =
+        let val pss' = step pss
+        in if psseq (pss,pss') then pssprev else loop pss' (union pseq pss' pssprev)
+        end
+  
+      val init = [map single xs]
+    in
+      loop init init
+    end
+  
+  fun mk_unique  [] = []
+    | mk_unique (x::xs) = x::mk_unique(List.filter (fn y => y <> x) xs)
+  
+  fun list_rm_pair sel l x = filter (fn e => sel e <> x) l
+  
+  fun list_minus list_rm l m = List.foldl (fn (a,b) => list_rm b a) l m
+
+  fun list_upto n =
+    let
+      fun aux m = if m >= n then [] else m::aux (m+1)
+    in
+      aux 0
+    end
+end
+\<close>
+
+ML\<open>
+structure Trac_Term (* : TRAC_TERM *) =
+struct
+open Trac_Utils
+exception TypeError
+
+type TypeDecl = string * string
+
+datatype Msg = Var of string
+             | Const of string
+             | Fun of string * Msg list
+             | Attack
+
+datatype VarType = EnumType of string
+                 | ValueType
+                 | Untyped
+
+datatype cMsg = cVar of string * VarType
+              | cConst of string
+              | cFun of string * cMsg list
+              | cAttack
+              | cSet of string * cMsg list
+              | cAbs of (string * string list) list
+              | cOccursFact of cMsg
+              | cPrivFunSec
+              | cEnum of string
+
+fun type_of et vt n =
+  case List.find (fn (v,_) => v = n) et of
+    SOME (_,t) => EnumType t
+  | NONE =>
+      if List.exists (fn v => v = n) vt
+      then ValueType
+      else Untyped
+
+fun certifyMsg et vt (Var n)       = cVar (n, type_of et vt n)
+  | certifyMsg _  _  (Const c)     = cConst c
+  | certifyMsg et vt (Fun (f, ts)) = cFun (f, map (certifyMsg et vt) ts)
+  | certifyMsg _  _  Attack        = cAttack
+
+fun mk_Value_cVar x = cVar (x,ValueType)
+
+val fv_Msg =
+  let
+    fun aux (Var x) = [x]
+      | aux (Fun (_,ts)) = List.concat (map aux ts)
+      | aux _ = []
+  in
+    mk_unique o  aux
+  end
+
+val fv_cMsg =
+  let
+    fun aux (cVar x) = [x]
+      | aux (cFun (_,ts)) = List.concat (map aux ts)
+      | aux (cSet (_,ts)) = List.concat (map aux ts)
+      | aux (cOccursFact bs) = aux bs
+      | aux _ = []
+  in
+    mk_unique o aux
+  end
+
+fun subst_apply' (delta:(string * VarType) -> cMsg) (t:cMsg) =
+  case t of
+    cVar x => delta x
+  | cFun (f,ts) => cFun (f, map (subst_apply' delta) ts)
+  | cSet (s,ts) => cSet (s, map (subst_apply' delta) ts)
+  | cOccursFact bs => cOccursFact (subst_apply' delta bs)
+  | c => c
+
+fun subst_apply (delta:(string * cMsg) list) =
+  subst_apply' (fn (n,tau) => (
+      case List.find (fn x => fst x = n) delta of
+        SOME x => snd x
+      | NONE => cVar (n,tau)))
+end
+\<close>
+
+ML\<open>
+
+structure TracProtocol (* : TRAC_TERM *) =
+struct
+open Trac_Utils
+datatype type_spec_elem =
+  Consts of string list
+| Union of string list
+
+fun is_Consts t = case t of Consts _ => true | _ => false
+fun the_Consts t = case t of Consts cs => cs | _ => error "Consts"
+
+type type_spec = (string * type_spec_elem) list
+type set_spec  = (string * string)
+
+fun extract_Consts (tspec:type_spec) =
+  (List.concat o map the_Consts o filter is_Consts o map snd) tspec
+
+type funT = (string * string)
+type fun_spec = {private: funT list, public: funT list}
+
+type ruleT = (string * string list) * Trac_Term.Msg list * string list
+type anaT = ruleT list
+
+datatype prot_label = LabelN | LabelS
+
+datatype action = RECEIVE of Trac_Term.Msg
+                | SEND of Trac_Term.Msg
+                | IN of Trac_Term.Msg * (string * Trac_Term.Msg list)
+                | NOTIN of Trac_Term.Msg * (string * Trac_Term.Msg list)
+                | NOTINANY of Trac_Term.Msg * string
+                | INSERT of Trac_Term.Msg * (string * Trac_Term.Msg list)
+                | DELETE of Trac_Term.Msg * (string * Trac_Term.Msg list)
+                | NEW of string
+                | ATTACK
+
+datatype cAction = cReceive of Trac_Term.cMsg
+                 | cSend of Trac_Term.cMsg
+                 | cInequality of Trac_Term.cMsg * Trac_Term.cMsg
+                 | cInSet of Trac_Term.cMsg * Trac_Term.cMsg
+                 | cNotInSet of Trac_Term.cMsg * Trac_Term.cMsg
+                 | cNotInAny of Trac_Term.cMsg * string
+                 | cInsert of Trac_Term.cMsg * Trac_Term.cMsg
+                 | cDelete of Trac_Term.cMsg * Trac_Term.cMsg
+                 | cNew of string
+                 | cAssertAttack
+
+type transaction_name = string * (string * string) list * (string * string) list
+
+type transaction={transaction:transaction_name,actions:(prot_label * action) list}
+
+type cTransaction={
+  transaction:transaction_name,
+  receive_actions:(prot_label * cAction) list,
+  checksingle_actions:(prot_label * cAction) list,
+  checkall_actions:(prot_label * cAction) list,
+  fresh_actions:(prot_label * cAction) list,
+  update_actions:(prot_label * cAction) list,
+  send_actions:(prot_label * cAction) list,
+  attack_actions:(prot_label * cAction) list}
+
+fun mkTransaction transaction actions = {transaction=transaction,
+                                        actions=actions}:transaction
+
+fun is_RECEIVE a = case a of RECEIVE _ => true | _ => false
+fun is_SEND a = case a of SEND _ => true | _ => false
+fun is_IN a = case a of IN _ => true | _ => false
+fun is_NOTIN a = case a of NOTIN _ => true | _ => false
+fun is_NOTINANY a = case a of NOTINANY _ => true | _ => false
+fun is_INSERT a = case a of INSERT _ => true | _ => false
+fun is_DELETE a = case a of DELETE _ => true | _ => false
+fun is_NEW a = case a of NEW _ => true | _ => false
+fun is_ATTACK a = case a of ATTACK => true | _ => false
+
+fun the_RECEIVE a = case a of RECEIVE t => t | _ => error "RECEIVE"
+fun the_SEND a = case a of SEND t => t | _ => error "SEND"
+fun the_IN a = case a of IN t => t | _ => error "IN"
+fun the_NOTIN a = case a of NOTIN t => t | _ => error "NOTIN"
+fun the_NOTINANY a = case a of NOTINANY t => t | _ => error "NOTINANY"
+fun the_INSERT a = case a of INSERT t => t | _ => error "INSERT"
+fun the_DELETE a = case a of DELETE t => t | _ => error "DELETE"
+fun the_NEW a = case a of NEW t => t | _ => error "FRESH"
+
+fun maybe_the_RECEIVE a = case a of RECEIVE t => SOME t | _ => NONE
+fun maybe_the_SEND a = case a of SEND t => SOME t | _ => NONE
+fun maybe_the_IN a = case a of IN t => SOME t | _ => NONE
+fun maybe_the_NOTIN a = case a of NOTIN t => SOME t | _ => NONE
+fun maybe_the_NOTINANY a = case a of NOTINANY t => SOME t | _ => NONE
+fun maybe_the_INSERT a = case a of INSERT t => SOME t | _ => NONE
+fun maybe_the_DELETE a = case a of DELETE t => SOME t | _ => NONE
+fun maybe_the_NEW a = case a of NEW t => SOME t | _ => NONE
+
+fun is_Receive a = case a of cReceive _ => true | _ => false
+fun is_Send a = case a of cSend _ => true | _ => false
+fun is_Inequality a = case a of cInequality _ => true | _ => false
+fun is_InSet a = case a of cInSet _ => true | _ => false
+fun is_NotInSet a = case a of cNotInSet _ => true | _ => false
+fun is_NotInAny a = case a of cNotInAny _ => true | _ => false
+fun is_Insert a = case a of cInsert _ => true | _ => false
+fun is_Delete a = case a of cDelete _ => true | _ => false
+fun is_Fresh a = case a of cNew _ => true | _ => false
+fun is_Attack a = case a of cAssertAttack => true | _ => false
+
+fun the_Receive a = case a of cReceive t => t | _ => error "Receive"
+fun the_Send a = case a of cSend t => t | _ => error "Send"
+fun the_Inequality a = case a of cInequality t => t | _ => error "Inequality"
+fun the_InSet a = case a of cInSet t => t | _ => error "InSet"
+fun the_NotInSet a = case a of cNotInSet t => t | _ => error "NotInSet"
+fun the_NotInAny a = case a of cNotInAny t => t | _ => error "NotInAny"
+fun the_Insert a = case a of cInsert t => t | _ => error "Insert"
+fun the_Delete a = case a of cDelete t => t | _ => error "Delete"
+fun the_Fresh a = case a of cNew t => t | _ => error "New"
+
+fun maybe_the_Receive a = case a of cReceive t => SOME t | _ => NONE
+fun maybe_the_Send a = case a of cSend t => SOME t | _ => NONE
+fun maybe_the_Inequality a = case a of cInequality t => SOME t | _ => NONE
+fun maybe_the_InSet a = case a of cInSet t => SOME t | _ => NONE
+fun maybe_the_NotInSet a = case a of cNotInSet t => SOME t | _ => NONE
+fun maybe_the_NotInAny a = case a of cNotInAny t => SOME t | _ => NONE
+fun maybe_the_Insert a = case a of cInsert t => SOME t | _ => NONE
+fun maybe_the_Delete a = case a of cDelete t => SOME t | _ => NONE
+fun maybe_the_Fresh a = case a of cNew t => SOME t | _ => NONE
+
+fun certifyAction et vt (lbl,SEND t)            = (lbl,cSend    (Trac_Term.certifyMsg et vt t))
+  | certifyAction et vt (lbl,RECEIVE t)         = (lbl,cReceive (Trac_Term.certifyMsg et vt t))
+  | certifyAction et vt (lbl,IN (x,(s,ps)))     = (lbl,cInSet
+      (Trac_Term.certifyMsg et vt x, Trac_Term.cSet (s, map (Trac_Term.certifyMsg et vt) ps)))
+  | certifyAction et vt (lbl,NOTIN (x,(s,ps)))  = (lbl,cNotInSet
+      (Trac_Term.certifyMsg et vt x, Trac_Term.cSet (s, map (Trac_Term.certifyMsg et vt) ps)))
+  | certifyAction et vt (lbl,NOTINANY (x,s))    = (lbl,cNotInAny (Trac_Term.certifyMsg et vt x, s))
+  | certifyAction et vt (lbl,INSERT (x,(s,ps))) = (lbl,cInsert
+      (Trac_Term.certifyMsg et vt x, Trac_Term.cSet (s, map (Trac_Term.certifyMsg et vt) ps)))
+  | certifyAction et vt (lbl,DELETE (x,(s,ps))) = (lbl,cDelete
+      (Trac_Term.certifyMsg et vt x, Trac_Term.cSet (s, map (Trac_Term.certifyMsg et vt) ps)))
+  | certifyAction _  _  (lbl,NEW x)             = (lbl,cNew x)
+  | certifyAction _  _  (lbl,ATTACK)            = (lbl,cAssertAttack)
+
+fun certifyTransaction (tr:transaction) =
+  let
+    val mk_cOccurs = Trac_Term.cOccursFact
+    fun mk_Value_cVar x = Trac_Term.cVar (x,Trac_Term.ValueType)
+    fun mk_cInequality x y = cInequality (mk_Value_cVar x, mk_Value_cVar y)
+    val mk_cInequalities = list_triangle_product mk_cInequality
+
+    val fresh_vals = map_filter (maybe_the_NEW o snd) (#actions tr)
+    val decl_vars = map fst (#2 (#transaction tr))
+    val neq_constrs = #3 (#transaction tr)
+
+    val _ = if     List.exists (fn x => List.exists (fn y => x = y) fresh_vals) decl_vars
+            orelse List.exists (fn x => List.exists (fn y => x = y) decl_vars)  fresh_vals
+            then error "the fresh and the declared variables must not overlap"
+            else ()
+
+    val _ = case List.find (fn (x,y) => x = y) neq_constrs of
+              SOME (x,y) => error ("illegal inequality constraint: " ^ x ^ " != " ^ y)
+            | NONE => ()
+
+    val nonfresh_vals = map fst (filter (fn x => snd x = "value") (#2 (#transaction tr)))
+    val enum_vars = filter (fn x => snd x <> "value") (#2 (#transaction tr))
+
+    fun lblS t = (LabelS,t)
+
+    val cactions = map (certifyAction enum_vars (nonfresh_vals@fresh_vals)) (#actions tr)
+
+    val nonfresh_occurs = map (lblS o cReceive o mk_cOccurs o mk_Value_cVar) nonfresh_vals
+    val receives = filter (is_Receive o snd) cactions
+    val value_inequalities = map lblS (mk_cInequalities nonfresh_vals)
+    val checksingles = filter (fn (_,a) => is_InSet a orelse is_NotInSet a) cactions
+    val checkalls = filter (is_NotInAny o snd) cactions
+    val updates = filter (fn (_,a) => is_Insert a orelse is_Delete a) cactions
+    val fresh = filter (is_Fresh o snd) cactions
+    val sends = filter (is_Send o snd) cactions
+    val fresh_occurs = map (lblS o cSend o mk_cOccurs o mk_Value_cVar) fresh_vals
+    val attack_signals = filter (is_Attack o snd) cactions
+  in
+    {transaction = #transaction tr,
+     receive_actions = nonfresh_occurs@receives,
+     checksingle_actions = value_inequalities@checksingles,
+     checkall_actions = checkalls,
+     fresh_actions = fresh,
+     update_actions = updates,
+     send_actions = sends@fresh_occurs,
+     attack_actions = attack_signals}:cTransaction
+  end
+
+fun subst_apply_action (delta:(string * Trac_Term.cMsg) list) (lbl:prot_label,a:cAction) =
+  let
+    val apply = Trac_Term.subst_apply delta
+  in
+    case a of
+      cReceive t => (lbl,cReceive (apply t))
+    | cSend t => (lbl,cSend (apply t))
+    | cInequality (x,y) => (lbl,cInequality (apply x, apply y))
+    | cInSet (x,s) => (lbl,cInSet (apply x, apply s))
+    | cNotInSet (x,s) => (lbl,cNotInSet (apply x, apply s))
+    | cNotInAny (x,s) => (lbl,cNotInAny (apply x, s))
+    | cInsert (x,s) => (lbl,cInsert (apply x, apply s))
+    | cDelete (x,s) => (lbl,cDelete (apply x, apply s))
+    | cNew x => (lbl,cNew x)
+    | cAssertAttack => (lbl,cAssertAttack)
+  end
+
+fun subst_apply_actions delta =
+  map (subst_apply_action delta)
+
+
+type protocol = {
+  name:string
+ ,type_spec:type_spec 
+ ,set_spec:set_spec list
+ ,function_spec:fun_spec option
+ ,analysis_spec:anaT
+ ,transaction_spec:(string option * transaction list) list
+ ,fixed_point: (Trac_Term.cMsg list * (string * string list) list list *
+                ((string * string list) list * (string * string list) list) list) option
+}
+
+exception TypeError
+
+val fun_empty = {
+                  public=[] 
+                 ,private=[]
+                }:fun_spec
+
+fun update_fun_public (fun_spec:fun_spec) public =
+    ({public = public
+     ,private = #private fun_spec 
+    }):fun_spec      
+
+fun update_fun_private (fun_spec:fun_spec) private =
+    ({public = #public fun_spec
+     ,private = private 
+    }):fun_spec      
+
+
+val empty={
+            name=""
+           ,type_spec=[]
+           ,set_spec=[]
+           ,function_spec=NONE
+           ,analysis_spec=[]
+           ,transaction_spec=[]
+           ,fixed_point = NONE
+          }:protocol
+
+fun update_name (protocol_spec:protocol) name =
+    ({name = name
+     ,type_spec = #type_spec protocol_spec
+     ,set_spec = #set_spec protocol_spec
+     ,function_spec = #function_spec protocol_spec
+     ,analysis_spec = #analysis_spec protocol_spec
+     ,transaction_spec = #transaction_spec protocol_spec
+     ,fixed_point = #fixed_point protocol_spec
+    }):protocol     
+fun update_sets (protocol_spec:protocol) set_spec =
+    ({name = #name protocol_spec
+     ,type_spec = #type_spec protocol_spec
+     ,set_spec =
+        if has_duplicates (op =) (map fst set_spec)
+        then error "Multiple declarations of the same set family"
+        else set_spec
+     ,function_spec = #function_spec protocol_spec
+     ,analysis_spec = #analysis_spec protocol_spec
+     ,transaction_spec = #transaction_spec protocol_spec
+     ,fixed_point = #fixed_point protocol_spec
+    }):protocol     
+fun update_type_spec (protocol_spec:protocol) type_spec =
+    ({name = #name protocol_spec
+     ,type_spec =
+        if has_duplicates (op =) (map fst type_spec)
+        then error "Multiple declarations of the same enumeration type"
+        else type_spec
+     ,set_spec = #set_spec protocol_spec
+     ,function_spec = #function_spec protocol_spec
+     ,analysis_spec = #analysis_spec protocol_spec
+     ,transaction_spec = #transaction_spec protocol_spec
+     ,fixed_point = #fixed_point protocol_spec
+    }):protocol     
+fun update_functions (protocol_spec:protocol) function_spec =
+    ({name = #name protocol_spec
+     ,type_spec = #type_spec protocol_spec
+     ,set_spec = #set_spec protocol_spec
+     ,function_spec = case function_spec of
+          SOME fs =>
+            if has_duplicates (op =) (map fst ((#public fs)@(#private fs)))
+            then error "Multiple declarations of the same constant or function symbol"
+            else SOME fs
+        | NONE => NONE
+     ,analysis_spec = #analysis_spec protocol_spec
+     ,transaction_spec = #transaction_spec protocol_spec
+     ,fixed_point = #fixed_point protocol_spec
+    }):protocol      
+fun update_analysis (protocol_spec:protocol) analysis_spec =
+    ({name = #name protocol_spec
+     ,type_spec = #type_spec protocol_spec
+     ,set_spec = #set_spec protocol_spec
+     ,function_spec = #function_spec protocol_spec
+     ,analysis_spec =
+        if has_duplicates (op =) (map (#1 o #1) analysis_spec)
+        then error "Multiple analysis rules declared for the same function symbol"
+        else if List.exists (has_duplicates (op =)) (map (#2 o #1) analysis_spec)
+        then error "The heads of the analysis rules must be linear terms"
+        else if let fun f ((_,xs),ts,ys) =
+                            subset (op =) (ys@List.concat (map Trac_Term.fv_Msg ts), xs)
+                in List.exists (not o f) analysis_spec end
+        then error "Variables occurring in the body of an analysis rule should also occur in its head"
+        else analysis_spec
+     ,transaction_spec = #transaction_spec protocol_spec
+     ,fixed_point = #fixed_point protocol_spec
+    }):protocol
+fun update_transactions (prot_name:string option) (protocol_spec:protocol) transaction_spec =
+    ({name = #name protocol_spec
+     ,type_spec = #type_spec protocol_spec
+     ,set_spec = #set_spec protocol_spec
+     ,function_spec = #function_spec protocol_spec
+     ,analysis_spec = #analysis_spec protocol_spec
+     ,transaction_spec = (prot_name,transaction_spec)::(#transaction_spec protocol_spec)
+     ,fixed_point = #fixed_point protocol_spec
+    }):protocol     
+fun update_fixed_point (protocol_spec:protocol) fixed_point =
+    ({name = #name protocol_spec
+     ,type_spec = #type_spec protocol_spec
+     ,set_spec = #set_spec protocol_spec
+     ,function_spec = #function_spec protocol_spec
+     ,analysis_spec = #analysis_spec protocol_spec
+     ,transaction_spec = #transaction_spec protocol_spec
+     ,fixed_point = fixed_point
+    }):protocol     
+           
+           
+end
+\<close>
+
+
+end
diff --git a/CITATION b/CITATION
new file mode 100644
index 0000000..36915ba
--- /dev/null
+++ b/CITATION
@@ -0,0 +1,31 @@
+To cite the use of this formal theory, please use
+
+  Andreas V. Hess, Sebastian Mödersheim, Achim D. Brucker, and Anders Schlichtkrull. 
+  Automated Stateful Protocol Verification. In Archive of Formal Proofs, 2020. 
+  http://www.isa-afp.org/entries/Automated_Stateful_Protocol_Verification.html, 
+  Formal proof development
+
+A BibTeX entry for LaTeX users is
+Article{ hess.ea:automated:2020,
+	abstract= {In protocol verification we observe a wide spectrum from fully 
+                   automated methods to interactive theorem proving with proof 
+                   assistants like Isabelle/HOL. In this AFP entry, we present a 
+                   fully-automated approach for verifying stateful security protocols, 
+                   i.e., protocols with mutable state that may span several sessions. 
+                   The approach supports reachability goals like secrecy and 
+                   authentication. We also include a simple user-friendly 
+                   transaction-based protocol specification language that is embedded 
+                   into Isabelle.},
+	author	= {Andreas V. Hess and Sebastian M{\"o}dersheim and Achim D. Brucker and Anders Schlichtkrull},
+	date	= {2020-04-08},
+	file	= {https://www.brucker.ch/bibliography/download/2020/hess.ea-automated-outline-2020.pdf},
+	filelabel= {Outline},
+	issn	= {2150-914x},
+	journal	= {Archive of Formal Proofs},
+	month	= {apr},
+	note	= {\url{http://www.isa-afp.org/entries/Automated_Stateful_Protocol_Verification.html}, Formal proof development},
+	pdf	= {https://www.brucker.ch/bibliography/download/2020/hess.ea-automated-2020.pdf},
+	title	= {Automated Stateful Protocol Verification},
+	url	= {https://www.brucker.ch/bibliography/abstract/hess.ea-automated-2020},
+	year	= {2020},
+} 
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..71b7f9f
--- /dev/null
+++ b/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.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..6c55f4e
--- /dev/null
+++ b/README.md
@@ -0,0 +1,58 @@
+# Automated Stateful Protocol Verification
+
+This git repository contains a local mirror of
+[Stateful Protocol Composition and Typing](https://www.isa-afp.org/entries/Automated_Stateful_Protocol_Verification.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 Automated Stateful Protocol Verification
+entry) at a later stage.
+
+## Installation
+
+This project depends on another [AFP](https://www.isa-afp.org) entry: 
+[Stateful Protocol Composition and Typing](https://www.isa-afp.org/entries/Stateful_Protocol_Composition_and_Typing.html). 
+Please follow the [official guidelines](https://www.isa-afp.org/using.shtml)
+for installing the AFP locally. For short:
+* [Download](https://www.isa-afp.org/release/afp-current.tar.gz) the complete AFP
+* Extract the downloaded archive to an directory of your choice
+* Let's assume the extracted archive lives in `/home/isabelle/afp`, now execute:
+
+```console
+achim@logicalhacking:~$ echo "/home/isabelle/afp/thys" >> ~/.isabelle/Isabelle2020/ROOTS
+```
+
+## How to build
+
+```console
+achim@logicalhacking:~$ isabelle build -D Automated_Stateful_Protocol_Verification
+```
+
+## Authors
+
+* Andreas V. Hess
+* [Sebastian Mödersheim](https://people.compute.dtu.dk/samo/)
+* [Achim D. Brucker](http://www.brucker.ch/)
+* [Anders Schlichtkrull](https://people.compute.dtu.dk/andschl/)
+
+## 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/Automated_Stateful_Protocol_Verification>.
+
+## Publications
+
+* Andreas V. Hess, Sebastian Mödersheim, Achim D. Brucker, and Anders
+  Schlichtkrull. Automated Stateful Protocol Verification. In Archive 
+  of Formal Proofs, 2020. 
+  <http://www.isa-afp.org/entries/Automated_Stateful_Protocol_Verification.html>, 
+  Formal proof development