Browse Source

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

master afp-Automated_Stateful_Protocol_Verification-Isabelle2020
Achim D. Brucker 2 years ago
commit
216e3831c7
  1. 110
      Automated_Stateful_Protocol_Verification/Eisbach_Protocol_Verification.thy
  2. 54
      Automated_Stateful_Protocol_Verification/Examples.thy
  3. 53
      Automated_Stateful_Protocol_Verification/PSPSP.thy
  4. 16
      Automated_Stateful_Protocol_Verification/ROOT
  5. 4410
      Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy
  6. 3681
      Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy
  7. 246
      Automated_Stateful_Protocol_Verification/Term_Abstraction.thy
  8. 2579
      Automated_Stateful_Protocol_Verification/Term_Implication.thy
  9. 451
      Automated_Stateful_Protocol_Verification/Term_Variants.thy
  10. 966
      Automated_Stateful_Protocol_Verification/Transactions.thy
  11. 72
      Automated_Stateful_Protocol_Verification/document/root.bib
  12. 166
      Automated_Stateful_Protocol_Verification/document/root.tex
  13. 133
      Automated_Stateful_Protocol_Verification/examples/Keyserver.thy
  14. 132
      Automated_Stateful_Protocol_Verification/examples/Keyserver2.thy
  15. 295
      Automated_Stateful_Protocol_Verification/examples/Keyserver_Composition.thy
  16. 161
      Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model03.thy
  17. 221
      Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model07.thy
  18. 237
      Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model09.thy
  19. 51
      Automated_Stateful_Protocol_Verification/trac/Makefile
  20. 13
      Automated_Stateful_Protocol_Verification/trac/README.md
  21. 42
      Automated_Stateful_Protocol_Verification/trac/bin/ml-lex-isa
  22. 39
      Automated_Stateful_Protocol_Verification/trac/bin/ml-yacc-isa
  23. 323
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/base.sig
  24. 40
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/copyright
  25. 118
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/join.sml
  26. 83
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/lrtable.sml
  27. 567
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/parser2.sml
  28. 29
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/root.sml
  29. 43
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/stream.sml
  30. 101
      Automated_Stateful_Protocol_Verification/trac/ml_yacc_lib.thy
  31. 1947
      Automated_Stateful_Protocol_Verification/trac/trac.thy
  32. 127
      Automated_Stateful_Protocol_Verification/trac/trac_fp_parser.thy
  33. 126
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm
  34. 29
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sig
  35. 678
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sml
  36. 103
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex
  37. 728
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex.sml
  38. 287
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm
  39. 73
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sig
  40. 1720
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sml
  41. 139
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex
  42. 2131
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex.sml
  43. 118
      Automated_Stateful_Protocol_Verification/trac/trac_protocol_parser.thy
  44. 565
      Automated_Stateful_Protocol_Verification/trac/trac_term.thy
  45. 31
      CITATION
  46. 30
      LICENSE
  47. 58
      README.md

110
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

54
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

53
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

16
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"

4410
Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy

File diff suppressed because it is too large

3681
Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy

File diff suppressed because it is too large

246
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

2579
Automated_Stateful_Protocol_Verification/Term_Implication.thy

File diff suppressed because it is too large

451
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

966
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>)"