@@ -0,0 +1,38 @@ | |||
To cite the use of this formal theory, please use | |||
Andreas V. Hess, Sebastian Mödersheim, and Achim D. Brucker. Stateful | |||
Protocol Composition and Typing. In Archive of Formal Proofs, 2020. | |||
http://www.isa-afp.org/entries/tateful_Protocol_Composition_and_Typing.html, | |||
Formal proof development | |||
A BibTeX entry for LaTeX users is | |||
@Article{ hess.ea:stateful:2020, | |||
abstract= {We provide in this AFP entry several relative soundness | |||
results for security protocols. In particular, we prove | |||
typing and compositionality results for stateful protocols | |||
(i.e., protocols with mutable state that may span several | |||
sessions), and that focuses on reachability properties. Such | |||
results are useful to simplify protocol verification by | |||
reducing it to a simpler problem: Typing results give | |||
conditions under which it is safe to verify a protocol in a | |||
typed model where only "well-typed" attacks can occur whereas | |||
compositionality results allow us to verify a composed protocol | |||
by only verifying the component protocols in isolation. The | |||
conditions on the protocols under which the results hold are | |||
furthermore syntactic in nature allowing for full automation. | |||
The foundation presented here is used in another entry to | |||
provide fully automated and formalized security proofs of | |||
stateful protocols.}, | |||
author = {Andreas V. Hess and Sebastian M{\"o}dersheim and Achim D. Brucker}, | |||
date = {2020-04-08}, | |||
file = {https://www.brucker.ch/bibliography/download/2020/hess.ea-stateful-outline-2020.pdf}, | |||
filelabel= {Outline}, | |||
issn = {2150-914x}, | |||
journal = {Archive of Formal Proofs}, | |||
month = {apr}, | |||
note = {\url{http://www.isa-afp.org/entries/tateful_Protocol_Composition_and_Typing.html}, Formal proof development}, | |||
pdf = {https://www.brucker.ch/bibliography/download/2020/hess.ea-stateful-2020.pdf}, | |||
title = {Stateful Protocol Composition and Typing}, | |||
url = {https://www.brucker.ch/bibliography/abstract/hess.ea-stateful-2020}, | |||
year = {2020}, | |||
} |
@@ -0,0 +1,30 @@ | |||
Copyright (c) 2015-2020 Technical University Denmark, Denmark | |||
2017-2019 The University of Sheffield, UK | |||
2019-2020 University of Exeter, UK | |||
All rights reserved. | |||
Redistribution and use in source and binary forms, with or without | |||
modification, are permitted provided that the following conditions are | |||
met: | |||
* Redistributions of source code must retain the above copyright | |||
notice, this list of conditions and the following disclaimer. | |||
* Redistributions in binary form must reproduce the above | |||
copyright notice, this list of conditions and the following | |||
disclaimer in the documentation and/or other materials provided | |||
with the distribution. | |||
* Neither the name of the copyright holders nor the names of its | |||
contributors may be used to endorse or promote products derived | |||
from this software without specific prior written permission. | |||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | |||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT | |||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR | |||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT | |||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | |||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT | |||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, | |||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY | |||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | |||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE | |||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
@@ -0,0 +1,44 @@ | |||
# Stateful Protocol Composition and Typing ( | |||
This git repository contains a local mirror of | |||
[Stateful Protocol Composition and Typing](https://www.isa-afp.org/entries/Stateful_Protocol_Composition_and_Typing.html) | |||
entry of the | |||
[Archive of Formal Proofs (AFP)](https://www.isa-afp.org). | |||
The official AFP releases are tagged. Additionally, this repository | |||
may contain extensions (i.e., a development version) that may be | |||
submitted (as an update of the Stateful Protocol Composition and Typing entry) at a later stage. | |||
## Installation | |||
```console | |||
achim@logicalhacking:~$ isabelle build -D Stateful_Protocol_Composition_and_Typing.html | |||
``` | |||
## Authors | |||
* Andreas V. Hess | |||
* [Sebastian Mödersheim](https://people.compute.dtu.dk/samo/) | |||
* [Achim D. Brucker](http://www.brucker.ch/) | |||
## License | |||
This project is licensed under a 3-clause BSD-style license. | |||
SPDX-License-Identifier: BSD-3-Clause | |||
## Master Repository | |||
The master git repository for this project is hosted by the [Software | |||
Assurance & Security Research Team](https://logicalhacking.com) at | |||
<https://git.logicalhacking.com/afp-mirror/Stateful_Protocol_Composition_and_Typing.html>. | |||
## Publications | |||
* Andreas V. Hess, Sebastian Mödersheim, and Achim D. Brucker. Stateful | |||
Protocol Composition and Typing. In Archive of Formal Proofs, 2020. | |||
http://www.isa-afp.org/entries/tateful_Protocol_Composition_and_Typing.html, | |||
Formal proof development | |||
* Andreas V. Hess, Sebastian A. Mödersheim, and Achim D. Brucker. Stateful | |||
Protocol Composition. In ESORICS. Lecture Notes in Computer Science (11098), | |||
pages 427-446, Springer-Verlag, 2018. doi:[10.1007/978-3-319-99073-6](https://dx.doi.org/10.1007/978-3-319-99073-6) |
@@ -0,0 +1,5 @@ | |||
theory Examples | |||
imports "examples/Example_Keyserver" | |||
"examples/Example_TLS" | |||
begin | |||
end |
@@ -0,0 +1,906 @@ | |||
(* | |||
(C) Copyright Andreas Viktor Hess, DTU, 2018-2020 | |||
All Rights Reserved. | |||
Redistribution and use in source and binary forms, with or without | |||
modification, are permitted provided that the following conditions are | |||
met: | |||
- Redistributions of source code must retain the above copyright | |||
notice, this list of conditions and the following disclaimer. | |||
- Redistributions in binary form must reproduce the above copyright | |||
notice, this list of conditions and the following disclaimer in the | |||
documentation and/or other materials provided with the distribution. | |||
- Neither the name of the copyright holder nor the names of its | |||
contributors may be used to endorse or promote products | |||
derived from this software without specific prior written | |||
permission. | |||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | |||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT | |||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR | |||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT | |||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | |||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT | |||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, | |||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY | |||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | |||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE | |||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | |||
*) | |||
(* Title: Labeled_Stateful_Strands.thy | |||
Author: Andreas Viktor Hess, DTU | |||
*) | |||
section \<open>Labeled Stateful Strands\<close> | |||
theory Labeled_Stateful_Strands | |||
imports Stateful_Strands Labeled_Strands | |||
begin | |||
subsection \<open>Definitions\<close> | |||
text\<open>Syntax for stateful strand labels\<close> | |||
abbreviation Star_step ("\<langle>\<star>, _\<rangle>") where | |||
"\<langle>\<star>, (s::('a,'b) stateful_strand_step)\<rangle> \<equiv> (\<star>, s)" | |||
abbreviation LabelN_step ("\<langle>_, _\<rangle>") where | |||
"\<langle>(l::'a), (s::('b,'c) stateful_strand_step)\<rangle> \<equiv> (ln l, s)" | |||
text\<open>Database projection\<close> | |||
abbreviation dbproj where "dbproj l D \<equiv> filter (\<lambda>d. fst d = l) D" | |||
text\<open>The type of labeled stateful strands\<close> | |||
type_synonym ('a,'b,'c) labeled_stateful_strand_step = "'c strand_label \<times> ('a,'b) stateful_strand_step" | |||
type_synonym ('a,'b,'c) labeled_stateful_strand = "('a,'b,'c) labeled_stateful_strand_step list" | |||
text\<open>Dual strands\<close> | |||
fun dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p::"('a,'b,'c) labeled_stateful_strand_step \<Rightarrow> ('a,'b,'c) labeled_stateful_strand_step" | |||
where | |||
"dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,send\<langle>t\<rangle>) = (l,receive\<langle>t\<rangle>)" | |||
| "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,receive\<langle>t\<rangle>) = (l,send\<langle>t\<rangle>)" | |||
| "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = x" | |||
definition dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t::"('a,'b,'c) labeled_stateful_strand \<Rightarrow> ('a,'b,'c) labeled_stateful_strand" | |||
where | |||
"dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<equiv> map dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p" | |||
text\<open>Substitution application\<close> | |||
fun subst_apply_labeled_stateful_strand_step:: | |||
"('a,'b,'c) labeled_stateful_strand_step \<Rightarrow> ('a,'b) subst \<Rightarrow> | |||
('a,'b,'c) labeled_stateful_strand_step" | |||
(infix "\<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p" 51) where | |||
"(l,s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta> = (l,s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)" | |||
definition subst_apply_labeled_stateful_strand:: | |||
"('a,'b,'c) labeled_stateful_strand \<Rightarrow> ('a,'b) subst \<Rightarrow> ('a,'b,'c) labeled_stateful_strand" | |||
(infix "\<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t" 51) where | |||
"S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta> \<equiv> map (\<lambda>x. x \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) S" | |||
text\<open>Definitions lifted from stateful strands\<close> | |||
abbreviation wfrestrictedvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "wfrestrictedvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t (unlabel S)" | |||
abbreviation ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> ik\<^sub>s\<^sub>s\<^sub>t (unlabel S)" | |||
abbreviation db\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> db\<^sub>s\<^sub>s\<^sub>t (unlabel S)" | |||
abbreviation db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> db'\<^sub>s\<^sub>s\<^sub>t (unlabel S)" | |||
abbreviation trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> trms\<^sub>s\<^sub>s\<^sub>t (unlabel S)" | |||
abbreviation trms_proj\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "trms_proj\<^sub>l\<^sub>s\<^sub>s\<^sub>t n S \<equiv> trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n S)" | |||
abbreviation vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> vars\<^sub>s\<^sub>s\<^sub>t (unlabel S)" | |||
abbreviation vars_proj\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "vars_proj\<^sub>l\<^sub>s\<^sub>s\<^sub>t n S \<equiv> vars\<^sub>s\<^sub>s\<^sub>t (proj_unl n S)" | |||
abbreviation bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel S)" | |||
abbreviation fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> fv\<^sub>s\<^sub>s\<^sub>t (unlabel S)" | |||
text\<open>Labeled set-operations\<close> | |||
fun setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p where | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,insert\<langle>t,s\<rangle>) = {(i,t,s)}" | |||
| "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,delete\<langle>t,s\<rangle>) = {(i,t,s)}" | |||
| "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,\<langle>_: t \<in> s\<rangle>) = {(i,t,s)}" | |||
| "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,\<forall>_\<langle>\<or>\<noteq>: _ \<or>\<notin>: F'\<rangle>) = ((\<lambda>(t,s). (i,t,s)) ` set F')" | |||
| "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p _ = {}" | |||
definition setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t where | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<equiv> \<Union>(setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ` set S)" | |||
subsection \<open>Minor Lemmata\<close> | |||
lemma subst_lsst_nil[simp]: "[] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = []" | |||
by (simp add: subst_apply_labeled_stateful_strand_def) | |||
lemma subst_lsst_cons: "a#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)#(A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" | |||
by (simp add: subst_apply_labeled_stateful_strand_def) | |||
lemma subst_lsst_singleton: "[(l,s)] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = [(l,s \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)]" | |||
by (simp add: subst_apply_labeled_stateful_strand_def) | |||
lemma subst_lsst_append: "A@B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)@(B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" | |||
by (simp add: subst_apply_labeled_stateful_strand_def) | |||
lemma subst_lsst_append_inv: | |||
assumes "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = B1@B2" | |||
shows "\<exists>A1 A2. A = A1@A2 \<and> A1 \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = B1 \<and> A2 \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = B2" | |||
using assms | |||
proof (induction A arbitrary: B1 B2) | |||
case (Cons a A) | |||
note prems = Cons.prems | |||
note IH = Cons.IH | |||
show ?case | |||
proof (cases B1) | |||
case Nil | |||
then obtain b B3 where "B2 = b#B3" "a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> = b" "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = B3" | |||
using prems subst_lsst_cons by fastforce | |||
thus ?thesis by (simp add: Nil subst_apply_labeled_stateful_strand_def) | |||
next | |||
case (Cons b B3) | |||
hence "a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> = b" "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> = B3@B2" | |||
using prems by (simp_all add: subst_lsst_cons) | |||
thus ?thesis by (metis Cons_eq_appendI Cons IH subst_lsst_cons) | |||
qed | |||
qed (metis append_is_Nil_conv subst_lsst_nil) | |||
lemma subst_lsst_member[intro]: "x \<in> set A \<Longrightarrow> x \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<in> set (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" | |||
by (metis image_eqI set_map subst_apply_labeled_stateful_strand_def) | |||
lemma subst_lsst_unlabel_cons: "unlabel ((l,b)#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)#(unlabel (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))" | |||
by (simp add: subst_apply_labeled_stateful_strand_def) | |||
lemma subst_lsst_unlabel: "unlabel (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = unlabel A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>" | |||
proof (induction A) | |||
case (Cons a A) | |||
then obtain l b where "a = (l,b)" by (metis surj_pair) | |||
thus ?case | |||
using Cons | |||
by (simp add: subst_apply_labeled_stateful_strand_def subst_apply_stateful_strand_def) | |||
qed simp | |||
lemma subst_lsst_unlabel_member[intro]: | |||
assumes "x \<in> set (unlabel A)" | |||
shows "x \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<in> set (unlabel (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>))" | |||
proof - | |||
obtain l where x: "(l,x) \<in> set A" using assms unfolding unlabel_def by moura | |||
thus ?thesis | |||
using subst_lsst_member | |||
by (metis unlabel_def in_set_zipE subst_apply_labeled_stateful_strand_step.simps zip_map_fst_snd) | |||
qed | |||
lemma subst_lsst_prefix: | |||
assumes "prefix B (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" | |||
shows "\<exists>C. C \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta> = B \<and> prefix C A" | |||
using assms | |||
proof (induction A rule: List.rev_induct) | |||
case (snoc a A) thus ?case | |||
proof (cases "B = A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>") | |||
case False thus ?thesis | |||
using snoc by (auto simp add: subst_lsst_append[of A] subst_lsst_cons) | |||
qed auto | |||
qed simp | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_nil[simp]: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] = []" | |||
by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_Cons[simp]: | |||
"dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,send\<langle>t\<rangle>)#A) = (l,receive\<langle>t\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
"dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,receive\<langle>t\<rangle>)#A) = (l,send\<langle>t\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
"dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,\<langle>a: t \<doteq> s\<rangle>)#A) = (l,\<langle>a: t \<doteq> s\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
"dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,insert\<langle>t,s\<rangle>)#A) = (l,insert\<langle>t,s\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
"dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,delete\<langle>t,s\<rangle>)#A) = (l,delete\<langle>t,s\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
"dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,\<langle>a: t \<in> s\<rangle>)#A) = (l,\<langle>a: t \<in> s\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
"dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>)#A) = (l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
by (simp_all add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append[simp]: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t B" | |||
by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p s) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>" | |||
proof - | |||
obtain l x where s: "s = (l,x)" by moura | |||
thus ?thesis by (cases x) (auto simp add: subst_apply_labeled_stateful_strand_def) | |||
qed | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>" | |||
proof (induction S) | |||
case (Cons s S) thus ?case | |||
using Cons dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[of s \<delta>] | |||
by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def) | |||
qed (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def) | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_unlabel: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>" | |||
by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst subst_lsst_unlabel) | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_cons: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma>)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>))" | |||
by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst list.simps(9) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def) | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_append: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t B) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>" | |||
by (metis (no_types) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append) | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>)@[dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma>]" | |||
by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_cons list.map(1) map_append | |||
subst_apply_labeled_stateful_strand_def) | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD: | |||
assumes "(l,a) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
shows "\<exists>b. (l,b) \<in> set A \<and> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,b) = (l,a)" | |||
using assms | |||
proof (induction A) | |||
case (Cons c A) | |||
hence "(l,a) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \<or> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p c = (l,a)" unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by force | |||
thus ?case | |||
proof | |||
assume "(l,a) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" thus ?case using Cons.IH by auto | |||
next | |||
assume a: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p c = (l,a)" | |||
obtain i b where b: "c = (i,b)" by (metis surj_pair) | |||
thus ?case using a by (cases b) auto | |||
qed | |||
qed simp | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv: | |||
assumes "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l, a) = (k, b)" | |||
shows "l = k" | |||
and "a = receive\<langle>t\<rangle> \<Longrightarrow> b = send\<langle>t\<rangle>" | |||
and "a = send\<langle>t\<rangle> \<Longrightarrow> b = receive\<langle>t\<rangle>" | |||
and "(\<nexists>t. a = receive\<langle>t\<rangle> \<or> a = send\<langle>t\<rangle>) \<Longrightarrow> b = a" | |||
proof - | |||
show "l = k" using assms by (cases a) auto | |||
show "a = receive\<langle>t\<rangle> \<Longrightarrow> b = send\<langle>t\<rangle>" using assms by (cases a) auto | |||
show "a = send\<langle>t\<rangle> \<Longrightarrow> b = receive\<langle>t\<rangle>" using assms by (cases a) auto | |||
show "(\<nexists>t. a = receive\<langle>t\<rangle> \<or> a = send\<langle>t\<rangle>) \<Longrightarrow> b = a" using assms by (cases a) auto | |||
qed | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_self_inverse: "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = A" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l b where "a = (l,b)" by (metis surj_pair) | |||
thus ?case using Cons by (cases b) auto | |||
qed simp | |||
lemma vars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq: "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l b where a: "a = (l,b)" by (metis surj_pair) | |||
thus ?case using Cons.IH by (cases b) auto | |||
qed simp | |||
lemma fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l b where a: "a = (l,b)" by (metis surj_pair) | |||
thus ?case using Cons.IH by (cases b) auto | |||
qed simp | |||
lemma bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l b where a: "a = (l,b)" by (metis surj_pair) | |||
thus ?case using Cons.IH by (cases b) simp+ | |||
qed simp | |||
lemma vars\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons: "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,b)#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" | |||
by (metis unlabel_Cons(1) vars\<^sub>s\<^sub>s\<^sub>t_Cons) | |||
lemma fv\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,b)#A) = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" | |||
by (metis unlabel_Cons(1) fv\<^sub>s\<^sub>s\<^sub>t_Cons) | |||
lemma bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,b)#A) = set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" | |||
by (metis unlabel_Cons(1) bvars\<^sub>s\<^sub>s\<^sub>t_Cons) | |||
lemma bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" | |||
by (metis subst_lsst_unlabel bvars\<^sub>s\<^sub>s\<^sub>t_subst) | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_member: | |||
assumes "(l,x) \<in> set A" | |||
and "\<not>is_Receive x" "\<not>is_Send x" | |||
shows "(l,x) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
using assms | |||
proof (induction A) | |||
case (Cons a A) thus ?case using assms(2,3) by (cases x) (auto simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) | |||
qed simp | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_member: | |||
assumes "x \<in> set (unlabel A)" | |||
and "\<not>is_Receive x" "\<not>is_Send x" | |||
shows "x \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
using assms dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_member[of _ _ A] | |||
by (meson unlabel_in unlabel_mem_has_label) | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff: | |||
"(l,send\<langle>t\<rangle>) \<in> set A \<longleftrightarrow> (l,receive\<langle>t\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
"(l,receive\<langle>t\<rangle>) \<in> set A \<longleftrightarrow> (l,send\<langle>t\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
"(l,\<langle>c: t \<doteq> s\<rangle>) \<in> set A \<longleftrightarrow> (l,\<langle>c: t \<doteq> s\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
"(l,insert\<langle>t,s\<rangle>) \<in> set A \<longleftrightarrow> (l,insert\<langle>t,s\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
"(l,delete\<langle>t,s\<rangle>) \<in> set A \<longleftrightarrow> (l,delete\<langle>t,s\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
"(l,\<langle>c: t \<in> s\<rangle>) \<in> set A \<longleftrightarrow> (l,\<langle>c: t \<in> s\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
"(l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) \<in> set A \<longleftrightarrow> (l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>) \<in> set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain j b where a: "a = (j,b)" by (metis surj_pair) | |||
{ case 1 thus ?case by (cases b) (simp_all add: Cons.IH(1) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) } | |||
{ case 2 thus ?case by (cases b) (simp_all add: Cons.IH(2) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) } | |||
{ case 3 thus ?case by (cases b) (simp_all add: Cons.IH(3) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) } | |||
{ case 4 thus ?case by (cases b) (simp_all add: Cons.IH(4) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) } | |||
{ case 5 thus ?case by (cases b) (simp_all add: Cons.IH(5) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) } | |||
{ case 6 thus ?case by (cases b) (simp_all add: Cons.IH(6) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) } | |||
{ case 7 thus ?case by (cases b) (simp_all add: Cons.IH(7) a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) } | |||
qed (simp_all add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff: | |||
"send\<langle>t\<rangle> \<in> set (unlabel A) \<longleftrightarrow> receive\<langle>t\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"receive\<langle>t\<rangle> \<in> set (unlabel A) \<longleftrightarrow> send\<langle>t\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"\<langle>c: t \<doteq> s\<rangle> \<in> set (unlabel A) \<longleftrightarrow> \<langle>c: t \<doteq> s\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"insert\<langle>t,s\<rangle> \<in> set (unlabel A) \<longleftrightarrow> insert\<langle>t,s\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"delete\<langle>t,s\<rangle> \<in> set (unlabel A) \<longleftrightarrow> delete\<langle>t,s\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"\<langle>c: t \<in> s\<rangle> \<in> set (unlabel A) \<longleftrightarrow> \<langle>c: t \<in> s\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set (unlabel A) \<longleftrightarrow> \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(1,2)[of _ t A] | |||
dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(3,6)[of _ c t s A] | |||
dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(4,5)[of _ t s A] | |||
dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(7)[of _ X F G A] | |||
by (meson unlabel_in unlabel_mem_has_label)+ | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all: | |||
"list_all is_Receive (unlabel A) \<Longrightarrow> list_all is_Send (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"list_all is_Send (unlabel A) \<Longrightarrow> list_all is_Receive (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"list_all is_Equality (unlabel A) \<Longrightarrow> list_all is_Equality (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"list_all is_Insert (unlabel A) \<Longrightarrow> list_all is_Insert (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"list_all is_Delete (unlabel A) \<Longrightarrow> list_all is_Delete (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"list_all is_InSet (unlabel A) \<Longrightarrow> list_all is_InSet (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"list_all is_NegChecks (unlabel A) \<Longrightarrow> list_all is_NegChecks (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"list_all is_Assignment (unlabel A) \<Longrightarrow> list_all is_Assignment (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"list_all is_Check (unlabel A) \<Longrightarrow> list_all is_Check (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
"list_all is_Update (unlabel A) \<Longrightarrow> list_all is_Update (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
proof (induct A) | |||
case (Cons a A) | |||
obtain l b where a: "a = (l,b)" by (metis surj_pair) | |||
{ case 1 thus ?case using Cons.hyps(1) a by (cases b) auto } | |||
{ case 2 thus ?case using Cons.hyps(2) a by (cases b) auto } | |||
{ case 3 thus ?case using Cons.hyps(3) a by (cases b) auto } | |||
{ case 4 thus ?case using Cons.hyps(4) a by (cases b) auto } | |||
{ case 5 thus ?case using Cons.hyps(5) a by (cases b) auto } | |||
{ case 6 thus ?case using Cons.hyps(6) a by (cases b) auto } | |||
{ case 7 thus ?case using Cons.hyps(7) a by (cases b) auto } | |||
{ case 8 thus ?case using Cons.hyps(8) a by (cases b) auto } | |||
{ case 9 thus ?case using Cons.hyps(9) a by (cases b) auto } | |||
{ case 10 thus ?case using Cons.hyps(10) a by (cases b) auto } | |||
qed simp_all | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain: | |||
assumes "s \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" | |||
shows "\<exists>l B s'. (l,s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,s') \<and> prefix (B@[(l,s')]) A" | |||
using assms | |||
proof (induction A rule: List.rev_induct) | |||
case (snoc a A) | |||
obtain i b where a: "a = (i,b)" by (metis surj_pair) | |||
show ?case using snoc | |||
proof (cases "s \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))") | |||
case False thus ?thesis | |||
using a snoc.prems unlabel_append[of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t [a]"] dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append[of A "[a]"] | |||
by (cases b) (force simp add: unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)+ | |||
qed auto | |||
qed simp | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst: | |||
assumes "s \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)))" | |||
shows "\<exists>l B s'. (l,s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s') \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) \<and> prefix ((B \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)@[(l,s') \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>]) (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" | |||
proof - | |||
obtain B l s' where B: "(l,s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,s')" "prefix (B@[(l,s')]) (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)" | |||
using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain[OF assms] by moura | |||
obtain C where C: "C \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta> = B@[(l,s')]" | |||
using subst_lsst_prefix[OF B(2)] by moura | |||
obtain D u where D: "C = D@[(l,u)]" "D \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta> = B" "[(l,u)] \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta> = [(l, s')]" | |||
using subst_lsst_prefix[OF B(2)] subst_lsst_append_inv[OF C(1)] | |||
by (auto simp add: subst_apply_labeled_stateful_strand_def) | |||
show ?thesis | |||
using B D subst_lsst_cons subst_lsst_singleton | |||
by (metis (no_types, lifting) nth_append_length) | |||
qed | |||
lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq: "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l b where a: "a = (l,b)" by (metis surj_pair) | |||
thus ?case using Cons.IH by (cases b) auto | |||
qed simp | |||
lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst_cons: | |||
"trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,b)#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" | |||
by (metis subst_lsst_unlabel trms\<^sub>s\<^sub>s\<^sub>t_subst_cons unlabel_Cons(1)) | |||
lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst: | |||
assumes "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<theta> = {}" | |||
shows "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>" | |||
by (metis trms\<^sub>s\<^sub>s\<^sub>t_subst[OF assms] subst_lsst_unlabel) | |||
lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst': | |||
fixes t::"('a,'b) term" and \<delta>::"('a,'b) subst" | |||
assumes "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" | |||
shows "\<exists>s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S. \<exists>X. set X \<subseteq> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<and> t = s \<cdot> rm_vars (set X) \<delta>" | |||
using assms | |||
proof (induction S) | |||
case (Cons a S) | |||
obtain l b where a: "a = (l,b)" by (metis surj_pair) | |||
hence "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) \<or> t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)" | |||
using Cons.prems trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst_cons by fast | |||
thus ?case | |||
proof | |||
assume *: "t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)" | |||
show ?thesis using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst''[OF *] a by auto | |||
next | |||
assume *: "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" | |||
show ?thesis using Cons.IH[OF *] a by auto | |||
qed | |||
qed simp | |||
lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst'': | |||
fixes t::"('a,'b) term" and \<delta> \<theta>::"('a,'b) subst" | |||
assumes "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>" | |||
shows "\<exists>s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S. \<exists>X. set X \<subseteq> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<and> t = s \<cdot> rm_vars (set X) \<delta> \<circ>\<^sub>s \<theta>" | |||
proof - | |||
obtain s where s: "s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" "t = s \<cdot> \<theta>" using assms by moura | |||
show ?thesis using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst'[OF s(1)] s(2) by auto | |||
qed | |||
lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual_subst_cons: | |||
"trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>)) = (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<sigma>)) \<union> (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>)))" | |||
proof - | |||
obtain l b where a: "a = (l,b)" by (metis surj_pair) | |||
thus ?thesis using a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_cons[of a A \<sigma>] by (cases b) auto | |||
qed | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_funs_term: | |||
"\<Union>(funs_term ` (trms\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S)))) = \<Union>(funs_term ` (trms\<^sub>s\<^sub>s\<^sub>t (unlabel S)))" | |||
using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq by fast | |||
lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_db\<^sub>l\<^sub>s\<^sub>s\<^sub>t: | |||
"db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l b where a: "a = (l,b)" by (metis surj_pair) | |||
thus ?case using Cons by (cases b) auto | |||
qed simp | |||
lemma db\<^sub>s\<^sub>s\<^sub>t_unlabel_append: | |||
"db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) I D = db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t B I (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I D)" | |||
by (metis db\<^sub>s\<^sub>s\<^sub>t_append unlabel_append) | |||
lemma db\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t: | |||
"db'\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>))) \<I> D = db'\<^sub>s\<^sub>s\<^sub>t (unlabel (T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)) \<I> D" | |||
proof (induction T arbitrary: D) | |||
case (Cons x T) | |||
obtain l s where "x = (l,s)" by moura | |||
thus ?case | |||
using Cons | |||
by (cases s) (simp_all add: unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def) | |||
qed (simp add: unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def) | |||
lemma labeled_list_insert_eq_cases: | |||
"d \<notin> set (unlabel D) \<Longrightarrow> List.insert d (unlabel D) = unlabel (List.insert (i,d) D)" | |||
"(i,d) \<in> set D \<Longrightarrow> List.insert d (unlabel D) = unlabel (List.insert (i,d) D)" | |||
unfolding unlabel_def | |||
by (metis (no_types, hide_lams) List.insert_def image_eqI list.simps(9) set_map snd_conv, | |||
metis in_set_insert set_zip_rightD zip_map_fst_snd) | |||
lemma labeled_list_insert_eq_ex_cases: | |||
"List.insert d (unlabel D) = unlabel (List.insert (i,d) D) \<or> | |||
(\<exists>j. (j,d) \<in> set D \<and> List.insert d (unlabel D) = unlabel (List.insert (j,d) D))" | |||
using labeled_list_insert_eq_cases unfolding unlabel_def | |||
by (metis in_set_impl_in_set_zip2 length_map zip_map_fst_snd) | |||
lemma proj_subst: "proj l (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = proj l A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l b where "a = (l,b)" by (metis surj_pair) | |||
thus ?case using Cons unfolding proj_def subst_apply_labeled_stateful_strand_def by force | |||
qed simp | |||
lemma proj_set_subset[simp]: | |||
"set (proj n A) \<subseteq> set A" | |||
unfolding proj_def by auto | |||
lemma proj_proj_set_subset[simp]: | |||
"set (proj n (proj m A)) \<subseteq> set (proj n A)" | |||
"set (proj n (proj m A)) \<subseteq> set (proj m A)" | |||
"set (proj_unl n (proj m A)) \<subseteq> set (proj_unl n A)" | |||
"set (proj_unl n (proj m A)) \<subseteq> set (proj_unl m A)" | |||
unfolding unlabel_def proj_def by auto | |||
lemma proj_in_set_iff: | |||
"(ln i, d) \<in> set (proj i D) \<longleftrightarrow> (ln i, d) \<in> set D" | |||
"(\<star>, d) \<in> set (proj i D) \<longleftrightarrow> (\<star>, d) \<in> set D" | |||
unfolding proj_def by auto | |||
lemma proj_list_insert: | |||
"proj i (List.insert (ln i,d) D) = List.insert (ln i,d) (proj i D)" | |||
"proj i (List.insert (\<star>,d) D) = List.insert (\<star>,d) (proj i D)" | |||
"i \<noteq> j \<Longrightarrow> proj i (List.insert (ln j,d) D) = proj i D" | |||
unfolding List.insert_def proj_def by auto | |||
lemma proj_filter: "proj i [d\<leftarrow>D. d \<notin> set Di] = [d\<leftarrow>proj i D. d \<notin> set Di]" | |||
by (simp_all add: proj_def conj_commute) | |||
lemma proj_list_Cons: | |||
"proj i ((ln i,d)#D) = (ln i,d)#proj i D" | |||
"proj i ((\<star>,d)#D) = (\<star>,d)#proj i D" | |||
"i \<noteq> j \<Longrightarrow> proj i ((ln j,d)#D) = proj i D" | |||
unfolding List.insert_def proj_def by auto | |||
lemma proj_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t: | |||
"proj l (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l A)" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain k b where "a = (k,b)" by (metis surj_pair) | |||
thus ?case using Cons unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def proj_def by (cases b) auto | |||
qed simp | |||
lemma proj_instance_ex: | |||
assumes B: "\<forall>b \<in> set B. \<exists>a \<in> set A. \<exists>\<delta>. b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> P \<delta>" | |||
and b: "b \<in> set (proj l B)" | |||
shows "\<exists>a \<in> set (proj l A). \<exists>\<delta>. b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> P \<delta>" | |||
proof - | |||
obtain a \<delta> where a: "a \<in> set A" "b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>" "P \<delta>" using B b proj_set_subset by fast | |||
obtain k b' where b': "b = (k, b')" "k = (ln l) \<or> k = \<star>" using b proj_in_setD by metis | |||
obtain a' where a': "a = (k, a')" using b'(1) a(2) by (cases a) simp_all | |||
show ?thesis using a a' b'(2) unfolding proj_def by auto | |||
qed | |||
lemma proj_dbproj: | |||
"dbproj (ln i) (proj i D) = dbproj (ln i) D" | |||
"dbproj \<star> (proj i D) = dbproj \<star> D" | |||
"i \<noteq> j \<Longrightarrow> dbproj (ln j) (proj i D) = []" | |||
unfolding proj_def by (induct D) auto | |||
lemma dbproj_Cons: | |||
"dbproj i ((i,d)#D) = (i,d)#dbproj i D" | |||
"i \<noteq> j \<Longrightarrow> dbproj j ((i,d)#D) = dbproj j D" | |||
by auto | |||
lemma dbproj_subset[simp]: | |||
"set (unlabel (dbproj i D)) \<subseteq> set (unlabel D)" | |||
unfolding unlabel_def by auto | |||
lemma dbproj_subseq: | |||
assumes "Di \<in> set (subseqs (dbproj k D))" | |||
shows "dbproj k Di = Di" (is ?A) | |||
and "i \<noteq> k \<Longrightarrow> dbproj i Di = []" (is "i \<noteq> k \<Longrightarrow> ?B") | |||
proof - | |||
have *: "set Di \<subseteq> set (dbproj k D)" using subseqs_powset[of "dbproj k D"] assms by auto | |||
thus ?A by (metis filter_True filter_set member_filter subsetCE) | |||
have "\<And>j d. (j,d) \<in> set Di \<Longrightarrow> j = k" using * by auto | |||
moreover have "\<And>j d. (j,d) \<in> set (dbproj i Di) \<Longrightarrow> j = i" by auto | |||
moreover have "\<And>j d. (j,d) \<in> set (dbproj i Di) \<Longrightarrow> (j,d) \<in> set Di" by auto | |||
ultimately show "i \<noteq> k \<Longrightarrow> ?B" by (metis set_empty subrelI subset_empty) | |||
qed | |||
lemma dbproj_subseq_subset: | |||
assumes "Di \<in> set (subseqs (dbproj i D))" | |||
shows "set Di \<subseteq> set D" | |||
by (metis Pow_iff assms filter_set image_eqI member_filter subseqs_powset subsetCE subsetI) | |||
lemma dbproj_subseq_in_subseqs: | |||
assumes "Di \<in> set (subseqs (dbproj i D))" | |||
shows "Di \<in> set (subseqs D)" | |||
using assms in_set_subseqs subseq_filter_left subseq_order.dual_order.trans by blast | |||
lemma proj_subseq: | |||
assumes "Di \<in> set (subseqs (dbproj (ln j) D))" "j \<noteq> i" | |||
shows "[d\<leftarrow>proj i D. d \<notin> set Di] = proj i D" | |||
proof - | |||
have "set Di \<subseteq> set (dbproj (ln j) D)" using subseqs_powset[of "dbproj (ln j) D"] assms by auto | |||
hence "\<And>k d. (k,d) \<in> set Di \<Longrightarrow> k = ln j" by auto | |||
moreover have "\<And>k d. (k,d) \<in> set (proj i D) \<Longrightarrow> k \<noteq> ln j" | |||
using assms(2) unfolding proj_def by auto | |||
ultimately have "\<And>d. d \<in> set (proj i D) \<Longrightarrow> d \<notin> set Di" by auto | |||
thus ?thesis by simp | |||
qed | |||
lemma unlabel_subseqsD: | |||
assumes "A \<in> set (subseqs (unlabel B))" | |||
shows "\<exists>C \<in> set (subseqs B). unlabel C = A" | |||
using assms map_subseqs unfolding unlabel_def by (metis imageE set_map) | |||
lemma unlabel_filter_eq: | |||
assumes "\<forall>(j, p) \<in> set A \<union> B. \<forall>(k, q) \<in> set A \<union> B. p = q \<longrightarrow> j = k" (is "?P (set A)") | |||
shows "[d\<leftarrow>unlabel A. d \<notin> snd ` B] = unlabel [d\<leftarrow>A. d \<notin> B]" | |||
using assms unfolding unlabel_def | |||
proof (induction A) | |||
case (Cons a A) | |||
have "set A \<subseteq> set (a#A)" "{a} \<subseteq> set (a#A)" by auto | |||
hence *: "?P (set A)" "?P {a}" using Cons.prems by fast+ | |||
hence IH: "[d\<leftarrow>map snd A . d \<notin> snd ` B] = map snd [d\<leftarrow>A . d \<notin> B]" using Cons.IH by auto | |||
{ assume "snd a \<in> snd ` B" | |||
then obtain b where b: "b \<in> B" "snd a = snd b" by moura | |||
hence "fst a = fst b" using *(2) by auto | |||
hence "a \<in> B" using b by (metis surjective_pairing) | |||
} hence **: "a \<notin> B \<Longrightarrow> snd a \<notin> snd ` B" by metis | |||
show ?case by (cases "a \<in> B") (simp add: ** IH)+ | |||
qed simp | |||
lemma subseqs_mem_dbproj: | |||
assumes "Di \<in> set (subseqs D)" "list_all (\<lambda>d. fst d = i) Di" | |||
shows "Di \<in> set (subseqs (dbproj i D))" | |||
using assms | |||
proof (induction D arbitrary: Di) | |||
case (Cons di D) | |||
obtain d j where di: "di = (j,d)" by (metis surj_pair) | |||
show ?case | |||
proof (cases "Di \<in> set (subseqs D)") | |||
case True | |||
hence "Di \<in> set (subseqs (dbproj i D))" using Cons.IH Cons.prems by auto | |||
thus ?thesis using subseqs_Cons by auto | |||
next | |||
case False | |||
then obtain Di' where Di': "Di = di#Di'" using Cons.prems(1) | |||
by (metis (mono_tags, lifting) Un_iff imageE set_append set_map subseqs.simps(2)) | |||
hence "Di' \<in> set (subseqs D)" using Cons.prems(1) False | |||
by (metis (no_types, lifting) UnE imageE list.inject set_append set_map subseqs.simps(2)) | |||
hence "Di' \<in> set (subseqs (dbproj i D))" using Cons.IH Cons.prems Di' by auto | |||
moreover have "i = j" using Di' di Cons.prems(2) by auto | |||
hence "dbproj i (di#D) = di#dbproj i D" by (simp add: di) | |||
ultimately show ?thesis using Di' | |||
by (metis (no_types, lifting) UnCI image_eqI set_append set_map subseqs.simps(2)) | |||
qed | |||
qed simp | |||
lemma unlabel_subst: "unlabel S \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta> = unlabel (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" | |||
unfolding unlabel_def subst_apply_stateful_strand_def subst_apply_labeled_stateful_strand_def | |||
by auto | |||
lemma subterms_subst_lsst: | |||
assumes "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S). (\<exists>f. \<sigma> x = Fun f []) \<or> (\<exists>y. \<sigma> x = Var y)" | |||
and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<sigma> = {}" | |||
shows "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>)) = subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>" | |||
using subterms_subst''[OF assms(1)] trms\<^sub>s\<^sub>s\<^sub>t_subst[OF assms(2)] unlabel_subst[of S \<sigma>] | |||
by simp | |||
lemma subterms_subst_lsst_ik: | |||
assumes "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t S). (\<exists>f. \<sigma> x = Fun f []) \<or> (\<exists>y. \<sigma> x = Var y)" | |||
shows "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<sigma>)) = subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>" | |||
using subterms_subst''[OF assms(1)] ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel S" \<sigma>] unlabel_subst[of S \<sigma>] | |||
by simp | |||
lemma labeled_stateful_strand_subst_comp: | |||
assumes "range_vars \<delta> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S = {}" | |||
shows "S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> \<circ>\<^sub>s \<theta> = (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>" | |||
using assms | |||
proof (induction S) | |||
case (Cons s S) | |||
obtain l x where s: "s = (l,x)" by (metis surj_pair) | |||
hence IH: "S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta> \<circ>\<^sub>s \<theta> = (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>" using Cons by auto | |||
have "x \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<circ>\<^sub>s \<theta> = (x \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>" | |||
using s Cons.prems stateful_strand_step_subst_comp[of \<delta> x \<theta>] by auto | |||
thus ?case using s IH by (simp add: subst_apply_labeled_stateful_strand_def) | |||
qed simp | |||
lemma sst_vars_proj_subset[simp]: | |||
"fv\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (unlabel A)" | |||
"bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A)" | |||
"vars\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> vars\<^sub>s\<^sub>s\<^sub>t (unlabel A)" | |||
using vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel A"] | |||
vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "proj_unl n A"] | |||
unfolding unlabel_def proj_def by auto | |||
lemma trms\<^sub>s\<^sub>s\<^sub>t_proj_subset[simp]: | |||
"trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A)" (is ?A) | |||
"trms\<^sub>s\<^sub>s\<^sub>t (proj_unl m (proj n A)) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n A)" (is ?B) | |||
"trms\<^sub>s\<^sub>s\<^sub>t (proj_unl m (proj n A)) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (proj_unl m A)" (is ?C) | |||
proof - | |||
show ?A unfolding unlabel_def proj_def by auto | |||
show ?B using trms\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_proj_set_subset(4)] by metis | |||
show ?C using trms\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_proj_set_subset(3)] by metis | |||
qed | |||
lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset: | |||
"trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B))" (is ?A) | |||
"trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n (A@B))" (is ?B) | |||
using trms\<^sub>s\<^sub>s\<^sub>t_mono[of "proj_unl n A" "proj_unl n (A@B)"] | |||
unfolding unlabel_def proj_def by auto | |||
lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_suffix_subset: | |||
"trms\<^sub>s\<^sub>s\<^sub>t (unlabel B) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B))" | |||
"trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n B) \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n (A@B))" | |||
using trms\<^sub>s\<^sub>s\<^sub>t_mono[of "proj_unl n B" "proj_unl n (A@B)"] | |||
unfolding unlabel_def proj_def by auto | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>pD: | |||
assumes p: "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" | |||
shows "fst p = fst a" (is ?P) | |||
and "is_Update (snd a) \<or> is_InSet (snd a) \<or> is_NegChecks (snd a)" (is ?Q) | |||
proof - | |||
obtain l k p' a' where a: "p = (l,p')" "a = (k,a')" by (metis surj_pair) | |||
show ?P using p a by (cases a') auto | |||
show ?Q using p a by (cases a') auto | |||
qed | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_nil[simp]: | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] = {}" | |||
by (simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_cons[simp]: | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (x#S) = setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \<union> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S" | |||
by (simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) | |||
lemma setops\<^sub>s\<^sub>s\<^sub>t_proj_subset: | |||
"setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" | |||
"setops\<^sub>s\<^sub>s\<^sub>t (proj_unl m (proj n A)) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n A)" | |||
"setops\<^sub>s\<^sub>s\<^sub>t (proj_unl m (proj n A)) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (proj_unl m A)" | |||
unfolding unlabel_def proj_def | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l b where lb: "a = (l,b)" by moura | |||
{ case 1 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) } | |||
{ case 2 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) } | |||
{ case 3 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) } | |||
qed simp_all | |||
lemma setops\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset: | |||
"setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B))" | |||
"setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n (A@B))" | |||
unfolding unlabel_def proj_def | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l b where lb: "a = (l,b)" by moura | |||
{ case 1 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) } | |||
{ case 2 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) } | |||
qed (simp_all add: setops\<^sub>s\<^sub>s\<^sub>t_def) | |||
lemma setops\<^sub>s\<^sub>s\<^sub>t_unlabel_suffix_subset: | |||
"setops\<^sub>s\<^sub>s\<^sub>t (unlabel B) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B))" | |||
"setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n B) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n (A@B))" | |||
unfolding unlabel_def proj_def | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l b where lb: "a = (l,b)" by moura | |||
{ case 1 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) } | |||
{ case 2 thus ?case using Cons.IH lb by (cases b) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) } | |||
qed simp_all | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj_subset: | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj m (proj n A)) \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A)" | |||
unfolding proj_def setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_prefix_subset: | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B)" | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n (A@B))" | |||
unfolding proj_def setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_suffix_subset: | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B)" | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n B) \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n (A@B))" | |||
unfolding proj_def setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_mono: | |||
"set M \<subseteq> set N \<Longrightarrow> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t M \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t N" | |||
by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) | |||
lemma trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subset_if_no_label: | |||
"\<not>list_ex (is_LabelN l) A \<Longrightarrow> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l A) \<subseteq> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l' A)" | |||
by (rule trms\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_subset_if_no_label(2)[of l A l']]) | |||
lemma setops\<^sub>s\<^sub>s\<^sub>t_unlabel_subset_if_no_label: | |||
"\<not>list_ex (is_LabelN l) A \<Longrightarrow> setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l A) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l' A)" | |||
by (rule setops\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_subset_if_no_label(2)[of l A l']]) | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj_subset_if_no_label: | |||
"\<not>list_ex (is_LabelN l) A \<Longrightarrow> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l A) \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l' A)" | |||
by (rule setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_subset_if_no_label(1)[of l A l']]) | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases[simp]: | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,send\<langle>t\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,receive\<langle>t\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,\<langle>ac: s \<doteq> t\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = {}" | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,insert\<langle>t,s\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = {(l,t \<cdot> \<delta>,s \<cdot> \<delta>)}" | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,delete\<langle>t,s\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = {(l,t \<cdot> \<delta>,s \<cdot> \<delta>)}" | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,\<langle>ac: t \<in> s\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = {(l,t \<cdot> \<delta>,s \<cdot> \<delta>)}" | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle>) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) = | |||
((\<lambda>(t,s). (l,t \<cdot> rm_vars (set X) \<delta>,s \<cdot> rm_vars (set X) \<delta>)) ` set F')" (is "?A = ?B") | |||
proof - | |||
have "?A = (\<lambda>(t,s). (l,t,s)) ` set (F' \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<delta>)" by auto | |||
thus "?A = ?B" unfolding subst_apply_pairs_def by auto | |||
qed simp_all | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst: | |||
assumes "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a)) \<inter> subst_domain \<theta> = {}" | |||
shows "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = (\<lambda>p. (fst a,snd p \<cdot>\<^sub>p \<theta>)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" | |||
proof - | |||
obtain l a' where a: "a = (l,a')" by (metis surj_pair) | |||
show ?thesis | |||
proof (cases a') | |||
case (NegChecks X F G) | |||
hence *: "rm_vars (set X) \<theta> = \<theta>" using a assms rm_vars_apply'[of \<theta> "set X"] by auto | |||
have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = (\<lambda>p. (fst a, p)) ` set (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)" | |||
using * NegChecks a by auto | |||
moreover have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = (\<lambda>p. (fst a, p)) ` set G" using NegChecks a by simp | |||
hence "(\<lambda>p. (fst a,snd p \<cdot>\<^sub>p \<theta>)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = (\<lambda>p. (fst a, p \<cdot>\<^sub>p \<theta>)) ` set G" | |||
by (metis (mono_tags, lifting) image_cong image_image snd_conv) | |||
hence "(\<lambda>p. (fst a,snd p \<cdot>\<^sub>p \<theta>)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = (\<lambda>p. (fst a, p)) ` (set G \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>)" | |||
unfolding case_prod_unfold by auto | |||
ultimately show ?thesis by (simp add: subst_apply_pairs_def) | |||
qed (use a in simp_all) | |||
qed | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst': | |||
assumes "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a)) \<inter> subst_domain \<theta> = {}" | |||
shows "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>) = (\<lambda>(i,p). (i,p \<cdot>\<^sub>p \<theta>)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" | |||
using setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[OF assms] setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>pD(1) unfolding case_prod_unfold | |||
by (metis (mono_tags, lifting) image_cong) | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst: | |||
assumes "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<theta> = {}" | |||
shows "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = (\<lambda>p. (fst p,snd p \<cdot>\<^sub>p \<theta>)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S" | |||
using assms | |||
proof (induction S) | |||
case (Cons a S) | |||
have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<inter> subst_domain \<theta> = {}" and *: "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a)) \<inter> subst_domain \<theta> = {}" | |||
using Cons.prems by auto | |||
hence IH: "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = (\<lambda>p. (fst p,snd p \<cdot>\<^sub>p \<theta>)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S" | |||
using Cons.IH by auto | |||
show ?case | |||
using setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst'[OF *] IH | |||
unfolding setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def case_prod_unfold subst_lsst_cons | |||
by auto | |||
qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_in_subst: | |||
assumes p: "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)" | |||
shows "\<exists>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. fst p = fst q \<and> snd p = snd q \<cdot>\<^sub>p rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a))) \<delta>" | |||
(is "\<exists>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. ?P q") | |||
proof - | |||
obtain l b where a: "a = (l,b)" by (metis surj_pair) | |||
show ?thesis | |||
proof (cases b) | |||
case (NegChecks X F F') | |||
hence "p \<in> (\<lambda>(t, s). (l, t \<cdot> rm_vars (set X) \<delta>, s \<cdot> rm_vars (set X) \<delta>)) ` set F'" | |||
using p a setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(7)[of l X F F' \<delta>] by blast | |||
then obtain s t where st: | |||
"(t,s) \<in> set F'" "p = (l, t \<cdot> rm_vars (set X) \<delta>, s \<cdot> rm_vars (set X) \<delta>)" | |||
by auto | |||
hence "(l,t,s) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" "fst p = fst (l,t,s)" | |||
"snd p = snd (l,t,s) \<cdot>\<^sub>p rm_vars (set X) \<delta>" | |||
using a NegChecks by fastforce+ | |||
moreover have "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a) = X" using NegChecks a by auto | |||
ultimately show ?thesis by blast | |||
qed (use p a in auto) | |||
qed | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_subst: | |||
assumes "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" | |||
shows "\<exists>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. fst p = fst q \<and> (\<exists>X \<subseteq> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. snd p = snd q \<cdot>\<^sub>p rm_vars X \<delta>)" | |||
(is "\<exists>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. ?P A q") | |||
using assms | |||
proof (induction A) | |||
case (Cons a A) | |||
note 0 = unlabel_Cons(2)[of a A] bvars\<^sub>s\<^sub>s\<^sub>t_Cons[of "snd a" "unlabel A"] | |||
show ?case | |||
proof (cases "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)") | |||
case False | |||
hence "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)" | |||
using Cons.prems setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_cons[of "a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>" "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>"] subst_lsst_cons[of a A \<delta>] by auto | |||
moreover have "(set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a))) \<subseteq> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A)" using 0 by simp | |||
ultimately have "\<exists>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. ?P (a#A) q" using setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_in_subst[of p a \<delta>] by blast | |||
thus ?thesis by auto | |||
qed (use Cons.IH 0 in auto) | |||
qed simp | |||
lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq: | |||
"setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) = setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l b where "a = (l,b)" by (metis surj_pair) | |||
thus ?case using Cons unfolding setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by (cases b) auto | |||
qed simp | |||
end |
@@ -0,0 +1,372 @@ | |||
(* | |||
(C) Copyright Andreas Viktor Hess, DTU, 2018-2020 | |||
(C) Copyright Sebastian A. Mödersheim, DTU, 2018-2020 | |||
(C) Copyright Achim D. Brucker, University of Sheffield, 2018-2020 | |||
All Rights Reserved. | |||
Redistribution and use in source and binary forms, with or without | |||
modification, are permitted provided that the following conditions are | |||
met: | |||
- Redistributions of source code must retain the above copyright | |||
notice, this list of conditions and the following disclaimer. | |||
- Redistributions in binary form must reproduce the above copyright | |||
notice, this list of conditions and the following disclaimer in the | |||
documentation and/or other materials provided with the distribution. | |||
- Neither the name of the copyright holder nor the names of its | |||
contributors may be used to endorse or promote products | |||
derived from this software without specific prior written | |||
permission. | |||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | |||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT | |||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR | |||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT | |||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | |||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT | |||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, | |||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY | |||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | |||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE | |||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | |||
*) | |||
(* Title: Labeled_Strands.thy | |||
Author: Andreas Viktor Hess, DTU | |||
Author: Sebastian A. Mödersheim, DTU | |||
Author: Achim D. Brucker, The University of Sheffield | |||
*) | |||
section \<open>Labeled Strands\<close> | |||
theory Labeled_Strands | |||
imports Strands_and_Constraints | |||
begin | |||
subsection \<open>Definitions: Labeled Strands and Constraints\<close> | |||
datatype 'l strand_label = | |||
LabelN (the_LabelN: "'l") ("ln _") | |||
| LabelS ("\<star>") | |||
text \<open>Labeled strands are strands whose steps are equipped with labels\<close> | |||
type_synonym ('a,'b,'c) labeled_strand_step = "'c strand_label \<times> ('a,'b) strand_step" | |||
type_synonym ('a,'b,'c) labeled_strand = "('a,'b,'c) labeled_strand_step list" | |||
abbreviation is_LabelN where "is_LabelN n x \<equiv> fst x = ln n" | |||
abbreviation is_LabelS where "is_LabelS x \<equiv> fst x = \<star>" | |||
definition unlabel where "unlabel S \<equiv> map snd S" | |||
definition proj where "proj n S \<equiv> filter (\<lambda>s. is_LabelN n s \<or> is_LabelS s) S" | |||
abbreviation proj_unl where "proj_unl n S \<equiv> unlabel (proj n S)" | |||
abbreviation wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t where "wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t S \<equiv> wfrestrictedvars\<^sub>s\<^sub>t (unlabel S)" | |||
abbreviation subst_apply_labeled_strand_step (infix "\<cdot>\<^sub>l\<^sub>s\<^sub>t\<^sub>p" 51) where | |||
"x \<cdot>\<^sub>l\<^sub>s\<^sub>t\<^sub>p \<theta> \<equiv> (case x of (l, s) \<Rightarrow> (l, s \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>))" | |||
abbreviation subst_apply_labeled_strand (infix "\<cdot>\<^sub>l\<^sub>s\<^sub>t" 51) where | |||
"S \<cdot>\<^sub>l\<^sub>s\<^sub>t \<theta> \<equiv> map (\<lambda>x. x \<cdot>\<^sub>l\<^sub>s\<^sub>t\<^sub>p \<theta>) S" | |||
abbreviation trms\<^sub>l\<^sub>s\<^sub>t where "trms\<^sub>l\<^sub>s\<^sub>t S \<equiv> trms\<^sub>s\<^sub>t (unlabel S)" | |||
abbreviation trms_proj\<^sub>l\<^sub>s\<^sub>t where "trms_proj\<^sub>l\<^sub>s\<^sub>t n S \<equiv> trms\<^sub>s\<^sub>t (proj_unl n S)" | |||
abbreviation vars\<^sub>l\<^sub>s\<^sub>t where "vars\<^sub>l\<^sub>s\<^sub>t S \<equiv> vars\<^sub>s\<^sub>t (unlabel S)" | |||
abbreviation vars_proj\<^sub>l\<^sub>s\<^sub>t where "vars_proj\<^sub>l\<^sub>s\<^sub>t n S \<equiv> vars\<^sub>s\<^sub>t (proj_unl n S)" | |||
abbreviation bvars\<^sub>l\<^sub>s\<^sub>t where "bvars\<^sub>l\<^sub>s\<^sub>t S \<equiv> bvars\<^sub>s\<^sub>t (unlabel S)" | |||
abbreviation fv\<^sub>l\<^sub>s\<^sub>t where "fv\<^sub>l\<^sub>s\<^sub>t S \<equiv> fv\<^sub>s\<^sub>t (unlabel S)" | |||
abbreviation wf\<^sub>l\<^sub>s\<^sub>t where "wf\<^sub>l\<^sub>s\<^sub>t V S \<equiv> wf\<^sub>s\<^sub>t V (unlabel S)" | |||
subsection \<open>Lemmata: Projections\<close> | |||
lemma is_LabelS_proj_iff_not_is_LabelN: | |||
"list_all is_LabelS (proj l A) \<longleftrightarrow> \<not>list_ex (is_LabelN l) A" | |||
by (induct A) (auto simp add: proj_def) | |||
lemma proj_subset_if_no_label: | |||
assumes "\<not>list_ex (is_LabelN l) A" | |||
shows "set (proj l A) \<subseteq> set (proj l' A)" | |||
and "set (proj_unl l A) \<subseteq> set (proj_unl l' A)" | |||
using assms by (induct A) (auto simp add: unlabel_def proj_def) | |||
lemma proj_in_setD: | |||
assumes a: "a \<in> set (proj l A)" | |||
obtains k b where "a = (k, b)" "k = (ln l) \<or> k = \<star>" | |||
using that a unfolding proj_def by (cases a) auto | |||
lemma proj_set_mono: | |||
assumes "set A \<subseteq> set B" | |||
shows "set (proj n A) \<subseteq> set (proj n B)" | |||
and "set (proj_unl n A) \<subseteq> set (proj_unl n B)" | |||
using assms unfolding proj_def unlabel_def by auto | |||
lemma unlabel_nil[simp]: "unlabel [] = []" | |||
by (simp add: unlabel_def) | |||
lemma unlabel_mono: "set A \<subseteq> set B \<Longrightarrow> set (unlabel A) \<subseteq> set (unlabel B)" | |||
by (auto simp add: unlabel_def) | |||
lemma unlabel_in: "(l,x) \<in> set A \<Longrightarrow> x \<in> set (unlabel A)" | |||
unfolding unlabel_def by force | |||
lemma unlabel_mem_has_label: "x \<in> set (unlabel A) \<Longrightarrow> \<exists>l. (l,x) \<in> set A" | |||
unfolding unlabel_def by auto | |||
lemma proj_nil[simp]: "proj n [] = []" "proj_unl n [] = []" | |||
unfolding unlabel_def proj_def by auto | |||
lemma singleton_lst_proj[simp]: | |||
"proj_unl l [(ln l, a)] = [a]" | |||
"l \<noteq> l' \<Longrightarrow> proj_unl l' [(ln l, a)] = []" | |||
"proj_unl l [(\<star>, a)] = [a]" | |||
"unlabel [(l'', a)] = [a]" | |||
unfolding proj_def unlabel_def by simp_all | |||
lemma unlabel_nil_only_if_nil[simp]: "unlabel A = [] \<Longrightarrow> A = []" | |||
unfolding unlabel_def by auto | |||
lemma unlabel_Cons[simp]: | |||
"unlabel ((l,a)#A) = a#unlabel A" | |||
"unlabel (b#A) = snd b#unlabel A" | |||
unfolding unlabel_def by simp_all | |||
lemma unlabel_append[simp]: "unlabel (A@B) = unlabel A@unlabel B" | |||
unfolding unlabel_def by auto | |||
lemma proj_Cons[simp]: | |||
"proj n ((ln n,a)#A) = (ln n,a)#proj n A" | |||
"proj n ((\<star>,a)#A) = (\<star>,a)#proj n A" | |||
"m \<noteq> n \<Longrightarrow> proj n ((ln m,a)#A) = proj n A" | |||
"l = (ln n) \<Longrightarrow> proj n ((l,a)#A) = (l,a)#proj n A" | |||
"l = \<star> \<Longrightarrow> proj n ((l,a)#A) = (l,a)#proj n A" | |||
"fst b \<noteq> \<star> \<Longrightarrow> fst b \<noteq> (ln n) \<Longrightarrow> proj n (b#A) = proj n A" | |||
unfolding proj_def by auto | |||
lemma proj_append[simp]: | |||
"proj l (A'@B') = proj l A'@proj l B'" | |||
"proj_unl l (A@B) = proj_unl l A@proj_unl l B" | |||
unfolding proj_def unlabel_def by auto | |||
lemma proj_unl_cons[simp]: | |||
"proj_unl l ((ln l, a)#A) = a#proj_unl l A" | |||
"l \<noteq> l' \<Longrightarrow> proj_unl l' ((ln l, a)#A) = proj_unl l' A" | |||
"proj_unl l ((\<star>, a)#A) = a#proj_unl l A" | |||
unfolding proj_def unlabel_def by simp_all | |||
lemma trms_unlabel_proj[simp]: | |||
"trms\<^sub>s\<^sub>t\<^sub>p (snd (ln l, x)) \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t l [(ln l, x)]" | |||
by auto | |||
lemma trms_unlabel_star[simp]: | |||
"trms\<^sub>s\<^sub>t\<^sub>p (snd (\<star>, x)) \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t l [(\<star>, x)]" | |||
by auto | |||
lemma trms\<^sub>l\<^sub>s\<^sub>t_union[simp]: "trms\<^sub>l\<^sub>s\<^sub>t A = (\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l A)" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l s where ls: "a = (l,s)" by moura | |||
have "trms\<^sub>l\<^sub>s\<^sub>t [a] = (\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l [a])" | |||
proof - | |||
have *: "trms\<^sub>l\<^sub>s\<^sub>t [a] = trms\<^sub>s\<^sub>t\<^sub>p s" using ls by simp | |||
show ?thesis | |||
proof (cases l) | |||
case (LabelN n) | |||
hence "trms_proj\<^sub>l\<^sub>s\<^sub>t n [a] = trms\<^sub>s\<^sub>t\<^sub>p s" using ls by simp | |||
moreover have "\<forall>m. n \<noteq> m \<longrightarrow> trms_proj\<^sub>l\<^sub>s\<^sub>t m [a] = {}" using ls LabelN by auto | |||
ultimately show ?thesis using * ls by fastforce | |||
next | |||
case LabelS | |||
hence "\<forall>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l [a] = trms\<^sub>s\<^sub>t\<^sub>p s" using ls by auto | |||
thus ?thesis using * ls by fastforce | |||
qed | |||
qed | |||
moreover have "\<forall>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l (a#A) = trms_proj\<^sub>l\<^sub>s\<^sub>t l [a] \<union> trms_proj\<^sub>l\<^sub>s\<^sub>t l A" | |||
unfolding unlabel_def proj_def by auto | |||
hence "(\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l (a#A)) = (\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l [a]) \<union> (\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l A)" by auto | |||
ultimately show ?case using Cons.IH ls by auto | |||
qed simp | |||
lemma trms\<^sub>l\<^sub>s\<^sub>t_append[simp]: "trms\<^sub>l\<^sub>s\<^sub>t (A@B) = trms\<^sub>l\<^sub>s\<^sub>t A \<union> trms\<^sub>l\<^sub>s\<^sub>t B" | |||
by (metis trms\<^sub>s\<^sub>t_append unlabel_append) | |||
lemma trms_proj\<^sub>l\<^sub>s\<^sub>t_append[simp]: "trms_proj\<^sub>l\<^sub>s\<^sub>t l (A@B) = trms_proj\<^sub>l\<^sub>s\<^sub>t l A \<union> trms_proj\<^sub>l\<^sub>s\<^sub>t l B" | |||
by (metis (no_types, lifting) filter_append proj_def trms\<^sub>l\<^sub>s\<^sub>t_append) | |||
lemma trms_proj\<^sub>l\<^sub>s\<^sub>t_subset[simp]: | |||
"trms_proj\<^sub>l\<^sub>s\<^sub>t l A \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t l (A@B)" | |||
"trms_proj\<^sub>l\<^sub>s\<^sub>t l B \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t l (A@B)" | |||
using trms_proj\<^sub>l\<^sub>s\<^sub>t_append[of l] by blast+ | |||
lemma trms\<^sub>l\<^sub>s\<^sub>t_subset[simp]: | |||
"trms\<^sub>l\<^sub>s\<^sub>t A \<subseteq> trms\<^sub>l\<^sub>s\<^sub>t (A@B)" | |||
"trms\<^sub>l\<^sub>s\<^sub>t B \<subseteq> trms\<^sub>l\<^sub>s\<^sub>t (A@B)" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l s where *: "a = (l,s)" by moura | |||
{ case 1 thus ?case using Cons * by auto } | |||
{ case 2 thus ?case using Cons * by auto } | |||
qed simp_all | |||
lemma vars\<^sub>l\<^sub>s\<^sub>t_union: "vars\<^sub>l\<^sub>s\<^sub>t A = (\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l A)" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l s where ls: "a = (l,s)" by moura | |||
have "vars\<^sub>l\<^sub>s\<^sub>t [a] = (\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l [a])" | |||
proof - | |||
have *: "vars\<^sub>l\<^sub>s\<^sub>t [a] = vars\<^sub>s\<^sub>t\<^sub>p s" using ls by auto | |||
show ?thesis | |||
proof (cases l) | |||
case (LabelN n) | |||
hence "vars_proj\<^sub>l\<^sub>s\<^sub>t n [a] = vars\<^sub>s\<^sub>t\<^sub>p s" using ls by simp | |||
moreover have "\<forall>m. n \<noteq> m \<longrightarrow> vars_proj\<^sub>l\<^sub>s\<^sub>t m [a] = {}" using ls LabelN by auto | |||
ultimately show ?thesis using * ls by fast | |||
next | |||
case LabelS | |||
hence "\<forall>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l [a] = vars\<^sub>s\<^sub>t\<^sub>p s" using ls by auto | |||
thus ?thesis using * ls by fast | |||
qed | |||
qed | |||
moreover have "\<forall>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l (a#A) = vars_proj\<^sub>l\<^sub>s\<^sub>t l [a] \<union> vars_proj\<^sub>l\<^sub>s\<^sub>t l A" | |||
unfolding unlabel_def proj_def by auto | |||
hence "(\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l (a#A)) = (\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l [a]) \<union> (\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l A)" | |||
using strand_vars_split(1) by auto | |||
ultimately show ?case using Cons.IH ls strand_vars_split(1) by auto | |||
qed simp | |||
lemma unlabel_Cons_inv: | |||
"unlabel A = b#B \<Longrightarrow> \<exists>A'. (\<exists>n. A = (ln n, b)#A') \<or> A = (\<star>, b)#A'" | |||
proof - | |||
assume *: "unlabel A = b#B" | |||
then obtain l A' where "A = (l,b)#A'" unfolding unlabel_def by moura | |||
thus "\<exists>A'. (\<exists>l. A = (ln l, b)#A') \<or> A = (\<star>, b)#A'" by (metis strand_label.exhaust) | |||
qed | |||
lemma unlabel_snoc_inv: | |||
"unlabel A = B@[b] \<Longrightarrow> \<exists>A'. (\<exists>n. A = A'@[(ln n, b)]) \<or> A = A'@[(\<star>, b)]" | |||
proof - | |||
assume *: "unlabel A = B@[b]" | |||
then obtain A' l where "A = A'@[(l,b)]" | |||
unfolding unlabel_def by (induct A rule: List.rev_induct) auto | |||
thus "\<exists>A'. (\<exists>n. A = A'@[(ln n, b)]) \<or> A = A'@[(\<star>, b)]" by (cases l) auto | |||
qed | |||
lemma proj_idem[simp]: "proj l (proj l A) = proj l A" | |||
unfolding proj_def by auto | |||
lemma proj_ik\<^sub>s\<^sub>t_is_proj_rcv_set: | |||
"ik\<^sub>s\<^sub>t (proj_unl n A) = {t. (ln n, Receive t) \<in> set A \<or> (\<star>, Receive t) \<in> set A} " | |||
using ik\<^sub>s\<^sub>t_is_rcv_set unfolding unlabel_def proj_def by force | |||
lemma unlabel_ik\<^sub>s\<^sub>t_is_rcv_set: | |||
"ik\<^sub>s\<^sub>t (unlabel A) = {t | l t. (l, Receive t) \<in> set A}" | |||
using ik\<^sub>s\<^sub>t_is_rcv_set unfolding unlabel_def by force | |||
lemma proj_ik_union_is_unlabel_ik: | |||
"ik\<^sub>s\<^sub>t (unlabel A) = (\<Union>l. ik\<^sub>s\<^sub>t (proj_unl l A))" | |||
proof | |||
show "(\<Union>l. ik\<^sub>s\<^sub>t (proj_unl l A)) \<subseteq> ik\<^sub>s\<^sub>t (unlabel A)" | |||
using unlabel_ik\<^sub>s\<^sub>t_is_rcv_set[of A] proj_ik\<^sub>s\<^sub>t_is_proj_rcv_set[of _ A] by auto | |||
show "ik\<^sub>s\<^sub>t (unlabel A) \<subseteq> (\<Union>l. ik\<^sub>s\<^sub>t (proj_unl l A))" | |||
proof | |||
fix t assume "t \<in> ik\<^sub>s\<^sub>t (unlabel A)" | |||
then obtain l where "(l, Receive t) \<in> set A" | |||
using ik\<^sub>s\<^sub>t_is_rcv_set unlabel_mem_has_label[of _ A] | |||
by moura | |||
thus "t \<in> (\<Union>l. ik\<^sub>s\<^sub>t (proj_unl l A))" using proj_ik\<^sub>s\<^sub>t_is_proj_rcv_set[of _ A] by (cases l) auto | |||
qed | |||
qed | |||
lemma proj_ik_append[simp]: | |||
"ik\<^sub>s\<^sub>t (proj_unl l (A@B)) = ik\<^sub>s\<^sub>t (proj_unl l A) \<union> ik\<^sub>s\<^sub>t (proj_unl l B)" | |||
using proj_append(2)[of l A B] ik_append by auto | |||
lemma proj_ik_append_subst_all: | |||
"ik\<^sub>s\<^sub>t (proj_unl l (A@B)) \<cdot>\<^sub>s\<^sub>e\<^sub>t I = (ik\<^sub>s\<^sub>t (proj_unl l A) \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<union> (ik\<^sub>s\<^sub>t (proj_unl l B) \<cdot>\<^sub>s\<^sub>e\<^sub>t I)" | |||
using proj_ik_append[of l] by auto | |||
lemma ik_proj_subset[simp]: "ik\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t n A" | |||
by auto | |||
lemma prefix_proj: | |||
"prefix A B \<Longrightarrow> prefix (unlabel A) (unlabel B)" | |||
"prefix A B \<Longrightarrow> prefix (proj n A) (proj n B)" | |||
"prefix A B \<Longrightarrow> prefix (proj_unl n A) (proj_unl n B)" | |||
unfolding prefix_def unlabel_def proj_def by auto | |||
subsection \<open>Lemmata: Well-formedness\<close> | |||
lemma wfvarsoccs\<^sub>s\<^sub>t_proj_union: | |||
"wfvarsoccs\<^sub>s\<^sub>t (unlabel A) = (\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A))" | |||
proof (induction A) | |||
case (Cons a A) | |||
obtain l s where ls: "a = (l,s)" by moura | |||
have "wfvarsoccs\<^sub>s\<^sub>t (unlabel [a]) = (\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a]))" | |||
proof - | |||
have *: "wfvarsoccs\<^sub>s\<^sub>t (unlabel [a]) = wfvarsoccs\<^sub>s\<^sub>t\<^sub>p s" using ls by auto | |||
show ?thesis | |||
proof (cases l) | |||
case (LabelN n) | |||
hence "wfvarsoccs\<^sub>s\<^sub>t (proj_unl n [a]) = wfvarsoccs\<^sub>s\<^sub>t\<^sub>p s" using ls by simp | |||
moreover have "\<forall>m. n \<noteq> m \<longrightarrow> wfvarsoccs\<^sub>s\<^sub>t (proj_unl m [a]) = {}" using ls LabelN by auto | |||
ultimately show ?thesis using * ls by fast | |||
next | |||
case LabelS | |||
hence "\<forall>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a]) = wfvarsoccs\<^sub>s\<^sub>t\<^sub>p s" using ls by auto | |||
thus ?thesis using * ls by fast | |||
qed | |||
qed | |||
moreover have | |||
"wfvarsoccs\<^sub>s\<^sub>t (proj_unl l (a#A)) = | |||
wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a]) \<union> wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A)" | |||
for l | |||
unfolding unlabel_def proj_def by auto | |||
hence "(\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l (a#A))) = | |||
(\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a])) \<union> (\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A))" | |||
using strand_vars_split(1) by auto | |||
ultimately show ?case using Cons.IH ls strand_vars_split(1) by auto | |||
qed simp | |||
lemma wf_if_wf_proj: | |||
assumes "\<forall>l. wf\<^sub>s\<^sub>t V (proj_unl l A)" | |||
shows "wf\<^sub>s\<^sub>t V (unlabel A)" | |||
using assms | |||
proof (induction A arbitrary: V rule: List.rev_induct) | |||
case (snoc a A) | |||
hence IH: "wf\<^sub>s\<^sub>t V (unlabel A)" using proj_append(2)[of _ A] by auto | |||
obtain b l where b: "a = (ln l, b) \<or> a = (\<star>, b)" by (cases a, metis strand_label.exhaust) | |||
hence *: "wf\<^sub>s\<^sub>t V (proj_unl l A@[b])" | |||
by (metis snoc.prems proj_append(2) singleton_lst_proj(1) proj_unl_cons(1,3)) | |||
thus ?case using IH b snoc.prems proj_append(2)[of l A "[a]"] unlabel_append[of A "[a]"] | |||
proof (cases b) | |||
case (Receive t) | |||
have "fv t \<subseteq> wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \<union> V" | |||
proof | |||
fix x assume "x \<in> fv t" | |||
hence "x \<in> V \<union> wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A)" using wf_append_exec[OF *] b Receive by auto | |||
thus "x \<in> wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \<union> V" using wfvarsoccs\<^sub>s\<^sub>t_proj_union[of A] by auto | |||
qed | |||
hence "fv t \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (unlabel A) \<union> V" | |||
using vars_snd_rcv_strand_subset2(4)[of "unlabel A"] by blast | |||
hence "wf\<^sub>s\<^sub>t V (unlabel A@[Receive t])" by (rule wf_rcv_append'''[OF IH]) | |||
thus ?thesis using b Receive unlabel_append[of A "[a]"] by auto | |||
next | |||
case (Equality ac s t) | |||
have "fv t \<subseteq> wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \<union> V" when "ac = Assign" | |||
proof | |||
fix x assume "x \<in> fv t" | |||
hence "x \<in> V \<union> wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A)" using wf_append_exec[OF *] b Equality that by auto | |||
thus "x \<in> wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \<union> V" using wfvarsoccs\<^sub>s\<^sub>t_proj_union[of A] by auto | |||
qed | |||
hence "fv t \<subseteq> wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t A \<union> V" when "ac = Assign" | |||
using vars_snd_rcv_strand_subset2(4)[of "unlabel A"] that by blast | |||
hence "wf\<^sub>s\<^sub>t V (unlabel A@[Equality ac s t])" | |||
by (cases ac) (metis wf_eq_append'''[OF IH], metis wf_eq_check_append''[OF IH]) | |||
thus ?thesis using b Equality unlabel_append[of A "[a]"] by auto | |||
qed auto | |||
qed simp | |||
end |
@@ -0,0 +1,884 @@ | |||
(* | |||
(C) Copyright Andreas Viktor Hess, DTU, 2015-2020 | |||
All Rights Reserved. | |||
Redistribution and use in source and binary forms, with or without | |||
modification, are permitted provided that the following conditions are | |||
met: | |||
- Redistributions of source code must retain the above copyright | |||
notice, this list of conditions and the following disclaimer. | |||
- Redistributions in binary form must reproduce the above copyright | |||
notice, this list of conditions and the following disclaimer in the | |||
documentation and/or other materials provided with the distribution. | |||
- Neither the name of the copyright holder nor the names of its | |||
contributors may be used to endorse or promote products | |||
derived from this software without specific prior written | |||
permission. | |||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | |||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT | |||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR | |||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT | |||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | |||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT | |||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, | |||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY | |||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | |||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE | |||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | |||
*) | |||
(* Title: Lazy_Intruder.thy | |||
Author: Andreas Viktor Hess, DTU | |||
*) | |||
section \<open>The Lazy Intruder\<close> | |||
theory Lazy_Intruder | |||
imports Strands_and_Constraints Intruder_Deduction | |||
begin | |||
context intruder_model | |||
begin | |||
subsection \<open>Definition of the Lazy Intruder\<close> | |||
text \<open>The lazy intruder constraint reduction system, defined as a relation on constraint states\<close> | |||
inductive_set LI_rel:: | |||
"((('fun,'var) strand \<times> (('fun,'var) subst)) \<times> | |||
('fun,'var) strand \<times> (('fun,'var) subst)) set" | |||
and LI_rel' (infix "\<leadsto>" 50) | |||
and LI_rel_trancl (infix "\<leadsto>\<^sup>+" 50) | |||
and LI_rel_rtrancl (infix "\<leadsto>\<^sup>*" 50) | |||
where | |||
"A \<leadsto> B \<equiv> (A,B) \<in> LI_rel" | |||
| "A \<leadsto>\<^sup>+ B \<equiv> (A,B) \<in> LI_rel\<^sup>+" | |||
| "A \<leadsto>\<^sup>* B \<equiv> (A,B) \<in> LI_rel\<^sup>*" | |||
| Compose: "\<lbrakk>simple S; length T = arity f; public f\<rbrakk> | |||
\<Longrightarrow> (S@Send (Fun f T)#S',\<theta>) \<leadsto> (S@(map Send T)@S',\<theta>)" | |||
| Unify: "\<lbrakk>simple S; Fun f T' \<in> ik\<^sub>s\<^sub>t S; Some \<delta> = mgu (Fun f T) (Fun f T')\<rbrakk> | |||
\<Longrightarrow> (S@Send (Fun f T)#S',\<theta>) \<leadsto> ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta> \<circ>\<^sub>s \<delta>)" | |||
| Equality: "\<lbrakk>simple S; Some \<delta> = mgu t t'\<rbrakk> | |||
\<Longrightarrow> (S@Equality _ t t'#S',\<theta>) \<leadsto> ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta> \<circ>\<^sub>s \<delta>)" | |||
subsection \<open>Lemma: The Lazy Intruder is Well-founded\<close> | |||
context | |||
begin | |||
private lemma LI_compose_measure_lt: "((S@(map Send T)@S',\<theta>\<^sub>1), (S@Send (Fun f T)#S',\<theta>\<^sub>2)) \<in> measure\<^sub>s\<^sub>t" | |||
using strand_fv_card_map_fun_eq[of S f T S'] strand_size_map_fun_lt(2)[of T f] | |||
by (simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def) | |||
private lemma LI_unify_measure_lt: | |||
assumes "Some \<delta> = mgu (Fun f T) t" "fv t \<subseteq> fv\<^sub>s\<^sub>t S" | |||
shows "(((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta>\<^sub>1), (S@Send (Fun f T)#S',\<theta>\<^sub>2)) \<in> measure\<^sub>s\<^sub>t" | |||
proof (cases "\<delta> = Var") | |||
assume "\<delta> = Var" | |||
hence "(S@S') \<cdot>\<^sub>s\<^sub>t \<delta> = S@S'" by blast | |||
thus ?thesis | |||
using strand_fv_card_rm_fun_le[of S S' f T] | |||
by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def) | |||
next | |||
assume "\<delta> \<noteq> Var" | |||
then obtain v where "v \<in> fv (Fun f T) \<union> fv t" "subst_elim \<delta> v" | |||
using mgu_eliminates[OF assms(1)[symmetric]] by metis | |||
hence v_in: "v \<in> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" | |||
using assms(2) by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def) | |||
have "range_vars \<delta> \<subseteq> fv (Fun f T) \<union> fv\<^sub>s\<^sub>t S" | |||
using assms(2) mgu_vars_bounded[OF assms(1)[symmetric]] by auto | |||
hence img_bound: "range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" by auto | |||
have finite_fv: "finite (fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S'))" by auto | |||
have "v \<notin> fv\<^sub>s\<^sub>t ((S@Send (Fun f T)#S') \<cdot>\<^sub>s\<^sub>t \<delta>)" | |||
using strand_fv_subst_subset_if_subst_elim[OF \<open>subst_elim \<delta> v\<close>] v_in by metis | |||
hence v_not_in: "v \<notin> fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)" by auto | |||
have "fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" | |||
using strand_subst_fv_bounded_if_img_bounded[OF img_bound] by simp | |||
hence "fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subset> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" using v_in v_not_in by blast | |||
hence "card (fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)) < card (fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S'))" | |||
using psubset_card_mono[OF finite_fv] by simp | |||
thus ?thesis by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def) | |||
qed | |||
private lemma LI_equality_measure_lt: | |||
assumes "Some \<delta> = mgu t t'" | |||
shows "(((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta>\<^sub>1), (S@Equality a t t'#S',\<theta>\<^sub>2)) \<in> measure\<^sub>s\<^sub>t" | |||
proof (cases "\<delta> = Var") | |||
assume "\<delta> = Var" | |||
hence "(S@S') \<cdot>\<^sub>s\<^sub>t \<delta> = S@S'" by blast | |||
thus ?thesis | |||
using strand_fv_card_rm_eq_le[of S S' a t t'] | |||
by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def) | |||
next | |||
assume "\<delta> \<noteq> Var" | |||
then obtain v where "v \<in> fv t \<union> fv t'" "subst_elim \<delta> v" | |||
using mgu_eliminates[OF assms(1)[symmetric]] by metis | |||
hence v_in: "v \<in> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" using assms by auto | |||
have "range_vars \<delta> \<subseteq> fv t \<union> fv t' \<union> fv\<^sub>s\<^sub>t S" | |||
using assms mgu_vars_bounded[OF assms(1)[symmetric]] by auto | |||
hence img_bound: "range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" by auto | |||
have finite_fv: "finite (fv\<^sub>s\<^sub>t (S@Equality a t t'#S'))" by auto | |||
have "v \<notin> fv\<^sub>s\<^sub>t ((S@Equality a t t'#S') \<cdot>\<^sub>s\<^sub>t \<delta>)" | |||
using strand_fv_subst_subset_if_subst_elim[OF \<open>subst_elim \<delta> v\<close>] v_in by metis | |||
hence v_not_in: "v \<notin> fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)" by auto | |||
have "fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" | |||
using strand_subst_fv_bounded_if_img_bounded[OF img_bound] by simp | |||
hence "fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subset> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" using v_in v_not_in by blast | |||
hence "card (fv\<^sub>s\<^sub>t ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>)) < card (fv\<^sub>s\<^sub>t (S@Equality a t t'#S'))" | |||
using psubset_card_mono[OF finite_fv] by simp | |||
thus ?thesis by (auto simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def) | |||
qed | |||
private lemma LI_in_measure: "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto> (S\<^sub>2,\<theta>\<^sub>2) \<Longrightarrow> ((S\<^sub>2,\<theta>\<^sub>2),(S\<^sub>1,\<theta>\<^sub>1)) \<in> measure\<^sub>s\<^sub>t" | |||
proof (induction rule: LI_rel.induct) | |||
case (Compose S T f S' \<theta>) thus ?case using LI_compose_measure_lt[of S T S'] by metis | |||
next | |||
case (Unify S f U \<delta> T S' \<theta>) | |||
hence "fv (Fun f U) \<subseteq> fv\<^sub>s\<^sub>t S" | |||
using fv_snd_rcv_strand_subset(2)[of S] by force | |||
thus ?case using LI_unify_measure_lt[OF Unify.hyps(3), of S S'] by metis | |||
qed (metis LI_equality_measure_lt) | |||
private lemma LI_in_measure_trans: "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>+ (S\<^sub>2,\<theta>\<^sub>2) \<Longrightarrow> ((S\<^sub>2,\<theta>\<^sub>2),(S\<^sub>1,\<theta>\<^sub>1)) \<in> measure\<^sub>s\<^sub>t" | |||
by (induction rule: trancl.induct, metis surjective_pairing LI_in_measure) | |||
(metis (no_types, lifting) surjective_pairing LI_in_measure measure\<^sub>s\<^sub>t_trans trans_def) | |||
private lemma LI_converse_wellfounded_trans: "wf ((LI_rel\<^sup>+)\<inverse>)" | |||
proof - | |||
have "(LI_rel\<^sup>+)\<inverse> \<subseteq> measure\<^sub>s\<^sub>t" using LI_in_measure_trans by auto | |||
thus ?thesis using measure\<^sub>s\<^sub>t_wellfounded wf_subset by metis | |||
qed | |||
private lemma LI_acyclic_trans: "acyclic (LI_rel\<^sup>+)" | |||
using wf_acyclic[OF LI_converse_wellfounded_trans] acyclic_converse by metis | |||
private lemma LI_acyclic: "acyclic LI_rel" | |||
using LI_acyclic_trans acyclic_subset by (simp add: acyclic_def) | |||
lemma LI_no_infinite_chain: "\<not>(\<exists>f. \<forall>i. f i \<leadsto>\<^sup>+ f (Suc i))" | |||
proof - | |||
have "\<not>(\<exists>f. \<forall>i. (f (Suc i), f i) \<in> (LI_rel\<^sup>+)\<inverse>)" | |||
using wf_iff_no_infinite_down_chain LI_converse_wellfounded_trans by metis | |||
thus ?thesis by simp | |||
qed | |||
private lemma LI_unify_finite: | |||
assumes "finite M" | |||
shows "finite {((S@Send (Fun f T)#S',\<theta>), ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta> \<circ>\<^sub>s \<delta>)) | \<delta> T'. | |||
simple S \<and> Fun f T' \<in> M \<and> Some \<delta> = mgu (Fun f T) (Fun f T')}" | |||
using assms | |||
proof (induction M rule: finite_induct) | |||
case (insert m M) thus ?case | |||
proof (cases m) | |||
case (Fun g U) | |||
let ?a = "\<lambda>\<delta>. ((S@Send (Fun f T)#S',\<theta>), ((S@S') \<cdot>\<^sub>s\<^sub>t \<delta>,\<theta> \<circ>\<^sub>s \<delta>))" | |||
let ?A = "\<lambda>B. {?a \<delta> | \<delta> T'. simple S \<and> Fun f T' \<in> B \<and> Some \<delta> = mgu (Fun f T) (Fun f T')}" | |||
have "?A (insert m M) = (?A M) \<union> (?A {m})" by auto | |||
moreover have "finite (?A {m})" | |||
proof (cases "\<exists>\<delta>. Some \<delta> = mgu (Fun f T) (Fun g U)") | |||
case True | |||
then obtain \<delta> where \<delta>: "Some \<delta> = mgu (Fun f T) (Fun g U)" by blast | |||
have A_m_eq: "\<And>\<delta>'. ?a \<delta>' \<in> ?A {m} \<Longrightarrow> ?a \<delta> = ?a \<delta>'" | |||
proof - | |||
fix \<delta>' assume "?a \<delta>' \<in> ?A {m}" | |||
hence "\<exists>\<sigma>. Some \<sigma> = mgu (Fun f T) (Fun g U) \<and> ?a \<sigma> = ?a \<delta>'" | |||
using \<open>m = Fun g U\<close> by auto | |||
thus "?a \<delta> = ?a \<delta>'" by (metis \<delta> option.inject) | |||
qed | |||
have "?A {m} = {} \<or> ?A {m} = {?a \<delta>}" | |||
proof (cases "simple S \<and> ?A {m} \<noteq> {}") | |||
case True | |||
hence "simple S" "?A {m} \<noteq> {}" by meson+ | |||
hence "?A {m} = {?a \<delta> | \<delta>. Some \<delta> = mgu (Fun f T) (Fun g U)}" using \<open>m = Fun g U\<close> by auto | |||
hence "?a \<delta> \<in> ?A {m}" using \<delta> by auto | |||
show ?thesis | |||
proof (rule ccontr) | |||
assume "\<not>(?A {m} = {} \<or> ?A {m} = {?a \<delta>})" | |||
then obtain B where B: "?A {m} = insert (?a \<delta>) B" "?a \<delta> \<notin> B" "B \<noteq> {}" | |||
using \<open>?A {m} \<noteq> {}\<close> \<open>?a \<delta> \<in> ?A {m}\<close> by (metis (no_types, lifting) Set.set_insert) | |||
then obtain b where b: "?a \<delta> \<noteq> b" "b \<in> B" by (metis (no_types, lifting) ex_in_conv) | |||
then obtain \<delta>' where \<delta>': "b = ?a \<delta>'" using B(1) by blast | |||
moreover have "?a \<delta>' \<in> ?A {m}" using B(1) b(2) \<delta>' by auto | |||
hence "?a \<delta> = ?a \<delta>'" by (blast dest!: A_m_eq) | |||
ultimately show False using b(1) by simp | |||
qed | |||
qed auto | |||
thus ?thesis by (metis (no_types, lifting) finite.emptyI finite_insert) | |||
next | |||
case False | |||
hence "?A {m} = {}" using \<open>m = Fun g U\<close> by blast | |||
thus ?thesis by (metis finite.emptyI) | |||
qed | |||
ultimately show ?thesis using insert.IH by auto | |||
qed simp | |||
qed fastforce | |||
end | |||
subsection \<open>Lemma: The Lazy Intruder Preserves Well-formedness\<close> | |||
context | |||
begin | |||
private lemma LI_preserves_subst_wf_single: | |||
assumes "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto> (S\<^sub>2,\<theta>\<^sub>2)" "fv\<^sub>s\<^sub>t S\<^sub>1 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>1 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<^sub>1" | |||
and "subst_domain \<theta>\<^sub>1 \<inter> vars\<^sub>s\<^sub>t S\<^sub>1 = {}" "range_vars \<theta>\<^sub>1 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>1 = {}" | |||
shows "fv\<^sub>s\<^sub>t S\<^sub>2 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>2 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<^sub>2" | |||
and "subst_domain \<theta>\<^sub>2 \<inter> vars\<^sub>s\<^sub>t S\<^sub>2 = {}" "range_vars \<theta>\<^sub>2 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>2 = {}" | |||
using assms | |||
proof (induction rule: LI_rel.induct) | |||
case (Compose S X f S' \<theta>) | |||
{ case 1 thus ?case using vars_st_snd_map by auto } | |||
{ case 2 thus ?case using vars_st_snd_map by auto } | |||
{ case 3 thus ?case using vars_st_snd_map by force } | |||
{ case 4 thus ?case using vars_st_snd_map by auto } | |||
next | |||
case (Unify S f U \<delta> T S' \<theta>) | |||
hence "fv (Fun f U) \<subseteq> fv\<^sub>s\<^sub>t S" using fv_subset_if_in_strand_ik' by blast | |||
hence *: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" | |||
using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] | |||
unfolding range_vars_alt_def by (fastforce simp del: subst_range.simps) | |||
have "fv\<^sub>s\<^sub>t (S@S') \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" "vars\<^sub>s\<^sub>t (S@S') \<subseteq> vars\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" | |||
by auto | |||
hence **: "fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" | |||
"vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> vars\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" | |||
using subst_sends_strand_fv_to_img[of "S@S'" \<delta>] | |||
strand_subst_vars_union_bound[of "S@S'" \<delta>] * | |||
by blast+ | |||
have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" by (fact mgu_gives_wellformed_subst[OF Unify.hyps(3)[symmetric]]) | |||
{ case 1 | |||
have "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" | |||
using bvars_subst_ident[of "S@S'" \<delta>] by auto | |||
thus ?case using 1 ** by blast | |||
} | |||
{ case 2 | |||
hence "subst_domain \<theta> \<inter> subst_domain \<delta> = {}" "subst_domain \<theta> \<inter> range_vars \<delta> = {}" | |||
using * by blast+ | |||
thus ?case by (metis wf_subst_compose[OF \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>\<close>]) | |||
} | |||
{ case 3 | |||
hence "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using ** by blast | |||
moreover have "v \<in> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" when "v \<in> subst_domain \<delta>" for v | |||
using * that by blast | |||
hence "subst_domain \<delta> \<inter> fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" | |||
using mgu_eliminates_dom[OF Unify.hyps(3)[symmetric], | |||
THEN strand_fv_subst_subset_if_subst_elim, of _ "S@Send (Fun f T)#S'"] | |||
unfolding subst_elim_def by auto | |||
moreover have "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" | |||
using bvars_subst_ident[of "S@S'" \<delta>] by auto | |||
hence "subst_domain \<delta> \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using 3(1) * by blast | |||
ultimately show ?case | |||
using ** * subst_domain_compose[of \<theta> \<delta>] vars\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>t[of "S@S' \<cdot>\<^sub>s\<^sub>t \<delta>"] | |||
by blast | |||
} | |||
{ case 4 | |||
have ***: "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" | |||
using bvars_subst_ident[of "S@S'" \<delta>] by auto | |||
hence "range_vars \<delta> \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using 4(1) * by blast | |||
thus ?case using subst_img_comp_subset[of \<theta> \<delta>] 4(4) *** by blast | |||
} | |||
next | |||
case (Equality S \<delta> t t' a S' \<theta>) | |||
hence *: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" | |||
using mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] | |||
unfolding range_vars_alt_def by fastforce | |||
have "fv\<^sub>s\<^sub>t (S@S') \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" "vars\<^sub>s\<^sub>t (S@S') \<subseteq> vars\<^sub>s\<^sub>t (S@Equality a t t'#S')" | |||
by auto | |||
hence **: "fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" | |||
"vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> vars\<^sub>s\<^sub>t (S@Equality a t t'#S')" | |||
using subst_sends_strand_fv_to_img[of "S@S'" \<delta>] | |||
strand_subst_vars_union_bound[of "S@S'" \<delta>] * | |||
by blast+ | |||
have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" by (fact mgu_gives_wellformed_subst[OF Equality.hyps(2)[symmetric]]) | |||
{ case 1 | |||
have "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Equality a t t'#S')" | |||
using bvars_subst_ident[of "S@S'" \<delta>] by auto | |||
thus ?case using 1 ** by blast | |||
} | |||
{ case 2 | |||
hence "subst_domain \<theta> \<inter> subst_domain \<delta> = {}" "subst_domain \<theta> \<inter> range_vars \<delta> = {}" | |||
using * by blast+ | |||
thus ?case by (metis wf_subst_compose[OF \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>\<close>]) | |||
} | |||
{ case 3 | |||
hence "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using ** by blast | |||
moreover have "v \<in> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" when "v \<in> subst_domain \<delta>" for v | |||
using * that by blast | |||
hence "subst_domain \<delta> \<inter> fv\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" | |||
using mgu_eliminates_dom[OF Equality.hyps(2)[symmetric], | |||
THEN strand_fv_subst_subset_if_subst_elim, of _ "S@Equality a t t'#S'"] | |||
unfolding subst_elim_def by auto | |||
moreover have "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Equality a t t'#S')" | |||
using bvars_subst_ident[of "S@S'" \<delta>] by auto | |||
hence "subst_domain \<delta> \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using 3(1) * by blast | |||
ultimately show ?case | |||
using ** * subst_domain_compose[of \<theta> \<delta>] vars\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>t[of "S@S' \<cdot>\<^sub>s\<^sub>t \<delta>"] | |||
by blast | |||
} | |||
{ case 4 | |||
have ***: "bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = bvars\<^sub>s\<^sub>t (S@Equality a t t'#S')" | |||
using bvars_subst_ident[of "S@S'" \<delta>] by auto | |||
hence "range_vars \<delta> \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" using 4(1) * by blast | |||
thus ?case using subst_img_comp_subset[of \<theta> \<delta>] 4(4) *** by blast | |||
} | |||
qed | |||
private lemma LI_preserves_subst_wf: | |||
assumes "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2)" "fv\<^sub>s\<^sub>t S\<^sub>1 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>1 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<^sub>1" | |||
and "subst_domain \<theta>\<^sub>1 \<inter> vars\<^sub>s\<^sub>t S\<^sub>1 = {}" "range_vars \<theta>\<^sub>1 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>1 = {}" | |||
shows "fv\<^sub>s\<^sub>t S\<^sub>2 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>2 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<^sub>2" | |||
and "subst_domain \<theta>\<^sub>2 \<inter> vars\<^sub>s\<^sub>t S\<^sub>2 = {}" "range_vars \<theta>\<^sub>2 \<inter> bvars\<^sub>s\<^sub>t S\<^sub>2 = {}" | |||
using assms | |||
proof (induction S\<^sub>2 \<theta>\<^sub>2 rule: rtrancl_induct2) | |||
case (step S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j) | |||
{ case 1 thus ?case using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] step.IH by metis } | |||
{ case 2 thus ?case using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] step.IH by metis } | |||
{ case 3 thus ?case using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] step.IH by metis } | |||
{ case 4 thus ?case using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] step.IH by metis } | |||
qed metis | |||
lemma LI_preserves_wellformedness: | |||
assumes "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto>\<^sup>* (S\<^sub>2,\<theta>\<^sub>2)" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1" | |||
shows "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>2 \<theta>\<^sub>2" | |||
proof - | |||
have *: "wf\<^sub>s\<^sub>t {} S\<^sub>j" | |||
when "(S\<^sub>i, \<theta>\<^sub>i) \<leadsto> (S\<^sub>j, \<theta>\<^sub>j)" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>i \<theta>\<^sub>i" for S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j | |||
using that | |||
proof (induction rule: LI_rel.induct) | |||
case (Unify S f U \<delta> T S' \<theta>) | |||
have "fv (Fun f T) \<union> fv (Fun f U) \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" using Unify.hyps(2) by force | |||
hence "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" | |||
using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] by (metis subset_trans) | |||
hence "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t (S@Send (Fun f T)#S') = {}" | |||
using Unify.prems unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by blast | |||
thus ?case | |||
using wf_unify[OF _ Unify.hyps(2) MGU_is_Unifier[OF mgu_gives_MGU], of "{}", | |||
OF _ Unify.hyps(3)[symmetric], of S'] Unify.prems(1) | |||
by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def) | |||
next | |||
case (Equality S \<delta> t t' a S' \<theta>) | |||
have "fv t \<union> fv t' \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" using Equality.hyps(2) by force | |||
hence "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" | |||
using mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] by (metis subset_trans) | |||
hence "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t (S@Equality a t t'#S') = {}" | |||
using Equality.prems unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by blast | |||
thus ?case | |||
using wf_equality[OF _ Equality.hyps(2)[symmetric], of "{}" S a S'] Equality.prems(1) | |||
by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def) | |||
qed (metis wf_send_compose wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def) | |||
show ?thesis using assms | |||
proof (induction rule: rtrancl_induct2) | |||
case (step S\<^sub>i \<theta>\<^sub>i S\<^sub>j \<theta>\<^sub>j) thus ?case | |||
using LI_preserves_subst_wf_single[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] *[OF \<open>(S\<^sub>i,\<theta>\<^sub>i) \<leadsto> (S\<^sub>j,\<theta>\<^sub>j)\<close>] | |||
by (metis wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def) | |||
qed simp | |||
qed | |||
lemma LI_preserves_trm_wf: | |||
assumes "(S,\<theta>) \<leadsto>\<^sup>* (S',\<theta>')" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" | |||
shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')" | |||
proof - | |||
{ fix S \<theta> S' \<theta>' | |||
assume "(S,\<theta>) \<leadsto> (S',\<theta>')" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" | |||
hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')" | |||
proof (induction rule: LI_rel.induct) | |||
case (Compose S T f S' \<theta>) | |||
hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" | |||
and *: "t \<in> set S \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p t)" "t \<in> set S' \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p t)" for t | |||
by auto | |||
hence "wf\<^sub>t\<^sub>r\<^sub>m t" when "t \<in> set T" for t using that unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto | |||
hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p t)" when "t \<in> set (map Send T)" for t | |||
using that unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto | |||
thus ?case using * by force | |||
next | |||
case (Unify S f U \<delta> T S' \<theta>) | |||
have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f U)" | |||
using Unify.prems(1) Unify.hyps(2) wf_trm_subterm[of _ "Fun f U"] | |||
by (simp, force) | |||
hence range_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" | |||
using mgu_wf_trm[OF Unify.hyps(3)[symmetric]] by simp | |||
{ fix s assume "s \<in> set (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)" | |||
hence "\<exists>s' \<in> set (S@S'). s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')" | |||
using Unify.prems(1) by (auto simp add: subst_apply_strand_def) | |||
moreover { | |||
fix s' assume s': "s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')" "s' \<in> set (S@S')" | |||
from s'(2) have "trms\<^sub>s\<^sub>t\<^sub>p (s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = trms\<^sub>s\<^sub>t\<^sub>p s' \<cdot>\<^sub>s\<^sub>e\<^sub>t (rm_vars (set (bvars\<^sub>s\<^sub>t\<^sub>p s')) \<delta>)" | |||
proof (induction s') | |||
case (Inequality X F) thus ?case by (induct F) (auto simp add: subst_apply_pairs_def) | |||
qed auto | |||
hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)" | |||
using wf_trm_subst[OF wf_trms_subst_rm_vars'[OF range_wf]] \<open>wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')\<close> s'(1) | |||
by simp | |||
} | |||
ultimately have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)" by auto | |||
} | |||
thus ?case by auto | |||
next | |||
case (Equality S \<delta> t t' a S' \<theta>) | |||
hence "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" by simp_all | |||
hence range_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" | |||
using mgu_wf_trm[OF Equality.hyps(2)[symmetric]] by simp | |||
{ fix s assume "s \<in> set (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)" | |||
hence "\<exists>s' \<in> set (S@S'). s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')" | |||
using Equality.prems(1) by (auto simp add: subst_apply_strand_def) | |||
moreover { | |||
fix s' assume s': "s = s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')" "s' \<in> set (S@S')" | |||
from s'(2) have "trms\<^sub>s\<^sub>t\<^sub>p (s' \<cdot>\<^sub>s\<^sub>t\<^sub>p \<delta>) = trms\<^sub>s\<^sub>t\<^sub>p s' \<cdot>\<^sub>s\<^sub>e\<^sub>t (rm_vars (set (bvars\<^sub>s\<^sub>t\<^sub>p s')) \<delta>)" | |||
proof (induction s') | |||
case (Inequality X F) thus ?case by (induct F) (auto simp add: subst_apply_pairs_def) | |||
qed auto | |||
hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)" | |||
using wf_trm_subst[OF wf_trms_subst_rm_vars'[OF range_wf]] \<open>wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')\<close> s'(1) | |||
by simp | |||
} | |||
ultimately have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s)" by auto | |||
} | |||
thus ?case by auto | |||
qed | |||
} | |||
with assms show ?thesis by (induction rule: rtrancl_induct2) metis+ | |||
qed | |||
end | |||
subsection \<open>Theorem: Soundness of the Lazy Intruder\<close> | |||
context | |||
begin | |||
private lemma LI_soundness_single: | |||
assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \<theta>\<^sub>1" "(S\<^sub>1,\<theta>\<^sub>1) \<leadsto> (S\<^sub>2,\<theta>\<^sub>2)" "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>2,\<theta>\<^sub>2\<rangle>" | |||
shows "\<I> \<Turnstile>\<^sub>c \<langle>S\<^sub>1,\<theta>\<^sub>1\<rangle>" | |||
using assms(2,1,3) | |||
proof (induction rule: LI_rel.induct) | |||
case (Compose S T f S' \<theta>) | |||
hence *: "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; map Send T\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>" | |||
unfolding constr_sem_c_def by force+ | |||
have "ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c Fun f T \<cdot> \<I>" | |||
using *(2) Compose.hyps(2) ComposeC[OF _ Compose.hyps(3), of "map (\<lambda>x. x \<cdot> \<I>) T"] | |||
unfolding subst_compose_def by force | |||
thus "\<I> \<Turnstile>\<^sub>c \<langle>S@Send (Fun f T)#S',\<theta>\<rangle>" | |||
using *(1,3) \<open>\<I> \<Turnstile>\<^sub>c \<langle>S@map Send T@S',\<theta>\<rangle>\<close> | |||
by (auto simp add: constr_sem_c_def) | |||
next | |||
case (Unify S f U \<delta> T S' \<theta>) | |||
have "(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>" "\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>" | |||
using Unify.prems(2) unfolding constr_sem_c_def by metis+ | |||
then obtain \<sigma> where \<sigma>: "\<theta> \<circ>\<^sub>s \<delta> \<circ>\<^sub>s \<sigma> = \<I>" unfolding subst_compose_def by auto | |||
have \<theta>fun_id: "Fun f U \<cdot> \<theta> = Fun f U" "Fun f T \<cdot> \<theta> = Fun f T" | |||
using Unify.prems(1) trm_subst_ident[of "Fun f U" \<theta>] | |||
fv_subset_if_in_strand_ik[of "Fun f U" S] Unify.hyps(2) | |||
fv_snd_rcv_strand_subset(2)[of S] | |||
strand_vars_split(1)[of S "Send (Fun f T)#S'"] | |||
unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def apply blast | |||
using Unify.prems(1) trm_subst_ident[of "Fun f T" \<theta>] | |||
unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by fastforce | |||
hence \<theta>\<delta>_disj: | |||
"subst_domain \<theta> \<inter> subst_domain \<delta> = {}" | |||
"subst_domain \<theta> \<inter> range_vars \<delta> = {}" | |||
"subst_domain \<theta> \<inter> range_vars \<theta> = {}" | |||
using trm_subst_disj mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] apply (blast,blast) | |||
using Unify.prems(1) unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by blast | |||
hence \<theta>\<delta>_support: "\<theta> supports \<I>" "\<delta> supports \<I>" | |||
by (simp_all add: subst_support_comp_split[OF \<open>(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>\<close>]) | |||
have "fv (Fun f T) \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" "fv (Fun f U) \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" | |||
using Unify.hyps(2) by force+ | |||
hence \<delta>_vars_bound: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" | |||
using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] by blast | |||
have "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; [Send (Fun f T)]\<rbrakk>\<^sub>c \<I>" | |||
proof - | |||
from Unify.hyps(2) have "Fun f U \<cdot> \<I> \<in> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by blast | |||
hence "Fun f U \<cdot> \<I> \<in> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by blast | |||
moreover have "Unifier \<delta> (Fun f T) (Fun f U)" | |||
by (fact MGU_is_Unifier[OF mgu_gives_MGU[OF Unify.hyps(3)[symmetric]]]) | |||
ultimately have "Fun f T \<cdot> \<I> \<in> ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" | |||
using \<sigma> by (metis \<theta>fun_id subst_subst_compose) | |||
thus ?thesis by simp | |||
qed | |||
have "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>" | |||
proof - | |||
have "(S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta> = S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "(S@S') \<cdot>\<^sub>s\<^sub>t \<theta> = S@S'" | |||
proof - | |||
have "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S') = {}" | |||
using Unify.prems(1) by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def) | |||
hence "subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" | |||
using \<theta>\<delta>_disj(2) strand_subst_vars_union_bound[of "S@S'" \<delta>] by blast | |||
thus "(S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>t \<theta> = S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "(S@S') \<cdot>\<^sub>s\<^sub>t \<theta> = S@S'" | |||
using strand_subst_comp \<open>subst_domain \<theta> \<inter> vars\<^sub>s\<^sub>t (S@S') = {}\<close> by (blast,blast) | |||
qed | |||
moreover have "subst_idem \<delta>" by (fact mgu_gives_subst_idem[OF Unify.hyps(3)[symmetric]]) | |||
moreover have | |||
"(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t (S@S') = {}" | |||
"(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> bvars\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>) = {}" | |||
"(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> bvars\<^sub>s\<^sub>t (S@S') = {}" | |||
using wf_constr_bvars_disj[OF Unify.prems(1)] | |||
wf_constr_bvars_disj'[OF Unify.prems(1) \<delta>_vars_bound] | |||
by auto | |||
ultimately have "\<lbrakk>{}; S@S'\<rbrakk>\<^sub>c \<I>" | |||
using \<open>\<lbrakk>{}; S@S' \<cdot>\<^sub>s\<^sub>t \<delta>\<rbrakk>\<^sub>c \<I>\<close> \<sigma> | |||
strand_sem_subst(1)[of \<theta> "S@S' \<cdot>\<^sub>s\<^sub>t \<delta>" "{}" "\<delta> \<circ>\<^sub>s \<sigma>"] | |||
strand_sem_subst(2)[of \<theta> "S@S'" "{}" "\<delta> \<circ>\<^sub>s \<sigma>"] | |||
strand_sem_subst_subst_idem[of \<delta> "S@S'" "{}" \<sigma>] | |||
unfolding constr_sem_c_def | |||
by (metis subst_compose_assoc) | |||
thus "\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>" "\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>" by auto | |||
qed | |||
show "\<I> \<Turnstile>\<^sub>c \<langle>S@Send (Fun f T)#S',\<theta>\<rangle>" | |||
using \<theta>\<delta>_support(1) \<open>\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; [Send (Fun f T)]\<rbrakk>\<^sub>c \<I>\<close> \<open>\<lbrakk>{}; S\<rbrakk>\<^sub>c \<I>\<close> \<open>\<lbrakk>ik\<^sub>s\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>; S'\<rbrakk>\<^sub>c \<I>\<close> | |||