diff --git a/metadata/metadata b/metadata/metadata --- a/metadata/metadata +++ b/metadata/metadata @@ -1,9378 +1,9416 @@ [Arith_Prog_Rel_Primes] title = Arithmetic progressions and relative primes author = José Manuel Rodríguez Caballero topic = Mathematics/Number theory date = 2020-02-01 notify = jose.manuel.rodriguez.caballero@ut.ee abstract = This article provides a formalization of the solution obtained by the author of the Problem “ARITHMETIC PROGRESSIONS” from the Putnam exam problems of 2002. The statement of the problem is as follows: For which integers n > 1 does the set of positive integers less than and relatively prime to n constitute an arithmetic progression? [Banach_Steinhaus] title = Banach-Steinhaus Theorem author = Dominique Unruh , Jose Manuel Rodriguez Caballero topic = Mathematics/Analysis date = 2020-05-02 notify = jose.manuel.rodriguez.caballero@ut.ee, unruh@ut.ee abstract = We formalize in Isabelle/HOL a result due to S. Banach and H. Steinhaus known as the Banach-Steinhaus theorem or Uniform boundedness principle: a pointwise-bounded family of continuous linear operators from a Banach space to a normed space is uniformly bounded. Our approach is an adaptation to Isabelle/HOL of a proof due to A. Sokal. [Complex_Geometry] title = Complex Geometry author = Filip Marić , Danijela Simić topic = Mathematics/Geometry date = 2019-12-16 notify = danijela@matf.bg.ac.rs, filip@matf.bg.ac.rs, boutry@unistra.fr abstract = A formalization of geometry of complex numbers is presented. Fundamental objects that are investigated are the complex plane extended by a single infinite point, its objects (points, lines and circles), and groups of transformations that act on them (e.g., inversions and Möbius transformations). Most objects are defined algebraically, but correspondence with classical geometric definitions is shown. [Poincare_Disc] title = Poincaré Disc Model author = Danijela Simić , Filip Marić , Pierre Boutry topic = Mathematics/Geometry date = 2019-12-16 notify = danijela@matf.bg.ac.rs, filip@matf.bg.ac.rs, boutry@unistra.fr abstract = We describe formalization of the Poincaré disc model of hyperbolic geometry within the Isabelle/HOL proof assistant. The model is defined within the extended complex plane (one dimensional complex projectives space ℂP1), formalized in the AFP entry “Complex Geometry”. Points, lines, congruence of pairs of points, betweenness of triples of points, circles, and isometries are defined within the model. It is shown that the model satisfies all Tarski's axioms except the Euclid's axiom. It is shown that it satisfies its negation and the limiting parallels axiom (which proves it to be a model of hyperbolic geometry). [Fourier] title = Fourier Series author = Lawrence C Paulson topic = Mathematics/Analysis date = 2019-09-06 notify = lp15@cam.ac.uk abstract = This development formalises the square integrable functions over the reals and the basics of Fourier series. It culminates with a proof that every well-behaved periodic function can be approximated by a Fourier series. The material is ported from HOL Light: https://github.com/jrh13/hol-light/blob/master/100/fourier.ml [Generic_Deriving] title = Deriving generic class instances for datatypes author = Jonas Rädle , Lars Hupel topic = Computer science/Data structures date = 2018-11-06 notify = jonas.raedle@gmail.com abstract =

We provide a framework for automatically deriving instances for generic type classes. Our approach is inspired by Haskell's generic-deriving package and Scala's shapeless library. In addition to generating the code for type class functions, we also attempt to automatically prove type class laws for these instances. As of now, however, some manual proofs are still required for recursive datatypes.

Note: There are already articles in the AFP that provide automatic instantiation for a number of classes. Concretely, Deriving allows the automatic instantiation of comparators, linear orders, equality, and hashing. Show instantiates a Haskell-style show class.

Our approach works for arbitrary classes (with some Isabelle/HOL overhead for each class), but a smaller set of datatypes.

[Partial_Order_Reduction] title = Partial Order Reduction author = Julian Brunner topic = Computer science/Automata and formal languages date = 2018-06-05 notify = brunnerj@in.tum.de abstract = This entry provides a formalization of the abstract theory of ample set partial order reduction. The formalization includes transition systems with actions, trace theory, as well as basics on finite, infinite, and lazy sequences. We also provide a basic framework for static analysis on concurrent systems with respect to the ample set condition. [CakeML] title = CakeML author = Lars Hupel , Yu Zhang <> contributors = Johannes Åman Pohjola <> topic = Computer science/Programming languages/Language definitions date = 2018-03-12 notify = hupel@in.tum.de abstract = CakeML is a functional programming language with a proven-correct compiler and runtime system. This entry contains an unofficial version of the CakeML semantics that has been exported from the Lem specifications to Isabelle. Additionally, there are some hand-written theory files that adapt the exported code to Isabelle and port proofs from the HOL4 formalization, e.g. termination and equivalence proofs. [CakeML_Codegen] title = A Verified Code Generator from Isabelle/HOL to CakeML author = Lars Hupel topic = Computer science/Programming languages/Compiling, Logic/Rewriting date = 2019-07-08 notify = lars@hupel.info abstract = This entry contains the formalization that accompanies my PhD thesis (see https://lars.hupel.info/research/codegen/). I develop a verified compilation toolchain from executable specifications in Isabelle/HOL to CakeML abstract syntax trees. This improves over the state-of-the-art in Isabelle by providing a trustworthy procedure for code generation. [DiscretePricing] title = Pricing in discrete financial models author = Mnacho Echenim topic = Mathematics/Probability theory, Mathematics/Games and economics date = 2018-07-16 notify = mnacho.echenim@univ-grenoble-alpes.fr abstract = We have formalized the computation of fair prices for derivative products in discrete financial models. As an application, we derive a way to compute fair prices of derivative products in the Cox-Ross-Rubinstein model of a financial market, thus completing the work that was presented in this paper. extra-history = Change history: [2019-05-12]: Renamed discr_mkt predicate to stk_strict_subs and got rid of predicate A for a more natural definition of the type discrete_market; renamed basic quantity processes for coherent notation; renamed value_process into val_process and closing_value_process to cls_val_process; relaxed hypothesis of lemma CRR_market_fair_price. Added functions to price some basic options. (revision 0b813a1a833f)
[Pell] title = Pell's Equation author = Manuel Eberl topic = Mathematics/Number theory date = 2018-06-23 notify = eberlm@in.tum.de abstract =

This article gives the basic theory of Pell's equation x2 = 1 + D y2, where D ∈ ℕ is a parameter and x, y are integer variables.

The main result that is proven is the following: If D is not a perfect square, then there exists a fundamental solution (x0, y0) that is not the trivial solution (1, 0) and which generates all other solutions (x, y) in the sense that there exists some n ∈ ℕ such that |x| + |y| √D = (x0 + y0 √D)n. This also implies that the set of solutions is infinite, and it gives us an explicit and executable characterisation of all the solutions.

Based on this, simple executable algorithms for computing the fundamental solution and the infinite sequence of all non-negative solutions are also provided.

[WebAssembly] title = WebAssembly author = Conrad Watt topic = Computer science/Programming languages/Language definitions date = 2018-04-29 notify = caw77@cam.ac.uk abstract = This is a mechanised specification of the WebAssembly language, drawn mainly from the previously published paper formalisation of Haas et al. Also included is a full proof of soundness of the type system, together with a verified type checker and interpreter. We include only a partial procedure for the extraction of the type checker and interpreter here. For more details, please see our paper in CPP 2018. [Knuth_Morris_Pratt] title = The string search algorithm by Knuth, Morris and Pratt author = Fabian Hellauer , Peter Lammich topic = Computer science/Algorithms date = 2017-12-18 notify = hellauer@in.tum.de, lammich@in.tum.de abstract = The Knuth-Morris-Pratt algorithm is often used to show that the problem of finding a string s in a text t can be solved deterministically in O(|s| + |t|) time. We use the Isabelle Refinement Framework to formulate and verify the algorithm. Via refinement, we apply some optimisations and finally use the Sepref tool to obtain executable code in Imperative/HOL. [Minkowskis_Theorem] title = Minkowski's Theorem author = Manuel Eberl topic = Mathematics/Geometry, Mathematics/Number theory date = 2017-07-13 notify = eberlm@in.tum.de abstract =

Minkowski's theorem relates a subset of ℝn, the Lebesgue measure, and the integer lattice ℤn: It states that any convex subset of ℝn with volume greater than 2n contains at least one lattice point from ℤn\{0}, i. e. a non-zero point with integer coefficients.

A related theorem which directly implies this is Blichfeldt's theorem, which states that any subset of ℝn with a volume greater than 1 contains two different points whose difference vector has integer components.

The entry contains a proof of both theorems.

[Name_Carrying_Type_Inference] title = Verified Metatheory and Type Inference for a Name-Carrying Simply-Typed Lambda Calculus author = Michael Rawson topic = Computer science/Programming languages/Type systems date = 2017-07-09 notify = mr644@cam.ac.uk, michaelrawson76@gmail.com abstract = I formalise a Church-style simply-typed \(\lambda\)-calculus, extended with pairs, a unit value, and projection functions, and show some metatheory of the calculus, such as the subject reduction property. Particular attention is paid to the treatment of names in the calculus. A nominal style of binding is used, but I use a manual approach over Nominal Isabelle in order to extract an executable type inference algorithm. More information can be found in my undergraduate dissertation. [Propositional_Proof_Systems] title = Propositional Proof Systems author = Julius Michaelis , Tobias Nipkow topic = Logic/Proof theory date = 2017-06-21 notify = maintainafpppt@liftm.de abstract = We formalize a range of proof systems for classical propositional logic (sequent calculus, natural deduction, Hilbert systems, resolution) and prove the most important meta-theoretic results about semantics and proofs: compactness, soundness, completeness, translations between proof systems, cut-elimination, interpolation and model existence. [Optics] title = Optics author = Simon Foster , Frank Zeyda topic = Computer science/Functional programming, Mathematics/Algebra date = 2017-05-25 notify = simon.foster@york.ac.uk abstract = Lenses provide an abstract interface for manipulating data types through spatially-separated views. They are defined abstractly in terms of two functions, get, the return a value from the source type, and put that updates the value. We mechanise the underlying theory of lenses, in terms of an algebraic hierarchy of lenses, including well-behaved and very well-behaved lenses, each lens class being characterised by a set of lens laws. We also mechanise a lens algebra in Isabelle that enables their composition and comparison, so as to allow construction of complex lenses. This is accompanied by a large library of algebraic laws. Moreover we also show how the lens classes can be applied by instantiating them with a number of Isabelle data types. extra-history = Change history: [2020-03-02]: Added partial bijective and symmetric lenses. Improved alphabet command generating additional lenses and results. Several additional lens relations, including observational equivalence. Additional theorems throughout. Adaptations for Isabelle 2020. (revision 44e2e5c) [Game_Based_Crypto] title = Game-based cryptography in HOL author = Andreas Lochbihler , S. Reza Sefidgar <>, Bhargav Bhatt topic = Computer science/Security/Cryptography date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract =

In this AFP entry, we show how to specify game-based cryptographic security notions and formally prove secure several cryptographic constructions from the literature using the CryptHOL framework. Among others, we formalise the notions of a random oracle, a pseudo-random function, an unpredictable function, and of encryption schemes that are indistinguishable under chosen plaintext and/or ciphertext attacks. We prove the random-permutation/random-function switching lemma, security of the Elgamal and hashed Elgamal public-key encryption scheme and correctness and security of several constructions with pseudo-random functions.

Our proofs follow the game-hopping style advocated by Shoup and Bellare and Rogaway, from which most of the examples have been taken. We generalise some of their results such that they can be reused in other proofs. Thanks to CryptHOL's integration with Isabelle's parametricity infrastructure, many simple hops are easily justified using the theory of representation independence.

extra-history = Change history: [2018-09-28]: added the CryptHOL tutorial for game-based cryptography (revision 489a395764ae) [Multi_Party_Computation] title = Multi-Party Computation author = David Aspinall , David Butler topic = Computer science/Security date = 2019-05-09 notify = dbutler@turing.ac.uk abstract = We use CryptHOL to consider Multi-Party Computation (MPC) protocols. MPC was first considered by Yao in 1983 and recent advances in efficiency and an increased demand mean it is now deployed in the real world. Security is considered using the real/ideal world paradigm. We first define security in the semi-honest security setting where parties are assumed not to deviate from the protocol transcript. In this setting we prove multiple Oblivious Transfer (OT) protocols secure and then show security for the gates of the GMW protocol. We then define malicious security, this is a stronger notion of security where parties are assumed to be fully corrupted by an adversary. In this setting we again consider OT, as it is a fundamental building block of almost all MPC protocols. [Sigma_Commit_Crypto] title = Sigma Protocols and Commitment Schemes author = David Butler , Andreas Lochbihler topic = Computer science/Security/Cryptography date = 2019-10-07 notify = dbutler@turing.ac.uk abstract = We use CryptHOL to formalise commitment schemes and Sigma-protocols. Both are widely used fundamental two party cryptographic primitives. Security for commitment schemes is considered using game-based definitions whereas the security of Sigma-protocols is considered using both the game-based and simulation-based security paradigms. In this work, we first define security for both primitives and then prove secure multiple case studies: the Schnorr, Chaum-Pedersen and Okamoto Sigma-protocols as well as a construction that allows for compound (AND and OR statements) Sigma-protocols and the Pedersen and Rivest commitment schemes. We also prove that commitment schemes can be constructed from Sigma-protocols. We formalise this proof at an abstract level, only assuming the existence of a Sigma-protocol; consequently, the instantiations of this result for the concrete Sigma-protocols we consider come for free. [CryptHOL] title = CryptHOL author = Andreas Lochbihler topic = Computer science/Security/Cryptography, Computer science/Functional programming, Mathematics/Probability theory date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract =

CryptHOL provides a framework for formalising cryptographic arguments in Isabelle/HOL. It shallowly embeds a probabilistic functional programming language in higher order logic. The language features monadic sequencing, recursion, random sampling, failures and failure handling, and black-box access to oracles. Oracles are probabilistic functions which maintain hidden state between different invocations. All operators are defined in the new semantic domain of generative probabilistic values, a codatatype. We derive proof rules for the operators and establish a connection with the theory of relational parametricity. Thus, the resuting proofs are trustworthy and comprehensible, and the framework is extensible and widely applicable.

The framework is used in the accompanying AFP entry "Game-based Cryptography in HOL". There, we show-case our framework by formalizing different game-based proofs from the literature. This formalisation continues the work described in the author's ESOP 2016 paper.

[Constructive_Cryptography] title = Constructive Cryptography in HOL author = Andreas Lochbihler , S. Reza Sefidgar<> topic = Computer science/Security/Cryptography, Mathematics/Probability theory date = 2018-12-17 notify = mail@andreas-lochbihler.de, reza.sefidgar@inf.ethz.ch abstract = Inspired by Abstract Cryptography, we extend CryptHOL, a framework for formalizing game-based proofs, with an abstract model of Random Systems and provide proof rules about their composition and equality. This foundation facilitates the formalization of Constructive Cryptography proofs, where the security of a cryptographic scheme is realized as a special form of construction in which a complex random system is built from simpler ones. This is a first step towards a fully-featured compositional framework, similar to Universal Composability framework, that supports formalization of simulation-based proofs. [Probabilistic_While] title = Probabilistic while loop author = Andreas Lochbihler topic = Computer science/Functional programming, Mathematics/Probability theory, Computer science/Algorithms date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = This AFP entry defines a probabilistic while operator based on sub-probability mass functions and formalises zero-one laws and variant rules for probabilistic loop termination. As applications, we implement probabilistic algorithms for the Bernoulli, geometric and arbitrary uniform distributions that only use fair coin flips, and prove them correct and terminating with probability 1. extra-history = Change history: [2018-02-02]: Added a proof that probabilistic conditioning can be implemented by repeated sampling. (revision 305867c4e911)
[Monad_Normalisation] title = Monad normalisation author = Joshua Schneider <>, Manuel Eberl , Andreas Lochbihler topic = Tools, Computer science/Functional programming, Logic/Rewriting date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = The usual monad laws can directly be used as rewrite rules for Isabelle’s simplifier to normalise monadic HOL terms and decide equivalences. In a commutative monad, however, the commutativity law is a higher-order permutative rewrite rule that makes the simplifier loop. This AFP entry implements a simproc that normalises monadic expressions in commutative monads using ordered rewriting. The simproc can also permute computations across control operators like if and case. [Monomorphic_Monad] title = Effect polymorphism in higher-order logic author = Andreas Lochbihler topic = Computer science/Functional programming date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = The notion of a monad cannot be expressed within higher-order logic (HOL) due to type system restrictions. We show that if a monad is used with values of only one type, this notion can be formalised in HOL. Based on this idea, we develop a library of effect specifications and implementations of monads and monad transformers. Hence, we can abstract over the concrete monad in HOL definitions and thus use the same definition for different (combinations of) effects. We illustrate the usefulness of effect polymorphism with a monadic interpreter for a simple language. extra-history = Change history: [2018-02-15]: added further specifications and implementations of non-determinism; more examples (revision bc5399eea78e)
[Constructor_Funs] title = Constructor Functions author = Lars Hupel topic = Tools date = 2017-04-19 notify = hupel@in.tum.de abstract = Isabelle's code generator performs various adaptations for target languages. Among others, constructor applications have to be fully saturated. That means that for constructor calls occuring as arguments to higher-order functions, synthetic lambdas have to be inserted. This entry provides tooling to avoid this construction altogether by introducing constructor functions. [Lazy_Case] title = Lazifying case constants author = Lars Hupel topic = Tools date = 2017-04-18 notify = hupel@in.tum.de abstract = Isabelle's code generator performs various adaptations for target languages. Among others, case statements are printed as match expressions. Internally, this is a sophisticated procedure, because in HOL, case statements are represented as nested calls to the case combinators as generated by the datatype package. Furthermore, the procedure relies on laziness of match expressions in the target language, i.e., that branches guarded by patterns that fail to match are not evaluated. Similarly, if-then-else is printed to the corresponding construct in the target language. This entry provides tooling to replace these special cases in the code generator by ignoring these target language features, instead printing case expressions and if-then-else as functions. [Dict_Construction] title = Dictionary Construction author = Lars Hupel topic = Tools date = 2017-05-24 notify = hupel@in.tum.de abstract = Isabelle's code generator natively supports type classes. For targets that do not have language support for classes and instances, it performs the well-known dictionary translation, as described by Haftmann and Nipkow. This translation happens outside the logic, i.e., there is no guarantee that it is correct, besides the pen-and-paper proof. This work implements a certified dictionary translation that produces new class-free constants and derives equality theorems. [Higher_Order_Terms] title = An Algebra for Higher-Order Terms author = Lars Hupel contributors = Yu Zhang <> topic = Computer science/Programming languages/Lambda calculi date = 2019-01-15 notify = lars@hupel.info abstract = In this formalization, I introduce a higher-order term algebra, generalizing the notions of free variables, matching, and substitution. The need arose from the work on a verified compiler from Isabelle to CakeML. Terms can be thought of as consisting of a generic (free variables, constants, application) and a specific part. As example applications, this entry provides instantiations for de-Bruijn terms, terms with named variables, and Blanchette’s λ-free higher-order terms. Furthermore, I implement translation functions between de-Bruijn terms and named terms and prove their correctness. [Subresultants] title = Subresultants author = Sebastiaan Joosten , René Thiemann , Akihisa Yamada topic = Mathematics/Algebra date = 2017-04-06 notify = rene.thiemann@uibk.ac.at abstract = We formalize the theory of subresultants and the subresultant polynomial remainder sequence as described by Brown and Traub. As a result, we obtain efficient certified algorithms for computing the resultant and the greatest common divisor of polynomials. [Comparison_Sort_Lower_Bound] title = Lower bound on comparison-based sorting algorithms author = Manuel Eberl topic = Computer science/Algorithms date = 2017-03-15 notify = eberlm@in.tum.de abstract =

This article contains a formal proof of the well-known fact that number of comparisons that a comparison-based sorting algorithm needs to perform to sort a list of length n is at least log2 (n!) in the worst case, i. e. Ω(n log n).

For this purpose, a shallow embedding for comparison-based sorting algorithms is defined: a sorting algorithm is a recursive datatype containing either a HOL function or a query of a comparison oracle with a continuation containing the remaining computation. This makes it possible to force the algorithm to use only comparisons and to track the number of comparisons made.

[Quick_Sort_Cost] title = The number of comparisons in QuickSort author = Manuel Eberl topic = Computer science/Algorithms date = 2017-03-15 notify = eberlm@in.tum.de abstract =

We give a formal proof of the well-known results about the number of comparisons performed by two variants of QuickSort: first, the expected number of comparisons of randomised QuickSort (i. e. QuickSort with random pivot choice) is 2 (n+1) Hn - 4 n, which is asymptotically equivalent to 2 n ln n; second, the number of comparisons performed by the classic non-randomised QuickSort has the same distribution in the average case as the randomised one.

[Random_BSTs] title = Expected Shape of Random Binary Search Trees author = Manuel Eberl topic = Computer science/Data structures date = 2017-04-04 notify = eberlm@in.tum.de abstract =

This entry contains proofs for the textbook results about the distributions of the height and internal path length of random binary search trees (BSTs), i. e. BSTs that are formed by taking an empty BST and inserting elements from a fixed set in random order.

In particular, we prove a logarithmic upper bound on the expected height and the Θ(n log n) closed-form solution for the expected internal path length in terms of the harmonic numbers. We also show how the internal path length relates to the average-case cost of a lookup in a BST.

[Randomised_BSTs] title = Randomised Binary Search Trees author = Manuel Eberl topic = Computer science/Data structures date = 2018-10-19 notify = eberlm@in.tum.de abstract =

This work is a formalisation of the Randomised Binary Search Trees introduced by Martínez and Roura, including definitions and correctness proofs.

Like randomised treaps, they are a probabilistic data structure that behaves exactly as if elements were inserted into a non-balancing BST in random order. However, unlike treaps, they only use discrete probability distributions, but their use of randomness is more complicated.

[E_Transcendental] title = The Transcendence of e author = Manuel Eberl topic = Mathematics/Analysis, Mathematics/Number theory date = 2017-01-12 notify = eberlm@in.tum.de abstract =

This work contains a proof that Euler's number e is transcendental. The proof follows the standard approach of assuming that e is algebraic and then using a specific integer polynomial to derive two inconsistent bounds, leading to a contradiction.

This kind of approach can be found in many different sources; this formalisation mostly follows a PlanetMath article by Roger Lipsett.

[Pi_Transcendental] title = The Transcendence of π author = Manuel Eberl topic = Mathematics/Number theory date = 2018-09-28 notify = eberlm@in.tum.de abstract =

This entry shows the transcendence of π based on the classic proof using the fundamental theorem of symmetric polynomials first given by von Lindemann in 1882, but the formalisation mostly follows the version by Niven. The proof reuses much of the machinery developed in the AFP entry on the transcendence of e.

[DFS_Framework] title = A Framework for Verifying Depth-First Search Algorithms author = Peter Lammich , René Neumann notify = lammich@in.tum.de date = 2016-07-05 topic = Computer science/Algorithms/Graph abstract =

This entry presents a framework for the modular verification of DFS-based algorithms, which is described in our [CPP-2015] paper. It provides a generic DFS algorithm framework, that can be parameterized with user-defined actions on certain events (e.g. discovery of new node). It comes with an extensible library of invariants, which can be used to derive invariants of a specific parameterization. Using refinement techniques, efficient implementations of the algorithms can easily be derived. Here, the framework comes with templates for a recursive and a tail-recursive implementation, and also with several templates for implementing the data structures required by the DFS algorithm. Finally, this entry contains a set of re-usable DFS-based algorithms, which illustrate the application of the framework.

[CPP-2015] Peter Lammich, René Neumann: A Framework for Verifying Depth-First Search Algorithms. CPP 2015: 137-146

[Flow_Networks] title = Flow Networks and the Min-Cut-Max-Flow Theorem author = Peter Lammich , S. Reza Sefidgar <> topic = Mathematics/Graph theory date = 2017-06-01 notify = lammich@in.tum.de abstract = We present a formalization of flow networks and the Min-Cut-Max-Flow theorem. Our formal proof closely follows a standard textbook proof, and is accessible even without being an expert in Isabelle/HOL, the interactive theorem prover used for the formalization. [Prpu_Maxflow] title = Formalizing Push-Relabel Algorithms author = Peter Lammich , S. Reza Sefidgar <> topic = Computer science/Algorithms/Graph, Mathematics/Graph theory date = 2017-06-01 notify = lammich@in.tum.de abstract = We present a formalization of push-relabel algorithms for computing the maximum flow in a network. We start with Goldberg's et al.~generic push-relabel algorithm, for which we show correctness and the time complexity bound of O(V^2E). We then derive the relabel-to-front and FIFO implementation. Using stepwise refinement techniques, we derive an efficient verified implementation. Our formal proof of the abstract algorithms closely follows a standard textbook proof. It is accessible even without being an expert in Isabelle/HOL, the interactive theorem prover used for the formalization. [Buildings] title = Chamber Complexes, Coxeter Systems, and Buildings author = Jeremy Sylvestre notify = jeremy.sylvestre@ualberta.ca date = 2016-07-01 topic = Mathematics/Algebra, Mathematics/Geometry abstract = We provide a basic formal framework for the theory of chamber complexes and Coxeter systems, and for buildings as thick chamber complexes endowed with a system of apartments. Along the way, we develop some of the general theory of abstract simplicial complexes and of groups (relying on the group_add class for the basics), including free groups and group presentations, and their universal properties. The main results verified are that the deletion condition is both necessary and sufficient for a group with a set of generators of order two to be a Coxeter system, and that the apartments in a (thick) building are all uniformly Coxeter. [Algebraic_VCs] title = Program Construction and Verification Components Based on Kleene Algebra author = Victor B. F. Gomes , Georg Struth notify = victor.gomes@cl.cam.ac.uk, g.struth@sheffield.ac.uk date = 2016-06-18 topic = Mathematics/Algebra abstract = Variants of Kleene algebra support program construction and verification by algebraic reasoning. This entry provides a verification component for Hoare logic based on Kleene algebra with tests, verification components for weakest preconditions and strongest postconditions based on Kleene algebra with domain and a component for step-wise refinement based on refinement Kleene algebra with tests. In addition to these components for the partial correctness of while programs, a verification component for total correctness based on divergence Kleene algebras and one for (partial correctness) of recursive programs based on domain quantales are provided. Finally we have integrated memory models for programs with pointers and a program trace semantics into the weakest precondition component. [C2KA_DistributedSystems] title = Communicating Concurrent Kleene Algebra for Distributed Systems Specification author = Maxime Buyse , Jason Jaskolka topic = Computer science/Automata and formal languages, Mathematics/Algebra date = 2019-08-06 notify = maxime.buyse@polytechnique.edu, jason.jaskolka@carleton.ca abstract = Communicating Concurrent Kleene Algebra (C²KA) is a mathematical framework for capturing the communicating and concurrent behaviour of agents in distributed systems. It extends Hoare et al.'s Concurrent Kleene Algebra (CKA) with communication actions through the notions of stimuli and shared environments. C²KA has applications in studying system-level properties of distributed systems such as safety, security, and reliability. In this work, we formalize results about C²KA and its application for distributed systems specification. We first formalize the stimulus structure and behaviour structure (CKA). Next, we combine them to formalize C²KA and its properties. Then, we formalize notions and properties related to the topology of distributed systems and the potential for communication via stimuli and via shared environments of agents, all within the algebraic setting of C²KA. [Card_Equiv_Relations] title = Cardinality of Equivalence Relations author = Lukas Bulwahn notify = lukas.bulwahn@gmail.com date = 2016-05-24 topic = Mathematics/Combinatorics abstract = This entry provides formulae for counting the number of equivalence relations and partial equivalence relations over a finite carrier set with given cardinality. To count the number of equivalence relations, we provide bijections between equivalence relations and set partitions, and then transfer the main results of the two AFP entries, Cardinality of Set Partitions and Spivey's Generalized Recurrence for Bell Numbers, to theorems on equivalence relations. To count the number of partial equivalence relations, we observe that counting partial equivalence relations over a set A is equivalent to counting all equivalence relations over all subsets of the set A. From this observation and the results on equivalence relations, we show that the cardinality of partial equivalence relations over a finite set of cardinality n is equal to the n+1-th Bell number. [Twelvefold_Way] title = The Twelvefold Way author = Lukas Bulwahn topic = Mathematics/Combinatorics date = 2016-12-29 notify = lukas.bulwahn@gmail.com abstract = This entry provides all cardinality theorems of the Twelvefold Way. The Twelvefold Way systematically classifies twelve related combinatorial problems concerning two finite sets, which include counting permutations, combinations, multisets, set partitions and number partitions. This development builds upon the existing formal developments with cardinality theorems for those structures. It provides twelve bijections from the various structures to different equivalence classes on finite functions, and hence, proves cardinality formulae for these equivalence classes on finite functions. [Chord_Segments] title = Intersecting Chords Theorem author = Lukas Bulwahn notify = lukas.bulwahn@gmail.com date = 2016-10-11 topic = Mathematics/Geometry abstract = This entry provides a geometric proof of the intersecting chords theorem. The theorem states that when two chords intersect each other inside a circle, the products of their segments are equal. After a short review of existing proofs in the literature, I decided to use a proof approach that employs reasoning about lengths of line segments, the orthogonality of two lines and the Pythagoras Law. Hence, one can understand the formalized proof easily with the knowledge of a few general geometric facts that are commonly taught in high-school. This theorem is the 55th theorem of the Top 100 Theorems list. [Category3] title = Category Theory with Adjunctions and Limits author = Eugene W. Stark notify = stark@cs.stonybrook.edu date = 2016-06-26 topic = Mathematics/Category theory abstract = This article attempts to develop a usable framework for doing category theory in Isabelle/HOL. Our point of view, which to some extent differs from that of the previous AFP articles on the subject, is to try to explore how category theory can be done efficaciously within HOL, rather than trying to match exactly the way things are done using a traditional approach. To this end, we define the notion of category in an "object-free" style, in which a category is represented by a single partial composition operation on arrows. This way of defining categories provides some advantages in the context of HOL, including the ability to avoid the use of records and the possibility of defining functors and natural transformations simply as certain functions on arrows, rather than as composite objects. We define various constructions associated with the basic notions, including: dual category, product category, functor category, discrete category, free category, functor composition, and horizontal and vertical composite of natural transformations. A "set category" locale is defined that axiomatizes the notion "category of all sets at a type and all functions between them," and a fairly extensive set of properties of set categories is derived from the locale assumptions. The notion of a set category is used to prove the Yoneda Lemma in a general setting of a category equipped with a "hom embedding," which maps arrows of the category to the "universe" of the set category. We also give a treatment of adjunctions, defining adjunctions via left and right adjoint functors, natural bijections between hom-sets, and unit and counit natural transformations, and showing the equivalence of these definitions. We also develop the theory of limits, including representations of functors, diagrams and cones, and diagonal functors. We show that right adjoint functors preserve limits, and that limits can be constructed via products and equalizers. We characterize the conditions under which limits exist in a set category. We also examine the case of limits in a functor category, ultimately culminating in a proof that the Yoneda embedding preserves limits. extra-history = Change history: [2018-05-29]: Revised axioms for the category locale. Introduced notation for composition and "in hom". (revision 8318366d4575)
[2020-02-15]: Move ConcreteCategory.thy from Bicategory to Category3 and use it systematically. Make other minor improvements throughout. (revision a51840d36867)
[MonoidalCategory] title = Monoidal Categories author = Eugene W. Stark topic = Mathematics/Category theory date = 2017-05-04 notify = stark@cs.stonybrook.edu abstract = Building on the formalization of basic category theory set out in the author's previous AFP article, the present article formalizes some basic aspects of the theory of monoidal categories. Among the notions defined here are monoidal category, monoidal functor, and equivalence of monoidal categories. The main theorems formalized are MacLane's coherence theorem and the constructions of the free monoidal category and free strict monoidal category generated by a given category. The coherence theorem is proved syntactically, using a structurally recursive approach to reduction of terms that might have some novel aspects. We also give proofs of some results given by Etingof et al, which may prove useful in a formal setting. In particular, we show that the left and right unitors need not be taken as given data in the definition of monoidal category, nor does the definition of monoidal functor need to take as given a specific isomorphism expressing the preservation of the unit object. Our definitions of monoidal category and monoidal functor are stated so as to take advantage of the economy afforded by these facts. extra-history = Change history: [2017-05-18]: Integrated material from MonoidalCategory/Category3Adapter into Category3/ and deleted adapter. (revision 015543cdd069)
[2018-05-29]: Modifications required due to 'Category3' changes. Introduced notation for "in hom". (revision 8318366d4575)
[2020-02-15]: Cosmetic improvements. (revision a51840d36867)
[Card_Multisets] title = Cardinality of Multisets author = Lukas Bulwahn notify = lukas.bulwahn@gmail.com date = 2016-06-26 topic = Mathematics/Combinatorics abstract =

This entry provides three lemmas to count the number of multisets of a given size and finite carrier set. The first lemma provides a cardinality formula assuming that the multiset's elements are chosen from the given carrier set. The latter two lemmas provide formulas assuming that the multiset's elements also cover the given carrier set, i.e., each element of the carrier set occurs in the multiset at least once.

The proof of the first lemma uses the argument of the recurrence relation for counting multisets. The proof of the second lemma is straightforward, and the proof of the third lemma is easily obtained using the first cardinality lemma. A challenge for the formalization is the derivation of the required induction rule, which is a special combination of the induction rules for finite sets and natural numbers. The induction rule is derived by defining a suitable inductive predicate and transforming the predicate's induction rule.

[Posix-Lexing] title = POSIX Lexing with Derivatives of Regular Expressions author = Fahad Ausaf , Roy Dyckhoff , Christian Urban notify = christian.urban@kcl.ac.uk date = 2016-05-24 topic = Computer science/Automata and formal languages abstract = Brzozowski introduced the notion of derivatives for regular expressions. They can be used for a very simple regular expression matching algorithm. Sulzmann and Lu cleverly extended this algorithm in order to deal with POSIX matching, which is the underlying disambiguation strategy for regular expressions needed in lexers. In this entry we give our inductive definition of what a POSIX value is and show (i) that such a value is unique (for given regular expression and string being matched) and (ii) that Sulzmann and Lu's algorithm always generates such a value (provided that the regular expression matches the string). We also prove the correctness of an optimised version of the POSIX matching algorithm. [LocalLexing] title = Local Lexing author = Steven Obua topic = Computer science/Automata and formal languages date = 2017-04-28 notify = steven@recursivemind.com abstract = This formalisation accompanies the paper Local Lexing which introduces a novel parsing concept of the same name. The paper also gives a high-level algorithm for local lexing as an extension of Earley's algorithm. This formalisation proves the algorithm to be correct with respect to its local lexing semantics. As a special case, this formalisation thus also contains a proof of the correctness of Earley's algorithm. The paper contains a short outline of how this formalisation is organised. [MFMC_Countable] title = A Formal Proof of the Max-Flow Min-Cut Theorem for Countable Networks author = Andreas Lochbihler date = 2016-05-09 topic = Mathematics/Graph theory abstract = This article formalises a proof of the maximum-flow minimal-cut theorem for networks with countably many edges. A network is a directed graph with non-negative real-valued edge labels and two dedicated vertices, the source and the sink. A flow in a network assigns non-negative real numbers to the edges such that for all vertices except for the source and the sink, the sum of values on incoming edges equals the sum of values on outgoing edges. A cut is a subset of the vertices which contains the source, but not the sink. Our theorem states that in every network, there is a flow and a cut such that the flow saturates all the edges going out of the cut and is zero on all the incoming edges. The proof is based on the paper The Max-Flow Min-Cut theorem for countable networks by Aharoni et al. Additionally, we prove a characterisation of the lifting operation for relations on discrete probability distributions, which leads to a concise proof of its distributivity over relation composition. notify = mail@andreas-lochbihler.de extra-history = Change history: [2017-09-06]: derive characterisation for the lifting operations on discrete distributions from finite version of the max-flow min-cut theorem (revision a7a198f5bab0)
[Liouville_Numbers] title = Liouville numbers author = Manuel Eberl date = 2015-12-28 topic = Mathematics/Analysis, Mathematics/Number theory abstract =

Liouville numbers are a class of transcendental numbers that can be approximated particularly well with rational numbers. Historically, they were the first numbers whose transcendence was proven.

In this entry, we define the concept of Liouville numbers as well as the standard construction to obtain Liouville numbers (including Liouville's constant) and we prove their most important properties: irrationality and transcendence.

The proof is very elementary and requires only standard arithmetic, the Mean Value Theorem for polynomials, and the boundedness of polynomials on compact intervals.

notify = eberlm@in.tum.de [Triangle] title = Basic Geometric Properties of Triangles author = Manuel Eberl date = 2015-12-28 topic = Mathematics/Geometry abstract =

This entry contains a definition of angles between vectors and between three points. Building on this, we prove basic geometric properties of triangles, such as the Isosceles Triangle Theorem, the Law of Sines and the Law of Cosines, that the sum of the angles of a triangle is π, and the congruence theorems for triangles.

The definitions and proofs were developed following those by John Harrison in HOL Light. However, due to Isabelle's type class system, all definitions and theorems in the Isabelle formalisation hold for all real inner product spaces.

notify = eberlm@in.tum.de [Prime_Harmonic_Series] title = The Divergence of the Prime Harmonic Series author = Manuel Eberl date = 2015-12-28 topic = Mathematics/Number theory abstract =

In this work, we prove the lower bound ln(H_n) - ln(5/3) for the partial sum of the Prime Harmonic series and, based on this, the divergence of the Prime Harmonic Series ∑[p prime] · 1/p.

The proof relies on the unique squarefree decomposition of natural numbers. This is similar to Euler's original proof (which was highly informal and morally questionable). Its advantage over proofs by contradiction, like the famous one by Paul Erdős, is that it provides a relatively good lower bound for the partial sums.

notify = eberlm@in.tum.de [Descartes_Sign_Rule] title = Descartes' Rule of Signs author = Manuel Eberl date = 2015-12-28 topic = Mathematics/Analysis abstract =

Descartes' Rule of Signs relates the number of positive real roots of a polynomial with the number of sign changes in its coefficient sequence.

Our proof follows the simple inductive proof given by Rob Arthan, which was also used by John Harrison in his HOL Light formalisation. We proved most of the lemmas for arbitrary linearly-ordered integrity domains (e.g. integers, rationals, reals); the main result, however, requires the intermediate value theorem and was therefore only proven for real polynomials.

notify = eberlm@in.tum.de [Euler_MacLaurin] title = The Euler–MacLaurin Formula author = Manuel Eberl topic = Mathematics/Analysis date = 2017-03-10 notify = eberlm@in.tum.de abstract =

The Euler-MacLaurin formula relates the value of a discrete sum to that of the corresponding integral in terms of the derivatives at the borders of the summation and a remainder term. Since the remainder term is often very small as the summation bounds grow, this can be used to compute asymptotic expansions for sums.

This entry contains a proof of this formula for functions from the reals to an arbitrary Banach space. Two variants of the formula are given: the standard textbook version and a variant outlined in Concrete Mathematics that is more useful for deriving asymptotic estimates.

As example applications, we use that formula to derive the full asymptotic expansion of the harmonic numbers and the sum of inverse squares.

[Card_Partitions] title = Cardinality of Set Partitions author = Lukas Bulwahn date = 2015-12-12 topic = Mathematics/Combinatorics abstract = The theory's main theorem states that the cardinality of set partitions of size k on a carrier set of size n is expressed by Stirling numbers of the second kind. In Isabelle, Stirling numbers of the second kind are defined in the AFP entry `Discrete Summation` through their well-known recurrence relation. The main theorem relates them to the alternative definition as cardinality of set partitions. The proof follows the simple and short explanation in Richard P. Stanley's `Enumerative Combinatorics: Volume 1` and Wikipedia, and unravels the full details and implicit reasoning steps of these explanations. notify = lukas.bulwahn@gmail.com [Card_Number_Partitions] title = Cardinality of Number Partitions author = Lukas Bulwahn date = 2016-01-14 topic = Mathematics/Combinatorics abstract = This entry provides a basic library for number partitions, defines the two-argument partition function through its recurrence relation and relates this partition function to the cardinality of number partitions. The main proof shows that the recursively-defined partition function with arguments n and k equals the cardinality of number partitions of n with exactly k parts. The combinatorial proof follows the proof sketch of Theorem 2.4.1 in Mazur's textbook `Combinatorics: A Guided Tour`. This entry can serve as starting point for various more intrinsic properties about number partitions, the partition function and related recurrence relations. notify = lukas.bulwahn@gmail.com [Multirelations] title = Binary Multirelations author = Hitoshi Furusawa , Georg Struth date = 2015-06-11 topic = Mathematics/Algebra abstract = Binary multirelations associate elements of a set with its subsets; hence they are binary relations from a set to its power set. Applications include alternating automata, models and logics for games, program semantics with dual demonic and angelic nondeterministic choices and concurrent dynamic logics. This proof document supports an arXiv article that formalises the basic algebra of multirelations and proposes axiom systems for them, ranging from weak bi-monoids to weak bi-quantales. notify = [Noninterference_Generic_Unwinding] title = The Generic Unwinding Theorem for CSP Noninterference Security author = Pasquale Noce date = 2015-06-11 topic = Computer science/Security, Computer science/Concurrency/Process calculi abstract =

The classical definition of noninterference security for a deterministic state machine with outputs requires to consider the outputs produced by machine actions after any trace, i.e. any indefinitely long sequence of actions, of the machine. In order to render the verification of the security of such a machine more straightforward, there is a need of some sufficient condition for security such that just individual actions, rather than unbounded sequences of actions, have to be considered.

By extending previous results applying to transitive noninterference policies, Rushby has proven an unwinding theorem that provides a sufficient condition of this kind in the general case of a possibly intransitive policy. This condition has to be satisfied by a generic function mapping security domains into equivalence relations over machine states.

An analogous problem arises for CSP noninterference security, whose definition requires to consider any possible future, i.e. any indefinitely long sequence of subsequent events and any indefinitely large set of refused events associated to that sequence, for each process trace.

This paper provides a sufficient condition for CSP noninterference security, which indeed requires to just consider individual accepted and refused events and applies to the general case of a possibly intransitive policy. This condition follows Rushby's one for classical noninterference security, and has to be satisfied by a generic function mapping security domains into equivalence relations over process traces; hence its name, Generic Unwinding Theorem. Variants of this theorem applying to deterministic processes and trace set processes are also proven. Finally, the sufficient condition for security expressed by the theorem is shown not to be a necessary condition as well, viz. there exists a secure process such that no domain-relation map satisfying the condition exists.

notify = [Noninterference_Ipurge_Unwinding] title = The Ipurge Unwinding Theorem for CSP Noninterference Security author = Pasquale Noce date = 2015-06-11 topic = Computer science/Security abstract =

The definition of noninterference security for Communicating Sequential Processes requires to consider any possible future, i.e. any indefinitely long sequence of subsequent events and any indefinitely large set of refused events associated to that sequence, for each process trace. In order to render the verification of the security of a process more straightforward, there is a need of some sufficient condition for security such that just individual accepted and refused events, rather than unbounded sequences and sets of events, have to be considered.

Of course, if such a sufficient condition were necessary as well, it would be even more valuable, since it would permit to prove not only that a process is secure by verifying that the condition holds, but also that a process is not secure by verifying that the condition fails to hold.

This paper provides a necessary and sufficient condition for CSP noninterference security, which indeed requires to just consider individual accepted and refused events and applies to the general case of a possibly intransitive policy. This condition follows Rushby's output consistency for deterministic state machines with outputs, and has to be satisfied by a specific function mapping security domains into equivalence relations over process traces. The definition of this function makes use of an intransitive purge function following Rushby's one; hence the name given to the condition, Ipurge Unwinding Theorem.

Furthermore, in accordance with Hoare's formal definition of deterministic processes, it is shown that a process is deterministic just in case it is a trace set process, i.e. it may be identified by means of a trace set alone, matching the set of its traces, in place of a failures-divergences pair. Then, variants of the Ipurge Unwinding Theorem are proven for deterministic processes and trace set processes.

notify = [List_Interleaving] title = Reasoning about Lists via List Interleaving author = Pasquale Noce date = 2015-06-11 topic = Computer science/Data structures abstract =

Among the various mathematical tools introduced in his outstanding work on Communicating Sequential Processes, Hoare has defined "interleaves" as the predicate satisfied by any three lists such that the first list may be split into sublists alternately extracted from the other two ones, whatever is the criterion for extracting an item from either one list or the other in each step.

This paper enriches Hoare's definition by identifying such criterion with the truth value of a predicate taking as inputs the head and the tail of the first list. This enhanced "interleaves" predicate turns out to permit the proof of equalities between lists without the need of an induction. Some rules that allow to infer "interleaves" statements without induction, particularly applying to the addition or removal of a prefix to the input lists, are also proven. Finally, a stronger version of the predicate, named "Interleaves", is shown to fulfil further rules applying to the addition or removal of a suffix to the input lists.

notify = [Residuated_Lattices] title = Residuated Lattices author = Victor B. F. Gomes , Georg Struth date = 2015-04-15 topic = Mathematics/Algebra abstract = The theory of residuated lattices, first proposed by Ward and Dilworth, is formalised in Isabelle/HOL. This includes concepts of residuated functions; their adjoints and conjugates. It also contains necessary and sufficient conditions for the existence of these operations in an arbitrary lattice. The mathematical components for residuated lattices are linked to the AFP entry for relation algebra. In particular, we prove Jonsson and Tsinakis conditions for a residuated boolean algebra to form a relation algebra. notify = g.struth@sheffield.ac.uk [ConcurrentGC] title = Relaxing Safely: Verified On-the-Fly Garbage Collection for x86-TSO author = Peter Gammie , Tony Hosking , Kai Engelhardt <> date = 2015-04-13 topic = Computer science/Algorithms/Concurrent abstract =

We use ConcurrentIMP to model Schism, a state-of-the-art real-time garbage collection scheme for weak memory, and show that it is safe on x86-TSO.

This development accompanies the PLDI 2015 paper of the same name.

notify = peteg42@gmail.com [List_Update] title = Analysis of List Update Algorithms author = Maximilian P.L. Haslbeck , Tobias Nipkow date = 2016-02-17 topic = Computer science/Algorithms/Online abstract =

These theories formalize the quantitative analysis of a number of classical algorithms for the list update problem: 2-competitiveness of move-to-front, the lower bound of 2 for the competitiveness of deterministic list update algorithms and 1.6-competitiveness of the randomized COMB algorithm, the best randomized list update algorithm known to date. The material is based on the first two chapters of Online Computation and Competitive Analysis by Borodin and El-Yaniv.

For an informal description see the FSTTCS 2016 publication Verified Analysis of List Update Algorithms by Haslbeck and Nipkow.

notify = nipkow@in.tum.de [ConcurrentIMP] title = Concurrent IMP author = Peter Gammie date = 2015-04-13 topic = Computer science/Programming languages/Logics abstract = ConcurrentIMP extends the small imperative language IMP with control non-determinism and constructs for synchronous message passing. notify = peteg42@gmail.com [TortoiseHare] title = The Tortoise and Hare Algorithm author = Peter Gammie date = 2015-11-18 topic = Computer science/Algorithms abstract = We formalize the Tortoise and Hare cycle-finding algorithm ascribed to Floyd by Knuth, and an improved version due to Brent. notify = peteg42@gmail.com [UPF] title = The Unified Policy Framework (UPF) author = Achim D. Brucker , Lukas Brügger , Burkhart Wolff date = 2014-11-28 topic = Computer science/Security abstract = We present the Unified Policy Framework (UPF), a generic framework for modelling security (access-control) policies. UPF emphasizes the view that a policy is a policy decision function that grants or denies access to resources, permissions, etc. In other words, instead of modelling the relations of permitted or prohibited requests directly, we model the concrete function that implements the policy decision point in a system. In more detail, UPF is based on the following four principles: 1) Functional representation of policies, 2) No conflicts are possible, 3) Three-valued decision type (allow, deny, undefined), 4) Output type not containing the decision only. notify = adbrucker@0x5f.org, wolff@lri.fr, lukas.a.bruegger@gmail.com [UPF_Firewall] title = Formal Network Models and Their Application to Firewall Policies author = Achim D. Brucker , Lukas Brügger<>, Burkhart Wolff topic = Computer science/Security, Computer science/Networks date = 2017-01-08 notify = adbrucker@0x5f.org abstract = We present a formal model of network protocols and their application to modeling firewall policies. The formalization is based on the Unified Policy Framework (UPF). The formalization was originally developed with for generating test cases for testing the security configuration actual firewall and router (middle-boxes) using HOL-TestGen. Our work focuses on modeling application level protocols on top of tcp/ip. [AODV] title = Loop freedom of the (untimed) AODV routing protocol author = Timothy Bourke , Peter Höfner date = 2014-10-23 topic = Computer science/Concurrency/Process calculi abstract =

The Ad hoc On-demand Distance Vector (AODV) routing protocol allows the nodes in a Mobile Ad hoc Network (MANET) or a Wireless Mesh Network (WMN) to know where to forward data packets. Such a protocol is ‘loop free’ if it never leads to routing decisions that forward packets in circles.

This development mechanises an existing pen-and-paper proof of loop freedom of AODV. The protocol is modelled in the Algebra of Wireless Networks (AWN), which is the subject of an earlier paper and AFP mechanization. The proof relies on a novel compositional approach for lifting invariants to networks of nodes.

We exploit the mechanization to analyse several variants of AODV and show that Isabelle/HOL can re-establish most proof obligations automatically and identify exactly the steps that are no longer valid.

notify = tim@tbrk.org [Show] title = Haskell's Show Class in Isabelle/HOL author = Christian Sternagel , René Thiemann date = 2014-07-29 topic = Computer science/Functional programming license = LGPL abstract = We implemented a type class for "to-string" functions, similar to Haskell's Show class. Moreover, we provide instantiations for Isabelle/HOL's standard types like bool, prod, sum, nats, ints, and rats. It is further possible, to automatically derive show functions for arbitrary user defined datatypes similar to Haskell's "deriving Show". extra-history = Change history: [2015-03-11]: Adapted development to new-style (BNF-based) datatypes.
[2015-04-10]: Moved development for old-style datatypes into subdirectory "Old_Datatype".
notify = christian.sternagel@uibk.ac.at, rene.thiemann@uibk.ac.at [Certification_Monads] title = Certification Monads author = Christian Sternagel , René Thiemann date = 2014-10-03 topic = Computer science/Functional programming abstract = This entry provides several monads intended for the development of stand-alone certifiers via code generation from Isabelle/HOL. More specifically, there are three flavors of error monads (the sum type, for the case where all monadic functions are total; an instance of the former, the so called check monad, yielding either success without any further information or an error message; as well as a variant of the sum type that accommodates partial functions by providing an explicit bottom element) and a parser monad built on top. All of this monads are heavily used in the IsaFoR/CeTA project which thus provides many examples of their usage. notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at [CISC-Kernel] title = Formal Specification of a Generic Separation Kernel author = Freek Verbeek , Sergey Tverdyshev , Oto Havle , Holger Blasum , Bruno Langenstein , Werner Stephan , Yakoub Nemouchi , Abderrahmane Feliachi , Burkhart Wolff , Julien Schmaltz date = 2014-07-18 topic = Computer science/Security abstract =

Intransitive noninterference has been a widely studied topic in the last few decades. Several well-established methodologies apply interactive theorem proving to formulate a noninterference theorem over abstract academic models. In joint work with several industrial and academic partners throughout Europe, we are helping in the certification process of PikeOS, an industrial separation kernel developed at SYSGO. In this process, established theories could not be applied. We present a new generic model of separation kernels and a new theory of intransitive noninterference. The model is rich in detail, making it suitable for formal verification of realistic and industrial systems such as PikeOS. Using a refinement-based theorem proving approach, we ensure that proofs remain manageable.

This document corresponds to the deliverable D31.1 of the EURO-MILS Project http://www.euromils.eu.

notify = [pGCL] title = pGCL for Isabelle author = David Cock date = 2014-07-13 topic = Computer science/Programming languages/Language definitions abstract =

pGCL is both a programming language and a specification language that incorporates both probabilistic and nondeterministic choice, in a unified manner. Program verification is by refinement or annotation (or both), using either Hoare triples, or weakest-precondition entailment, in the style of GCL.

This package provides both a shallow embedding of the language primitives, and an annotation and refinement framework. The generated document includes a brief tutorial.

notify = [Noninterference_CSP] title = Noninterference Security in Communicating Sequential Processes author = Pasquale Noce date = 2014-05-23 topic = Computer science/Security abstract =

An extension of classical noninterference security for deterministic state machines, as introduced by Goguen and Meseguer and elegantly formalized by Rushby, to nondeterministic systems should satisfy two fundamental requirements: it should be based on a mathematically precise theory of nondeterminism, and should be equivalent to (or at least not weaker than) the classical notion in the degenerate deterministic case.

This paper proposes a definition of noninterference security applying to Hoare's Communicating Sequential Processes (CSP) in the general case of a possibly intransitive noninterference policy, and proves the equivalence of this security property to classical noninterference security for processes representing deterministic state machines.

Furthermore, McCullough's generalized noninterference security is shown to be weaker than both the proposed notion of CSP noninterference security for a generic process, and classical noninterference security for processes representing deterministic state machines. This renders CSP noninterference security preferable as an extension of classical noninterference security to nondeterministic systems.

notify = pasquale.noce.lavoro@gmail.com [Floyd_Warshall] title = The Floyd-Warshall Algorithm for Shortest Paths author = Simon Wimmer , Peter Lammich topic = Computer science/Algorithms/Graph date = 2017-05-08 notify = wimmers@in.tum.de abstract = The Floyd-Warshall algorithm [Flo62, Roy59, War62] is a classic dynamic programming algorithm to compute the length of all shortest paths between any two vertices in a graph (i.e. to solve the all-pairs shortest path problem, or APSP for short). Given a representation of the graph as a matrix of weights M, it computes another matrix M' which represents a graph with the same path lengths and contains the length of the shortest path between any two vertices i and j. This is only possible if the graph does not contain any negative cycles. However, in this case the Floyd-Warshall algorithm will detect the situation by calculating a negative diagonal entry. This entry includes a formalization of the algorithm and of these key properties. The algorithm is refined to an efficient imperative version using the Imperative Refinement Framework. [Roy_Floyd_Warshall] title = Transitive closure according to Roy-Floyd-Warshall author = Makarius Wenzel <> date = 2014-05-23 topic = Computer science/Algorithms/Graph abstract = This formulation of the Roy-Floyd-Warshall algorithm for the transitive closure bypasses matrices and arrays, but uses a more direct mathematical model with adjacency functions for immediate predecessors and successors. This can be implemented efficiently in functional programming languages and is particularly adequate for sparse relations. notify = [GPU_Kernel_PL] title = Syntax and semantics of a GPU kernel programming language author = John Wickerson date = 2014-04-03 topic = Computer science/Programming languages/Language definitions abstract = This document accompanies the article "The Design and Implementation of a Verification Technique for GPU Kernels" by Adam Betts, Nathan Chong, Alastair F. Donaldson, Jeroen Ketema, Shaz Qadeer, Paul Thomson and John Wickerson. It formalises all of the definitions provided in Sections 3 and 4 of the article. notify = [AWN] title = Mechanization of the Algebra for Wireless Networks (AWN) author = Timothy Bourke date = 2014-03-08 topic = Computer science/Concurrency/Process calculi abstract =

AWN is a process algebra developed for modelling and analysing protocols for Mobile Ad hoc Networks (MANETs) and Wireless Mesh Networks (WMNs). AWN models comprise five distinct layers: sequential processes, local parallel compositions, nodes, partial networks, and complete networks.

This development mechanises the original operational semantics of AWN and introduces a variant 'open' operational semantics that enables the compositional statement and proof of invariants across distinct network nodes. It supports labels (for weakening invariants) and (abstract) data state manipulations. A framework for compositional invariant proofs is developed, including a tactic (inv_cterms) for inductive invariant proofs of sequential processes, lifting rules for the open versions of the higher layers, and a rule for transferring lifted properties back to the standard semantics. A notion of 'control terms' reduces proof obligations to the subset of subterms that act directly (in contrast to operators for combining terms and joining processes).

notify = tim@tbrk.org [Selection_Heap_Sort] title = Verification of Selection and Heap Sort Using Locales author = Danijela Petrovic date = 2014-02-11 topic = Computer science/Algorithms abstract = Stepwise program refinement techniques can be used to simplify program verification. Programs are better understood since their main properties are clearly stated, and verification of rather complex algorithms is reduced to proving simple statements connecting successive program specifications. Additionally, it is easy to analyze similar algorithms and to compare their properties within a single formalization. Usually, formal analysis is not done in educational setting due to complexity of verification and a lack of tools and procedures to make comparison easy. Verification of an algorithm should not only give correctness proof, but also better understanding of an algorithm. If the verification is based on small step program refinement, it can become simple enough to be demonstrated within the university-level computer science curriculum. In this paper we demonstrate this and give a formal analysis of two well known algorithms (Selection Sort and Heap Sort) using proof assistant Isabelle/HOL and program refinement techniques. notify = [Real_Impl] title = Implementing field extensions of the form Q[sqrt(b)] author = René Thiemann date = 2014-02-06 license = LGPL topic = Mathematics/Analysis abstract = We apply data refinement to implement the real numbers, where we support all numbers in the field extension Q[sqrt(b)], i.e., all numbers of the form p + q * sqrt(b) for rational numbers p and q and some fixed natural number b. To this end, we also developed algorithms to precisely compute roots of a rational number, and to perform a factorization of natural numbers which eliminates duplicate prime factors.

Our results have been used to certify termination proofs which involve polynomial interpretations over the reals. extra-history = Change history: [2014-07-11]: Moved NthRoot_Impl to Sqrt-Babylonian. notify = rene.thiemann@uibk.ac.at [ShortestPath] title = An Axiomatic Characterization of the Single-Source Shortest Path Problem author = Christine Rizkallah date = 2013-05-22 topic = Mathematics/Graph theory abstract = This theory is split into two sections. In the first section, we give a formal proof that a well-known axiomatic characterization of the single-source shortest path problem is correct. Namely, we prove that in a directed graph with a non-negative cost function on the edges the single-source shortest path function is the only function that satisfies a set of four axioms. In the second section, we give a formal proof of the correctness of an axiomatic characterization of the single-source shortest path problem for directed graphs with general cost functions. The axioms here are more involved because we have to account for potential negative cycles in the graph. The axioms are summarized in three Isabelle locales. notify = [Launchbury] title = The Correctness of Launchbury's Natural Semantics for Lazy Evaluation author = Joachim Breitner date = 2013-01-31 topic = Computer science/Programming languages/Lambda calculi, Computer science/Semantics abstract = In his seminal paper "Natural Semantics for Lazy Evaluation", John Launchbury proves his semantics correct with respect to a denotational semantics, and outlines an adequacy proof. We have formalized both semantics and machine-checked the correctness proof, clarifying some details. Furthermore, we provide a new and more direct adequacy proof that does not require intermediate operational semantics. extra-history = Change history: [2014-05-24]: Added the proof of adequacy, as well as simplified and improved the existing proofs. Adjusted abstract accordingly. [2015-03-16]: Booleans and if-then-else added to syntax and semantics, making this entry suitable to be used by the entry "Call_Arity". notify = [Call_Arity] title = The Safety of Call Arity author = Joachim Breitner date = 2015-02-20 topic = Computer science/Programming languages/Transformations abstract = We formalize the Call Arity analysis, as implemented in GHC, and prove both functional correctness and, more interestingly, safety (i.e. the transformation does not increase allocation).

We use syntax and the denotational semantics from the entry "Launchbury", where we formalized Launchbury's natural semantics for lazy evaluation.

The functional correctness of Call Arity is proved with regard to that denotational semantics. The operational properties are shown with regard to a small-step semantics akin to Sestoft's mark 1 machine, which we prove to be equivalent to Launchbury's semantics.

We use Christian Urban's Nominal2 package to define our terms and make use of Brian Huffman's HOLCF package for the domain-theoretical aspects of the development. extra-history = Change history: [2015-03-16]: This entry now builds on top of the Launchbury entry, and the equivalency proof of the natural and the small-step semantics was added. notify = [CCS] title = CCS in nominal logic author = Jesper Bengtson date = 2012-05-29 topic = Computer science/Concurrency/Process calculi abstract = We formalise a large portion of CCS as described in Milner's book 'Communication and Concurrency' using the nominal datatype package in Isabelle. Our results include many of the standard theorems of bisimulation equivalence and congruence, for both weak and strong versions. One main goal of this formalisation is to keep the machine-checked proofs as close to their pen-and-paper counterpart as possible.

This entry is described in detail in Bengtson's thesis. notify = [Pi_Calculus] title = The pi-calculus in nominal logic author = Jesper Bengtson date = 2012-05-29 topic = Computer science/Concurrency/Process calculi abstract = We formalise the pi-calculus using the nominal datatype package, based on ideas from the nominal logic by Pitts et al., and demonstrate an implementation in Isabelle/HOL. The purpose is to derive powerful induction rules for the semantics in order to conduct machine checkable proofs, closely following the intuitive arguments found in manual proofs. In this way we have covered many of the standard theorems of bisimulation equivalence and congruence, both late and early, and both strong and weak in a uniform manner. We thus provide one of the most extensive formalisations of a the pi-calculus ever done inside a theorem prover.

A significant gain in our formulation is that agents are identified up to alpha-equivalence, thereby greatly reducing the arguments about bound names. This is a normal strategy for manual proofs about the pi-calculus, but that kind of hand waving has previously been difficult to incorporate smoothly in an interactive theorem prover. We show how the nominal logic formalism and its support in Isabelle accomplishes this and thus significantly reduces the tedium of conducting completely formal proofs. This improves on previous work using weak higher order abstract syntax since we do not need extra assumptions to filter out exotic terms and can keep all arguments within a familiar first-order logic.

This entry is described in detail in Bengtson's thesis. notify = [Psi_Calculi] title = Psi-calculi in Isabelle author = Jesper Bengtson date = 2012-05-29 topic = Computer science/Concurrency/Process calculi abstract = Psi-calculi are extensions of the pi-calculus, accommodating arbitrary nominal datatypes to represent not only data but also communication channels, assertions and conditions, giving it an expressive power beyond the applied pi-calculus and the concurrent constraint pi-calculus.

We have formalised psi-calculi in the interactive theorem prover Isabelle using its nominal datatype package. One distinctive feature is that the framework needs to treat binding sequences, as opposed to single binders, in an efficient way. While different methods for formalising single binder calculi have been proposed over the last decades, representations for such binding sequences are not very well explored.

The main effort in the formalisation is to keep the machine checked proofs as close to their pen-and-paper counterparts as possible. This includes treating all binding sequences as atomic elements, and creating custom induction and inversion rules that to remove the bulk of manual alpha-conversions.

This entry is described in detail in Bengtson's thesis. notify = [Encodability_Process_Calculi] title = Analysing and Comparing Encodability Criteria for Process Calculi author = Kirstin Peters , Rob van Glabbeek date = 2015-08-10 topic = Computer science/Concurrency/Process calculi abstract = Encodings or the proof of their absence are the main way to compare process calculi. To analyse the quality of encodings and to rule out trivial or meaningless encodings, they are augmented with quality criteria. There exists a bunch of different criteria and different variants of criteria in order to reason in different settings. This leads to incomparable results. Moreover it is not always clear whether the criteria used to obtain a result in a particular setting do indeed fit to this setting. We show how to formally reason about and compare encodability criteria by mapping them on requirements on a relation between source and target terms that is induced by the encoding function. In particular we analyse the common criteria full abstraction, operational correspondence, divergence reflection, success sensitiveness, and respect of barbs; e.g. we analyse the exact nature of the simulation relation (coupled simulation versus bisimulation) that is induced by different variants of operational correspondence. This way we reduce the problem of analysing or comparing encodability criteria to the better understood problem of comparing relations on processes. notify = kirstin.peters@tu-berlin.de [Circus] title = Isabelle/Circus author = Abderrahmane Feliachi , Burkhart Wolff , Marie-Claude Gaudel contributors = Makarius Wenzel date = 2012-05-27 topic = Computer science/Concurrency/Process calculi, Computer science/System description languages abstract = The Circus specification language combines elements for complex data and behavior specifications, using an integration of Z and CSP with a refinement calculus. Its semantics is based on Hoare and He's Unifying Theories of Programming (UTP). Isabelle/Circus is a formalization of the UTP and the Circus language in Isabelle/HOL. It contains proof rules and tactic support that allows for proofs of refinement for Circus processes (involving both data and behavioral aspects).

The Isabelle/Circus environment supports a syntax for the semantic definitions which is close to textbook presentations of Circus. This article contains an extended version of corresponding VSTTE Paper together with the complete formal development of its underlying commented theories. extra-history = Change history: [2014-06-05]: More polishing, shorter proofs, added Circus syntax, added Makarius Wenzel as contributor. notify = [Dijkstra_Shortest_Path] title = Dijkstra's Shortest Path Algorithm author = Benedikt Nordhoff , Peter Lammich topic = Computer science/Algorithms/Graph date = 2012-01-30 abstract = We implement and prove correct Dijkstra's algorithm for the single source shortest path problem, conceived in 1956 by E. Dijkstra. The algorithm is implemented using the data refinement framework for monadic, nondeterministic programs. An efficient implementation is derived using data structures from the Isabelle Collection Framework. notify = lammich@in.tum.de [Refine_Monadic] title = Refinement for Monadic Programs author = Peter Lammich topic = Computer science/Programming languages/Logics date = 2012-01-30 abstract = We provide a framework for program and data refinement in Isabelle/HOL. The framework is based on a nondeterminism-monad with assertions, i.e., the monad carries a set of results or an assertion failure. Recursion is expressed by fixed points. For convenience, we also provide while and foreach combinators.

The framework provides tools to automatize canonical tasks, such as verification condition generation, finding appropriate data refinement relations, and refine an executable program to a form that is accepted by the Isabelle/HOL code generator.

This submission comes with a collection of examples and a user-guide, illustrating the usage of the framework. extra-history = Change history: [2012-04-23] Introduced ordered FOREACH loops
[2012-06] New features: REC_rule_arb and RECT_rule_arb allow for generalizing over variables. prepare_code_thms - command extracts code equations for recursion combinators.
[2012-07] New example: Nested DFS for emptiness check of Buchi-automata with witness.
New feature: fo_rule method to apply resolution using first-order matching. Useful for arg_conf, fun_cong.
[2012-08] Adaptation to ICF v2.
[2012-10-05] Adaptations to include support for Automatic Refinement Framework.
[2013-09] This entry now depends on Automatic Refinement
[2014-06] New feature: vc_solve method to solve verification conditions. Maintenace changes: VCG-rules for nfoldli, improved setup for FOREACH-loops.
[2014-07] Now defining recursion via flat domain. Dropped many single-valued prerequisites. Changed notion of data refinement. In single-valued case, this matches the old notion. In non-single valued case, the new notion allows for more convenient rules. In particular, the new definitions allow for projecting away ghost variables as a refinement step.
[2014-11] New features: le-or-fail relation (leof), modular reasoning about loop invariants. notify = lammich@in.tum.de [Refine_Imperative_HOL] title = The Imperative Refinement Framework author = Peter Lammich notify = lammich@in.tum.de date = 2016-08-08 topic = Computer science/Programming languages/Transformations,Computer science/Data structures abstract = We present the Imperative Refinement Framework (IRF), a tool that supports a stepwise refinement based approach to imperative programs. This entry is based on the material we presented in [ITP-2015, CPP-2016]. It uses the Monadic Refinement Framework as a frontend for the specification of the abstract programs, and Imperative/HOL as a backend to generate executable imperative programs. The IRF comes with tool support to synthesize imperative programs from more abstract, functional ones, using efficient imperative implementations for the abstract data structures. This entry also includes the Imperative Isabelle Collection Framework (IICF), which provides a library of re-usable imperative collection data structures. Moreover, this entry contains a quickstart guide and a reference manual, which provide an introduction to using the IRF for Isabelle/HOL experts. It also provids a collection of (partly commented) practical examples, some highlights being Dijkstra's Algorithm, Nested-DFS, and a generic worklist algorithm with subsumption. Finally, this entry contains benchmark scripts that compare the runtime of some examples against reference implementations of the algorithms in Java and C++. [ITP-2015] Peter Lammich: Refinement to Imperative/HOL. ITP 2015: 253--269 [CPP-2016] Peter Lammich: Refinement based verification of imperative data structures. CPP 2016: 27--36 [Automatic_Refinement] title = Automatic Data Refinement author = Peter Lammich topic = Computer science/Programming languages/Logics date = 2013-10-02 abstract = We present the Autoref tool for Isabelle/HOL, which automatically refines algorithms specified over abstract concepts like maps and sets to algorithms over concrete implementations like red-black-trees, and produces a refinement theorem. It is based on ideas borrowed from relational parametricity due to Reynolds and Wadler. The tool allows for rapid prototyping of verified, executable algorithms. Moreover, it can be configured to fine-tune the result to the user~s needs. Our tool is able to automatically instantiate generic algorithms, which greatly simplifies the implementation of executable data structures.

This AFP-entry provides the basic tool, which is then used by the Refinement and Collection Framework to provide automatic data refinement for the nondeterminism monad and various collection datastructures. notify = lammich@in.tum.de [EdmondsKarp_Maxflow] title = Formalizing the Edmonds-Karp Algorithm author = Peter Lammich , S. Reza Sefidgar<> notify = lammich@in.tum.de date = 2016-08-12 topic = Computer science/Algorithms/Graph abstract = We present a formalization of the Ford-Fulkerson method for computing the maximum flow in a network. Our formal proof closely follows a standard textbook proof, and is accessible even without being an expert in Isabelle/HOL--- the interactive theorem prover used for the formalization. We then use stepwise refinement to obtain the Edmonds-Karp algorithm, and formally prove a bound on its complexity. Further refinement yields a verified implementation, whose execution time compares well to an unverified reference implementation in Java. This entry is based on our ITP-2016 paper with the same title. [VerifyThis2018] title = VerifyThis 2018 - Polished Isabelle Solutions author = Peter Lammich , Simon Wimmer topic = Computer science/Algorithms date = 2018-04-27 notify = lammich@in.tum.de abstract = VerifyThis 2018 was a program verification competition associated with ETAPS 2018. It was the 7th event in the VerifyThis competition series. In this entry, we present polished and completed versions of our solutions that we created during the competition. [PseudoHoops] title = Pseudo Hoops author = George Georgescu <>, Laurentiu Leustean <>, Viorel Preoteasa topic = Mathematics/Algebra date = 2011-09-22 abstract = Pseudo-hoops are algebraic structures introduced by B. Bosbach under the name of complementary semigroups. In this formalization we prove some properties of pseudo-hoops and we define the basic concepts of filter and normal filter. The lattice of normal filters is isomorphic with the lattice of congruences of a pseudo-hoop. We also study some important classes of pseudo-hoops. Bounded Wajsberg pseudo-hoops are equivalent to pseudo-Wajsberg algebras and bounded basic pseudo-hoops are equivalent to pseudo-BL algebras. Some examples of pseudo-hoops are given in the last section of the formalization. notify = viorel.preoteasa@aalto.fi [MonoBoolTranAlgebra] title = Algebra of Monotonic Boolean Transformers author = Viorel Preoteasa topic = Computer science/Programming languages/Logics date = 2011-09-22 abstract = Algebras of imperative programming languages have been successful in reasoning about programs. In general an algebra of programs is an algebraic structure with programs as elements and with program compositions (sequential composition, choice, skip) as algebra operations. Various versions of these algebras were introduced to model partial correctness, total correctness, refinement, demonic choice, and other aspects. We formalize here an algebra which can be used to model total correctness, refinement, demonic and angelic choice. The basic model of this algebra are monotonic Boolean transformers (monotonic functions from a Boolean algebra to itself). notify = viorel.preoteasa@aalto.fi [LatticeProperties] title = Lattice Properties author = Viorel Preoteasa topic = Mathematics/Order date = 2011-09-22 abstract = This formalization introduces and collects some algebraic structures based on lattices and complete lattices for use in other developments. The structures introduced are modular, and lattice ordered groups. In addition to the results proved for the new lattices, this formalization also introduces theorems about latices and complete lattices in general. extra-history = Change history: [2012-01-05]: Removed the theory about distributive complete lattices which is in the standard library now. Added a theory about well founded and transitive relations and a result about fixpoints in complete lattices and well founded relations. Moved the results about conjunctive and disjunctive functions to a new theory. Removed the syntactic classes for inf and sup which are in the standard library now. notify = viorel.preoteasa@aalto.fi [Impossible_Geometry] title = Proving the Impossibility of Trisecting an Angle and Doubling the Cube author = Ralph Romanos , Lawrence C. Paulson topic = Mathematics/Algebra, Mathematics/Geometry date = 2012-08-05 abstract = Squaring the circle, doubling the cube and trisecting an angle, using a compass and straightedge alone, are classic unsolved problems first posed by the ancient Greeks. All three problems were proved to be impossible in the 19th century. The following document presents the proof of the impossibility of solving the latter two problems using Isabelle/HOL, following a proof by Carrega. The proof uses elementary methods: no Galois theory or field extensions. The set of points constructible using a compass and straightedge is defined inductively. Radical expressions, which involve only square roots and arithmetic of rational numbers, are defined, and we find that all constructive points have radical coordinates. Finally, doubling the cube and trisecting certain angles requires solving certain cubic equations that can be proved to have no rational roots. The Isabelle proofs require a great many detailed calculations. notify = ralph.romanos@student.ecp.fr, lp15@cam.ac.uk [IP_Addresses] title = IP Addresses author = Cornelius Diekmann , Julius Michaelis , Lars Hupel notify = diekmann@net.in.tum.de date = 2016-06-28 topic = Computer science/Networks abstract = This entry contains a definition of IP addresses and a library to work with them. Generic IP addresses are modeled as machine words of arbitrary length. Derived from this generic definition, IPv4 addresses are 32bit machine words, IPv6 addresses are 128bit words. Additionally, IPv4 addresses can be represented in dot-decimal notation and IPv6 addresses in (compressed) colon-separated notation. We support toString functions and parsers for both notations. Sets of IP addresses can be represented with a netmask (e.g. 192.168.0.0/255.255.0.0) or in CIDR notation (e.g. 192.168.0.0/16). To provide executable code for set operations on IP address ranges, the library includes a datatype to work on arbitrary intervals of machine words. [Simple_Firewall] title = Simple Firewall author = Cornelius Diekmann , Julius Michaelis , Maximilian Haslbeck notify = diekmann@net.in.tum.de, max.haslbeck@gmx.de date = 2016-08-24 topic = Computer science/Networks abstract = We present a simple model of a firewall. The firewall can accept or drop a packet and can match on interfaces, IP addresses, protocol, and ports. It was designed to feature nice mathematical properties: The type of match expressions was carefully crafted such that the conjunction of two match expressions is only one match expression. This model is too simplistic to mirror all aspects of the real world. In the upcoming entry "Iptables Semantics", we will translate the Linux firewall iptables to this model. For a fixed service (e.g. ssh, http), we provide an algorithm to compute an overview of the firewall's filtering behavior. The algorithm computes minimal service matrices, i.e. graphs which partition the complete IPv4 and IPv6 address space and visualize the allowed accesses between partitions. For a detailed description, see Verified iptables Firewall Analysis, IFIP Networking 2016. [Iptables_Semantics] title = Iptables Semantics author = Cornelius Diekmann , Lars Hupel notify = diekmann@net.in.tum.de, hupel@in.tum.de date = 2016-09-09 topic = Computer science/Networks abstract = We present a big step semantics of the filtering behavior of the Linux/netfilter iptables firewall. We provide algorithms to simplify complex iptables rulests to a simple firewall model (c.f. AFP entry Simple_Firewall) and to verify spoofing protection of a ruleset. Internally, we embed our semantics into ternary logic, ultimately supporting every iptables match condition by abstracting over unknowns. Using this AFP entry and all entries it depends on, we created an easy-to-use, stand-alone haskell tool called fffuu. The tool does not require any input —except for the iptables-save dump of the analyzed firewall— and presents interesting results about the user's ruleset. Real-Word firewall errors have been uncovered, and the correctness of rulesets has been proved, with the help of our tool. [Routing] title = Routing author = Julius Michaelis , Cornelius Diekmann notify = afp@liftm.de date = 2016-08-31 topic = Computer science/Networks abstract = This entry contains definitions for routing with routing tables/longest prefix matching. A routing table entry is modelled as a record of a prefix match, a metric, an output port, and an optional next hop. A routing table is a list of entries, sorted by prefix length and metric. Additionally, a parser and serializer for the output of the ip-route command, a function to create a relation from output port to corresponding destination IP space, and a model of a Linux-style router are included. [KBPs] title = Knowledge-based programs author = Peter Gammie topic = Computer science/Automata and formal languages date = 2011-05-17 abstract = Knowledge-based programs (KBPs) are a formalism for directly relating agents' knowledge and behaviour. Here we present a general scheme for compiling KBPs to executable automata with a proof of correctness in Isabelle/HOL. We develop the algorithm top-down, using Isabelle's locale mechanism to structure these proofs, and show that two classic examples can be synthesised using Isabelle's code generator. extra-history = Change history: [2012-03-06]: Add some more views and revive the code generation. notify = kleing@cse.unsw.edu.au [Tarskis_Geometry] title = The independence of Tarski's Euclidean axiom author = T. J. M. Makarios topic = Mathematics/Geometry date = 2012-10-30 abstract = Tarski's axioms of plane geometry are formalized and, using the standard real Cartesian model, shown to be consistent. A substantial theory of the projective plane is developed. Building on this theory, the Klein-Beltrami model of the hyperbolic plane is defined and shown to satisfy all of Tarski's axioms except his Euclidean axiom; thus Tarski's Euclidean axiom is shown to be independent of his other axioms of plane geometry.

An earlier version of this work was the subject of the author's MSc thesis, which contains natural-language explanations of some of the more interesting proofs. notify = tjm1983@gmail.com [General-Triangle] title = The General Triangle Is Unique author = Joachim Breitner topic = Mathematics/Geometry date = 2011-04-01 abstract = Some acute-angled triangles are special, e.g. right-angled or isoscele triangles. Some are not of this kind, but, without measuring angles, look as if they were. In that sense, there is exactly one general triangle. This well-known fact is proven here formally. notify = mail@joachim-breitner.de [LightweightJava] title = Lightweight Java author = Rok Strniša , Matthew Parkinson topic = Computer science/Programming languages/Language definitions date = 2011-02-07 abstract = A fully-formalized and extensible minimal imperative fragment of Java. notify = rok@strnisa.com [Lower_Semicontinuous] title = Lower Semicontinuous Functions author = Bogdan Grechuk topic = Mathematics/Analysis date = 2011-01-08 abstract = We define the notions of lower and upper semicontinuity for functions from a metric space to the extended real line. We prove that a function is both lower and upper semicontinuous if and only if it is continuous. We also give several equivalent characterizations of lower semicontinuity. In particular, we prove that a function is lower semicontinuous if and only if its epigraph is a closed set. Also, we introduce the notion of the lower semicontinuous hull of an arbitrary function and prove its basic properties. notify = hoelzl@in.tum.de [RIPEMD-160-SPARK] title = RIPEMD-160 author = Fabian Immler topic = Computer science/Programming languages/Static analysis date = 2011-01-10 abstract = This work presents a verification of an implementation in SPARK/ADA of the cryptographic hash-function RIPEMD-160. A functional specification of RIPEMD-160 is given in Isabelle/HOL. Proofs for the verification conditions generated by the static-analysis toolset of SPARK certify the functional correctness of the implementation. extra-history = Change history: [2015-11-09]: Entry is now obsolete, moved to Isabelle distribution. notify = immler@in.tum.de [Regular-Sets] title = Regular Sets and Expressions author = Alexander Krauss , Tobias Nipkow contributors = Manuel Eberl topic = Computer science/Automata and formal languages date = 2010-05-12 abstract = This is a library of constructions on regular expressions and languages. It provides the operations of concatenation, Kleene star and derivative on languages. Regular expressions and their meaning are defined. An executable equivalence checker for regular expressions is verified; it does not need automata but works directly on regular expressions. By mapping regular expressions to binary relations, an automatic and complete proof method for (in)equalities of binary relations over union, concatenation and (reflexive) transitive closure is obtained.

Extended regular expressions with complement and intersection are also defined and an equivalence checker is provided. extra-history = Change history: [2011-08-26]: Christian Urban added a theory about derivatives and partial derivatives of regular expressions
[2012-05-10]: Tobias Nipkow added extended regular expressions
[2012-05-10]: Tobias Nipkow added equivalence checking with partial derivatives notify = nipkow@in.tum.de, krauss@in.tum.de, christian.urban@kcl.ac.uk [Regex_Equivalence] title = Unified Decision Procedures for Regular Expression Equivalence author = Tobias Nipkow , Dmitriy Traytel topic = Computer science/Automata and formal languages date = 2014-01-30 abstract = We formalize a unified framework for verified decision procedures for regular expression equivalence. Five recently published formalizations of such decision procedures (three based on derivatives, two on marked regular expressions) can be obtained as instances of the framework. We discover that the two approaches based on marked regular expressions, which were previously thought to be the same, are different, and one seems to produce uniformly smaller automata. The common framework makes it possible to compare the performance of the different decision procedures in a meaningful way. The formalization is described in a paper of the same name presented at Interactive Theorem Proving 2014. notify = nipkow@in.tum.de, traytel@in.tum.de [MSO_Regex_Equivalence] title = Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions author = Dmitriy Traytel , Tobias Nipkow topic = Computer science/Automata and formal languages, Logic/General logic/Decidability of theories date = 2014-06-12 abstract = Monadic second-order logic on finite words (MSO) is a decidable yet expressive logic into which many decision problems can be encoded. Since MSO formulas correspond to regular languages, equivalence of MSO formulas can be reduced to the equivalence of some regular structures (e.g. automata). We verify an executable decision procedure for MSO formulas that is not based on automata but on regular expressions.

Decision procedures for regular expression equivalence have been formalized before, usually based on Brzozowski derivatives. Yet, for a straightforward embedding of MSO formulas into regular expressions an extension of regular expressions with a projection operation is required. We prove total correctness and completeness of an equivalence checker for regular expressions extended in that way. We also define a language-preserving translation of formulas into regular expressions with respect to two different semantics of MSO.

The formalization is described in this ICFP 2013 functional pearl. notify = traytel@in.tum.de, nipkow@in.tum.de [Formula_Derivatives] title = Derivatives of Logical Formulas author = Dmitriy Traytel topic = Computer science/Automata and formal languages, Logic/General logic/Decidability of theories date = 2015-05-28 abstract = We formalize new decision procedures for WS1S, M2L(Str), and Presburger Arithmetics. Formulas of these logics denote regular languages. Unlike traditional decision procedures, we do not translate formulas into automata (nor into regular expressions), at least not explicitly. Instead we devise notions of derivatives (inspired by Brzozowski derivatives for regular expressions) that operate on formulas directly and compute a syntactic bisimulation using these derivatives. The treatment of Boolean connectives and quantifiers is uniform for all mentioned logics and is abstracted into a locale. This locale is then instantiated by different atomic formulas and their derivatives (which may differ even for the same logic under different encodings of interpretations as formal words).

The WS1S instance is described in the draft paper A Coalgebraic Decision Procedure for WS1S by the author. notify = traytel@in.tum.de [Myhill-Nerode] title = The Myhill-Nerode Theorem Based on Regular Expressions author = Chunhan Wu <>, Xingyuan Zhang <>, Christian Urban contributors = Manuel Eberl topic = Computer science/Automata and formal languages date = 2011-08-26 abstract = There are many proofs of the Myhill-Nerode theorem using automata. In this library we give a proof entirely based on regular expressions, since regularity of languages can be conveniently defined using regular expressions (it is more painful in HOL to define regularity in terms of automata). We prove the first direction of the Myhill-Nerode theorem by solving equational systems that involve regular expressions. For the second direction we give two proofs: one using tagging-functions and another using partial derivatives. We also establish various closure properties of regular languages. Most details of the theories are described in our ITP 2011 paper. notify = christian.urban@kcl.ac.uk [Universal_Turing_Machine] title = Universal Turing Machine author = Jian Xu<>, Xingyuan Zhang<>, Christian Urban , Sebastiaan J. C. Joosten topic = Logic/Computability, Computer science/Automata and formal languages date = 2019-02-08 notify = sjcjoosten@gmail.com, christian.urban@kcl.ac.uk abstract = We formalise results from computability theory: recursive functions, undecidability of the halting problem, and the existence of a universal Turing machine. This formalisation is the AFP entry corresponding to the paper Mechanising Turing Machines and Computability Theory in Isabelle/HOL, ITP 2013. [CYK] title = A formalisation of the Cocke-Younger-Kasami algorithm author = Maksym Bortin date = 2016-04-27 topic = Computer science/Algorithms, Computer science/Automata and formal languages abstract = The theory provides a formalisation of the Cocke-Younger-Kasami algorithm (CYK for short), an approach to solving the word problem for context-free languages. CYK decides if a word is in the languages generated by a context-free grammar in Chomsky normal form. The formalized algorithm is executable. notify = maksym.bortin@nicta.com.au [Boolean_Expression_Checkers] title = Boolean Expression Checkers author = Tobias Nipkow date = 2014-06-08 topic = Computer science/Algorithms, Logic/General logic/Mechanization of proofs abstract = This entry provides executable checkers for the following properties of boolean expressions: satisfiability, tautology and equivalence. Internally, the checkers operate on binary decision trees and are reasonably efficient (for purely functional algorithms). extra-history = Change history: [2015-09-23]: Salomon Sickert added an interface that does not require the usage of the Boolean formula datatype. Furthermore the general Mapping type is used instead of an association list. notify = nipkow@in.tum.de [Presburger-Automata] title = Formalizing the Logic-Automaton Connection author = Stefan Berghofer , Markus Reiter <> date = 2009-12-03 topic = Computer science/Automata and formal languages, Logic/General logic/Decidability of theories abstract = This work presents a formalization of a library for automata on bit strings. It forms the basis of a reflection-based decision procedure for Presburger arithmetic, which is efficiently executable thanks to Isabelle's code generator. With this work, we therefore provide a mechanized proof of a well-known connection between logic and automata theory. The formalization is also described in a publication [TPHOLs 2009]. notify = berghofe@in.tum.de [Functional-Automata] title = Functional Automata author = Tobias Nipkow date = 2004-03-30 topic = Computer science/Automata and formal languages abstract = This theory defines deterministic and nondeterministic automata in a functional representation: the transition function/relation and the finality predicate are just functions. Hence the state space may be infinite. It is shown how to convert regular expressions into such automata. A scanner (generator) is implemented with the help of functional automata: the scanner chops the input up into longest recognized substrings. Finally we also show how to convert a certain subclass of functional automata (essentially the finite deterministic ones) into regular sets. notify = nipkow@in.tum.de [Statecharts] title = Formalizing Statecharts using Hierarchical Automata author = Steffen Helke , Florian Kammüller topic = Computer science/Automata and formal languages date = 2010-08-08 abstract = We formalize in Isabelle/HOL the abtract syntax and a synchronous step semantics for the specification language Statecharts. The formalization is based on Hierarchical Automata which allow a structural decomposition of Statecharts into Sequential Automata. To support the composition of Statecharts, we introduce calculating operators to construct a Hierarchical Automaton in a stepwise manner. Furthermore, we present a complete semantics of Statecharts including a theory of data spaces, which enables the modelling of racing effects. We also adapt CTL for Statecharts to build a bridge for future combinations with model checking. However the main motivation of this work is to provide a sound and complete basis for reasoning on Statecharts. As a central meta theorem we prove that the well-formedness of a Statechart is preserved by the semantics. notify = nipkow@in.tum.de [Stuttering_Equivalence] title = Stuttering Equivalence author = Stephan Merz topic = Computer science/Automata and formal languages date = 2012-05-07 abstract =

Two omega-sequences are stuttering equivalent if they differ only by finite repetitions of elements. Stuttering equivalence is a fundamental concept in the theory of concurrent and distributed systems. Notably, Lamport argues that refinement notions for such systems should be insensitive to finite stuttering. Peled and Wilke showed that all PLTL (propositional linear-time temporal logic) properties that are insensitive to stuttering equivalence can be expressed without the next-time operator. Stuttering equivalence is also important for certain verification techniques such as partial-order reduction for model checking.

We formalize stuttering equivalence in Isabelle/HOL. Our development relies on the notion of stuttering sampling functions that may skip blocks of identical sequence elements. We also encode PLTL and prove the theorem due to Peled and Wilke.

extra-history = Change history: [2013-01-31]: Added encoding of PLTL and proved Peled and Wilke's theorem. Adjusted abstract accordingly. notify = Stephan.Merz@loria.fr [Coinductive_Languages] title = A Codatatype of Formal Languages author = Dmitriy Traytel topic = Computer science/Automata and formal languages date = 2013-11-15 abstract =

We define formal languages as a codataype of infinite trees branching over the alphabet. Each node in such a tree indicates whether the path to this node constitutes a word inside or outside of the language. This codatatype is isormorphic to the set of lists representation of languages, but caters for definitions by corecursion and proofs by coinduction.

Regular operations on languages are then defined by primitive corecursion. A difficulty arises here, since the standard definitions of concatenation and iteration from the coalgebraic literature are not primitively corecursive-they require guardedness up-to union/concatenation. Without support for up-to corecursion, these operation must be defined as a composition of primitive ones (and proved being equal to the standard definitions). As an exercise in coinduction we also prove the axioms of Kleene algebra for the defined regular operations.

Furthermore, a language for context-free grammars given by productions in Greibach normal form and an initial nonterminal is constructed by primitive corecursion, yielding an executable decision procedure for the word problem without further ado.

notify = traytel@in.tum.de [Tree-Automata] title = Tree Automata author = Peter Lammich date = 2009-11-25 topic = Computer science/Automata and formal languages abstract = This work presents a machine-checked tree automata library for Standard-ML, OCaml and Haskell. The algorithms are efficient by using appropriate data structures like RB-trees. The available algorithms for non-deterministic automata include membership query, reduction, intersection, union, and emptiness check with computation of a witness for non-emptiness. The executable algorithms are derived from less-concrete, non-executable algorithms using data-refinement techniques. The concrete data structures are from the Isabelle Collections Framework. Moreover, this work contains a formalization of the class of tree-regular languages and its closure properties under set operations. notify = peter.lammich@uni-muenster.de, nipkow@in.tum.de [Depth-First-Search] title = Depth First Search author = Toshiaki Nishihara <>, Yasuhiko Minamide <> date = 2004-06-24 topic = Computer science/Algorithms/Graph abstract = Depth-first search of a graph is formalized with recdef. It is shown that it visits all of the reachable nodes from a given list of nodes. Executable ML code of depth-first search is obtained using the code generation feature of Isabelle/HOL. notify = lp15@cam.ac.uk, krauss@in.tum.de [FFT] title = Fast Fourier Transform author = Clemens Ballarin date = 2005-10-12 topic = Computer science/Algorithms/Mathematical abstract = We formalise a functional implementation of the FFT algorithm over the complex numbers, and its inverse. Both are shown equivalent to the usual definitions of these operations through Vandermonde matrices. They are also shown to be inverse to each other, more precisely, that composition of the inverse and the transformation yield the identity up to a scalar. notify = ballarin@in.tum.de [Gauss-Jordan-Elim-Fun] title = Gauss-Jordan Elimination for Matrices Represented as Functions author = Tobias Nipkow date = 2011-08-19 topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra abstract = This theory provides a compact formulation of Gauss-Jordan elimination for matrices represented as functions. Its distinctive feature is succinctness. It is not meant for large computations. notify = nipkow@in.tum.de [UpDown_Scheme] title = Verification of the UpDown Scheme author = Johannes Hölzl date = 2015-01-28 topic = Computer science/Algorithms/Mathematical abstract = The UpDown scheme is a recursive scheme used to compute the stiffness matrix on a special form of sparse grids. Usually, when discretizing a Euclidean space of dimension d we need O(n^d) points, for n points along each dimension. Sparse grids are a hierarchical representation where the number of points is reduced to O(n * log(n)^d). One disadvantage of such sparse grids is that the algorithm now operate recursively in the dimensions and levels of the sparse grid.

The UpDown scheme allows us to compute the stiffness matrix on such a sparse grid. The stiffness matrix represents the influence of each representation function on the L^2 scalar product. For a detailed description see Dirk Pflüger's PhD thesis. This formalization was developed as an interdisciplinary project (IDP) at the Technische Universität München. notify = hoelzl@in.tum.de [GraphMarkingIBP] title = Verification of the Deutsch-Schorr-Waite Graph Marking Algorithm using Data Refinement author = Viorel Preoteasa , Ralph-Johan Back date = 2010-05-28 topic = Computer science/Algorithms/Graph abstract = The verification of the Deutsch-Schorr-Waite graph marking algorithm is used as a benchmark in many formalizations of pointer programs. The main purpose of this mechanization is to show how data refinement of invariant based programs can be used in verifying practical algorithms. The verification starts with an abstract algorithm working on a graph given by a relation next on nodes. Gradually the abstract program is refined into Deutsch-Schorr-Waite graph marking algorithm where only one bit per graph node of additional memory is used for marking. extra-history = Change history: [2012-01-05]: Updated for the new definition of data refinement and the new syntax for demonic and angelic update statements notify = viorel.preoteasa@aalto.fi [Efficient-Mergesort] title = Efficient Mergesort topic = Computer science/Algorithms date = 2011-11-09 author = Christian Sternagel abstract = We provide a formalization of the mergesort algorithm as used in GHC's Data.List module, proving correctness and stability. Furthermore, experimental data suggests that generated (Haskell-)code for this algorithm is much faster than for previous algorithms available in the Isabelle distribution. extra-history = Change history: [2012-10-24]: Added reference to journal article.
[2018-09-17]: Added theory Efficient_Mergesort that works exclusively with the mutual induction schemas generated by the function package.
[2018-09-19]: Added theory Mergesort_Complexity that proves an upper bound on the number of comparisons that are required by mergesort.
[2018-09-19]: Theory Efficient_Mergesort replaces theory Efficient_Sort but keeping the old name Efficient_Sort. notify = c.sternagel@gmail.com [SATSolverVerification] title = Formal Verification of Modern SAT Solvers author = Filip Marić date = 2008-07-23 topic = Computer science/Algorithms abstract = This document contains formal correctness proofs of modern SAT solvers. Following (Krstic et al, 2007) and (Nieuwenhuis et al., 2006), solvers are described using state-transition systems. Several different SAT solver descriptions are given and their partial correctness and termination is proved. These include:

  • a solver based on classical DPLL procedure (using only a backtrack-search with unit propagation),
  • a very general solver with backjumping and learning (similar to the description given in (Nieuwenhuis et al., 2006)), and
  • a solver with a specific conflict analysis algorithm (similar to the description given in (Krstic et al., 2007)).
Within the SAT solver correctness proofs, a large number of lemmas about propositional logic and CNF formulae are proved. This theory is self-contained and could be used for further exploring of properties of CNF based SAT algorithms. notify = [Transitive-Closure] title = Executable Transitive Closures of Finite Relations topic = Computer science/Algorithms/Graph date = 2011-03-14 author = Christian Sternagel , René Thiemann license = LGPL abstract = We provide a generic work-list algorithm to compute the transitive closure of finite relations where only successors of newly detected states are generated. This algorithm is then instantiated for lists over arbitrary carriers and red black trees (which are faster but require a linear order on the carrier), respectively. Our formalization was performed as part of the IsaFoR/CeTA project where reflexive transitive closures of large tree automata have to be computed. extra-history = Change history: [2014-09-04] added example simprocs in Finite_Transitive_Closure_Simprocs notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at [Transitive-Closure-II] title = Executable Transitive Closures topic = Computer science/Algorithms/Graph date = 2012-02-29 author = René Thiemann license = LGPL abstract =

We provide a generic work-list algorithm to compute the (reflexive-)transitive closure of relations where only successors of newly detected states are generated. In contrast to our previous work, the relations do not have to be finite, but each element must only have finitely many (indirect) successors. Moreover, a subsumption relation can be used instead of pure equality. An executable variant of the algorithm is available where the generic operations are instantiated with list operations.

This formalization was performed as part of the IsaFoR/CeTA project, and it has been used to certify size-change termination proofs where large transitive closures have to be computed.

notify = rene.thiemann@uibk.ac.at [MuchAdoAboutTwo] title = Much Ado About Two author = Sascha Böhme date = 2007-11-06 topic = Computer science/Algorithms abstract = This article is an Isabelle formalisation of a paper with the same title. In a similar way as Knuth's 0-1-principle for sorting algorithms, that paper develops a 0-1-2-principle for parallel prefix computations. notify = boehmes@in.tum.de [DiskPaxos] title = Proving the Correctness of Disk Paxos date = 2005-06-22 author = Mauro Jaskelioff , Stephan Merz topic = Computer science/Algorithms/Distributed abstract = Disk Paxos is an algorithm for building arbitrary fault-tolerant distributed systems. The specification of Disk Paxos has been proved correct informally and tested using the TLC model checker, but up to now, it has never been fully formally verified. In this work we have formally verified its correctness using the Isabelle theorem prover and the HOL logic system, showing that Isabelle is a practical tool for verifying properties of TLA+ specifications. notify = kleing@cse.unsw.edu.au [GenClock] title = Formalization of a Generalized Protocol for Clock Synchronization author = Alwen Tiu date = 2005-06-24 topic = Computer science/Algorithms/Distributed abstract = We formalize the generalized Byzantine fault-tolerant clock synchronization protocol of Schneider. This protocol abstracts from particular algorithms or implementations for clock synchronization. This abstraction includes several assumptions on the behaviors of physical clocks and on general properties of concrete algorithms/implementations. Based on these assumptions the correctness of the protocol is proved by Schneider. His proof was later verified by Shankar using the theorem prover EHDM (precursor to PVS). Our formalization in Isabelle/HOL is based on Shankar's formalization. notify = kleing@cse.unsw.edu.au [ClockSynchInst] title = Instances of Schneider's generalized protocol of clock synchronization author = Damián Barsotti date = 2006-03-15 topic = Computer science/Algorithms/Distributed abstract = F. B. Schneider ("Understanding protocols for Byzantine clock synchronization") generalizes a number of protocols for Byzantine fault-tolerant clock synchronization and presents a uniform proof for their correctness. In Schneider's schema, each processor maintains a local clock by periodically adjusting each value to one computed by a convergence function applied to the readings of all the clocks. Then, correctness of an algorithm, i.e. that the readings of two clocks at any time are within a fixed bound of each other, is based upon some conditions on the convergence function. To prove that a particular clock synchronization algorithm is correct it suffices to show that the convergence function used by the algorithm meets Schneider's conditions. Using the theorem prover Isabelle, we formalize the proofs that the convergence functions of two algorithms, namely, the Interactive Convergence Algorithm (ICA) of Lamport and Melliar-Smith and the Fault-tolerant Midpoint algorithm of Lundelius-Lynch, meet Schneider's conditions. Furthermore, we experiment on handling some parts of the proofs with fully automatic tools like ICS and CVC-lite. These theories are part of a joint work with Alwen Tiu and Leonor P. Nieto "Verification of Clock Synchronization Algorithms: Experiments on a combination of deductive tools" in proceedings of AVOCS 2005. In this work the correctness of Schneider schema was also verified using Isabelle (entry GenClock in AFP). notify = kleing@cse.unsw.edu.au [Heard_Of] title = Verifying Fault-Tolerant Distributed Algorithms in the Heard-Of Model date = 2012-07-27 author = Henri Debrat , Stephan Merz topic = Computer science/Algorithms/Distributed abstract = Distributed computing is inherently based on replication, promising increased tolerance to failures of individual computing nodes or communication channels. Realizing this promise, however, involves quite subtle algorithmic mechanisms, and requires precise statements about the kinds and numbers of faults that an algorithm tolerates (such as process crashes, communication faults or corrupted values). The landmark theorem due to Fischer, Lynch, and Paterson shows that it is impossible to achieve Consensus among N asynchronously communicating nodes in the presence of even a single permanent failure. Existing solutions must rely on assumptions of "partial synchrony".

Indeed, there have been numerous misunderstandings on what exactly a given algorithm is supposed to realize in what kinds of environments. Moreover, the abundance of subtly different computational models complicates comparisons between different algorithms. Charron-Bost and Schiper introduced the Heard-Of model for representing algorithms and failure assumptions in a uniform framework, simplifying comparisons between algorithms.

In this contribution, we represent the Heard-Of model in Isabelle/HOL. We define two semantics of runs of algorithms with different unit of atomicity and relate these through a reduction theorem that allows us to verify algorithms in the coarse-grained semantics (where proofs are easier) and infer their correctness for the fine-grained one (which corresponds to actual executions). We instantiate the framework by verifying six Consensus algorithms that differ in the underlying algorithmic mechanisms and the kinds of faults they tolerate. notify = Stephan.Merz@loria.fr [Consensus_Refined] title = Consensus Refined date = 2015-03-18 author = Ognjen Maric <>, Christoph Sprenger topic = Computer science/Algorithms/Distributed abstract = Algorithms for solving the consensus problem are fundamental to distributed computing. Despite their brevity, their ability to operate in concurrent, asynchronous and failure-prone environments comes at the cost of complex and subtle behaviors. Accordingly, understanding how they work and proving their correctness is a non-trivial endeavor where abstraction is immensely helpful. Moreover, research on consensus has yielded a large number of algorithms, many of which appear to share common algorithmic ideas. A natural question is whether and how these similarities can be distilled and described in a precise, unified way. In this work, we combine stepwise refinement and lockstep models to provide an abstract and unified view of a sizeable family of consensus algorithms. Our models provide insights into the design choices underlying the different algorithms, and classify them based on those choices. notify = sprenger@inf.ethz.ch [Key_Agreement_Strong_Adversaries] title = Refining Authenticated Key Agreement with Strong Adversaries author = Joseph Lallemand , Christoph Sprenger topic = Computer science/Security license = LGPL date = 2017-01-31 notify = joseph.lallemand@loria.fr, sprenger@inf.ethz.ch abstract = We develop a family of key agreement protocols that are correct by construction. Our work substantially extends prior work on developing security protocols by refinement. First, we strengthen the adversary by allowing him to compromise different resources of protocol participants, such as their long-term keys or their session keys. This enables the systematic development of protocols that ensure strong properties such as perfect forward secrecy. Second, we broaden the class of protocols supported to include those with non-atomic keys and equationally defined cryptographic operators. We use these extensions to develop key agreement protocols including signed Diffie-Hellman and the core of IKEv1 and SKEME. [Security_Protocol_Refinement] title = Developing Security Protocols by Refinement author = Christoph Sprenger , Ivano Somaini<> topic = Computer science/Security license = LGPL date = 2017-05-24 notify = sprenger@inf.ethz.ch abstract = We propose a development method for security protocols based on stepwise refinement. Our refinement strategy transforms abstract security goals into protocols that are secure when operating over an insecure channel controlled by a Dolev-Yao-style intruder. As intermediate levels of abstraction, we employ messageless guard protocols and channel protocols communicating over channels with security properties. These abstractions provide insights on why protocols are secure and foster the development of families of protocols sharing common structure and properties. We have implemented our method in Isabelle/HOL and used it to develop different entity authentication and key establishment protocols, including realistic features such as key confirmation, replay caches, and encrypted tickets. Our development highlights that guard protocols and channel protocols provide fundamental abstractions for bridging the gap between security properties and standard protocol descriptions based on cryptographic messages. It also shows that our refinement approach scales to protocols of nontrivial size and complexity. [Abortable_Linearizable_Modules] title = Abortable Linearizable Modules author = Rachid Guerraoui , Viktor Kuncak , Giuliano Losa date = 2012-03-01 topic = Computer science/Algorithms/Distributed abstract = We define the Abortable Linearizable Module automaton (ALM for short) and prove its key composition property using the IOA theory of HOLCF. The ALM is at the heart of the Speculative Linearizability framework. This framework simplifies devising correct speculative algorithms by enabling their decomposition into independent modules that can be analyzed and proved correct in isolation. It is particularly useful when working in a distributed environment, where the need to tolerate faults and asynchrony has made current monolithic protocols so intricate that it is no longer tractable to check their correctness. Our theory contains a typical example of a refinement proof in the I/O-automata framework of Lynch and Tuttle. notify = giuliano@losa.fr, nipkow@in.tum.de [Amortized_Complexity] title = Amortized Complexity Verified author = Tobias Nipkow date = 2014-07-07 topic = Computer science/Data structures abstract = A framework for the analysis of the amortized complexity of functional data structures is formalized in Isabelle/HOL and applied to a number of standard examples and to the folowing non-trivial ones: skew heaps, splay trees, splay heaps and pairing heaps.

A preliminary version of this work (without pairing heaps) is described in a paper published in the proceedings of the conference on Interactive Theorem Proving ITP 2015. An extended version of this publication is available here. extra-history = Change history: [2015-03-17]: Added pairing heaps by Hauke Brinkop.
[2016-07-12]: Moved splay heaps from here to Splay_Tree
[2016-07-14]: Moved pairing heaps from here to the new Pairing_Heap notify = nipkow@in.tum.de [Dynamic_Tables] title = Parameterized Dynamic Tables author = Tobias Nipkow date = 2015-06-07 topic = Computer science/Data structures abstract = This article formalizes the amortized analysis of dynamic tables parameterized with their minimal and maximal load factors and the expansion and contraction factors.

A full description is found in a companion paper. notify = nipkow@in.tum.de [AVL-Trees] title = AVL Trees author = Tobias Nipkow , Cornelia Pusch <> date = 2004-03-19 topic = Computer science/Data structures abstract = Two formalizations of AVL trees with room for extensions. The first formalization is monolithic and shorter, the second one in two stages, longer and a bit simpler. The final implementation is the same. If you are interested in developing this further, please contact gerwin.klein@nicta.com.au. extra-history = Change history: [2011-04-11]: Ondrej Kuncar added delete function notify = kleing@cse.unsw.edu.au [BDD] title = BDD Normalisation author = Veronika Ortner <>, Norbert Schirmer <> date = 2008-02-29 topic = Computer science/Data structures abstract = We present the verification of the normalisation of a binary decision diagram (BDD). The normalisation follows the original algorithm presented by Bryant in 1986 and transforms an ordered BDD in a reduced, ordered and shared BDD. The verification is based on Hoare logics. notify = kleing@cse.unsw.edu.au, norbert.schirmer@web.de [BinarySearchTree] title = Binary Search Trees author = Viktor Kuncak date = 2004-04-05 topic = Computer science/Data structures abstract = The correctness is shown of binary search tree operations (lookup, insert and remove) implementing a set. Two versions are given, for both structured and linear (tactic-style) proofs. An implementation of integer-indexed maps is also verified. notify = lp15@cam.ac.uk [Splay_Tree] title = Splay Tree author = Tobias Nipkow notify = nipkow@in.tum.de date = 2014-08-12 topic = Computer science/Data structures abstract = Splay trees are self-adjusting binary search trees which were invented by Sleator and Tarjan [JACM 1985]. This entry provides executable and verified functional splay trees as well as the related splay heaps (due to Okasaki).

The amortized complexity of splay trees and heaps is analyzed in the AFP entry Amortized Complexity. extra-history = Change history: [2016-07-12]: Moved splay heaps here from Amortized_Complexity [Root_Balanced_Tree] title = Root-Balanced Tree author = Tobias Nipkow notify = nipkow@in.tum.de date = 2017-08-20 topic = Computer science/Data structures abstract =

Andersson introduced general balanced trees, search trees based on the design principle of partial rebuilding: perform update operations naively until the tree becomes too unbalanced, at which point a whole subtree is rebalanced. This article defines and analyzes a functional version of general balanced trees, which we call root-balanced trees. Using a lightweight model of execution time, amortized logarithmic complexity is verified in the theorem prover Isabelle.

This is the Isabelle formalization of the material decribed in the APLAS 2017 article Verified Root-Balanced Trees by the same author, which also presents experimental results that show competitiveness of root-balanced with AVL and red-black trees.

[Skew_Heap] title = Skew Heap author = Tobias Nipkow date = 2014-08-13 topic = Computer science/Data structures abstract = Skew heaps are an amazingly simple and lightweight implementation of priority queues. They were invented by Sleator and Tarjan [SIAM 1986] and have logarithmic amortized complexity. This entry provides executable and verified functional skew heaps.

The amortized complexity of skew heaps is analyzed in the AFP entry Amortized Complexity. notify = nipkow@in.tum.de [Pairing_Heap] title = Pairing Heap author = Hauke Brinkop , Tobias Nipkow date = 2016-07-14 topic = Computer science/Data structures abstract = This library defines three different versions of pairing heaps: a functional version of the original design based on binary trees [Fredman et al. 1986], the version by Okasaki [1998] and a modified version of the latter that is free of structural invariants.

The amortized complexity of pairing heaps is analyzed in the AFP article Amortized Complexity. extra-0 = Origin: This library was extracted from Amortized Complexity and extended. notify = nipkow@in.tum.de [Priority_Queue_Braun] title = Priority Queues Based on Braun Trees author = Tobias Nipkow date = 2014-09-04 topic = Computer science/Data structures abstract = This entry verifies priority queues based on Braun trees. Insertion and deletion take logarithmic time and preserve the balanced nature of Braun trees. Two implementations of deletion are provided. notify = nipkow@in.tum.de extra-history = Change history: [2019-12-16]: Added theory Priority_Queue_Braun2 with second version of del_min [Binomial-Queues] title = Functional Binomial Queues author = René Neumann date = 2010-10-28 topic = Computer science/Data structures abstract = Priority queues are an important data structure and efficient implementations of them are crucial. We implement a functional variant of binomial queues in Isabelle/HOL and show its functional correctness. A verification against an abstract reference specification of priority queues has also been attempted, but could not be achieved to the full extent. notify = florian.haftmann@informatik.tu-muenchen.de [Binomial-Heaps] title = Binomial Heaps and Skew Binomial Heaps author = Rene Meis , Finn Nielsen , Peter Lammich date = 2010-10-28 topic = Computer science/Data structures abstract = We implement and prove correct binomial heaps and skew binomial heaps. Both are data-structures for priority queues. While binomial heaps have logarithmic findMin, deleteMin, insert, and meld operations, skew binomial heaps have constant time findMin, insert, and meld operations, and only the deleteMin-operation is logarithmic. This is achieved by using skew links to avoid cascading linking on insert-operations, and data-structural bootstrapping to get constant-time findMin and meld operations. Our implementation follows the paper by Brodal and Okasaki. notify = peter.lammich@uni-muenster.de [Finger-Trees] title = Finger Trees author = Benedikt Nordhoff , Stefan Körner , Peter Lammich date = 2010-10-28 topic = Computer science/Data structures abstract = We implement and prove correct 2-3 finger trees. Finger trees are a general purpose data structure, that can be used to efficiently implement other data structures, such as priority queues. Intuitively, a finger tree is an annotated sequence, where the annotations are elements of a monoid. Apart from operations to access the ends of the sequence, the main operation is to split the sequence at the point where a monotone predicate over the sum of the left part of the sequence becomes true for the first time. The implementation follows the paper of Hinze and Paterson. The code generator can be used to get efficient, verified code. notify = peter.lammich@uni-muenster.de [Trie] title = Trie author = Andreas Lochbihler , Tobias Nipkow date = 2015-03-30 topic = Computer science/Data structures abstract = This article formalizes the ``trie'' data structure invented by Fredkin [CACM 1960]. It also provides a specialization where the entries in the trie are lists. extra-0 = Origin: This article was extracted from existing articles by the authors. notify = nipkow@in.tum.de [FinFun] title = Code Generation for Functions as Data author = Andreas Lochbihler date = 2009-05-06 topic = Computer science/Data structures abstract = FinFuns are total functions that are constant except for a finite set of points, i.e. a generalisation of finite maps. They are formalised as a new type in Isabelle/HOL such that the code generator can handle equality tests and quantification on FinFuns. On the code output level, FinFuns are explicitly represented by constant functions and pointwise updates, similarly to associative lists. Inside the logic, they behave like ordinary functions with extensionality. Via the update/constant pattern, a recursion combinator and an induction rule for FinFuns allow for defining and reasoning about operators on FinFun that are also executable. extra-history = Change history: [2010-08-13]: new concept domain of a FinFun as a FinFun (revision 34b3517cbc09)
[2010-11-04]: new conversion function from FinFun to list of elements in the domain (revision 0c167102e6ed)
[2012-03-07]: replace sets as FinFuns by predicates as FinFuns because the set type constructor has been reintroduced (revision b7aa87989f3a) notify = nipkow@in.tum.de [Collections] title = Collections Framework author = Peter Lammich contributors = Andreas Lochbihler , Thomas Tuerk <> date = 2009-11-25 topic = Computer science/Data structures abstract = This development provides an efficient, extensible, machine checked collections framework. The library adopts the concepts of interface, implementation and generic algorithm from object-oriented programming and implements them in Isabelle/HOL. The framework features the use of data refinement techniques to refine an abstract specification (using high-level concepts like sets) to a more concrete implementation (using collection datastructures, like red-black-trees). The code-generator of Isabelle/HOL can be used to generate efficient code. extra-history = Change history: [2010-10-08]: New Interfaces: OrderedSet, OrderedMap, List. Fifo now implements list-interface: Function names changed: put/get --> enqueue/dequeue. New Implementations: ArrayList, ArrayHashMap, ArrayHashSet, TrieMap, TrieSet. Invariant-free datastructures: Invariant implicitely hidden in typedef. Record-interfaces: All operations of an interface encapsulated as record. Examples moved to examples subdirectory.
[2010-12-01]: New Interfaces: Priority Queues, Annotated Lists. Implemented by finger trees, (skew) binomial queues.
[2011-10-10]: SetSpec: Added operations: sng, isSng, bexists, size_abort, diff, filter, iterate_rule_insertP MapSpec: Added operations: sng, isSng, iterate_rule_insertP, bexists, size, size_abort, restrict, map_image_filter, map_value_image_filter Some maintenance changes
[2012-04-25]: New iterator foundation by Tuerk. Various maintenance changes.
[2012-08]: Collections V2. New features: Polymorphic iterators. Generic algorithm instantiation where required. Naming scheme changed from xx_opname to xx.opname. A compatibility file CollectionsV1 tries to simplify porting of existing theories, by providing old naming scheme and the old monomorphic iterator locales.
[2013-09]: Added Generic Collection Framework based on Autoref. The GenCF provides: Arbitrary nesting, full integration with Autoref.
[2014-06]: Maintenace changes to GenCF: Optimized inj_image on list_set. op_set_cart (Cartesian product). big-Union operation. atLeastLessThan - operation ({a..<b})
notify = lammich@in.tum.de [Containers] title = Light-weight Containers author = Andreas Lochbihler contributors = René Thiemann date = 2013-04-15 topic = Computer science/Data structures abstract = This development provides a framework for container types like sets and maps such that generated code implements these containers with different (efficient) data structures. Thanks to type classes and refinement during code generation, this light-weight approach can seamlessly replace Isabelle's default setup for code generation. Heuristics automatically pick one of the available data structures depending on the type of elements to be stored, but users can also choose on their own. The extensible design permits to add more implementations at any time.

To support arbitrary nesting of sets, we define a linear order on sets based on a linear order of the elements and provide efficient implementations. It even allows to compare complements with non-complements. extra-history = Change history: [2013-07-11]: add pretty printing for sets (revision 7f3f52c5f5fa)
[2013-09-20]: provide generators for canonical type class instantiations (revision 159f4401f4a8 by René Thiemann)
[2014-07-08]: add support for going from partial functions to mappings (revision 7a6fc957e8ed)
[2018-03-05]: add two application examples: depth-first search and 2SAT (revision e5e1a1da2411) notify = mail@andreas-lochbihler.de [FileRefinement] title = File Refinement author = Karen Zee , Viktor Kuncak date = 2004-12-09 topic = Computer science/Data structures abstract = These theories illustrates the verification of basic file operations (file creation, file read and file write) in the Isabelle theorem prover. We describe a file at two levels of abstraction: an abstract file represented as a resizable array, and a concrete file represented using data blocks. notify = kkz@mit.edu [Datatype_Order_Generator] title = Generating linear orders for datatypes author = René Thiemann date = 2012-08-07 topic = Computer science/Data structures abstract = We provide a framework for registering automatic methods to derive class instances of datatypes, as it is possible using Haskell's ``deriving Ord, Show, ...'' feature.

We further implemented such automatic methods to derive (linear) orders or hash-functions which are required in the Isabelle Collection Framework. Moreover, for the tactic of Huffman and Krauss to show that a datatype is countable, we implemented a wrapper so that this tactic becomes accessible in our framework.

Our formalization was performed as part of the IsaFoR/CeTA project. With our new tactic we could completely remove tedious proofs for linear orders of two datatypes.

This development is aimed at datatypes generated by the "old_datatype" command. notify = rene.thiemann@uibk.ac.at [Deriving] title = Deriving class instances for datatypes author = Christian Sternagel , René Thiemann date = 2015-03-11 topic = Computer science/Data structures abstract =

We provide a framework for registering automatic methods to derive class instances of datatypes, as it is possible using Haskell's ``deriving Ord, Show, ...'' feature.

We further implemented such automatic methods to derive comparators, linear orders, parametrizable equality functions, and hash-functions which are required in the Isabelle Collection Framework and the Container Framework. Moreover, for the tactic of Blanchette to show that a datatype is countable, we implemented a wrapper so that this tactic becomes accessible in our framework. All of the generators are based on the infrastructure that is provided by the BNF-based datatype package.

Our formalization was performed as part of the IsaFoR/CeTA project. With our new tactics we could remove several tedious proofs for (conditional) linear orders, and conditional equality operators within IsaFoR and the Container Framework.

notify = rene.thiemann@uibk.ac.at [List-Index] title = List Index date = 2010-02-20 author = Tobias Nipkow topic = Computer science/Data structures abstract = This theory provides functions for finding the index of an element in a list, by predicate and by value. notify = nipkow@in.tum.de [List-Infinite] title = Infinite Lists date = 2011-02-23 author = David Trachtenherz <> topic = Computer science/Data structures abstract = We introduce a theory of infinite lists in HOL formalized as functions over naturals (folder ListInf, theories ListInf and ListInf_Prefix). It also provides additional results for finite lists (theory ListInf/List2), natural numbers (folder CommonArith, esp. division/modulo, naturals with infinity), sets (folder CommonSet, esp. cutting/truncating sets, traversing sets of naturals). notify = nipkow@in.tum.de [Matrix] title = Executable Matrix Operations on Matrices of Arbitrary Dimensions topic = Computer science/Data structures date = 2010-06-17 author = Christian Sternagel , René Thiemann license = LGPL abstract = We provide the operations of matrix addition, multiplication, transposition, and matrix comparisons as executable functions over ordered semirings. Moreover, it is proven that strongly normalizing (monotone) orders can be lifted to strongly normalizing (monotone) orders over matrices. We further show that the standard semirings over the naturals, integers, and rationals, as well as the arctic semirings satisfy the axioms that are required by our matrix theory. Our formalization is part of the CeTA system which contains several termination techniques. The provided theories have been essential to formalize matrix-interpretations and arctic interpretations. extra-history = Change history: [2010-09-17]: Moved theory on arbitrary (ordered) semirings to Abstract Rewriting. notify = rene.thiemann@uibk.ac.at, christian.sternagel@uibk.ac.at [Matrix_Tensor] title = Tensor Product of Matrices topic = Computer science/Data structures, Mathematics/Algebra date = 2016-01-18 author = T.V.H. Prathamesh abstract = In this work, the Kronecker tensor product of matrices and the proofs of some of its properties are formalized. Properties which have been formalized include associativity of the tensor product and the mixed-product property. notify = prathamesh@imsc.res.in [Huffman] title = The Textbook Proof of Huffman's Algorithm author = Jasmin Christian Blanchette date = 2008-10-15 topic = Computer science/Data structures abstract = Huffman's algorithm is a procedure for constructing a binary tree with minimum weighted path length. This report presents a formal proof of the correctness of Huffman's algorithm written using Isabelle/HOL. Our proof closely follows the sketches found in standard algorithms textbooks, uncovering a few snags in the process. Another distinguishing feature of our formalization is the use of custom induction rules to help Isabelle's automatic tactics, leading to very short proofs for most of the lemmas. notify = jasmin.blanchette@gmail.com [Partial_Function_MR] title = Mutually Recursive Partial Functions author = René Thiemann topic = Computer science/Functional programming date = 2014-02-18 license = LGPL abstract = We provide a wrapper around the partial-function command that supports mutual recursion. notify = rene.thiemann@uibk.ac.at [Lifting_Definition_Option] title = Lifting Definition Option author = René Thiemann topic = Computer science/Functional programming date = 2014-10-13 license = LGPL abstract = We implemented a command that can be used to easily generate elements of a restricted type {x :: 'a. P x}, provided the definition is of the form f ys = (if check ys then Some(generate ys :: 'a) else None) where ys is a list of variables y1 ... yn and check ys ==> P(generate ys) can be proved.

In principle, such a definition is also directly possible using the lift_definition command. However, then this definition will not be suitable for code-generation. To this end, we automated a more complex construction of Joachim Breitner which is amenable for code-generation, and where the test check ys will only be performed once. In the automation, one auxiliary type is created, and Isabelle's lifting- and transfer-package is invoked several times. notify = rene.thiemann@uibk.ac.at [Coinductive] title = Coinductive topic = Computer science/Functional programming author = Andreas Lochbihler contributors = Johannes Hölzl date = 2010-02-12 abstract = This article collects formalisations of general-purpose coinductive data types and sets. Currently, it contains coinductive natural numbers, coinductive lists, i.e. lazy lists or streams, infinite streams, coinductive terminated lists, coinductive resumptions, a library of operations on coinductive lists, and a version of König's lemma as an application for coinductive lists.
The initial theory was contributed by Paulson and Wenzel. Extensions and other coinductive formalisations of general interest are welcome. extra-history = Change history: [2010-06-10]: coinductive lists: setup for quotient package (revision 015574f3bf3c)
[2010-06-28]: new codatatype terminated lazy lists (revision e12de475c558)
[2010-08-04]: terminated lazy lists: setup for quotient package; more lemmas (revision 6ead626f1d01)
[2010-08-17]: Koenig's lemma as an example application for coinductive lists (revision f81ce373fa96)
[2011-02-01]: lazy implementation of coinductive (terminated) lists for the code generator (revision 6034973dce83)
[2011-07-20]: new codatatype resumption (revision 811364c776c7)
[2012-06-27]: new codatatype stream with operations (with contributions by Peter Gammie) (revision dd789a56473c)
[2013-03-13]: construct codatatypes with the BNF package and adjust the definitions and proofs, setup for lifting and transfer packages (revision f593eda5b2c0)
[2013-09-20]: stream theory uses type and operations from HOL/BNF/Examples/Stream (revision 692809b2b262)
[2014-04-03]: ccpo structure on codatatypes used to define ldrop, ldropWhile, lfilter, lconcat as least fixpoint; ccpo topology on coinductive lists contributed by Johannes Hölzl; added examples (revision 23cd8156bd42)
notify = mail@andreas-lochbihler.de [Stream-Fusion] title = Stream Fusion author = Brian Huffman topic = Computer science/Functional programming date = 2009-04-29 abstract = Stream Fusion is a system for removing intermediate list structures from Haskell programs; it consists of a Haskell library along with several compiler rewrite rules. (The library is available online.)

These theories contain a formalization of much of the Stream Fusion library in HOLCF. Lazy list and stream types are defined, along with coercions between the two types, as well as an equivalence relation for streams that generate the same list. List and stream versions of map, filter, foldr, enumFromTo, append, zipWith, and concatMap are defined, and the stream versions are shown to respect stream equivalence. notify = brianh@cs.pdx.edu [Tycon] title = Type Constructor Classes and Monad Transformers author = Brian Huffman date = 2012-06-26 topic = Computer science/Functional programming abstract = These theories contain a formalization of first class type constructors and axiomatic constructor classes for HOLCF. This work is described in detail in the ICFP 2012 paper Formal Verification of Monad Transformers by the author. The formalization is a revised and updated version of earlier joint work with Matthews and White.

Based on the hierarchy of type classes in Haskell, we define classes for functors, monads, monad-plus, etc. Each one includes all the standard laws as axioms. We also provide a new user command, tycondef, for defining new type constructors in HOLCF. Using tycondef, we instantiate the type class hierarchy with various monads and monad transformers. notify = huffman@in.tum.de [CoreC++] title = CoreC++ author = Daniel Wasserrab date = 2006-05-15 topic = Computer science/Programming languages/Language definitions abstract = We present an operational semantics and type safety proof for multiple inheritance in C++. The semantics models the behavior of method calls, field accesses, and two forms of casts in C++ class hierarchies. For explanations see the OOPSLA 2006 paper by Wasserrab, Nipkow, Snelting and Tip. notify = nipkow@in.tum.de [FeatherweightJava] title = A Theory of Featherweight Java in Isabelle/HOL author = J. Nathan Foster , Dimitrios Vytiniotis date = 2006-03-31 topic = Computer science/Programming languages/Language definitions abstract = We formalize the type system, small-step operational semantics, and type soundness proof for Featherweight Java, a simple object calculus, in Isabelle/HOL. notify = kleing@cse.unsw.edu.au [Jinja] title = Jinja is not Java author = Gerwin Klein , Tobias Nipkow date = 2005-06-01 topic = Computer science/Programming languages/Language definitions abstract = We introduce Jinja, a Java-like programming language with a formal semantics designed to exhibit core features of the Java language architecture. Jinja is a compromise between realism of the language and tractability and clarity of the formal semantics. The following aspects are formalised: a big and a small step operational semantics for Jinja and a proof of their equivalence; a type system and a definite initialisation analysis; a type safety proof of the small step semantics; a virtual machine (JVM), its operational semantics and its type system; a type safety proof for the JVM; a bytecode verifier, i.e. data flow analyser for the JVM; a correctness proof of the bytecode verifier w.r.t. the type system; a compiler and a proof that it preserves semantics and well-typedness. The emphasis of this work is not on particular language features but on providing a unified model of the source language, the virtual machine and the compiler. The whole development has been carried out in the theorem prover Isabelle/HOL. notify = kleing@cse.unsw.edu.au, nipkow@in.tum.de [JinjaThreads] title = Jinja with Threads author = Andreas Lochbihler date = 2007-12-03 topic = Computer science/Programming languages/Language definitions abstract = We extend the Jinja source code semantics by Klein and Nipkow with Java-style arrays and threads. Concurrency is captured in a generic framework semantics for adding concurrency through interleaving to a sequential semantics, which features dynamic thread creation, inter-thread communication via shared memory, lock synchronisation and joins. Also, threads can suspend themselves and be notified by others. We instantiate the framework with the adapted versions of both Jinja source and byte code and show type safety for the multithreaded case. Equally, the compiler from source to byte code is extended, for which we prove weak bisimilarity between the source code small step semantics and the defensive Jinja virtual machine. On top of this, we formalise the JMM and show the DRF guarantee and consistency. For description of the different parts, see Lochbihler's papers at FOOL 2008, ESOP 2010, ITP 2011, and ESOP 2012. extra-history = Change history: [2008-04-23]: added bytecode formalisation with arrays and threads, added thread joins (revision f74a8be156a7)
[2009-04-27]: added verified compiler from source code to bytecode; encapsulate native methods in separate semantics (revision e4f26541e58a)
[2009-11-30]: extended compiler correctness proof to infinite and deadlocking computations (revision e50282397435)
[2010-06-08]: added thread interruption; new abstract memory model with sequential consistency as implementation (revision 0cb9e8dbd78d)
[2010-06-28]: new thread interruption model (revision c0440d0a1177)
[2010-10-15]: preliminary version of the Java memory model for source code (revision 02fee0ef3ca2)
[2010-12-16]: improved version of the Java memory model, also for bytecode executable scheduler for source code semantics (revision 1f41c1842f5a)
[2011-02-02]: simplified code generator setup new random scheduler (revision 3059dafd013f)
[2011-07-21]: new interruption model, generalized JMM proof of DRF guarantee, allow class Object to declare methods and fields, simplified subtyping relation, corrected division and modulo implementation (revision 46e4181ed142)
[2012-02-16]: added example programs (revision bf0b06c8913d)
[2012-11-21]: type safety proof for the Java memory model, allow spurious wake-ups (revision 76063d860ae0)
[2013-05-16]: support for non-deterministic memory allocators (revision cc3344a49ced)
[2017-10-20]: add an atomic compare-and-swap operation for volatile fields (revision a6189b1d6b30)
notify = mail@andreas-lochbihler.de [Locally-Nameless-Sigma] title = Locally Nameless Sigma Calculus author = Ludovic Henrio , Florian Kammüller , Bianca Lutz , Henry Sudhof date = 2010-04-30 topic = Computer science/Programming languages/Language definitions abstract = We present a Theory of Objects based on the original functional sigma-calculus by Abadi and Cardelli but with an additional parameter to methods. We prove confluence of the operational semantics following the outline of Nipkow's proof of confluence for the lambda-calculus reusing his theory Commutation, a generic diamond lemma reduction. We furthermore formalize a simple type system for our sigma-calculus including a proof of type safety. The entire development uses the concept of Locally Nameless representation for binders. We reuse an earlier proof of confluence for a simpler sigma-calculus based on de Bruijn indices and lists to represent objects. notify = nipkow@in.tum.de [Attack_Trees] title = Attack Trees in Isabelle for GDPR compliance of IoT healthcare systems author = Florian Kammueller topic = Computer science/Security date = 2020-04-27 notify = florian.kammuller@gmail.com abstract = In this article, we present a proof theory for Attack Trees. Attack Trees are a well established and useful model for the construction of attacks on systems since they allow a stepwise exploration of high level attacks in application scenarios. Using the expressiveness of Higher Order Logic in Isabelle, we develop a generic theory of Attack Trees with a state-based semantics based on Kripke structures and CTL. The resulting framework allows mechanically supported logic analysis of the meta-theory of the proof calculus of Attack Trees and at the same time the developed proof theory enables application to case studies. A central correctness and completeness result proved in Isabelle establishes a connection between the notion of Attack Tree validity and CTL. The application is illustrated on the example of a healthcare IoT system and GDPR compliance verification. [AutoFocus-Stream] title = AutoFocus Stream Processing for Single-Clocking and Multi-Clocking Semantics author = David Trachtenherz <> date = 2011-02-23 topic = Computer science/Programming languages/Language definitions abstract = We formalize the AutoFocus Semantics (a time-synchronous subset of the Focus formalism) as stream processing functions on finite and infinite message streams represented as finite/infinite lists. The formalization comprises both the conventional single-clocking semantics (uniform global clock for all components and communications channels) and its extension to multi-clocking semantics (internal execution clocking of a component may be a multiple of the external communication clocking). The semantics is defined by generic stream processing functions making it suitable for simulation/code generation in Isabelle/HOL. Furthermore, a number of AutoFocus semantics properties are formalized using definitions from the IntervalLogic theories. notify = nipkow@in.tum.de [FocusStreamsCaseStudies] title = Stream Processing Components: Isabelle/HOL Formalisation and Case Studies author = Maria Spichkova date = 2013-11-14 topic = Computer science/Programming languages/Language definitions abstract = This set of theories presents an Isabelle/HOL formalisation of stream processing components introduced in Focus, a framework for formal specification and development of interactive systems. This is an extended and updated version of the formalisation, which was elaborated within the methodology "Focus on Isabelle". In addition, we also applied the formalisation on three case studies that cover different application areas: process control (Steam Boiler System), data transmission (FlexRay communication protocol), memory and processing components (Automotive-Gateway System). notify = lp15@cam.ac.uk, maria.spichkova@rmit.edu.au [Isabelle_Meta_Model] title = A Meta-Model for the Isabelle API author = Frédéric Tuong , Burkhart Wolff date = 2015-09-16 topic = Computer science/Programming languages/Language definitions abstract = We represent a theory of (a fragment of) Isabelle/HOL in Isabelle/HOL. The purpose of this exercise is to write packages for domain-specific specifications such as class models, B-machines, ..., and generally speaking, any domain-specific languages whose abstract syntax can be defined by a HOL "datatype". On this basis, the Isabelle code-generator can then be used to generate code for global context transformations as well as tactic code.

Consequently the package is geared towards parsing, printing and code-generation to the Isabelle API. It is at the moment not sufficiently rich for doing meta theory on Isabelle itself. Extensions in this direction are possible though.

Moreover, the chosen fragment is fairly rudimentary. However it should be easily adapted to one's needs if a package is written on top of it. The supported API contains types, terms, transformation of global context like definitions and data-type declarations as well as infrastructure for Isar-setups.

This theory is drawn from the Featherweight OCL project where it is used to construct a package for object-oriented data-type theories generated from UML class diagrams. The Featherweight OCL, for example, allows for both the direct execution of compiled tactic code by the Isabelle API as well as the generation of ".thy"-files for debugging purposes.

Gained experience from this project shows that the compiled code is sufficiently efficient for practical purposes while being based on a formal model on which properties of the package can be proven such as termination of certain transformations, correctness, etc. notify = tuong@users.gforge.inria.fr, wolff@lri.fr [Clean] title = Clean - An Abstract Imperative Programming Language and its Theory author = Frédéric Tuong , Burkhart Wolff topic = Computer science/Programming languages, Computer science/Semantics date = 2019-10-04 notify = wolff@lri.fr, ftuong@lri.fr abstract = Clean is based on a simple, abstract execution model for an imperative target language. “Abstract” is understood in contrast to “Concrete Semantics”; alternatively, the term “shallow-style embedding” could be used. It strives for a type-safe notion of program-variables, an incremental construction of the typed state-space, support of incremental verification, and open-world extensibility of new type definitions being intertwined with the program definitions. Clean is based on a “no-frills” state-exception monad with the usual definitions of bind and unit for the compositional glue of state-based computations. Clean offers conditionals and loops supporting C-like control-flow operators such as break and return. The state-space construction is based on the extensible record package. Direct recursion of procedures is supported. Clean’s design strives for extreme simplicity. It is geared towards symbolic execution and proven correct verification tools. The underlying libraries of this package, however, deliberately restrict themselves to the most elementary infrastructure for these tasks. The package is intended to serve as demonstrator semantic backend for Isabelle/C, or for the test-generation techniques. [PCF] title = Logical Relations for PCF author = Peter Gammie date = 2012-07-01 topic = Computer science/Programming languages/Lambda calculi abstract = We apply Andy Pitts's methods of defining relations over domains to several classical results in the literature. We show that the Y combinator coincides with the domain-theoretic fixpoint operator, that parallel-or and the Plotkin existential are not definable in PCF, that the continuation semantics for PCF coincides with the direct semantics, and that our domain-theoretic semantics for PCF is adequate for reasoning about contextual equivalence in an operational semantics. Our version of PCF is untyped and has both strict and non-strict function abstractions. The development is carried out in HOLCF. notify = peteg42@gmail.com [POPLmark-deBruijn] title = POPLmark Challenge Via de Bruijn Indices author = Stefan Berghofer date = 2007-08-02 topic = Computer science/Programming languages/Lambda calculi abstract = We present a solution to the POPLmark challenge designed by Aydemir et al., which has as a goal the formalization of the meta-theory of System F<:. The formalization is carried out in the theorem prover Isabelle/HOL using an encoding based on de Bruijn indices. We start with a relatively simple formalization covering only the basic features of System F<:, and explain how it can be extended to also cover records and more advanced binding constructs. notify = berghofe@in.tum.de [Lam-ml-Normalization] title = Strong Normalization of Moggis's Computational Metalanguage author = Christian Doczkal date = 2010-08-29 topic = Computer science/Programming languages/Lambda calculi abstract = Handling variable binding is one of the main difficulties in formal proofs. In this context, Moggi's computational metalanguage serves as an interesting case study. It features monadic types and a commuting conversion rule that rearranges the binding structure. Lindley and Stark have given an elegant proof of strong normalization for this calculus. The key construction in their proof is a notion of relational TT-lifting, using stacks of elimination contexts to obtain a Girard-Tait style logical relation. I give a formalization of their proof in Isabelle/HOL-Nominal with a particular emphasis on the treatment of bound variables. notify = doczkal@ps.uni-saarland.de, nipkow@in.tum.de [MiniML] title = Mini ML author = Wolfgang Naraschewski <>, Tobias Nipkow date = 2004-03-19 topic = Computer science/Programming languages/Type systems abstract = This theory defines the type inference rules and the type inference algorithm W for MiniML (simply-typed lambda terms with let) due to Milner. It proves the soundness and completeness of W w.r.t. the rules. notify = kleing@cse.unsw.edu.au [Simpl] title = A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment author = Norbert Schirmer <> date = 2008-02-29 topic = Computer science/Programming languages/Language definitions, Computer science/Programming languages/Logics license = LGPL abstract = We present the theory of Simpl, a sequential imperative programming language. We introduce its syntax, its semantics (big and small-step operational semantics) and Hoare logics for both partial as well as total correctness. We prove soundness and completeness of the Hoare logic. We integrate and automate the Hoare logic in Isabelle/HOL to obtain a practically usable verification environment for imperative programs. Simpl is independent of a concrete programming language but expressive enough to cover all common language features: mutually recursive procedures, abrupt termination and exceptions, runtime faults, local and global variables, pointers and heap, expressions with side effects, pointers to procedures, partial application and closures, dynamic method invocation and also unbounded nondeterminism. notify = kleing@cse.unsw.edu.au, norbert.schirmer@web.de [Separation_Algebra] title = Separation Algebra author = Gerwin Klein , Rafal Kolanski , Andrew Boyton date = 2012-05-11 topic = Computer science/Programming languages/Logics license = BSD abstract = We present a generic type class implementation of separation algebra for Isabelle/HOL as well as lemmas and generic tactics which can be used directly for any instantiation of the type class.

The ex directory contains example instantiations that include structures such as a heap or virtual memory.

The abstract separation algebra is based upon "Abstract Separation Logic" by Calcagno et al. These theories are also the basis of the ITP 2012 rough diamond "Mechanised Separation Algebra" by the authors.

The aim of this work is to support and significantly reduce the effort for future separation logic developments in Isabelle/HOL by factoring out the part of separation logic that can be treated abstractly once and for all. This includes developing typical default rule sets for reasoning as well as automated tactic support for separation logic. notify = kleing@cse.unsw.edu.au, rafal.kolanski@nicta.com.au [Separation_Logic_Imperative_HOL] title = A Separation Logic Framework for Imperative HOL author = Peter Lammich , Rene Meis date = 2012-11-14 topic = Computer science/Programming languages/Logics license = BSD abstract = We provide a framework for separation-logic based correctness proofs of Imperative HOL programs. Our framework comes with a set of proof methods to automate canonical tasks such as verification condition generation and frame inference. Moreover, we provide a set of examples that show the applicability of our framework. The examples include algorithms on lists, hash-tables, and union-find trees. We also provide abstract interfaces for lists, maps, and sets, that allow to develop generic imperative algorithms and use data-refinement techniques.
As we target Imperative HOL, our programs can be translated to efficiently executable code in various target languages, including ML, OCaml, Haskell, and Scala. notify = lammich@in.tum.de [Inductive_Confidentiality] title = Inductive Study of Confidentiality author = Giampaolo Bella date = 2012-05-02 topic = Computer science/Security abstract = This document contains the full theory files accompanying article Inductive Study of Confidentiality --- for Everyone in Formal Aspects of Computing. They aim at an illustrative and didactic presentation of the Inductive Method of protocol analysis, focusing on the treatment of one of the main goals of security protocols: confidentiality against a threat model. The treatment of confidentiality, which in fact forms a key aspect of all protocol analysis tools, has been found cryptic by many learners of the Inductive Method, hence the motivation for this work. The theory files in this document guide the reader step by step towards design and proof of significant confidentiality theorems. These are developed against two threat models, the standard Dolev-Yao and a more audacious one, the General Attacker, which turns out to be particularly useful also for teaching purposes. notify = giamp@dmi.unict.it [Possibilistic_Noninterference] title = Possibilistic Noninterference author = Andrei Popescu , Johannes Hölzl date = 2012-09-10 topic = Computer science/Security, Computer science/Programming languages/Type systems abstract = We formalize a wide variety of Volpano/Smith-style noninterference notions for a while language with parallel composition. We systematize and classify these notions according to compositionality w.r.t. the language constructs. Compositionality yields sound syntactic criteria (a.k.a. type systems) in a uniform way.

An article about these proofs is published in the proceedings of the conference Certified Programs and Proofs 2012. notify = hoelzl@in.tum.de [SIFUM_Type_Systems] title = A Formalization of Assumptions and Guarantees for Compositional Noninterference author = Sylvia Grewe , Heiko Mantel , Daniel Schoepe date = 2014-04-23 topic = Computer science/Security, Computer science/Programming languages/Type systems abstract = Research in information-flow security aims at developing methods to identify undesired information leaks within programs from private (high) sources to public (low) sinks. For a concurrent system, it is desirable to have compositional analysis methods that allow for analyzing each thread independently and that nevertheless guarantee that the parallel composition of successfully analyzed threads satisfies a global security guarantee. However, such a compositional analysis should not be overly pessimistic about what an environment might do with shared resources. Otherwise, the analysis will reject many intuitively secure programs.

The paper "Assumptions and Guarantees for Compositional Noninterference" by Mantel et. al. presents one solution for this problem: an approach for compositionally reasoning about non-interference in concurrent programs via rely-guarantee-style reasoning. We present an Isabelle/HOL formalization of the concepts and proofs of this approach. notify = grewe@cs.tu-darmstadt.de [Dependent_SIFUM_Type_Systems] title = A Dependent Security Type System for Concurrent Imperative Programs author = Toby Murray , Robert Sison<>, Edward Pierzchalski<>, Christine Rizkallah notify = toby.murray@unimelb.edu.au date = 2016-06-25 topic = Computer science/Security, Computer science/Programming languages/Type systems abstract = The paper "Compositional Verification and Refinement of Concurrent Value-Dependent Noninterference" by Murray et. al. (CSF 2016) presents a dependent security type system for compositionally verifying a value-dependent noninterference property, defined in (Murray, PLAS 2015), for concurrent programs. This development formalises that security definition, the type system and its soundness proof, and demonstrates its application on some small examples. It was derived from the SIFUM_Type_Systems AFP entry, by Sylvia Grewe, Heiko Mantel and Daniel Schoepe, and whose structure it inherits. extra-history = Change history: [2016-08-19]: Removed unused "stop" parameter and "stop_no_eval" assumption from the sifum_security locale. (revision dbc482d36372) [2016-09-27]: Added security locale support for the imposition of requirements on the initial memory. (revision cce4ceb74ddb) [Dependent_SIFUM_Refinement] title = Compositional Security-Preserving Refinement for Concurrent Imperative Programs author = Toby Murray , Robert Sison<>, Edward Pierzchalski<>, Christine Rizkallah notify = toby.murray@unimelb.edu.au date = 2016-06-28 topic = Computer science/Security abstract = The paper "Compositional Verification and Refinement of Concurrent Value-Dependent Noninterference" by Murray et. al. (CSF 2016) presents a compositional theory of refinement for a value-dependent noninterference property, defined in (Murray, PLAS 2015), for concurrent programs. This development formalises that refinement theory, and demonstrates its application on some small examples. extra-history = Change history: [2016-08-19]: Removed unused "stop" parameters from the sifum_refinement locale. (revision dbc482d36372) [2016-09-02]: TobyM extended "simple" refinement theory to be usable for all bisimulations. (revision 547f31c25f60) [Relational-Incorrectness-Logic] title = An Under-Approximate Relational Logic author = Toby Murray topic = Computer science/Programming languages/Logics, Computer science/Security date = 2020-03-12 notify = toby.murray@unimelb.edu.au abstract = Recently, authors have proposed under-approximate logics for reasoning about programs. So far, all such logics have been confined to reasoning about individual program behaviours. Yet there exist many over-approximate relational logics for reasoning about pairs of programs and relating their behaviours. We present the first under-approximate relational logic, for the simple imperative language IMP. We prove our logic is both sound and complete. Additionally, we show how reasoning in this logic can be decomposed into non-relational reasoning in an under-approximate Hoare logic, mirroring Beringer’s result for over-approximate relational logics. We illustrate the application of our logic on some small examples in which we provably demonstrate the presence of insecurity. [Strong_Security] title = A Formalization of Strong Security author = Sylvia Grewe , Alexander Lux , Heiko Mantel , Jens Sauer date = 2014-04-23 topic = Computer science/Security, Computer science/Programming languages/Type systems abstract = Research in information-flow security aims at developing methods to identify undesired information leaks within programs from private sources to public sinks. Noninterference captures this intuition. Strong security from Sabelfeld and Sands formalizes noninterference for concurrent systems.

We present an Isabelle/HOL formalization of strong security for arbitrary security lattices (Sabelfeld and Sands use a two-element security lattice in the original publication). The formalization includes compositionality proofs for strong security and a soundness proof for a security type system that checks strong security for programs in a simple while language with dynamic thread creation.

Our formalization of the security type system is abstract in the language for expressions and in the semantic side conditions for expressions. It can easily be instantiated with different syntactic approximations for these side conditions. The soundness proof of such an instantiation boils down to showing that these syntactic approximations imply the semantic side conditions. notify = grewe@cs.tu-darmstadt.de [WHATandWHERE_Security] title = A Formalization of Declassification with WHAT-and-WHERE-Security author = Sylvia Grewe , Alexander Lux , Heiko Mantel , Jens Sauer date = 2014-04-23 topic = Computer science/Security, Computer science/Programming languages/Type systems abstract = Research in information-flow security aims at developing methods to identify undesired information leaks within programs from private sources to public sinks. Noninterference captures this intuition by requiring that no information whatsoever flows from private sources to public sinks. However, in practice this definition is often too strict: Depending on the intuitive desired security policy, the controlled declassification of certain private information (WHAT) at certain points in the program (WHERE) might not result in an undesired information leak.

We present an Isabelle/HOL formalization of such a security property for controlled declassification, namely WHAT&WHERE-security from "Scheduler-Independent Declassification" by Lux, Mantel, and Perner. The formalization includes compositionality proofs for and a soundness proof for a security type system that checks for programs in a simple while language with dynamic thread creation.

Our formalization of the security type system is abstract in the language for expressions and in the semantic side conditions for expressions. It can easily be instantiated with different syntactic approximations for these side conditions. The soundness proof of such an instantiation boils down to showing that these syntactic approximations imply the semantic side conditions.

This Isabelle/HOL formalization uses theories from the entry Strong Security. notify = grewe@cs.tu-darmstadt.de [VolpanoSmith] title = A Correctness Proof for the Volpano/Smith Security Typing System author = Gregor Snelting , Daniel Wasserrab date = 2008-09-02 topic = Computer science/Programming languages/Type systems, Computer science/Security abstract = The Volpano/Smith/Irvine security type systems requires that variables are annotated as high (secret) or low (public), and provides typing rules which guarantee that secret values cannot leak to public output ports. This property of a program is called confidentiality. For a simple while-language without threads, our proof shows that typeability in the Volpano/Smith system guarantees noninterference. Noninterference means that if two initial states for program execution are low-equivalent, then the final states are low-equivalent as well. This indeed implies that secret values cannot leak to public ports. The proof defines an abstract syntax and operational semantics for programs, formalizes noninterference, and then proceeds by rule induction on the operational semantics. The mathematically most intricate part is the treatment of implicit flows. Note that the Volpano/Smith system is not flow-sensitive and thus quite unprecise, resulting in false alarms. However, due to the correctness property, all potential breaks of confidentiality are discovered. notify = [Abstract-Hoare-Logics] title = Abstract Hoare Logics author = Tobias Nipkow date = 2006-08-08 topic = Computer science/Programming languages/Logics abstract = These therories describe Hoare logics for a number of imperative language constructs, from while-loops to mutually recursive procedures. Both partial and total correctness are treated. In particular a proof system for total correctness of recursive procedures in the presence of unbounded nondeterminism is presented. notify = nipkow@in.tum.de [Stone_Algebras] title = Stone Algebras author = Walter Guttmann notify = walter.guttmann@canterbury.ac.nz date = 2016-09-06 topic = Mathematics/Order abstract = A range of algebras between lattices and Boolean algebras generalise the notion of a complement. We develop a hierarchy of these pseudo-complemented algebras that includes Stone algebras. Independently of this theory we study filters based on partial orders. Both theories are combined to prove Chen and Grätzer's construction theorem for Stone algebras. The latter involves extensive reasoning about algebraic structures in addition to reasoning in algebraic structures. [Kleene_Algebra] title = Kleene Algebra author = Alasdair Armstrong <>, Georg Struth , Tjark Weber date = 2013-01-15 topic = Computer science/Programming languages/Logics, Computer science/Automata and formal languages, Mathematics/Algebra abstract = These files contain a formalisation of variants of Kleene algebras and their most important models as axiomatic type classes in Isabelle/HOL. Kleene algebras are foundational structures in computing with applications ranging from automata and language theory to computational modeling, program construction and verification.

We start with formalising dioids, which are additively idempotent semirings, and expand them by axiomatisations of the Kleene star for finite iteration and an omega operation for infinite iteration. We show that powersets over a given monoid, (regular) languages, sets of paths in a graph, sets of computation traces, binary relations and formal power series form Kleene algebras, and consider further models based on lattices, max-plus semirings and min-plus semirings. We also demonstrate that dioids are closed under the formation of matrices (proofs for Kleene algebras remain to be completed).

On the one hand we have aimed at a reference formalisation of variants of Kleene algebras that covers a wide range of variants and the core theorems in a structured and modular way and provides readable proofs at text book level. On the other hand, we intend to use this algebraic hierarchy and its models as a generic algebraic middle-layer from which programming applications can quickly be explored, implemented and verified. notify = g.struth@sheffield.ac.uk, tjark.weber@it.uu.se [KAT_and_DRA] title = Kleene Algebra with Tests and Demonic Refinement Algebras author = Alasdair Armstrong <>, Victor B. F. Gomes , Georg Struth date = 2014-01-23 topic = Computer science/Programming languages/Logics, Computer science/Automata and formal languages, Mathematics/Algebra abstract = We formalise Kleene algebra with tests (KAT) and demonic refinement algebra (DRA) in Isabelle/HOL. KAT is relevant for program verification and correctness proofs in the partial correctness setting. While DRA targets similar applications in the context of total correctness. Our formalisation contains the two most important models of these algebras: binary relations in the case of KAT and predicate transformers in the case of DRA. In addition, we derive the inference rules for Hoare logic in KAT and its relational model and present a simple formally verified program verification tool prototype based on the algebraic approach. notify = g.struth@dcs.shef.ac.uk [KAD] title = Kleene Algebras with Domain author = Victor B. F. Gomes , Walter Guttmann , Peter Höfner , Georg Struth , Tjark Weber date = 2016-04-12 topic = Computer science/Programming languages/Logics, Computer science/Automata and formal languages, Mathematics/Algebra abstract = Kleene algebras with domain are Kleene algebras endowed with an operation that maps each element of the algebra to its domain of definition (or its complement) in abstract fashion. They form a simple algebraic basis for Hoare logics, dynamic logics or predicate transformer semantics. We formalise a modular hierarchy of algebras with domain and antidomain (domain complement) operations in Isabelle/HOL that ranges from domain and antidomain semigroups to modal Kleene algebras and divergence Kleene algebras. We link these algebras with models of binary relations and program traces. We include some examples from modal logics, termination and program analysis. notify = walter.guttman@canterbury.ac.nz, g.struth@sheffield.ac.uk, tjark.weber@it.uu.se [Regular_Algebras] title = Regular Algebras author = Simon Foster , Georg Struth date = 2014-05-21 topic = Computer science/Automata and formal languages, Mathematics/Algebra abstract = Regular algebras axiomatise the equational theory of regular expressions as induced by regular language identity. We use Isabelle/HOL for a detailed systematic study of regular algebras given by Boffa, Conway, Kozen and Salomaa. We investigate the relationships between these classes, formalise a soundness proof for the smallest class (Salomaa's) and obtain completeness of the largest one (Boffa's) relative to a deep result by Krob. In addition we provide a large collection of regular identities in the general setting of Boffa's axiom. Our regular algebra hierarchy is orthogonal to the Kleene algebra hierarchy in the Archive of Formal Proofs; we have not aimed at an integration for pragmatic reasons. notify = simon.foster@york.ac.uk, g.struth@sheffield.ac.uk [BytecodeLogicJmlTypes] title = A Bytecode Logic for JML and Types author = Lennart Beringer <>, Martin Hofmann date = 2008-12-12 topic = Computer science/Programming languages/Logics abstract = This document contains the Isabelle/HOL sources underlying the paper A bytecode logic for JML and types by Beringer and Hofmann, updated to Isabelle 2008. We present a program logic for a subset of sequential Java bytecode that is suitable for representing both, features found in high-level specification language JML as well as interpretations of high-level type systems. To this end, we introduce a fine-grained collection of assertions, including strong invariants, local annotations and VDM-reminiscent partial-correctness specifications. Thanks to a goal-oriented structure and interpretation of judgements, verification may proceed without recourse to an additional control flow analysis. The suitability for interpreting intensional type systems is illustrated by the proof-carrying-code style encoding of a type system for a first-order functional language which guarantees a constant upper bound on the number of objects allocated throughout an execution, be the execution terminating or non-terminating. Like the published paper, the formal development is restricted to a comparatively small subset of the JVML, lacking (among other features) exceptions, arrays, virtual methods, and static fields. This shortcoming has been overcome meanwhile, as our paper has formed the basis of the Mobius base logic, a program logic for the full sequential fragment of the JVML. Indeed, the present formalisation formed the basis of a subsequent formalisation of the Mobius base logic in the proof assistant Coq, which includes a proof of soundness with respect to the Bicolano operational semantics by Pichardie. notify = [DataRefinementIBP] title = Semantics and Data Refinement of Invariant Based Programs author = Viorel Preoteasa , Ralph-Johan Back date = 2010-05-28 topic = Computer science/Programming languages/Logics abstract = The invariant based programming is a technique of constructing correct programs by first identifying the basic situations (pre- and post-conditions and invariants) that can occur during the execution of the program, and then defining the transitions and proving that they preserve the invariants. Data refinement is a technique of building correct programs working on concrete datatypes as refinements of more abstract programs. In the theories presented here we formalize the predicate transformer semantics for invariant based programs and their data refinement. extra-history = Change history: [2012-01-05]: Moved some general complete lattice properties to the AFP entry Lattice Properties. Changed the definition of the data refinement relation to be more general and updated all corresponding theorems. Added new syntax for demonic and angelic update statements. notify = viorel.preoteasa@aalto.fi [RefinementReactive] title = Formalization of Refinement Calculus for Reactive Systems author = Viorel Preoteasa date = 2014-10-08 topic = Computer science/Programming languages/Logics abstract = We present a formalization of refinement calculus for reactive systems. Refinement calculus is based on monotonic predicate transformers (monotonic functions from sets of post-states to sets of pre-states), and it is a powerful formalism for reasoning about imperative programs. We model reactive systems as monotonic property transformers that transform sets of output infinite sequences into sets of input infinite sequences. Within this semantics we can model refinement of reactive systems, (unbounded) angelic and demonic nondeterminism, sequential composition, and other semantic properties. We can model systems that may fail for some inputs, and we can model compatibility of systems. We can specify systems that have liveness properties using linear temporal logic, and we can refine system specifications into systems based on symbolic transitions systems, suitable for implementations. notify = viorel.preoteasa@aalto.fi [SIFPL] title = Secure information flow and program logics author = Lennart Beringer <>, Martin Hofmann date = 2008-11-10 topic = Computer science/Programming languages/Logics, Computer science/Security abstract = We present interpretations of type systems for secure information flow in Hoare logic, complementing previous encodings in relational program logics. We first treat the imperative language IMP, extended by a simple procedure call mechanism. For this language we consider base-line non-interference in the style of Volpano et al. and the flow-sensitive type system by Hunt and Sands. In both cases, we show how typing derivations may be used to automatically generate proofs in the program logic that certify the absence of illicit flows. We then add instructions for object creation and manipulation, and derive appropriate proof rules for base-line non-interference. As a consequence of our work, standard verification technology may be used for verifying that a concrete program satisfies the non-interference property.

The present proof development represents an update of the formalisation underlying our paper [CSF 2007] and is intended to resolve any ambiguities that may be present in the paper. notify = lennart.beringer@ifi.lmu.de [TLA] title = A Definitional Encoding of TLA* in Isabelle/HOL author = Gudmund Grov , Stephan Merz date = 2011-11-19 topic = Computer science/Programming languages/Logics abstract = We mechanise the logic TLA* [Merz 1999], an extension of Lamport's Temporal Logic of Actions (TLA) [Lamport 1994] for specifying and reasoning about concurrent and reactive systems. Aiming at a framework for mechanising] the verification of TLA (or TLA*) specifications, this contribution reuses some elements from a previous axiomatic encoding of TLA in Isabelle/HOL by the second author [Merz 1998], which has been part of the Isabelle distribution. In contrast to that previous work, we give here a shallow, definitional embedding, with the following highlights:

  • a theory of infinite sequences, including a formalisation of the concepts of stuttering invariance central to TLA and TLA*;
  • a definition of the semantics of TLA*, which extends TLA by a mutually-recursive definition of formulas and pre-formulas, generalising TLA action formulas;
  • a substantial set of derived proof rules, including the TLA* axioms and Lamport's proof rules for system verification;
  • a set of examples illustrating the usage of Isabelle/TLA* for reasoning about systems.
Note that this work is unrelated to the ongoing development of a proof system for the specification language TLA+, which includes an encoding of TLA+ as a new Isabelle object logic [Chaudhuri et al 2010]. notify = ggrov@inf.ed.ac.uk [Compiling-Exceptions-Correctly] title = Compiling Exceptions Correctly author = Tobias Nipkow date = 2004-07-09 topic = Computer science/Programming languages/Compiling abstract = An exception compilation scheme that dynamically creates and removes exception handler entries on the stack. A formalization of an article of the same name by Hutton and Wright. notify = nipkow@in.tum.de [NormByEval] title = Normalization by Evaluation author = Klaus Aehlig , Tobias Nipkow date = 2008-02-18 topic = Computer science/Programming languages/Compiling abstract = This article formalizes normalization by evaluation as implemented in Isabelle. Lambda calculus plus term rewriting is compiled into a functional program with pattern matching. It is proved that the result of a successful evaluation is a) correct, i.e. equivalent to the input, and b) in normal form. notify = nipkow@in.tum.de [Program-Conflict-Analysis] title = Formalization of Conflict Analysis of Programs with Procedures, Thread Creation, and Monitors topic = Computer science/Programming languages/Static analysis author = Peter Lammich , Markus Müller-Olm date = 2007-12-14 abstract = In this work we formally verify the soundness and precision of a static program analysis that detects conflicts (e. g. data races) in programs with procedures, thread creation and monitors with the Isabelle theorem prover. As common in static program analysis, our program model abstracts guarded branching by nondeterministic branching, but completely interprets the call-/return behavior of procedures, synchronization by monitors, and thread creation. The analysis is based on the observation that all conflicts already occur in a class of particularly restricted schedules. These restricted schedules are suited to constraint-system-based program analysis. The formalization is based upon a flowgraph-based program model with an operational semantics as reference point. notify = peter.lammich@uni-muenster.de [Shivers-CFA] title = Shivers' Control Flow Analysis topic = Computer science/Programming languages/Static analysis author = Joachim Breitner date = 2010-11-16 abstract = In his dissertation, Olin Shivers introduces a concept of control flow graphs for functional languages, provides an algorithm to statically derive a safe approximation of the control flow graph and proves this algorithm correct. In this research project, Shivers' algorithms and proofs are formalized in the HOLCF extension of HOL. notify = mail@joachim-breitner.de, nipkow@in.tum.de [Slicing] title = Towards Certified Slicing author = Daniel Wasserrab date = 2008-09-16 topic = Computer science/Programming languages/Static analysis abstract = Slicing is a widely-used technique with applications in e.g. compiler technology and software security. Thus verification of algorithms in these areas is often based on the correctness of slicing, which should ideally be proven independent of concrete programming languages and with the help of well-known verifying techniques such as proof assistants. As a first step in this direction, this contribution presents a framework for dynamic and static intraprocedural slicing based on control flow and program dependence graphs. Abstracting from concrete syntax we base the framework on a graph representation of the program fulfilling certain structural and well-formedness properties.

The formalization consists of the basic framework (in subdirectory Basic/), the correctness proof for dynamic slicing (in subdirectory Dynamic/), the correctness proof for static intraprocedural slicing (in subdirectory StaticIntra/) and instantiations of the framework with a simple While language (in subdirectory While/) and the sophisticated object-oriented bytecode language of Jinja (in subdirectory JinjaVM/). For more information on the framework, see the TPHOLS 2008 paper by Wasserrab and Lochbihler and the PLAS 2009 paper by Wasserrab et al. notify = [HRB-Slicing] title = Backing up Slicing: Verifying the Interprocedural Two-Phase Horwitz-Reps-Binkley Slicer author = Daniel Wasserrab date = 2009-11-13 topic = Computer science/Programming languages/Static analysis abstract = After verifying dynamic and static interprocedural slicing, we present a modular framework for static interprocedural slicing. To this end, we formalized the standard two-phase slicer from Horwitz, Reps and Binkley (see their TOPLAS 12(1) 1990 paper) together with summary edges as presented by Reps et al. (see FSE 1994). The framework is again modular in the programming language by using an abstract CFG, defined via structural and well-formedness properties. Using a weak simulation between the original and sliced graph, we were able to prove the correctness of static interprocedural slicing. We also instantiate our framework with a simple While language with procedures. This shows that the chosen abstractions are indeed valid. notify = nipkow@in.tum.de [WorkerWrapper] title = The Worker/Wrapper Transformation author = Peter Gammie date = 2009-10-30 topic = Computer science/Programming languages/Transformations abstract = Gill and Hutton formalise the worker/wrapper transformation, building on the work of Launchbury and Peyton-Jones who developed it as a way of changing the type at which a recursive function operates. This development establishes the soundness of the technique and several examples of its use. notify = peteg42@gmail.com, nipkow@in.tum.de [JiveDataStoreModel] title = Jive Data and Store Model author = Nicole Rauch , Norbert Schirmer <> date = 2005-06-20 license = LGPL topic = Computer science/Programming languages/Misc abstract = This document presents the formalization of an object-oriented data and store model in Isabelle/HOL. This model is being used in the Java Interactive Verification Environment, Jive. notify = kleing@cse.unsw.edu.au, schirmer@in.tum.de [HotelKeyCards] title = Hotel Key Card System author = Tobias Nipkow date = 2006-09-09 topic = Computer science/Security abstract = Two models of an electronic hotel key card system are contrasted: a state based and a trace based one. Both are defined, verified, and proved equivalent in the theorem prover Isabelle/HOL. It is shown that if a guest follows a certain safety policy regarding her key cards, she can be sure that nobody but her can enter her room. notify = nipkow@in.tum.de [RSAPSS] title = SHA1, RSA, PSS and more author = Christina Lindenberg <>, Kai Wirt <> date = 2005-05-02 topic = Computer science/Security/Cryptography abstract = Formal verification is getting more and more important in computer science. However the state of the art formal verification methods in cryptography are very rudimentary. These theories are one step to provide a tool box allowing the use of formal methods in every aspect of cryptography. Moreover we present a proof of concept for the feasibility of verification techniques to a standard signature algorithm. notify = nipkow@in.tum.de [InformationFlowSlicing] title = Information Flow Noninterference via Slicing author = Daniel Wasserrab date = 2010-03-23 topic = Computer science/Security abstract =

In this contribution, we show how correctness proofs for intra- and interprocedural slicing can be used to prove that slicing is able to guarantee information flow noninterference. Moreover, we also illustrate how to lift the control flow graphs of the respective frameworks such that they fulfil the additional assumptions needed in the noninterference proofs. A detailed description of the intraprocedural proof and its interplay with the slicing framework can be found in the PLAS'09 paper by Wasserrab et al.

This entry contains the part for intra-procedural slicing. See entry InformationFlowSlicing_Inter for the inter-procedural part.

extra-history = Change history: [2016-06-10]: The original entry InformationFlowSlicing contained both the inter- and intra-procedural case was split into two for easier maintenance. notify = [InformationFlowSlicing_Inter] title = Inter-Procedural Information Flow Noninterference via Slicing author = Daniel Wasserrab date = 2010-03-23 topic = Computer science/Security abstract =

In this contribution, we show how correctness proofs for intra- and interprocedural slicing can be used to prove that slicing is able to guarantee information flow noninterference. Moreover, we also illustrate how to lift the control flow graphs of the respective frameworks such that they fulfil the additional assumptions needed in the noninterference proofs. A detailed description of the intraprocedural proof and its interplay with the slicing framework can be found in the PLAS'09 paper by Wasserrab et al.

This entry contains the part for inter-procedural slicing. See entry InformationFlowSlicing for the intra-procedural part.

extra-history = Change history: [2016-06-10]: The original entry InformationFlowSlicing contained both the inter- and intra-procedural case was split into two for easier maintenance. notify = [ComponentDependencies] title = Formalisation and Analysis of Component Dependencies author = Maria Spichkova date = 2014-04-28 topic = Computer science/System description languages abstract = This set of theories presents a formalisation in Isabelle/HOL of data dependencies between components. The approach allows to analyse system structure oriented towards efficient checking of system: it aims at elaborating for a concrete system, which parts of the system are necessary to check a given property. notify = maria.spichkova@rmit.edu.au [Verified-Prover] title = A Mechanically Verified, Efficient, Sound and Complete Theorem Prover For First Order Logic author = Tom Ridge <> date = 2004-09-28 topic = Logic/General logic/Mechanization of proofs abstract = Soundness and completeness for a system of first order logic are formally proved, building on James Margetson's formalization of work by Wainer and Wallen. The completeness proofs naturally suggest an algorithm to derive proofs. This algorithm, which can be implemented tail recursively, is formalized in Isabelle/HOL. The algorithm can be executed via the rewriting tactics of Isabelle. Alternatively, the definitions can be exported to OCaml, yielding a directly executable program. notify = lp15@cam.ac.uk [Completeness] title = Completeness theorem author = James Margetson <>, Tom Ridge <> date = 2004-09-20 topic = Logic/Proof theory abstract = The completeness of first-order logic is proved, following the first five pages of Wainer and Wallen's chapter of the book Proof Theory by Aczel et al., CUP, 1992. Their presentation of formulas allows the proofs to use symmetry arguments. Margetson formalized this theorem by early 2000. The Isar conversion is thanks to Tom Ridge. A paper describing the formalization is available [pdf]. notify = lp15@cam.ac.uk [Ordinal] title = Countable Ordinals author = Brian Huffman date = 2005-11-11 topic = Logic/Set theory abstract = This development defines a well-ordered type of countable ordinals. It includes notions of continuous and normal functions, recursively defined functions over ordinals, least fixed-points, and derivatives. Much of ordinal arithmetic is formalized, including exponentials and logarithms. The development concludes with formalizations of Cantor Normal Form and Veblen hierarchies over normal functions. notify = lcp@cl.cam.ac.uk [Ordinals_and_Cardinals] title = Ordinals and Cardinals author = Andrei Popescu <> date = 2009-09-01 topic = Logic/Set theory abstract = We develop a basic theory of ordinals and cardinals in Isabelle/HOL, up to the point where some cardinality facts relevant for the ``working mathematician" become available. Unlike in set theory, here we do not have at hand canonical notions of ordinal and cardinal. Therefore, here an ordinal is merely a well-order relation and a cardinal is an ordinal minim w.r.t. order embedding on its field. extra-history = Change history: [2012-09-25]: This entry has been discontinued because it is now part of the Isabelle distribution. notify = uuomul@yahoo.com, nipkow@in.tum.de [FOL-Fitting] title = First-Order Logic According to Fitting author = Stefan Berghofer contributors = Asta Halkjær From date = 2007-08-02 topic = Logic/General logic/Classical first-order logic abstract = We present a formalization of parts of Melvin Fitting's book "First-Order Logic and Automated Theorem Proving". The formalization covers the syntax of first-order logic, its semantics, the model existence theorem, a natural deduction proof calculus together with a proof of correctness and completeness, as well as the Löwenheim-Skolem theorem. extra-history = Change history: [2018-07-21]: Proved completeness theorem for open formulas. Proofs are now written in the declarative style. Enumeration of pairs and datatypes is automated using the Countable theory. notify = berghofe@in.tum.de [Epistemic_Logic] title = Epistemic Logic author = Asta Halkjær From topic = Logic/General logic/Logics of knowledge and belief date = 2018-10-29 notify = ahfrom@dtu.dk abstract = This work is a formalization of epistemic logic with countably many agents. It includes proofs of soundness and completeness for the axiom system K. The completeness proof is based on the textbook "Reasoning About Knowledge" by Fagin, Halpern, Moses and Vardi (MIT Press 1995). [SequentInvertibility] title = Invertibility in Sequent Calculi author = Peter Chapman <> date = 2009-08-28 topic = Logic/Proof theory license = LGPL abstract = The invertibility of the rules of a sequent calculus is important for guiding proof search and can be used in some formalised proofs of Cut admissibility. We present sufficient conditions for when a rule is invertible with respect to a calculus. We illustrate the conditions with examples. It must be noted we give purely syntactic criteria; no guarantees are given as to the suitability of the rules. notify = pc@cs.st-andrews.ac.uk, nipkow@in.tum.de [LinearQuantifierElim] title = Quantifier Elimination for Linear Arithmetic author = Tobias Nipkow date = 2008-01-11 topic = Logic/General logic/Decidability of theories abstract = This article formalizes quantifier elimination procedures for dense linear orders, linear real arithmetic and Presburger arithmetic. In each case both a DNF-based non-elementary algorithm and one or more (doubly) exponential NNF-based algorithms are formalized, including the well-known algorithms by Ferrante and Rackoff and by Cooper. The NNF-based algorithms for dense linear orders are new but based on Ferrante and Rackoff and on an algorithm by Loos and Weisspfenning which simulates infenitesimals. All algorithms are directly executable. In particular, they yield reflective quantifier elimination procedures for HOL itself. The formalization makes heavy use of locales and is therefore highly modular. notify = nipkow@in.tum.de [Nat-Interval-Logic] title = Interval Temporal Logic on Natural Numbers author = David Trachtenherz <> date = 2011-02-23 topic = Logic/General logic/Temporal logic abstract = We introduce a theory of temporal logic operators using sets of natural numbers as time domain, formalized in a shallow embedding manner. The theory comprises special natural intervals (theory IL_Interval: open and closed intervals, continuous and modulo intervals, interval traversing results), operators for shifting intervals to left/right on the number axis as well as expanding/contracting intervals by constant factors (theory IL_IntervalOperators.thy), and ultimately definitions and results for unary and binary temporal operators on arbitrary natural sets (theory IL_TemporalOperators). notify = nipkow@in.tum.de [Recursion-Theory-I] title = Recursion Theory I author = Michael Nedzelsky <> date = 2008-04-05 topic = Logic/Computability abstract = This document presents the formalization of introductory material from recursion theory --- definitions and basic properties of primitive recursive functions, Cantor pairing function and computably enumerable sets (including a proof of existence of a one-complete computably enumerable set and a proof of the Rice's theorem). notify = MichaelNedzelsky@yandex.ru [Free-Boolean-Algebra] topic = Logic/General logic/Classical propositional logic title = Free Boolean Algebra author = Brian Huffman date = 2010-03-29 abstract = This theory defines a type constructor representing the free Boolean algebra over a set of generators. Values of type (α)formula represent propositional formulas with uninterpreted variables from type α, ordered by implication. In addition to all the standard Boolean algebra operations, the library also provides a function for building homomorphisms to any other Boolean algebra type. notify = brianh@cs.pdx.edu [Sort_Encodings] title = Sound and Complete Sort Encodings for First-Order Logic author = Jasmin Christian Blanchette , Andrei Popescu date = 2013-06-27 topic = Logic/General logic/Mechanization of proofs abstract = This is a formalization of the soundness and completeness properties for various efficient encodings of sorts in unsorted first-order logic used by Isabelle's Sledgehammer tool.

Essentially, the encodings proceed as follows: a many-sorted problem is decorated with (as few as possible) tags or guards that make the problem monotonic; then sorts can be soundly erased.

The development employs a formalization of many-sorted first-order logic in clausal form (clauses, structures and the basic properties of the satisfaction relation), which could be of interest as the starting point for other formalizations of first-order logic metatheory. notify = uuomul@yahoo.com [Lambda_Free_RPOs] title = Formalization of Recursive Path Orders for Lambda-Free Higher-Order Terms author = Jasmin Christian Blanchette , Uwe Waldmann , Daniel Wand date = 2016-09-23 topic = Logic/Rewriting abstract = This Isabelle/HOL formalization defines recursive path orders (RPOs) for higher-order terms without lambda-abstraction and proves many useful properties about them. The main order fully coincides with the standard RPO on first-order terms also in the presence of currying, distinguishing it from previous work. An optimized variant is formalized as well. It appears promising as the basis of a higher-order superposition calculus. notify = jasmin.blanchette@gmail.com [Lambda_Free_KBOs] title = Formalization of Knuth–Bendix Orders for Lambda-Free Higher-Order Terms author = Heiko Becker , Jasmin Christian Blanchette , Uwe Waldmann , Daniel Wand date = 2016-11-12 topic = Logic/Rewriting abstract = This Isabelle/HOL formalization defines Knuth–Bendix orders for higher-order terms without lambda-abstraction and proves many useful properties about them. The main order fully coincides with the standard transfinite KBO with subterm coefficients on first-order terms. It appears promising as the basis of a higher-order superposition calculus. notify = jasmin.blanchette@gmail.com [Lambda_Free_EPO] title = Formalization of the Embedding Path Order for Lambda-Free Higher-Order Terms author = Alexander Bentkamp topic = Logic/Rewriting date = 2018-10-19 notify = a.bentkamp@vu.nl abstract = This Isabelle/HOL formalization defines the Embedding Path Order (EPO) for higher-order terms without lambda-abstraction and proves many useful properties about it. In contrast to the lambda-free recursive path orders, it does not fully coincide with RPO on first-order terms, but it is compatible with arbitrary higher-order contexts. [Nested_Multisets_Ordinals] title = Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals author = Jasmin Christian Blanchette , Mathias Fleury , Dmitriy Traytel date = 2016-11-12 topic = Logic/Rewriting abstract = This Isabelle/HOL formalization introduces a nested multiset datatype and defines Dershowitz and Manna's nested multiset order. The order is proved well founded and linear. By removing one constructor, we transform the nested multisets into hereditary multisets. These are isomorphic to the syntactic ordinals—the ordinals can be recursively expressed in Cantor normal form. Addition, subtraction, multiplication, and linear orders are provided on this type. notify = jasmin.blanchette@gmail.com [Abstract-Rewriting] title = Abstract Rewriting topic = Logic/Rewriting date = 2010-06-14 author = Christian Sternagel , René Thiemann license = LGPL abstract = We present an Isabelle formalization of abstract rewriting (see, e.g., the book by Baader and Nipkow). First, we define standard relations like joinability, meetability, conversion, etc. Then, we formalize important properties of abstract rewrite systems, e.g., confluence and strong normalization. Our main concern is on strong normalization, since this formalization is the basis of CeTA (which is mainly about strong normalization of term rewrite systems). Hence lemmas involving strong normalization constitute by far the biggest part of this theory. One of those is Newman's lemma. extra-history = Change history: [2010-09-17]: Added theories defining several (ordered) semirings related to strong normalization and giving some standard instances.
[2013-10-16]: Generalized delta-orders from rationals to Archimedean fields. notify = christian.sternagel@uibk.ac.at, rene.thiemann@uibk.ac.at [First_Order_Terms] title = First-Order Terms author = Christian Sternagel , René Thiemann topic = Logic/Rewriting, Computer science/Algorithms license = LGPL date = 2018-02-06 notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at abstract = We formalize basic results on first-order terms, including matching and a first-order unification algorithm, as well as well-foundedness of the subsumption order. This entry is part of the Isabelle Formalization of Rewriting IsaFoR, where first-order terms are omni-present: the unification algorithm is used to certify several confluence and termination techniques, like critical-pair computation and dependency graph approximations; and the subsumption order is a crucial ingredient for completion. [Free-Groups] title = Free Groups author = Joachim Breitner date = 2010-06-24 topic = Mathematics/Algebra abstract = Free Groups are, in a sense, the most generic kind of group. They are defined over a set of generators with no additional relations in between them. They play an important role in the definition of group presentations and in other fields. This theory provides the definition of Free Group as the set of fully canceled words in the generators. The universal property is proven, as well as some isomorphisms results about Free Groups. extra-history = Change history: [2011-12-11]: Added the Ping Pong Lemma. notify = [CofGroups] title = An Example of a Cofinitary Group in Isabelle/HOL author = Bart Kastermans date = 2009-08-04 topic = Mathematics/Algebra abstract = We formalize the usual proof that the group generated by the function k -> k + 1 on the integers gives rise to a cofinitary group. notify = nipkow@in.tum.de [Group-Ring-Module] title = Groups, Rings and Modules author = Hidetsune Kobayashi <>, L. Chen <>, H. Murao <> date = 2004-05-18 topic = Mathematics/Algebra abstract = The theory of groups, rings and modules is developed to a great depth. Group theory results include Zassenhaus's theorem and the Jordan-Hoelder theorem. The ring theory development includes ideals, quotient rings and the Chinese remainder theorem. The module development includes the Nakayama lemma, exact sequences and Tensor products. notify = lp15@cam.ac.uk [Robbins-Conjecture] title = A Complete Proof of the Robbins Conjecture author = Matthew Wampler-Doty <> date = 2010-05-22 topic = Mathematics/Algebra abstract = This document gives a formalization of the proof of the Robbins conjecture, following A. Mann, A Complete Proof of the Robbins Conjecture, 2003. notify = nipkow@in.tum.de [Valuation] title = Fundamental Properties of Valuation Theory and Hensel's Lemma author = Hidetsune Kobayashi <> date = 2007-08-08 topic = Mathematics/Algebra abstract = Convergence with respect to a valuation is discussed as convergence of a Cauchy sequence. Cauchy sequences of polynomials are defined. They are used to formalize Hensel's lemma. notify = lp15@cam.ac.uk [Rank_Nullity_Theorem] title = Rank-Nullity Theorem in Linear Algebra author = Jose Divasón , Jesús Aransay topic = Mathematics/Algebra date = 2013-01-16 abstract = In this contribution, we present some formalizations based on the HOL-Multivariate-Analysis session of Isabelle. Firstly, a generalization of several theorems of such library are presented. Secondly, some definitions and proofs involving Linear Algebra and the four fundamental subspaces of a matrix are shown. Finally, we present a proof of the result known in Linear Algebra as the ``Rank-Nullity Theorem'', which states that, given any linear map f from a finite dimensional vector space V to a vector space W, then the dimension of V is equal to the dimension of the kernel of f (which is a subspace of V) and the dimension of the range of f (which is a subspace of W). The proof presented here is based on the one given by Sheldon Axler in his book Linear Algebra Done Right. As a corollary of the previous theorem, and taking advantage of the relationship between linear maps and matrices, we prove that, for every matrix A (which has associated a linear map between finite dimensional vector spaces), the sum of its null space and its column space (which is equal to the range of the linear map) is equal to the number of columns of A. extra-history = Change history: [2014-07-14]: Added some generalizations that allow us to formalize the Rank-Nullity Theorem over finite dimensional vector spaces, instead of over the more particular euclidean spaces. Updated abstract. notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es [Affine_Arithmetic] title = Affine Arithmetic author = Fabian Immler date = 2014-02-07 topic = Mathematics/Analysis abstract = We give a formalization of affine forms as abstract representations of zonotopes. We provide affine operations as well as overapproximations of some non-affine operations like multiplication and division. Expressions involving those operations can automatically be turned into (executable) functions approximating the original expression in affine arithmetic. extra-history = Change history: [2015-01-31]: added algorithm for zonotope/hyperplane intersection
[2017-09-20]: linear approximations for all symbols from the floatarith data type notify = immler@in.tum.de [Laplace_Transform] title = Laplace Transform author = Fabian Immler topic = Mathematics/Analysis date = 2019-08-14 notify = fimmler@cs.cmu.edu abstract = This entry formalizes the Laplace transform and concrete Laplace transforms for arithmetic functions, frequency shift, integration and (higher) differentiation in the time domain. It proves Lerch's lemma and uniqueness of the Laplace transform for continuous functions. In order to formalize the foundational assumptions, this entry contains a formalization of piecewise continuous functions and functions of exponential order. [Cauchy] title = Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality author = Benjamin Porter <> date = 2006-03-14 topic = Mathematics/Analysis abstract = This document presents the mechanised proofs of two popular theorems attributed to Augustin Louis Cauchy - Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality. notify = kleing@cse.unsw.edu.au [Integration] title = Integration theory and random variables author = Stefan Richter date = 2004-11-19 topic = Mathematics/Analysis abstract = Lebesgue-style integration plays a major role in advanced probability. We formalize concepts of elementary measure theory, real-valued random variables as Borel-measurable functions, and a stepwise inductive definition of the integral itself. All proofs are carried out in human readable style using the Isar language. extra-note = Note: This article is of historical interest only. Lebesgue-style integration and probability theory are now available as part of the Isabelle/HOL distribution (directory Probability). notify = richter@informatik.rwth-aachen.de, nipkow@in.tum.de, hoelzl@in.tum.de [Ordinary_Differential_Equations] title = Ordinary Differential Equations author = Fabian Immler , Johannes Hölzl topic = Mathematics/Analysis date = 2012-04-26 abstract =

Session Ordinary-Differential-Equations formalizes ordinary differential equations (ODEs) and initial value problems. This work comprises proofs for local and global existence of unique solutions (Picard-Lindelöf theorem). Moreover, it contains a formalization of the (continuous or even differentiable) dependency of the flow on initial conditions as the flow of ODEs.

Not in the generated document are the following sessions:

  • HOL-ODE-Numerics: Rigorous numerical algorithms for computing enclosures of solutions based on Runge-Kutta methods and affine arithmetic. Reachability analysis with splitting and reduction at hyperplanes.
  • HOL-ODE-Examples: Applications of the numerical algorithms to concrete systems of ODEs.
  • Lorenz_C0, Lorenz_C1: Verified algorithms for checking C1-information according to Tucker's proof, computation of C0-information.

extra-history = Change history: [2014-02-13]: added an implementation of the Euler method based on affine arithmetic
[2016-04-14]: added flow and variational equation
[2016-08-03]: numerical algorithms for reachability analysis (using second-order Runge-Kutta methods, splitting, and reduction) implemented using Lammich's framework for automatic refinement
[2017-09-20]: added Poincare map and propagation of variational equation in reachability analysis, verified algorithms for C1-information and computations for C0-information of the Lorenz attractor. notify = immler@in.tum.de, hoelzl@in.tum.de [Polynomials] title = Executable Multivariate Polynomials author = Christian Sternagel , René Thiemann , Alexander Maletzky , Fabian Immler , Florian Haftmann , Andreas Lochbihler , Alexander Bentkamp date = 2010-08-10 topic = Mathematics/Analysis, Mathematics/Algebra, Computer science/Algorithms/Mathematical license = LGPL abstract = We define multivariate polynomials over arbitrary (ordered) semirings in combination with (executable) operations like addition, multiplication, and substitution. We also define (weak) monotonicity of polynomials and comparison of polynomials where we provide standard estimations like absolute positiveness or the more recent approach of Neurauter, Zankl, and Middeldorp. Moreover, it is proven that strongly normalizing (monotone) orders can be lifted to strongly normalizing (monotone) orders over polynomials. Our formalization was performed as part of the IsaFoR/CeTA-system which contains several termination techniques. The provided theories have been essential to formalize polynomial interpretations.

This formalization also contains an abstract representation as coefficient functions with finite support and a type of power-products. If this type is ordered by a linear (term) ordering, various additional notions, such as leading power-product, leading coefficient etc., are introduced as well. Furthermore, a lot of generic properties of, and functions on, multivariate polynomials are formalized, including the substitution and evaluation homomorphisms, embeddings of polynomial rings into larger rings (i.e. with one additional indeterminate), homogenization and dehomogenization of polynomials, and the canonical isomorphism between R[X,Y] and R[X][Y]. extra-history = Change history: [2010-09-17]: Moved theories on arbitrary (ordered) semirings to Abstract Rewriting.
[2016-10-28]: Added abstract representation of polynomials and authors Maletzky/Immler.
[2018-01-23]: Added authors Haftmann, Lochbihler after incorporating their formalization of multivariate polynomials based on Polynomial mappings. Moved material from Bentkamp's entry "Deep Learning".
[2019-04-18]: Added material about polynomials whose power-products are represented themselves by polynomial mappings. notify = rene.thiemann@uibk.ac.at, christian.sternagel@uibk.ac.at, alexander.maletzky@risc.jku.at, immler@in.tum.de [Sqrt_Babylonian] title = Computing N-th Roots using the Babylonian Method author = René Thiemann date = 2013-01-03 topic = Mathematics/Analysis license = LGPL abstract = We implement the Babylonian method to compute n-th roots of numbers. We provide precise algorithms for naturals, integers and rationals, and offer an approximation algorithm for square roots over linear ordered fields. Moreover, there are precise algorithms to compute the floor and the ceiling of n-th roots. extra-history = Change history: [2013-10-16]: Added algorithms to compute floor and ceiling of sqrt of integers. [2014-07-11]: Moved NthRoot_Impl from Real-Impl to this entry. notify = rene.thiemann@uibk.ac.at [Sturm_Sequences] title = Sturm's Theorem author = Manuel Eberl date = 2014-01-11 topic = Mathematics/Analysis abstract = Sturm's Theorem states that polynomial sequences with certain properties, so-called Sturm sequences, can be used to count the number of real roots of a real polynomial. This work contains a proof of Sturm's Theorem and code for constructing Sturm sequences efficiently. It also provides the “sturm” proof method, which can decide certain statements about the roots of real polynomials, such as “the polynomial P has exactly n roots in the interval I” or “P(x) > Q(x) for all x ∈ ℝ”. notify = eberlm@in.tum.de [Sturm_Tarski] title = The Sturm-Tarski Theorem author = Wenda Li date = 2014-09-19 topic = Mathematics/Analysis abstract = We have formalized the Sturm-Tarski theorem (also referred as the Tarski theorem), which generalizes Sturm's theorem. Sturm's theorem is usually used as a way to count distinct real roots, while the Sturm-Tarksi theorem forms the basis for Tarski's classic quantifier elimination for real closed field. notify = wl302@cam.ac.uk [Markov_Models] title = Markov Models author = Johannes Hölzl , Tobias Nipkow date = 2012-01-03 topic = Mathematics/Probability theory, Computer science/Automata and formal languages abstract = This is a formalization of Markov models in Isabelle/HOL. It builds on Isabelle's probability theory. The available models are currently Discrete-Time Markov Chains and a extensions of them with rewards.

As application of these models we formalize probabilistic model checking of pCTL formulas, analysis of IPv4 address allocation in ZeroConf and an analysis of the anonymity of the Crowds protocol. See here for the corresponding paper. notify = hoelzl@in.tum.de [Probabilistic_System_Zoo] title = A Zoo of Probabilistic Systems author = Johannes Hölzl , Andreas Lochbihler , Dmitriy Traytel date = 2015-05-27 topic = Computer science/Automata and formal languages abstract = Numerous models of probabilistic systems are studied in the literature. Coalgebra has been used to classify them into system types and compare their expressiveness. We formalize the resulting hierarchy of probabilistic system types by modeling the semantics of the different systems as codatatypes. This approach yields simple and concise proofs, as bisimilarity coincides with equality for codatatypes.

This work is described in detail in the ITP 2015 publication by the authors. notify = traytel@in.tum.de [Density_Compiler] title = A Verified Compiler for Probability Density Functions author = Manuel Eberl , Johannes Hölzl , Tobias Nipkow date = 2014-10-09 topic = Mathematics/Probability theory, Computer science/Programming languages/Compiling abstract = Bhat et al. [TACAS 2013] developed an inductive compiler that computes density functions for probability spaces described by programs in a probabilistic functional language. In this work, we implement such a compiler for a modified version of this language within the theorem prover Isabelle and give a formal proof of its soundness w.r.t. the semantics of the source and target language. Together with Isabelle's code generation for inductive predicates, this yields a fully verified, executable density compiler. The proof is done in two steps: First, an abstract compiler working with abstract functions modelled directly in the theorem prover's logic is defined and proved sound. Then, this compiler is refined to a concrete version that returns a target-language expression.

An article with the same title and authors is published in the proceedings of ESOP 2015. A detailed presentation of this work can be found in the first author's master's thesis. notify = hoelzl@in.tum.de [CAVA_Automata] title = The CAVA Automata Library author = Peter Lammich date = 2014-05-28 topic = Computer science/Automata and formal languages abstract = We report on the graph and automata library that is used in the fully verified LTL model checker CAVA. As most components of CAVA use some type of graphs or automata, a common automata library simplifies assembly of the components and reduces redundancy.

The CAVA Automata Library provides a hierarchy of graph and automata classes, together with some standard algorithms. Its object oriented design allows for sharing of algorithms, theorems, and implementations between its classes, and also simplifies extensions of the library. Moreover, it is integrated into the Automatic Refinement Framework, supporting automatic refinement of the abstract automata types to efficient data structures.

Note that the CAVA Automata Library is work in progress. Currently, it is very specifically tailored towards the requirements of the CAVA model checker. Nevertheless, the formalization techniques presented here allow an extension of the library to a wider scope. Moreover, they are not limited to graph libraries, but apply to class hierarchies in general.

The CAVA Automata Library is described in the paper: Peter Lammich, The CAVA Automata Library, Isabelle Workshop 2014. notify = lammich@in.tum.de [LTL] title = Linear Temporal Logic author = Salomon Sickert contributors = Benedikt Seidl date = 2016-03-01 topic = Logic/General logic/Temporal logic, Computer science/Automata and formal languages abstract = This theory provides a formalisation of linear temporal logic (LTL) and unifies previous formalisations within the AFP. This entry establishes syntax and semantics for this logic and decouples it from existing entries, yielding a common environment for theories reasoning about LTL. Furthermore a parser written in SML and an executable simplifier are provided. extra-history = Change history: [2019-03-12]: Support for additional operators, implementation of common equivalence relations, definition of syntactic fragments of LTL and the minimal disjunctive normal form.
notify = sickert@in.tum.de [LTL_to_GBA] title = Converting Linear-Time Temporal Logic to Generalized Büchi Automata author = Alexander Schimpf , Peter Lammich date = 2014-05-28 topic = Computer science/Automata and formal languages abstract = We formalize linear-time temporal logic (LTL) and the algorithm by Gerth et al. to convert LTL formulas to generalized Büchi automata. We also formalize some syntactic rewrite rules that can be applied to optimize the LTL formula before conversion. Moreover, we integrate the Stuttering Equivalence AFP-Entry by Stefan Merz, adapting the lemma that next-free LTL formula cannot distinguish between stuttering equivalent runs to our setting.

We use the Isabelle Refinement and Collection framework, as well as the Autoref tool, to obtain a refined version of our algorithm, from which efficiently executable code can be extracted. notify = lammich@in.tum.de [Gabow_SCC] title = Verified Efficient Implementation of Gabow's Strongly Connected Components Algorithm author = Peter Lammich date = 2014-05-28 topic = Computer science/Algorithms/Graph, Mathematics/Graph theory abstract = We present an Isabelle/HOL formalization of Gabow's algorithm for finding the strongly connected components of a directed graph. Using data refinement techniques, we extract efficient code that performs comparable to a reference implementation in Java. Our style of formalization allows for re-using large parts of the proofs when defining variants of the algorithm. We demonstrate this by verifying an algorithm for the emptiness check of generalized Büchi automata, re-using most of the existing proofs. notify = lammich@in.tum.de [Promela] title = Promela Formalization author = René Neumann date = 2014-05-28 topic = Computer science/System description languages abstract = We present an executable formalization of the language Promela, the description language for models of the model checker SPIN. This formalization is part of the work for a completely verified model checker (CAVA), but also serves as a useful (and executable!) description of the semantics of the language itself, something that is currently missing. The formalization uses three steps: It takes an abstract syntax tree generated from an SML parser, removes syntactic sugar and enriches it with type information. This further gets translated into a transition system, on which the semantic engine (read: successor function) operates. notify = [CAVA_LTL_Modelchecker] title = A Fully Verified Executable LTL Model Checker author = Javier Esparza , Peter Lammich , René Neumann , Tobias Nipkow , Alexander Schimpf , Jan-Georg Smaus date = 2014-05-28 topic = Computer science/Automata and formal languages abstract = We present an LTL model checker whose code has been completely verified using the Isabelle theorem prover. The checker consists of over 4000 lines of ML code. The code is produced using the Isabelle Refinement Framework, which allows us to split its correctness proof into (1) the proof of an abstract version of the checker, consisting of a few hundred lines of ``formalized pseudocode'', and (2) a verified refinement step in which mathematical sets and other abstract structures are replaced by implementations of efficient structures like red-black trees and functional arrays. This leads to a checker that, while still slower than unverified checkers, can already be used as a trusted reference implementation against which advanced implementations can be tested.

An early version of this model checker is described in the CAV 2013 paper with the same title. notify = lammich@in.tum.de [Fermat3_4] title = Fermat's Last Theorem for Exponents 3 and 4 and the Parametrisation of Pythagorean Triples author = Roelof Oosterhuis <> date = 2007-08-12 topic = Mathematics/Number theory abstract = This document presents the mechanised proofs of

  • Fermat's Last Theorem for exponents 3 and 4 and
  • the parametrisation of Pythagorean Triples.
notify = nipkow@in.tum.de, roelofoosterhuis@gmail.com [Perfect-Number-Thm] title = Perfect Number Theorem author = Mark Ijbema date = 2009-11-22 topic = Mathematics/Number theory abstract = These theories present the mechanised proof of the Perfect Number Theorem. notify = nipkow@in.tum.de [SumSquares] title = Sums of Two and Four Squares author = Roelof Oosterhuis <> date = 2007-08-12 topic = Mathematics/Number theory abstract = This document presents the mechanised proofs of the following results:
  • any prime number of the form 4m+1 can be written as the sum of two squares;
  • any natural number can be written as the sum of four squares
notify = nipkow@in.tum.de, roelofoosterhuis@gmail.com [Lehmer] title = Lehmer's Theorem author = Simon Wimmer , Lars Noschinski date = 2013-07-22 topic = Mathematics/Number theory abstract = In 1927, Lehmer presented criterions for primality, based on the converse of Fermat's litte theorem. This work formalizes the second criterion from Lehmer's paper, a necessary and sufficient condition for primality.

As a side product we formalize some properties of Euler's phi-function, the notion of the order of an element of a group, and the cyclicity of the multiplicative group of a finite field. notify = noschinl@gmail.com, simon.wimmer@tum.de [Pratt_Certificate] title = Pratt's Primality Certificates author = Simon Wimmer , Lars Noschinski date = 2013-07-22 topic = Mathematics/Number theory abstract = In 1975, Pratt introduced a proof system for certifying primes. He showed that a number p is prime iff a primality certificate for p exists. By showing a logarithmic upper bound on the length of the certificates in size of the prime number, he concluded that the decision problem for prime numbers is in NP. This work formalizes soundness and completeness of Pratt's proof system as well as an upper bound for the size of the certificate. notify = noschinl@gmail.com, simon.wimmer@tum.de [Monad_Memo_DP] title = Monadification, Memoization and Dynamic Programming author = Simon Wimmer , Shuwei Hu , Tobias Nipkow topic = Computer science/Programming languages/Transformations, Computer science/Algorithms, Computer science/Functional programming date = 2018-05-22 notify = wimmers@in.tum.de abstract = We present a lightweight framework for the automatic verified (functional or imperative) memoization of recursive functions. Our tool can turn a pure Isabelle/HOL function definition into a monadified version in a state monad or the Imperative HOL heap monad, and prove a correspondence theorem. We provide a variety of memory implementations for the two types of monads. A number of simple techniques allow us to achieve bottom-up computation and space-efficient memoization. The framework’s utility is demonstrated on a number of representative dynamic programming problems. A detailed description of our work can be found in the accompanying paper [2]. [Probabilistic_Timed_Automata] title = Probabilistic Timed Automata author = Simon Wimmer , Johannes Hölzl topic = Mathematics/Probability theory, Computer science/Automata and formal languages date = 2018-05-24 notify = wimmers@in.tum.de, hoelzl@in.tum.de abstract = We present a formalization of probabilistic timed automata (PTA) for which we try to follow the formula MDP + TA = PTA as far as possible: our work starts from our existing formalizations of Markov decision processes (MDP) and timed automata (TA) and combines them modularly. We prove the fundamental result for probabilistic timed automata: the region construction that is known from timed automata carries over to the probabilistic setting. In particular, this allows us to prove that minimum and maximum reachability probabilities can be computed via a reduction to MDP model checking, including the case where one wants to disregard unrealizable behavior. Further information can be found in our ITP paper [2]. [Hidden_Markov_Models] title = Hidden Markov Models author = Simon Wimmer topic = Mathematics/Probability theory, Computer science/Algorithms date = 2018-05-25 notify = wimmers@in.tum.de abstract = This entry contains a formalization of hidden Markov models [3] based on Johannes Hölzl's formalization of discrete time Markov chains [1]. The basic definitions are provided and the correctness of two main (dynamic programming) algorithms for hidden Markov models is proved: the forward algorithm for computing the likelihood of an observed sequence, and the Viterbi algorithm for decoding the most probable hidden state sequence. The Viterbi algorithm is made executable including memoization. Hidden markov models have various applications in natural language processing. For an introduction see Jurafsky and Martin [2]. [ArrowImpossibilityGS] title = Arrow and Gibbard-Satterthwaite author = Tobias Nipkow date = 2008-09-01 topic = Mathematics/Games and economics abstract = This article formalizes two proofs of Arrow's impossibility theorem due to Geanakoplos and derives the Gibbard-Satterthwaite theorem as a corollary. One formalization is based on utility functions, the other one on strict partial orders.

An article about these proofs is found here. notify = nipkow@in.tum.de [SenSocialChoice] title = Some classical results in Social Choice Theory author = Peter Gammie date = 2008-11-09 topic = Mathematics/Games and economics abstract = Drawing on Sen's landmark work "Collective Choice and Social Welfare" (1970), this development proves Arrow's General Possibility Theorem, Sen's Liberal Paradox and May's Theorem in a general setting. The goal was to make precise the classical statements and proofs of these results, and to provide a foundation for more recent results such as the Gibbard-Satterthwaite and Duggan-Schwartz theorems. notify = nipkow@in.tum.de [Vickrey_Clarke_Groves] title = VCG - Combinatorial Vickrey-Clarke-Groves Auctions author = Marco B. Caminati <>, Manfred Kerber , Christoph Lange, Colin Rowat date = 2015-04-30 topic = Mathematics/Games and economics abstract = A VCG auction (named after their inventors Vickrey, Clarke, and Groves) is a generalization of the single-good, second price Vickrey auction to the case of a combinatorial auction (multiple goods, from which any participant can bid on each possible combination). We formalize in this entry VCG auctions, including tie-breaking and prove that the functions for the allocation and the price determination are well-defined. Furthermore we show that the allocation function allocates goods only to participants, only goods in the auction are allocated, and no good is allocated twice. We also show that the price function is non-negative. These properties also hold for the automatically extracted Scala code. notify = mnfrd.krbr@gmail.com [Topology] title = Topology author = Stefan Friedrich <> date = 2004-04-26 topic = Mathematics/Topology abstract = This entry contains two theories. The first, Topology, develops the basic notions of general topology. The second, which can be viewed as a demonstration of the first, is called LList_Topology. It develops the topology of lazy lists. notify = lcp@cl.cam.ac.uk [Knot_Theory] title = Knot Theory author = T.V.H. Prathamesh date = 2016-01-20 topic = Mathematics/Topology abstract = This work contains a formalization of some topics in knot theory. The concepts that were formalized include definitions of tangles, links, framed links and link/tangle equivalence. The formalization is based on a formulation of links in terms of tangles. We further construct and prove the invariance of the Bracket polynomial. Bracket polynomial is an invariant of framed links closely linked to the Jones polynomial. This is perhaps the first attempt to formalize any aspect of knot theory in an interactive proof assistant. notify = prathamesh@imsc.res.in [Graph_Theory] title = Graph Theory author = Lars Noschinski date = 2013-04-28 topic = Mathematics/Graph theory abstract = This development provides a formalization of directed graphs, supporting (labelled) multi-edges and infinite graphs. A polymorphic edge type allows edges to be treated as pairs of vertices, if multi-edges are not required. Formalized properties are i.a. walks (and related concepts), connectedness and subgraphs and basic properties of isomorphisms.

This formalization is used to prove characterizations of Euler Trails, Shortest Paths and Kuratowski subgraphs. notify = noschinl@gmail.com [Planarity_Certificates] title = Planarity Certificates author = Lars Noschinski date = 2015-11-11 topic = Mathematics/Graph theory abstract = This development provides a formalization of planarity based on combinatorial maps and proves that Kuratowski's theorem implies combinatorial planarity. Moreover, it contains verified implementations of programs checking certificates for planarity (i.e., a combinatorial map) or non-planarity (i.e., a Kuratowski subgraph). notify = noschinl@gmail.com [Max-Card-Matching] title = Maximum Cardinality Matching author = Christine Rizkallah date = 2011-07-21 topic = Mathematics/Graph theory abstract =

A matching in a graph G is a subset M of the edges of G such that no two share an endpoint. A matching has maximum cardinality if its cardinality is at least as large as that of any other matching. An odd-set cover OSC of a graph G is a labeling of the nodes of G with integers such that every edge of G is either incident to a node labeled 1 or connects two nodes labeled with the same number i ≥ 2.

This article proves Edmonds theorem:
Let M be a matching in a graph G and let OSC be an odd-set cover of G. For any i ≥ 0, let n(i) be the number of nodes labeled i. If |M| = n(1) + ∑i ≥ 2(n(i) div 2), then M is a maximum cardinality matching.

notify = nipkow@in.tum.de [Girth_Chromatic] title = A Probabilistic Proof of the Girth-Chromatic Number Theorem author = Lars Noschinski date = 2012-02-06 topic = Mathematics/Graph theory abstract = This works presents a formalization of the Girth-Chromatic number theorem in graph theory, stating that graphs with arbitrarily large girth and chromatic number exist. The proof uses the theory of Random Graphs to prove the existence with probabilistic arguments. notify = noschinl@gmail.com [Random_Graph_Subgraph_Threshold] title = Properties of Random Graphs -- Subgraph Containment author = Lars Hupel date = 2014-02-13 topic = Mathematics/Graph theory, Mathematics/Probability theory abstract = Random graphs are graphs with a fixed number of vertices, where each edge is present with a fixed probability. We are interested in the probability that a random graph contains a certain pattern, for example a cycle or a clique. A very high edge probability gives rise to perhaps too many edges (which degrades performance for many algorithms), whereas a low edge probability might result in a disconnected graph. We prove a theorem about a threshold probability such that a higher edge probability will asymptotically almost surely produce a random graph with the desired subgraph. notify = hupel@in.tum.de [Flyspeck-Tame] title = Flyspeck I: Tame Graphs author = Gertrud Bauer <>, Tobias Nipkow date = 2006-05-22 topic = Mathematics/Graph theory abstract = These theories present the verified enumeration of tame plane graphs as defined by Thomas C. Hales in his proof of the Kepler Conjecture in his book Dense Sphere Packings. A Blueprint for Formal Proofs. [CUP 2012]. The values of the constants in the definition of tameness are identical to those in the Flyspeck project. The IJCAR 2006 paper by Nipkow, Bauer and Schultz refers to the original version of Hales' proof, the ITP 2011 paper by Nipkow refers to the Blueprint version of the proof. extra-history = Change history: [2010-11-02]: modified theories to reflect the modified definition of tameness in Hales' revised proof.
[2014-07-03]: modified constants in def of tameness and Archive according to the final state of the Flyspeck proof. notify = nipkow@in.tum.de [Well_Quasi_Orders] title = Well-Quasi-Orders author = Christian Sternagel date = 2012-04-13 topic = Mathematics/Combinatorics abstract = Based on Isabelle/HOL's type class for preorders, we introduce a type class for well-quasi-orders (wqo) which is characterized by the absence of "bad" sequences (our proofs are along the lines of the proof of Nash-Williams, from which we also borrow terminology). Our main results are instantiations for the product type, the list type, and a type of finite trees, which (almost) directly follow from our proofs of (1) Dickson's Lemma, (2) Higman's Lemma, and (3) Kruskal's Tree Theorem. More concretely:
  • If the sets A and B are wqo then their Cartesian product is wqo.
  • If the set A is wqo then the set of finite lists over A is wqo.
  • If the set A is wqo then the set of finite trees over A is wqo.
The research was funded by the Austrian Science Fund (FWF): J3202. extra-history = Change history: [2012-06-11]: Added Kruskal's Tree Theorem.
[2012-12-19]: New variant of Kruskal's tree theorem for terms (as opposed to variadic terms, i.e., trees), plus finite version of the tree theorem as corollary.
[2013-05-16]: Simplified construction of minimal bad sequences.
[2014-07-09]: Simplified proofs of Higman's lemma and Kruskal's tree theorem, based on homogeneous sequences.
[2016-01-03]: An alternative proof of Higman's lemma by open induction.
[2017-06-08]: Proved (classical) equivalence to inductive definition of almost-full relations according to the ITP 2012 paper "Stop When You Are Almost-Full" by Vytiniotis, Coquand, and Wahlstedt. notify = c.sternagel@gmail.com [Marriage] title = Hall's Marriage Theorem author = Dongchen Jiang , Tobias Nipkow date = 2010-12-17 topic = Mathematics/Combinatorics abstract = Two proofs of Hall's Marriage Theorem: one due to Halmos and Vaughan, one due to Rado. extra-history = Change history: [2011-09-09]: Added Rado's proof notify = nipkow@in.tum.de [Bondy] title = Bondy's Theorem author = Jeremy Avigad , Stefan Hetzl date = 2012-10-27 topic = Mathematics/Combinatorics abstract = A proof of Bondy's theorem following B. Bollabas, Combinatorics, 1986, Cambridge University Press. notify = avigad@cmu.edu, hetzl@logic.at [Ramsey-Infinite] title = Ramsey's theorem, infinitary version author = Tom Ridge <> date = 2004-09-20 topic = Mathematics/Combinatorics abstract = This formalization of Ramsey's theorem (infinitary version) is taken from Boolos and Jeffrey, Computability and Logic, 3rd edition, Chapter 26. It differs slightly from the text by assuming a slightly stronger hypothesis. In particular, the induction hypothesis is stronger, holding for any infinite subset of the naturals. This avoids the rather peculiar mapping argument between kj and aikj on p.263, which is unnecessary and slightly mars this really beautiful result. notify = lp15@cam.ac.uk [Derangements] title = Derangements Formula author = Lukas Bulwahn date = 2015-06-27 topic = Mathematics/Combinatorics abstract = The Derangements Formula describes the number of fixpoint-free permutations as a closed formula. This theorem is the 88th theorem in a list of the ``Top 100 Mathematical Theorems''. notify = lukas.bulwahn@gmail.com [Euler_Partition] title = Euler's Partition Theorem author = Lukas Bulwahn date = 2015-11-19 topic = Mathematics/Combinatorics abstract = Euler's Partition Theorem states that the number of partitions with only distinct parts is equal to the number of partitions with only odd parts. The combinatorial proof follows John Harrison's HOL Light formalization. This theorem is the 45th theorem of the Top 100 Theorems list. notify = lukas.bulwahn@gmail.com [Discrete_Summation] title = Discrete Summation author = Florian Haftmann contributors = Amine Chaieb <> date = 2014-04-13 topic = Mathematics/Combinatorics abstract = These theories introduce basic concepts and proofs about discrete summation: shifts, formal summation, falling factorials and stirling numbers. As proof of concept, a simple summation conversion is provided. notify = florian.haftmann@informatik.tu-muenchen.de [Open_Induction] title = Open Induction author = Mizuhito Ogawa <>, Christian Sternagel date = 2012-11-02 topic = Mathematics/Combinatorics abstract = A proof of the open induction schema based on J.-C. Raoult, Proving open properties by induction, Information Processing Letters 29, 1988, pp.19-23.

This research was supported by the Austrian Science Fund (FWF): J3202.

notify = c.sternagel@gmail.com [Category] title = Category Theory to Yoneda's Lemma author = Greg O'Keefe date = 2005-04-21 topic = Mathematics/Category theory license = LGPL abstract = This development proves Yoneda's lemma and aims to be readable by humans. It only defines what is needed for the lemma: categories, functors and natural transformations. Limits, adjunctions and other important concepts are not included. extra-history = Change history: [2010-04-23]: The definition of the constant equinumerous was slightly too weak in the original submission and has been fixed in revision 8c2b5b3c995f. notify = lcp@cl.cam.ac.uk [Category2] title = Category Theory author = Alexander Katovsky date = 2010-06-20 topic = Mathematics/Category theory abstract = This article presents a development of Category Theory in Isabelle/HOL. A Category is defined using records and locales. Functors and Natural Transformations are also defined. The main result that has been formalized is that the Yoneda functor is a full and faithful embedding. We also formalize the completeness of many sorted monadic equational logic. Extensive use is made of the HOLZF theory in both cases. For an informal description see here [pdf]. notify = alexander.katovsky@cantab.net [FunWithFunctions] title = Fun With Functions author = Tobias Nipkow date = 2008-08-26 topic = Mathematics/Misc abstract = This is a collection of cute puzzles of the form ``Show that if a function satisfies the following constraints, it must be ...'' Please add further examples to this collection! notify = nipkow@in.tum.de [FunWithTilings] title = Fun With Tilings author = Tobias Nipkow , Lawrence C. Paulson date = 2008-11-07 topic = Mathematics/Misc abstract = Tilings are defined inductively. It is shown that one form of mutilated chess board cannot be tiled with dominoes, while another one can be tiled with L-shaped tiles. Please add further fun examples of this kind! notify = nipkow@in.tum.de [Lazy-Lists-II] title = Lazy Lists II author = Stefan Friedrich <> date = 2004-04-26 topic = Computer science/Data structures abstract = This theory contains some useful extensions to the LList (lazy list) theory by Larry Paulson, including finite, infinite, and positive llists over an alphabet, as well as the new constants take and drop and the prefix order of llists. Finally, the notions of safety and liveness in the sense of Alpern and Schneider (1985) are defined. notify = lcp@cl.cam.ac.uk [Ribbon_Proofs] title = Ribbon Proofs author = John Wickerson <> date = 2013-01-19 topic = Computer science/Programming languages/Logics abstract = This document concerns the theory of ribbon proofs: a diagrammatic proof system, based on separation logic, for verifying program correctness. We include the syntax, proof rules, and soundness results for two alternative formalisations of ribbon proofs.

Compared to traditional proof outlines, ribbon proofs emphasise the structure of a proof, so are intelligible and pedagogical. Because they contain less redundancy than proof outlines, and allow each proof step to be checked locally, they may be more scalable. Where proof outlines are cumbersome to modify, ribbon proofs can be visually manoeuvred to yield proofs of variant programs. notify = [Koenigsberg_Friendship] title = The Königsberg Bridge Problem and the Friendship Theorem author = Wenda Li date = 2013-07-19 topic = Mathematics/Graph theory abstract = This development provides a formalization of undirected graphs and simple graphs, which are based on Benedikt Nordhoff and Peter Lammich's simple formalization of labelled directed graphs in the archive. Then, with our formalization of graphs, we show both necessary and sufficient conditions for Eulerian trails and circuits as well as the fact that the Königsberg Bridge Problem does not have a solution. In addition, we show the Friendship Theorem in simple graphs. notify = [Tree_Decomposition] title = Tree Decomposition author = Christoph Dittmann notify = date = 2016-05-31 topic = Mathematics/Graph theory abstract = We formalize tree decompositions and tree width in Isabelle/HOL, proving that trees have treewidth 1. We also show that every edge of a tree decomposition is a separation of the underlying graph. As an application of this theorem we prove that complete graphs of size n have treewidth n-1. [Menger] title = Menger's Theorem author = Christoph Dittmann topic = Mathematics/Graph theory date = 2017-02-26 notify = isabelle@christoph-d.de abstract = We present a formalization of Menger's Theorem for directed and undirected graphs in Isabelle/HOL. This well-known result shows that if two non-adjacent distinct vertices u, v in a directed graph have no separator smaller than n, then there exist n internally vertex-disjoint paths from u to v. The version for undirected graphs follows immediately because undirected graphs are a special case of directed graphs. [IEEE_Floating_Point] title = A Formal Model of IEEE Floating Point Arithmetic author = Lei Yu contributors = Fabian Hellauer , Fabian Immler date = 2013-07-27 topic = Computer science/Data structures abstract = This development provides a formal model of IEEE-754 floating-point arithmetic. This formalization, including formal specification of the standard and proofs of important properties of floating-point arithmetic, forms the foundation for verifying programs with floating-point computation. There is also a code generation setup for floats so that we can execute programs using this formalization in functional programming languages. notify = lp15@cam.ac.uk, immler@in.tum.de extra-history = Change history: [2017-09-25]: Added conversions from and to software floating point numbers (by Fabian Hellauer and Fabian Immler).
[2018-02-05]: 'Modernized' representation following the formalization in HOL4: former "float_format" and predicate "is_valid" is now encoded in a type "('e, 'f) float" where 'e and 'f encode the size of exponent and fraction. [Native_Word] title = Native Word author = Andreas Lochbihler contributors = Peter Lammich date = 2013-09-17 topic = Computer science/Data structures abstract = This entry makes machine words and machine arithmetic available for code generation from Isabelle/HOL. It provides a common abstraction that hides the differences between the different target languages. The code generator maps these operations to the APIs of the target languages. Apart from that, we extend the available bit operations on types int and integer, and map them to the operations in the target languages. extra-history = Change history: [2013-11-06]: added conversion function between native words and characters (revision fd23d9a7fe3a)
[2014-03-31]: added words of default size in the target language (by Peter Lammich) (revision 25caf5065833)
[2014-10-06]: proper test setup with compilation and execution of tests in all target languages (revision 5d7a1c9ae047)
[2017-09-02]: added 64-bit words (revision c89f86244e3c)
[2018-07-15]: added cast operators for default-size words (revision fc1f1fb8dd30)
notify = mail@andreas-lochbihler.de [XML] title = XML author = Christian Sternagel , René Thiemann date = 2014-10-03 topic = Computer science/Functional programming, Computer science/Data structures abstract = This entry provides an XML library for Isabelle/HOL. This includes parsing and pretty printing of XML trees as well as combinators for transforming XML trees into arbitrary user-defined data. The main contribution of this entry is an interface (fit for code generation) that allows for communication between verified programs formalized in Isabelle/HOL and the outside world via XML. This library was developed as part of the IsaFoR/CeTA project to which we refer for examples of its usage. notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at [HereditarilyFinite] title = The Hereditarily Finite Sets author = Lawrence C. Paulson date = 2013-11-17 topic = Logic/Set theory abstract = The theory of hereditarily finite sets is formalised, following the development of Swierczkowski. An HF set is a finite collection of other HF sets; they enjoy an induction principle and satisfy all the axioms of ZF set theory apart from the axiom of infinity, which is negated. All constructions that are possible in ZF set theory (Cartesian products, disjoint sums, natural numbers, functions) without using infinite sets are possible here. The definition of addition for the HF sets follows Kirby. This development forms the foundation for the Isabelle proof of Gödel's incompleteness theorems, which has been formalised separately. extra-history = Change history: [2015-02-23]: Added the theory "Finitary" defining the class of types that can be embedded in hf, including int, char, option, list, etc. notify = lp15@cam.ac.uk [Incompleteness] title = Gödel's Incompleteness Theorems author = Lawrence C. Paulson date = 2013-11-17 topic = Logic/Proof theory abstract = Gödel's two incompleteness theorems are formalised, following a careful presentation by Swierczkowski, in the theory of hereditarily finite sets. This represents the first ever machine-assisted proof of the second incompleteness theorem. Compared with traditional formalisations using Peano arithmetic (see e.g. Boolos), coding is simpler, with no need to formalise the notion of multiplication (let alone that of a prime number) in the formalised calculus upon which the theorem is based. However, other technical problems had to be solved in order to complete the argument. notify = lp15@cam.ac.uk [Finite_Automata_HF] title = Finite Automata in Hereditarily Finite Set Theory author = Lawrence C. Paulson date = 2015-02-05 topic = Computer science/Automata and formal languages abstract = Finite Automata, both deterministic and non-deterministic, for regular languages. The Myhill-Nerode Theorem. Closure under intersection, concatenation, etc. Regular expressions define regular languages. Closure under reversal; the powerset construction mapping NFAs to DFAs. Left and right languages; minimal DFAs. Brzozowski's minimization algorithm. Uniqueness up to isomorphism of minimal DFAs. notify = lp15@cam.ac.uk [Decreasing-Diagrams] title = Decreasing Diagrams author = Harald Zankl license = LGPL date = 2013-11-01 topic = Logic/Rewriting abstract = This theory contains a formalization of decreasing diagrams showing that any locally decreasing abstract rewrite system is confluent. We consider the valley (van Oostrom, TCS 1994) and the conversion version (van Oostrom, RTA 2008) and closely follow the original proofs. As an application we prove Newman's lemma. notify = Harald.Zankl@uibk.ac.at [Decreasing-Diagrams-II] title = Decreasing Diagrams II author = Bertram Felgenhauer license = LGPL date = 2015-08-20 topic = Logic/Rewriting abstract = This theory formalizes the commutation version of decreasing diagrams for Church-Rosser modulo. The proof follows Felgenhauer and van Oostrom (RTA 2013). The theory also provides important specializations, in particular van Oostrom’s conversion version (TCS 2008) of decreasing diagrams. notify = bertram.felgenhauer@uibk.ac.at [GoedelGod] title = Gödel's God in Isabelle/HOL author = Christoph Benzmüller , Bruno Woltzenlogel Paleo date = 2013-11-12 topic = Logic/Philosophical aspects abstract = Dana Scott's version of Gödel's proof of God's existence is formalized in quantified modal logic KB (QML KB). QML KB is modeled as a fragment of classical higher-order logic (HOL); thus, the formalization is essentially a formalization in HOL. notify = lp15@cam.ac.uk, c.benzmueller@fu-berlin.de [Types_Tableaus_and_Goedels_God] title = Types, Tableaus and Gödel’s God in Isabelle/HOL author = David Fuenmayor , Christoph Benzmüller topic = Logic/Philosophical aspects date = 2017-05-01 notify = davfuenmayor@gmail.com, c.benzmueller@gmail.com abstract = A computer-formalisation of the essential parts of Fitting's textbook "Types, Tableaus and Gödel's God" in Isabelle/HOL is presented. In particular, Fitting's (and Anderson's) variant of the ontological argument is verified and confirmed. This variant avoids the modal collapse, which has been criticised as an undesirable side-effect of Kurt Gödel's (and Dana Scott's) versions of the ontological argument. Fitting's work is employing an intensional higher-order modal logic, which we shallowly embed here in classical higher-order logic. We then utilize the embedded logic for the formalisation of Fitting's argument. (See also the earlier AFP entry ``Gödel's God in Isabelle/HOL''.) [GewirthPGCProof] title = Formalisation and Evaluation of Alan Gewirth's Proof for the Principle of Generic Consistency in Isabelle/HOL author = David Fuenmayor , Christoph Benzmüller topic = Logic/Philosophical aspects date = 2018-10-30 notify = davfuenmayor@gmail.com, c.benzmueller@gmail.com abstract = An ambitious ethical theory ---Alan Gewirth's "Principle of Generic Consistency"--- is encoded and analysed in Isabelle/HOL. Gewirth's theory has stirred much attention in philosophy and ethics and has been proposed as a potential means to bound the impact of artificial general intelligence. extra-history = Change history: [2019-04-09]: added proof for a stronger variant of the PGC and examplary inferences (revision 88182cb0a2f6)
[Lowe_Ontological_Argument] title = Computer-assisted Reconstruction and Assessment of E. J. Lowe's Modal Ontological Argument author = David Fuenmayor , Christoph Benzmüller topic = Logic/Philosophical aspects date = 2017-09-21 notify = davfuenmayor@gmail.com, c.benzmueller@gmail.com abstract = Computers may help us to understand --not just verify-- philosophical arguments. By utilizing modern proof assistants in an iterative interpretive process, we can reconstruct and assess an argument by fully formal means. Through the mechanization of a variant of St. Anselm's ontological argument by E. J. Lowe, which is a paradigmatic example of a natural-language argument with strong ties to metaphysics and religion, we offer an ideal showcase for our computer-assisted interpretive method. [AnselmGod] title = Anselm's God in Isabelle/HOL author = Ben Blumson topic = Logic/Philosophical aspects date = 2017-09-06 notify = benblumson@gmail.com abstract = Paul Oppenheimer and Edward Zalta's formalisation of Anselm's ontological argument for the existence of God is automated by embedding a free logic for definite descriptions within Isabelle/HOL. [Tail_Recursive_Functions] title = A General Method for the Proof of Theorems on Tail-recursive Functions author = Pasquale Noce date = 2013-12-01 topic = Computer science/Functional programming abstract =

Tail-recursive function definitions are sometimes more straightforward than alternatives, but proving theorems on them may be roundabout because of the peculiar form of the resulting recursion induction rules.

This paper describes a proof method that provides a general solution to this problem by means of suitable invariants over inductive sets, and illustrates the application of such method by examining two case studies.

notify = pasquale.noce.lavoro@gmail.com [CryptoBasedCompositionalProperties] title = Compositional Properties of Crypto-Based Components author = Maria Spichkova date = 2014-01-11 topic = Computer science/Security abstract = This paper presents an Isabelle/HOL set of theories which allows the specification of crypto-based components and the verification of their composition properties wrt. cryptographic aspects. We introduce a formalisation of the security property of data secrecy, the corresponding definitions and proofs. Please note that here we import the Isabelle/HOL theory ListExtras.thy, presented in the AFP entry FocusStreamsCaseStudies-AFP. notify = maria.spichkova@rmit.edu.au [Featherweight_OCL] title = Featherweight OCL: A Proposal for a Machine-Checked Formal Semantics for OCL 2.5 author = Achim D. Brucker , Frédéric Tuong , Burkhart Wolff date = 2014-01-16 topic = Computer science/System description languages abstract = The Unified Modeling Language (UML) is one of the few modeling languages that is widely used in industry. While UML is mostly known as diagrammatic modeling language (e.g., visualizing class models), it is complemented by a textual language, called Object Constraint Language (OCL). The current version of OCL is based on a four-valued logic that turns UML into a formal language. Any type comprises the elements "invalid" and "null" which are propagated as strict and non-strict, respectively. Unfortunately, the former semi-formal semantics of this specification language, captured in the "Annex A" of the OCL standard, leads to different interpretations of corner cases. We formalize the core of OCL: denotational definitions, a logical calculus and operational rules that allow for the execution of OCL expressions by a mixture of term rewriting and code compilation. Our formalization reveals several inconsistencies and contradictions in the current version of the OCL standard. Overall, this document is intended to provide the basis for a machine-checked text "Annex A" of the OCL standard targeting at tool implementors. extra-history = Change history: [2015-10-13]: afp-devel@ea3b38fc54d6 and hol-testgen@12148
   Update of Featherweight OCL including a change in the abstract.
[2014-01-16]: afp-devel@9091ce05cb20 and hol-testgen@10241
   New Entry: Featherweight OCL notify = brucker@spamfence.net, tuong@users.gforge.inria.fr, wolff@lri.fr [Relation_Algebra] title = Relation Algebra author = Alasdair Armstrong <>, Simon Foster , Georg Struth , Tjark Weber date = 2014-01-25 topic = Mathematics/Algebra abstract = Tarski's algebra of binary relations is formalised along the lines of the standard textbooks of Maddux and Schmidt and Ströhlein. This includes relation-algebraic concepts such as subidentities, vectors and a domain operation as well as various notions associated to functions. Relation algebras are also expanded by a reflexive transitive closure operation, and they are linked with Kleene algebras and models of binary relations and Boolean matrices. notify = g.struth@sheffield.ac.uk, tjark.weber@it.uu.se [PSemigroupsConvolution] title = Partial Semigroups and Convolution Algebras author = Brijesh Dongol , Victor B. F. Gomes , Ian J. Hayes , Georg Struth topic = Mathematics/Algebra date = 2017-06-13 notify = g.struth@sheffield.ac.uk, victor.gomes@cl.cam.ac.uk abstract = Partial Semigroups are relevant to the foundations of quantum mechanics and combinatorics as well as to interval and separation logics. Convolution algebras can be understood either as algebras of generalised binary modalities over ternary Kripke frames, in particular over partial semigroups, or as algebras of quantale-valued functions which are equipped with a convolution-style operation of multiplication that is parametrised by a ternary relation. Convolution algebras provide algebraic semantics for various substructural logics, including categorial, relevance and linear logics, for separation logic and for interval logics; they cover quantitative and qualitative applications. These mathematical components for partial semigroups and convolution algebras provide uniform foundations from which models of computation based on relations, program traces or pomsets, and verification components for separation or interval temporal logics can be built with little effort. [Secondary_Sylow] title = Secondary Sylow Theorems author = Jakob von Raumer date = 2014-01-28 topic = Mathematics/Algebra abstract = These theories extend the existing proof of the first Sylow theorem (written by Florian Kammueller and L. C. Paulson) by what are often called the second, third and fourth Sylow theorems. These theorems state propositions about the number of Sylow p-subgroups of a group and the fact that they are conjugate to each other. The proofs make use of an implementation of group actions and their properties. notify = psxjv4@nottingham.ac.uk [Jordan_Hoelder] title = The Jordan-Hölder Theorem author = Jakob von Raumer date = 2014-09-09 topic = Mathematics/Algebra abstract = This submission contains theories that lead to a formalization of the proof of the Jordan-Hölder theorem about composition series of finite groups. The theories formalize the notions of isomorphism classes of groups, simple groups, normal series, composition series, maximal normal subgroups. Furthermore, they provide proofs of the second isomorphism theorem for groups, the characterization theorem for maximal normal subgroups as well as many useful lemmas about normal subgroups and factor groups. The proof is inspired by course notes of Stuart Rankin. notify = psxjv4@nottingham.ac.uk [Cayley_Hamilton] title = The Cayley-Hamilton Theorem author = Stephan Adelsberger , Stefan Hetzl , Florian Pollak date = 2014-09-15 topic = Mathematics/Algebra abstract = This document contains a proof of the Cayley-Hamilton theorem based on the development of matrices in HOL/Multivariate Analysis. notify = stvienna@gmail.com [Probabilistic_Noninterference] title = Probabilistic Noninterference author = Andrei Popescu , Johannes Hölzl date = 2014-03-11 topic = Computer science/Security abstract = We formalize a probabilistic noninterference for a multi-threaded language with uniform scheduling, where probabilistic behaviour comes from both the scheduler and the individual threads. We define notions probabilistic noninterference in two variants: resumption-based and trace-based. For the resumption-based notions, we prove compositionality w.r.t. the language constructs and establish sound type-system-like syntactic criteria. This is a formalization of the mathematical development presented at CPP 2013 and CALCO 2013. It is the probabilistic variant of the Possibilistic Noninterference AFP entry. notify = hoelzl@in.tum.de [HyperCTL] title = A shallow embedding of HyperCTL* author = Markus N. Rabe , Peter Lammich , Andrei Popescu date = 2014-04-16 topic = Computer science/Security, Logic/General logic/Temporal logic abstract = We formalize HyperCTL*, a temporal logic for expressing security properties. We first define a shallow embedding of HyperCTL*, within which we prove inductive and coinductive rules for the operators. Then we show that a HyperCTL* formula captures Goguen-Meseguer noninterference, a landmark information flow property. We also define a deep embedding and connect it to the shallow embedding by a denotational semantics, for which we prove sanity w.r.t. dependence on the free variables. Finally, we show that under some finiteness assumptions about the model, noninterference is given by a (finitary) syntactic formula. notify = uuomul@yahoo.com [Bounded_Deducibility_Security] title = Bounded-Deducibility Security author = Andrei Popescu , Peter Lammich date = 2014-04-22 topic = Computer science/Security abstract = This is a formalization of bounded-deducibility security (BD security), a flexible notion of information-flow security applicable to arbitrary input-output automata. It generalizes Sutherland's classic notion of nondeducibility by factoring in declassification bounds and trigger, whereas nondeducibility states that, in a system, information cannot flow between specified sources and sinks, BD security indicates upper bounds for the flow and triggers under which these upper bounds are no longer guaranteed. notify = uuomul@yahoo.com, lammich@in.tum.de [Network_Security_Policy_Verification] title = Network Security Policy Verification author = Cornelius Diekmann date = 2014-07-04 topic = Computer science/Security abstract = We present a unified theory for verifying network security policies. A security policy is represented as directed graph. To check high-level security goals, security invariants over the policy are expressed. We cover monotonic security invariants, i.e. prohibiting more does not harm security. We provide the following contributions for the security invariant theory.
  • Secure auto-completion of scenario-specific knowledge, which eases usability.
  • Security violations can be repaired by tightening the policy iff the security invariants hold for the deny-all policy.
  • An algorithm to compute a security policy.
  • A formalization of stateful connection semantics in network security mechanisms.
  • An algorithm to compute a secure stateful implementation of a policy.
  • An executable implementation of all the theory.
  • Examples, ranging from an aircraft cabin data network to the analysis of a large real-world firewall.
  • More examples: A fully automated translation of high-level security goals to both firewall and SDN configurations (see Examples/Distributed_WebApp.thy).
For a detailed description, see extra-history = Change history: [2015-04-14]: Added Distributed WebApp example and improved graphviz visualization (revision 4dde08ca2ab8)
notify = diekmann@net.in.tum.de [Abstract_Completeness] title = Abstract Completeness author = Jasmin Christian Blanchette , Andrei Popescu , Dmitriy Traytel date = 2014-04-16 topic = Logic/Proof theory abstract = A formalization of an abstract property of possibly infinite derivation trees (modeled by a codatatype), representing the core of a proof (in Beth/Hintikka style) of the first-order logic completeness theorem, independent of the concrete syntax or inference rules. This work is described in detail in the IJCAR 2014 publication by the authors. The abstract proof can be instantiated for a wide range of Gentzen and tableau systems as well as various flavors of FOL---e.g., with or without predicates, equality, or sorts. Here, we give only a toy example instantiation with classical propositional logic. A more serious instance---many-sorted FOL with equality---is described elsewhere [Blanchette and Popescu, FroCoS 2013]. notify = traytel@in.tum.de [Pop_Refinement] title = Pop-Refinement author = Alessandro Coglio date = 2014-07-03 topic = Computer science/Programming languages/Misc abstract = Pop-refinement is an approach to stepwise refinement, carried out inside an interactive theorem prover by constructing a monotonically decreasing sequence of predicates over deeply embedded target programs. The sequence starts with a predicate that characterizes the possible implementations, and ends with a predicate that characterizes a unique program in explicit syntactic form. Pop-refinement enables more requirements (e.g. program-level and non-functional) to be captured in the initial specification and preserved through refinement. Security requirements expressed as hyperproperties (i.e. predicates over sets of traces) are always preserved by pop-refinement, unlike the popular notion of refinement as trace set inclusion. Two simple examples in Isabelle/HOL are presented, featuring program-level requirements, non-functional requirements, and hyperproperties. notify = coglio@kestrel.edu [VectorSpace] title = Vector Spaces author = Holden Lee date = 2014-08-29 topic = Mathematics/Algebra abstract = This formalisation of basic linear algebra is based completely on locales, building off HOL-Algebra. It includes basic definitions: linear combinations, span, linear independence; linear transformations; interpretation of function spaces as vector spaces; the direct sum of vector spaces, sum of subspaces; the replacement theorem; existence of bases in finite-dimensional; vector spaces, definition of dimension; the rank-nullity theorem. Some concepts are actually defined and proved for modules as they also apply there. Infinite-dimensional vector spaces are supported, but dimension is only supported for finite-dimensional vector spaces. The proofs are standard; the proofs of the replacement theorem and rank-nullity theorem roughly follow the presentation in Linear Algebra by Friedberg, Insel, and Spence. The rank-nullity theorem generalises the existing development in the Archive of Formal Proof (originally using type classes, now using a mix of type classes and locales). notify = holdenl@princeton.edu [Special_Function_Bounds] title = Real-Valued Special Functions: Upper and Lower Bounds author = Lawrence C. Paulson date = 2014-08-29 topic = Mathematics/Analysis abstract = This development proves upper and lower bounds for several familiar real-valued functions. For sin, cos, exp and sqrt, it defines and verifies infinite families of upper and lower bounds, mostly based on Taylor series expansions. For arctan, ln and exp, it verifies a finite collection of upper and lower bounds, originally obtained from the functions' continued fraction expansions using the computer algebra system Maple. A common theme in these proofs is to take the difference between a function and its approximation, which should be zero at one point, and then consider the sign of the derivative. The immediate purpose of this development is to verify axioms used by MetiTarski, an automatic theorem prover for real-valued special functions. Crucial to MetiTarski's operation is the provision of upper and lower bounds for each function of interest. notify = lp15@cam.ac.uk [Landau_Symbols] title = Landau Symbols author = Manuel Eberl date = 2015-07-14 topic = Mathematics/Analysis abstract = This entry provides Landau symbols to describe and reason about the asymptotic growth of functions for sufficiently large inputs. A number of simplification procedures are provided for additional convenience: cancelling of dominated terms in sums under a Landau symbol, cancelling of common factors in products, and a decision procedure for Landau expressions containing products of powers of functions like x, ln(x), ln(ln(x)) etc. notify = eberlm@in.tum.de [Error_Function] title = The Error Function author = Manuel Eberl topic = Mathematics/Analysis date = 2018-02-06 notify = eberlm@in.tum.de abstract =

This entry provides the definitions and basic properties of the complex and real error function erf and the complementary error function erfc. Additionally, it gives their full asymptotic expansions.

[Akra_Bazzi] title = The Akra-Bazzi theorem and the Master theorem author = Manuel Eberl date = 2015-07-14 topic = Mathematics/Analysis abstract = This article contains a formalisation of the Akra-Bazzi method based on a proof by Leighton. It is a generalisation of the well-known Master Theorem for analysing the complexity of Divide & Conquer algorithms. We also include a generalised version of the Master theorem based on the Akra-Bazzi theorem, which is easier to apply than the Akra-Bazzi theorem itself.

Some proof methods that facilitate applying the Master theorem are also included. For a more detailed explanation of the formalisation and the proof methods, see the accompanying paper (publication forthcoming). notify = eberlm@in.tum.de [Dirichlet_Series] title = Dirichlet Series author = Manuel Eberl topic = Mathematics/Number theory date = 2017-10-12 notify = eberlm@in.tum.de abstract = This entry is a formalisation of much of Chapters 2, 3, and 11 of Apostol's “Introduction to Analytic Number Theory”. This includes:

  • Definitions and basic properties for several number-theoretic functions (Euler's φ, Möbius μ, Liouville's λ, the divisor function σ, von Mangoldt's Λ)
  • Executable code for most of these functions, the most efficient implementations using the factoring algorithm by Thiemann et al.
  • Dirichlet products and formal Dirichlet series
  • Analytic results connecting convergent formal Dirichlet series to complex functions
  • Euler product expansions
  • Asymptotic estimates of number-theoretic functions including the density of squarefree integers and the average number of divisors of a natural number
These results are useful as a basis for developing more number-theoretic results, such as the Prime Number Theorem. [Gauss_Sums] title = Gauss Sums and the Pólya–Vinogradov Inequality author = Rodrigo Raya , Manuel Eberl topic = Mathematics/Number theory date = 2019-12-10 notify = manuel.eberl@tum.de abstract =

This article provides a full formalisation of Chapter 8 of Apostol's Introduction to Analytic Number Theory. Subjects that are covered are:

  • periodic arithmetic functions and their finite Fourier series
  • (generalised) Ramanujan sums
  • Gauss sums and separable characters
  • induced moduli and primitive characters
  • the Pólya—Vinogradov inequality
[Zeta_Function] title = The Hurwitz and Riemann ζ Functions author = Manuel Eberl topic = Mathematics/Number theory, Mathematics/Analysis date = 2017-10-12 notify = eberlm@in.tum.de abstract =

This entry builds upon the results about formal and analytic Dirichlet series to define the Hurwitz ζ function ζ(a,s) and, based on that, the Riemann ζ function ζ(s). This is done by first defining them for ℜ(z) > 1 and then successively extending the domain to the left using the Euler–MacLaurin formula.

Apart from the most basic facts such as analyticity, the following results are provided:

  • the Stieltjes constants and the Laurent expansion of ζ(s) at s = 1
  • the non-vanishing of ζ(s) for ℜ(z) ≥ 1
  • the relationship between ζ(a,s) and Γ
  • the special values at negative integers and positive even integers
  • Hurwitz's formula and the reflection formula for ζ(s)
  • the Hadjicostas–Chapman formula

The entry also contains Euler's analytic proof of the infinitude of primes, based on the fact that ζ(s) has a pole at s = 1.

[Linear_Recurrences] title = Linear Recurrences author = Manuel Eberl topic = Mathematics/Analysis date = 2017-10-12 notify = eberlm@in.tum.de abstract =

Linear recurrences with constant coefficients are an interesting class of recurrence equations that can be solved explicitly. The most famous example are certainly the Fibonacci numbers with the equation f(n) = f(n-1) + f(n - 2) and the quite non-obvious closed form (φn - (-φ)-n) / √5 where φ is the golden ratio.

In this work, I build on existing tools in Isabelle – such as formal power series and polynomial factorisation algorithms – to develop a theory of these recurrences and derive a fully executable solver for them that can be exported to programming languages like Haskell.

[Lambert_W] title = The Lambert W Function on the Reals author = Manuel Eberl topic = Mathematics/Analysis date = 2020-04-24 notify = eberlm@in.tum.de abstract =

The Lambert W function is a multi-valued function defined as the inverse function of x ↦ x ex. Besides numerous applications in combinatorics, physics, and engineering, it also frequently occurs when solving equations containing both ex and x, or both x and log x.

This article provides a definition of the two real-valued branches W0(x) and W-1(x) and proves various properties such as basic identities and inequalities, monotonicity, differentiability, asymptotic expansions, and the MacLaurin series of W0(x) at x = 0.

[Cartan_FP] title = The Cartan Fixed Point Theorems author = Lawrence C. Paulson date = 2016-03-08 topic = Mathematics/Analysis abstract = The Cartan fixed point theorems concern the group of holomorphic automorphisms on a connected open set of Cn. Ciolli et al. have formalised the one-dimensional case of these theorems in HOL Light. This entry contains their proofs, ported to Isabelle/HOL. Thus it addresses the authors' remark that "it would be important to write a formal proof in a language that can be read by both humans and machines". notify = lp15@cam.ac.uk [Gauss_Jordan] title = Gauss-Jordan Algorithm and Its Applications author = Jose Divasón , Jesús Aransay topic = Computer science/Algorithms/Mathematical date = 2014-09-03 abstract = The Gauss-Jordan algorithm states that any matrix over a field can be transformed by means of elementary row operations to a matrix in reduced row echelon form. The formalization is based on the Rank Nullity Theorem entry of the AFP and on the HOL-Multivariate-Analysis session of Isabelle, where matrices are represented as functions over finite types. We have set up the code generator to make this representation executable. In order to improve the performance, a refinement to immutable arrays has been carried out. We have formalized some of the applications of the Gauss-Jordan algorithm. Thanks to this development, the following facts can be computed over matrices whose elements belong to a field: Ranks, Determinants, Inverses, Bases and dimensions and Solutions of systems of linear equations. Code can be exported to SML and Haskell. notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es [Echelon_Form] title = Echelon Form author = Jose Divasón , Jesús Aransay topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra date = 2015-02-12 abstract = We formalize an algorithm to compute the Echelon Form of a matrix. We have proved its existence over Bézout domains and made it executable over Euclidean domains, such as the integer ring and the univariate polynomials over a field. This allows us to compute determinants, inverses and characteristic polynomials of matrices. The work is based on the HOL-Multivariate Analysis library, and on both the Gauss-Jordan and Cayley-Hamilton AFP entries. As a by-product, some algebraic structures have been implemented (principal ideal domains, Bézout domains...). The algorithm has been refined to immutable arrays and code can be generated to functional languages as well. notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es [QR_Decomposition] title = QR Decomposition author = Jose Divasón , Jesús Aransay topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra date = 2015-02-12 abstract = QR decomposition is an algorithm to decompose a real matrix A into the product of two other matrices Q and R, where Q is orthogonal and R is invertible and upper triangular. The algorithm is useful for the least squares problem; i.e., the computation of the best approximation of an unsolvable system of linear equations. As a side-product, the Gram-Schmidt process has also been formalized. A refinement using immutable arrays is presented as well. The development relies, among others, on the AFP entry "Implementing field extensions of the form Q[sqrt(b)]" by René Thiemann, which allows execution of the algorithm using symbolic computations. Verified code can be generated and executed using floats as well. extra-history = Change history: [2015-06-18]: The second part of the Fundamental Theorem of Linear Algebra has been generalized to more general inner product spaces. notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es [Hermite] title = Hermite Normal Form author = Jose Divasón , Jesús Aransay topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra date = 2015-07-07 abstract = Hermite Normal Form is a canonical matrix analogue of Reduced Echelon Form, but involving matrices over more general rings. In this work we formalise an algorithm to compute the Hermite Normal Form of a matrix by means of elementary row operations, taking advantage of the Echelon Form AFP entry. We have proven the correctness of such an algorithm and refined it to immutable arrays. Furthermore, we have also formalised the uniqueness of the Hermite Normal Form of a matrix. Code can be exported and some examples of execution involving integer matrices and polynomial matrices are presented as well. notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es [Imperative_Insertion_Sort] title = Imperative Insertion Sort author = Christian Sternagel date = 2014-09-25 topic = Computer science/Algorithms abstract = The insertion sort algorithm of Cormen et al. (Introduction to Algorithms) is expressed in Imperative HOL and proved to be correct and terminating. For this purpose we also provide a theory about imperative loop constructs with accompanying induction/invariant rules for proving partial and total correctness. Furthermore, the formalized algorithm is fit for code generation. notify = lp15@cam.ac.uk [Stream_Fusion_Code] title = Stream Fusion in HOL with Code Generation author = Andreas Lochbihler , Alexandra Maximova date = 2014-10-10 topic = Computer science/Functional programming abstract = Stream Fusion is a system for removing intermediate list data structures from functional programs, in particular Haskell. This entry adapts stream fusion to Isabelle/HOL and its code generator. We define stream types for finite and possibly infinite lists and stream versions for most of the fusible list functions in the theories List and Coinductive_List, and prove them correct with respect to the conversion functions between lists and streams. The Stream Fusion transformation itself is implemented as a simproc in the preprocessor of the code generator. [Brian Huffman's AFP entry formalises stream fusion in HOLCF for the domain of lazy lists to prove the GHC compiler rewrite rules correct. In contrast, this work enables Isabelle's code generator to perform stream fusion itself. To that end, it covers both finite and coinductive lists from the HOL library and the Coinductive entry. The fusible list functions require specification and proof principles different from Huffman's.] notify = mail@andreas-lochbihler.de [Case_Labeling] title = Generating Cases from Labeled Subgoals author = Lars Noschinski date = 2015-07-21 topic = Tools, Computer science/Programming languages/Misc abstract = Isabelle/Isar provides named cases to structure proofs. This article contains an implementation of a proof method casify, which can be used to easily extend proof tools with support for named cases. Such a proof tool must produce labeled subgoals, which are then interpreted by casify.

As examples, this work contains verification condition generators producing named cases for three languages: The Hoare language from HOL/Library, a monadic language for computations with failure (inspired by the AutoCorres tool), and a language of conditional expressions. These VCGs are demonstrated by a number of example programs. notify = noschinl@gmail.com [DPT-SAT-Solver] title = A Fast SAT Solver for Isabelle in Standard ML topic = Tools author = Armin Heller <> date = 2009-12-09 abstract = This contribution contains a fast SAT solver for Isabelle written in Standard ML. By loading the theory DPT_SAT_Solver, the SAT solver installs itself (under the name ``dptsat'') and certain Isabelle tools like Refute will start using it automatically. This is a port of the DPT (Decision Procedure Toolkit) SAT Solver written in OCaml. notify = jasmin.blanchette@gmail.com [Rep_Fin_Groups] title = Representations of Finite Groups topic = Mathematics/Algebra author = Jeremy Sylvestre date = 2015-08-12 abstract = We provide a formal framework for the theory of representations of finite groups, as modules over the group ring. Along the way, we develop the general theory of groups (relying on the group_add class for the basics), modules, and vector spaces, to the extent required for theory of group representations. We then provide formal proofs of several important introductory theorems in the subject, including Maschke's theorem, Schur's lemma, and Frobenius reciprocity. We also prove that every irreducible representation is isomorphic to a submodule of the group ring, leading to the fact that for a finite group there are only finitely many isomorphism classes of irreducible representations. In all of this, no restriction is made on the characteristic of the ring or field of scalars until the definition of a group representation, and then the only restriction made is that the characteristic must not divide the order of the group. notify = jsylvest@ualberta.ca [Noninterference_Inductive_Unwinding] title = The Inductive Unwinding Theorem for CSP Noninterference Security topic = Computer science/Security author = Pasquale Noce date = 2015-08-18 abstract =

The necessary and sufficient condition for CSP noninterference security stated by the Ipurge Unwinding Theorem is expressed in terms of a pair of event lists varying over the set of process traces. This does not render it suitable for the subsequent application of rule induction in the case of a process defined inductively, since rule induction may rather be applied to a single variable ranging over an inductively defined set.

Starting from the Ipurge Unwinding Theorem, this paper derives a necessary and sufficient condition for CSP noninterference security that involves a single event list varying over the set of process traces, and is thus suitable for rule induction; hence its name, Inductive Unwinding Theorem. Similarly to the Ipurge Unwinding Theorem, the new theorem only requires to consider individual accepted and refused events for each process trace, and applies to the general case of a possibly intransitive noninterference policy. Specific variants of this theorem are additionally proven for deterministic processes and trace set processes.

notify = pasquale.noce.lavoro@gmail.com [Password_Authentication_Protocol] title = Verification of a Diffie-Hellman Password-based Authentication Protocol by Extending the Inductive Method author = Pasquale Noce topic = Computer science/Security date = 2017-01-03 notify = pasquale.noce.lavoro@gmail.com abstract = This paper constructs a formal model of a Diffie-Hellman password-based authentication protocol between a user and a smart card, and proves its security. The protocol provides for the dispatch of the user's password to the smart card on a secure messaging channel established by means of Password Authenticated Connection Establishment (PACE), where the mapping method being used is Chip Authentication Mapping. By applying and suitably extending Paulson's Inductive Method, this paper proves that the protocol establishes trustworthy secure messaging channels, preserves the secrecy of users' passwords, and provides an effective mutual authentication service. What is more, these security properties turn out to hold independently of the secrecy of the PACE authentication key. [Jordan_Normal_Form] title = Matrices, Jordan Normal Forms, and Spectral Radius Theory topic = Mathematics/Algebra author = René Thiemann , Akihisa Yamada contributors = Alexander Bentkamp date = 2015-08-21 abstract =

Matrix interpretations are useful as measure functions in termination proving. In order to use these interpretations also for complexity analysis, the growth rate of matrix powers has to examined. Here, we formalized a central result of spectral radius theory, namely that the growth rate is polynomially bounded if and only if the spectral radius of a matrix is at most one.

To formally prove this result we first studied the growth rates of matrices in Jordan normal form, and prove the result that every complex matrix has a Jordan normal form using a constructive prove via Schur decomposition.

The whole development is based on a new abstract type for matrices, which is also executable by a suitable setup of the code generator. It completely subsumes our former AFP-entry on executable matrices, and its main advantage is its close connection to the HMA-representation which allowed us to easily adapt existing proofs on determinants.

All the results have been applied to improve CeTA, our certifier to validate termination and complexity proof certificates.

extra-history = Change history: [2016-01-07]: Added Schur-decomposition, Gram-Schmidt orthogonalization, uniqueness of Jordan normal forms
[2018-04-17]: Integrated lemmas from deep-learning AFP-entry of Alexander Bentkamp notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp [LTL_to_DRA] title = Converting Linear Temporal Logic to Deterministic (Generalized) Rabin Automata topic = Computer science/Automata and formal languages author = Salomon Sickert date = 2015-09-04 abstract = Recently, Javier Esparza and Jan Kretinsky proposed a new method directly translating linear temporal logic (LTL) formulas to deterministic (generalized) Rabin automata. Compared to the existing approaches of constructing a non-deterministic Buechi-automaton in the first step and then applying a determinization procedure (e.g. some variant of Safra's construction) in a second step, this new approach preservers a relation between the formula and the states of the resulting automaton. While the old approach produced a monolithic structure, the new method is compositional. Furthermore, in some cases the resulting automata are much smaller than the automata generated by existing approaches. In order to ensure the correctness of the construction, this entry contains a complete formalisation and verification of the translation. Furthermore from this basis executable code is generated. extra-history = Change history: [2015-09-23]: Enable code export for the eager unfolding optimisation and reduce running time of the generated tool. Moreover, add support for the mlton SML compiler.
[2016-03-24]: Make use of the LTL entry and include the simplifier. notify = sickert@in.tum.de [Timed_Automata] title = Timed Automata author = Simon Wimmer date = 2016-03-08 topic = Computer science/Automata and formal languages abstract = Timed automata are a widely used formalism for modeling real-time systems, which is employed in a class of successful model checkers such as UPPAAL [LPY97], HyTech [HHWt97] or Kronos [Yov97]. This work formalizes the theory for the subclass of diagonal-free timed automata, which is sufficient to model many interesting problems. We first define the basic concepts and semantics of diagonal-free timed automata. Based on this, we prove two types of decidability results for the language emptiness problem. The first is the classic result of Alur and Dill [AD90, AD94], which uses a finite partitioning of the state space into so-called `regions`. Our second result focuses on an approach based on `Difference Bound Matrices (DBMs)`, which is practically used by model checkers. We prove the correctness of the basic forward analysis operations on DBMs. One of these operations is the Floyd-Warshall algorithm for the all-pairs shortest paths problem. To obtain a finite search space, a widening operation has to be used for this kind of analysis. We use Patricia Bouyer's [Bou04] approach to prove that this widening operation is correct in the sense that DBM-based forward analysis in combination with the widening operation also decides language emptiness. The interesting property of this proof is that the first decidability result is reused to obtain the second one. notify = wimmers@in.tum.de [Parity_Game] title = Positional Determinacy of Parity Games author = Christoph Dittmann date = 2015-11-02 topic = Mathematics/Games and economics, Mathematics/Graph theory abstract = We present a formalization of parity games (a two-player game on directed graphs) and a proof of their positional determinacy in Isabelle/HOL. This proof works for both finite and infinite games. notify = [Ergodic_Theory] title = Ergodic Theory author = Sebastien Gouezel date = 2015-12-01 topic = Mathematics/Probability theory abstract = Ergodic theory is the branch of mathematics that studies the behaviour of measure preserving transformations, in finite or infinite measure. It interacts both with probability theory (mainly through measure theory) and with geometry as a lot of interesting examples are from geometric origin. We implement the first definitions and theorems of ergodic theory, including notably Poicaré recurrence theorem for finite measure preserving systems (together with the notion of conservativity in general), induced maps, Kac's theorem, Birkhoff theorem (arguably the most important theorem in ergodic theory), and variations around it such as conservativity of the corresponding skew product, or Atkinson lemma. notify = sebastien.gouezel@univ-rennes1.fr, hoelzl@in.tum.de [Latin_Square] title = Latin Square author = Alexander Bentkamp date = 2015-12-02 topic = Mathematics/Combinatorics abstract = A Latin Square is a n x n table filled with integers from 1 to n where each number appears exactly once in each row and each column. A Latin Rectangle is a partially filled n x n table with r filled rows and n-r empty rows, such that each number appears at most once in each row and each column. The main result of this theory is that any Latin Rectangle can be completed to a Latin Square. notify = bentkamp@gmail.com [Deep_Learning] title = Expressiveness of Deep Learning author = Alexander Bentkamp date = 2016-11-10 topic = Computer science/Machine learning, Mathematics/Analysis abstract = Deep learning has had a profound impact on computer science in recent years, with applications to search engines, image recognition and language processing, bioinformatics, and more. Recently, Cohen et al. provided theoretical evidence for the superiority of deep learning over shallow learning. This formalization of their work simplifies and generalizes the original proof, while working around the limitations of the Isabelle type system. To support the formalization, I developed reusable libraries of formalized mathematics, including results about the matrix rank, the Lebesgue measure, and multivariate polynomials, as well as a library for tensor analysis. notify = bentkamp@gmail.com [Applicative_Lifting] title = Applicative Lifting author = Andreas Lochbihler , Joshua Schneider <> date = 2015-12-22 topic = Computer science/Functional programming abstract = Applicative functors augment computations with effects by lifting function application to types which model the effects. As the structure of the computation cannot depend on the effects, applicative expressions can be analysed statically. This allows us to lift universally quantified equations to the effectful types, as observed by Hinze. Thus, equational reasoning over effectful computations can be reduced to pure types.

This entry provides a package for registering applicative functors and two proof methods for lifting of equations over applicative functors. The first method normalises applicative expressions according to the laws of applicative functors. This way, equations whose two sides contain the same list of variables can be lifted to every applicative functor.

To lift larger classes of equations, the second method exploits a number of additional properties (e.g., commutativity of effects) provided the properties have been declared for the concrete applicative functor at hand upon registration.

We declare several types from the Isabelle library as applicative functors and illustrate the use of the methods with two examples: the lifting of the arithmetic type class hierarchy to streams and the verification of a relabelling function on binary trees. We also formalise and verify the normalisation algorithm used by the first proof method.

extra-history = Change history: [2016-03-03]: added formalisation of lifting with combinators
[2016-06-10]: implemented automatic derivation of lifted combinator reductions; support arbitrary lifted relations using relators; improved compatibility with locale interpretation (revision ec336f354f37)
notify = mail@andreas-lochbihler.de [Stern_Brocot] title = The Stern-Brocot Tree author = Peter Gammie , Andreas Lochbihler date = 2015-12-22 topic = Mathematics/Number theory abstract = The Stern-Brocot tree contains all rational numbers exactly once and in their lowest terms. We formalise the Stern-Brocot tree as a coinductive tree using recursive and iterative specifications, which we have proven equivalent, and show that it indeed contains all the numbers as stated. Following Hinze, we prove that the Stern-Brocot tree can be linearised looplessly into Stern's diatonic sequence (also known as Dijkstra's fusc function) and that it is a permutation of the Bird tree.

The reasoning stays at an abstract level by appealing to the uniqueness of solutions of guarded recursive equations and lifting algebraic laws point-wise to trees and streams using applicative functors.

notify = mail@andreas-lochbihler.de [Algebraic_Numbers] title = Algebraic Numbers in Isabelle/HOL topic = Mathematics/Algebra author = René Thiemann , Akihisa Yamada , Sebastiaan Joosten date = 2015-12-22 abstract = Based on existing libraries for matrices, factorization of rational polynomials, and Sturm's theorem, we formalized algebraic numbers in Isabelle/HOL. Our development serves as an implementation for real and complex numbers, and it admits to compute roots and completely factorize real and complex polynomials, provided that all coefficients are rational numbers. Moreover, we provide two implementations to display algebraic numbers, an injective and expensive one, or a faster but approximative version.

To this end, we mechanized several results on resultants, which also required us to prove that polynomials over a unique factorization domain form again a unique factorization domain.

extra-history = Change history: [2016-01-29]: Split off Polynomial Interpolation and Polynomial Factorization
[2017-04-16]: Use certified Berlekamp-Zassenhaus factorization, use subresultant algorithm for computing resultants, improved bisection algorithm notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp, sebastiaan.joosten@uibk.ac.at [Polynomial_Interpolation] title = Polynomial Interpolation topic = Mathematics/Algebra author = René Thiemann , Akihisa Yamada date = 2016-01-29 abstract = We formalized three algorithms for polynomial interpolation over arbitrary fields: Lagrange's explicit expression, the recursive algorithm of Neville and Aitken, and the Newton interpolation in combination with an efficient implementation of divided differences. Variants of these algorithms for integer polynomials are also available, where sometimes the interpolation can fail; e.g., there is no linear integer polynomial p such that p(0) = 0 and p(2) = 1. Moreover, for the Newton interpolation for integer polynomials, we proved that all intermediate results that are computed during the algorithm must be integers. This admits an early failure detection in the implementation. Finally, we proved the uniqueness of polynomial interpolation.

The development also contains improved code equations to speed up the division of integers in target languages. notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp [Polynomial_Factorization] title = Polynomial Factorization topic = Mathematics/Algebra author = René Thiemann , Akihisa Yamada date = 2016-01-29 abstract = Based on existing libraries for polynomial interpolation and matrices, we formalized several factorization algorithms for polynomials, including Kronecker's algorithm for integer polynomials, Yun's square-free factorization algorithm for field polynomials, and Berlekamp's algorithm for polynomials over finite fields. By combining the last one with Hensel's lifting, we derive an efficient factorization algorithm for the integer polynomials, which is then lifted for rational polynomials by mechanizing Gauss' lemma. Finally, we assembled a combined factorization algorithm for rational polynomials, which combines all the mentioned algorithms and additionally uses the explicit formula for roots of quadratic polynomials and a rational root test.

As side products, we developed division algorithms for polynomials over integral domains, as well as primality-testing and prime-factorization algorithms for integers. notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp [Perron_Frobenius] title = Perron-Frobenius Theorem for Spectral Radius Analysis author = Jose Divasón , Ondřej Kunčar , René Thiemann , Akihisa Yamada notify = rene.thiemann@uibk.ac.at date = 2016-05-20 topic = Mathematics/Algebra abstract =

The spectral radius of a matrix A is the maximum norm of all eigenvalues of A. In previous work we already formalized that for a complex matrix A, the values in An grow polynomially in n if and only if the spectral radius is at most one. One problem with the above characterization is the determination of all complex eigenvalues. In case A contains only non-negative real values, a simplification is possible with the help of the Perron–Frobenius theorem, which tells us that it suffices to consider only the real eigenvalues of A, i.e., applying Sturm's method can decide the polynomial growth of An.

We formalize the Perron–Frobenius theorem based on a proof via Brouwer's fixpoint theorem, which is available in the HOL multivariate analysis (HMA) library. Since the results on the spectral radius is based on matrices in the Jordan normal form (JNF) library, we further develop a connection which allows us to easily transfer theorems between HMA and JNF. With this connection we derive the combined result: if A is a non-negative real matrix, and no real eigenvalue of A is strictly larger than one, then An is polynomially bounded in n.

extra-history = Change history: [2017-10-18]: added Perron-Frobenius theorem for irreducible matrices with generalization (revision bda1f1ce8a1c)
[2018-05-17]: prove conjecture of CPP'18 paper: Jordan blocks of spectral radius have maximum size (revision ffdb3794e5d5) [Stochastic_Matrices] title = Stochastic Matrices and the Perron-Frobenius Theorem author = René Thiemann topic = Mathematics/Algebra, Computer science/Automata and formal languages date = 2017-11-22 notify = rene.thiemann@uibk.ac.at abstract = Stochastic matrices are a convenient way to model discrete-time and finite state Markov chains. The Perron–Frobenius theorem tells us something about the existence and uniqueness of non-negative eigenvectors of a stochastic matrix. In this entry, we formalize stochastic matrices, link the formalization to the existing AFP-entry on Markov chains, and apply the Perron–Frobenius theorem to prove that stationary distributions always exist, and they are unique if the stochastic matrix is irreducible. [Formal_SSA] title = Verified Construction of Static Single Assignment Form author = Sebastian Ullrich , Denis Lohner date = 2016-02-05 topic = Computer science/Algorithms, Computer science/Programming languages/Transformations abstract =

We define a functional variant of the static single assignment (SSA) form construction algorithm described by Braun et al., which combines simplicity and efficiency. The definition is based on a general, abstract control flow graph representation using Isabelle locales.

We prove that the algorithm's output is semantically equivalent to the input according to a small-step semantics, and that it is in minimal SSA form for the common special case of reducible inputs. We then show the satisfiability of the locale assumptions by giving instantiations for a simple While language.

Furthermore, we use a generic instantiation based on typedefs in order to extract OCaml code and replace the unverified SSA construction algorithm of the CompCertSSA project with it.

A more detailed description of the verified SSA construction can be found in the paper Verified Construction of Static Single Assignment Form, CC 2016.

notify = denis.lohner@kit.edu [Minimal_SSA] title = Minimal Static Single Assignment Form author = Max Wagner , Denis Lohner topic = Computer science/Programming languages/Transformations date = 2017-01-17 notify = denis.lohner@kit.edu abstract =

This formalization is an extension to "Verified Construction of Static Single Assignment Form". In their work, the authors have shown that Braun et al.'s static single assignment (SSA) construction algorithm produces minimal SSA form for input programs with a reducible control flow graph (CFG). However Braun et al. also proposed an extension to their algorithm that they claim produces minimal SSA form even for irreducible CFGs.
In this formalization we support that claim by giving a mechanized proof.

As the extension of Braun et al.'s algorithm aims for removing so-called redundant strongly connected components of phi functions, we show that this suffices to guarantee minimality according to Cytron et al..

[PropResPI] title = Propositional Resolution and Prime Implicates Generation author = Nicolas Peltier notify = Nicolas.Peltier@imag.fr date = 2016-03-11 topic = Logic/General logic/Mechanization of proofs abstract = We provide formal proofs in Isabelle-HOL (using mostly structured Isar proofs) of the soundness and completeness of the Resolution rule in propositional logic. The completeness proofs take into account the usual redundancy elimination rules (tautology elimination and subsumption), and several refinements of the Resolution rule are considered: ordered resolution (with selection functions), positive and negative resolution, semantic resolution and unit resolution (the latter refinement is complete only for clause sets that are Horn- renamable). We also define a concrete procedure for computing saturated sets and establish its soundness and completeness. The clause sets are not assumed to be finite, so that the results can be applied to formulas obtained by grounding sets of first-order clauses (however, a total ordering among atoms is assumed to be given). Next, we show that the unrestricted Resolution rule is deductive- complete, in the sense that it is able to generate all (prime) implicates of any set of propositional clauses (i.e., all entailment- minimal, non-valid, clausal consequences of the considered set). The generation of prime implicates is an important problem, with many applications in artificial intelligence and verification (for abductive reasoning, knowledge compilation, diagnosis, debugging etc.). We also show that implicates can be computed in an incremental way, by fixing an ordering among all the atoms in the considered sets and resolving upon these atoms one by one in the considered order (with no backtracking). This feature is critical for the efficient computation of prime implicates. Building on these results, we provide a procedure for computing such implicates and establish its soundness and completeness. [SuperCalc] title = A Variant of the Superposition Calculus author = Nicolas Peltier notify = Nicolas.Peltier@imag.fr date = 2016-09-06 topic = Logic/Proof theory abstract = We provide a formalization of a variant of the superposition calculus, together with formal proofs of soundness and refutational completeness (w.r.t. the usual redundancy criteria based on clause ordering). This version of the calculus uses all the standard restrictions of the superposition rules, together with the following refinement, inspired by the basic superposition calculus: each clause is associated with a set of terms which are assumed to be in normal form -- thus any application of the replacement rule on these terms is blocked. The set is initially empty and terms may be added or removed at each inference step. The set of terms that are assumed to be in normal form includes any term introduced by previous unifiers as well as any term occurring in the parent clauses at a position that is smaller (according to some given ordering on positions) than a previously replaced term. The standard superposition calculus corresponds to the case where the set of irreducible terms is always empty. [Nominal2] title = Nominal 2 author = Christian Urban , Stefan Berghofer , Cezary Kaliszyk date = 2013-02-21 topic = Tools abstract =

Dealing with binders, renaming of bound variables, capture-avoiding substitution, etc., is very often a major problem in formal proofs, especially in proofs by structural and rule induction. Nominal Isabelle is designed to make such proofs easy to formalise: it provides an infrastructure for declaring nominal datatypes (that is alpha-equivalence classes) and for defining functions over them by structural recursion. It also provides induction principles that have Barendregt’s variable convention already built in.

This entry can be used as a more advanced replacement for HOL/Nominal in the Isabelle distribution.

notify = christian.urban@kcl.ac.uk [First_Welfare_Theorem] title = Microeconomics and the First Welfare Theorem author = Julian Parsert , Cezary Kaliszyk topic = Mathematics/Games and economics license = LGPL date = 2017-09-01 notify = julian.parsert@uibk.ac.at, cezary.kaliszyk@uibk.ac.at abstract = Economic activity has always been a fundamental part of society. Due to modern day politics, economic theory has gained even more influence on our lives. Thus we want models and theories to be as precise as possible. This can be achieved using certification with the help of formal proof technology. Hence we will use Isabelle/HOL to construct two economic models, that of the the pure exchange economy and a version of the Arrow-Debreu Model. We will prove that the First Theorem of Welfare Economics holds within both. The theorem is the mathematical formulation of Adam Smith's famous invisible hand and states that a group of self-interested and rational actors will eventually achieve an efficient allocation of goods and services. extra-history = Change history: [2018-06-17]: Added some lemmas and a theory file, also introduced Microeconomics folder.
[Noninterference_Sequential_Composition] title = Conservation of CSP Noninterference Security under Sequential Composition author = Pasquale Noce date = 2016-04-26 topic = Computer science/Security, Computer science/Concurrency/Process calculi abstract =

In his outstanding work on Communicating Sequential Processes, Hoare has defined two fundamental binary operations allowing to compose the input processes into another, typically more complex, process: sequential composition and concurrent composition. Particularly, the output of the former operation is a process that initially behaves like the first operand, and then like the second operand once the execution of the first one has terminated successfully, as long as it does.

This paper formalizes Hoare's definition of sequential composition and proves, in the general case of a possibly intransitive policy, that CSP noninterference security is conserved under this operation, provided that successful termination cannot be affected by confidential events and cannot occur as an alternative to other events in the traces of the first operand. Both of these assumptions are shown, by means of counterexamples, to be necessary for the theorem to hold.

notify = pasquale.noce.lavoro@gmail.com [Noninterference_Concurrent_Composition] title = Conservation of CSP Noninterference Security under Concurrent Composition author = Pasquale Noce notify = pasquale.noce.lavoro@gmail.com date = 2016-06-13 topic = Computer science/Security, Computer science/Concurrency/Process calculi abstract =

In his outstanding work on Communicating Sequential Processes, Hoare has defined two fundamental binary operations allowing to compose the input processes into another, typically more complex, process: sequential composition and concurrent composition. Particularly, the output of the latter operation is a process in which any event not shared by both operands can occur whenever the operand that admits the event can engage in it, whereas any event shared by both operands can occur just in case both can engage in it.

This paper formalizes Hoare's definition of concurrent composition and proves, in the general case of a possibly intransitive policy, that CSP noninterference security is conserved under this operation. This result, along with the previous analogous one concerning sequential composition, enables the construction of more and more complex processes enforcing noninterference security by composing, sequentially or concurrently, simpler secure processes, whose security can in turn be proven using either the definition of security, or unwinding theorems.

[ROBDD] title = Algorithms for Reduced Ordered Binary Decision Diagrams author = Julius Michaelis , Maximilian Haslbeck , Peter Lammich , Lars Hupel date = 2016-04-27 topic = Computer science/Algorithms, Computer science/Data structures abstract = We present a verified and executable implementation of ROBDDs in Isabelle/HOL. Our implementation relates pointer-based computation in the Heap monad to operations on an abstract definition of boolean functions. Internally, we implemented the if-then-else combinator in a recursive fashion, following the Shannon decomposition of the argument functions. The implementation mixes and adapts known techniques and is built with efficiency in mind. notify = bdd@liftm.de, haslbecm@in.tum.de [No_FTL_observers] title = No Faster-Than-Light Observers author = Mike Stannett , István Németi date = 2016-04-28 topic = Mathematics/Physics abstract = We provide a formal proof within First Order Relativity Theory that no observer can travel faster than the speed of light. Originally reported in Stannett & Németi (2014) "Using Isabelle/HOL to verify first-order relativity theory", Journal of Automated Reasoning 52(4), pp. 361-378. notify = m.stannett@sheffield.ac.uk [Groebner_Bases] title = Gröbner Bases Theory author = Fabian Immler , Alexander Maletzky date = 2016-05-02 topic = Mathematics/Algebra, Computer science/Algorithms/Mathematical abstract = This formalization is concerned with the theory of Gröbner bases in (commutative) multivariate polynomial rings over fields, originally developed by Buchberger in his 1965 PhD thesis. Apart from the statement and proof of the main theorem of the theory, the formalization also implements Buchberger's algorithm for actually computing Gröbner bases as a tail-recursive function, thus allowing to effectively decide ideal membership in finitely generated polynomial ideals. Furthermore, all functions can be executed on a concrete representation of multivariate polynomials as association lists. extra-history = Change history: [2019-04-18]: Specialized Gröbner bases to less abstract representation of polynomials, where power-products are represented as polynomial mappings.
notify = alexander.maletzky@risc.jku.at [Nullstellensatz] title = Hilbert's Nullstellensatz author = Alexander Maletzky topic = Mathematics/Algebra, Mathematics/Geometry date = 2019-06-16 notify = alexander.maletzky@risc-software.at abstract = This entry formalizes Hilbert's Nullstellensatz, an important theorem in algebraic geometry that can be viewed as the generalization of the Fundamental Theorem of Algebra to multivariate polynomials: If a set of (multivariate) polynomials over an algebraically closed field has no common zero, then the ideal it generates is the entire polynomial ring. The formalization proves several equivalent versions of this celebrated theorem: the weak Nullstellensatz, the strong Nullstellensatz (connecting algebraic varieties and radical ideals), and the field-theoretic Nullstellensatz. The formalization follows Chapter 4.1. of Ideals, Varieties, and Algorithms by Cox, Little and O'Shea. [Bell_Numbers_Spivey] title = Spivey's Generalized Recurrence for Bell Numbers author = Lukas Bulwahn date = 2016-05-04 topic = Mathematics/Combinatorics abstract = This entry defines the Bell numbers as the cardinality of set partitions for a carrier set of given size, and derives Spivey's generalized recurrence relation for Bell numbers following his elegant and intuitive combinatorial proof.

As the set construction for the combinatorial proof requires construction of three intermediate structures, the main difficulty of the formalization is handling the overall combinatorial argument in a structured way. The introduced proof structure allows us to compose the combinatorial argument from its subparts, and supports to keep track how the detailed proof steps are related to the overall argument. To obtain this structure, this entry uses set monad notation for the set construction's definition, introduces suitable predicates and rules, and follows a repeating structure in its Isar proof. notify = lukas.bulwahn@gmail.com [Randomised_Social_Choice] title = Randomised Social Choice Theory author = Manuel Eberl date = 2016-05-05 topic = Mathematics/Games and economics abstract = This work contains a formalisation of basic Randomised Social Choice, including Stochastic Dominance and Social Decision Schemes (SDSs) along with some of their most important properties (Anonymity, Neutrality, ex-post- and SD-Efficiency, SD-Strategy-Proofness) and two particular SDSs – Random Dictatorship and Random Serial Dictatorship (with proofs of the properties that they satisfy). Many important properties of these concepts are also proven – such as the two equivalent characterisations of Stochastic Dominance and the fact that SD-efficiency of a lottery only depends on the support. The entry also provides convenient commands to define Preference Profiles, prove their well-formedness, and automatically derive restrictions that sufficiently nice SDSs need to satisfy on the defined profiles. Currently, the formalisation focuses on weak preferences and Stochastic Dominance, but it should be easy to extend it to other domains – such as strict preferences – or other lottery extensions – such as Bilinear Dominance or Pairwise Comparison. notify = eberlm@in.tum.de [SDS_Impossibility] title = The Incompatibility of SD-Efficiency and SD-Strategy-Proofness author = Manuel Eberl date = 2016-05-04 topic = Mathematics/Games and economics abstract = This formalisation contains the proof that there is no anonymous and neutral Social Decision Scheme for at least four voters and alternatives that fulfils both SD-Efficiency and SD-Strategy- Proofness. The proof is a fully structured and quasi-human-redable one. It was derived from the (unstructured) SMT proof of the case for exactly four voters and alternatives by Brandl et al. Their proof relies on an unverified translation of the original problem to SMT, and the proof that lifts the argument for exactly four voters and alternatives to the general case is also not machine-checked. In this Isabelle proof, on the other hand, all of these steps are fully proven and machine-checked. This is particularly important seeing as a previously published informal proof of a weaker statement contained a mistake in precisely this lifting step. notify = eberlm@in.tum.de [Median_Of_Medians_Selection] title = The Median-of-Medians Selection Algorithm author = Manuel Eberl topic = Computer science/Algorithms date = 2017-12-21 notify = eberlm@in.tum.de abstract =

This entry provides an executable functional implementation of the Median-of-Medians algorithm for selecting the k-th smallest element of an unsorted list deterministically in linear time. The size bounds for the recursive call that lead to the linear upper bound on the run-time of the algorithm are also proven.

[Mason_Stothers] title = The Mason–Stothers Theorem author = Manuel Eberl topic = Mathematics/Algebra date = 2017-12-21 notify = eberlm@in.tum.de abstract =

This article provides a formalisation of Snyder’s simple and elegant proof of the Mason–Stothers theorem, which is the polynomial analogue of the famous abc Conjecture for integers. Remarkably, Snyder found this very elegant proof when he was still a high-school student.

In short, the statement of the theorem is that three non-zero coprime polynomials A, B, C over a field which sum to 0 and do not all have vanishing derivatives fulfil max{deg(A), deg(B), deg(C)} < deg(rad(ABC)) where the rad(P) denotes the radical of P, i. e. the product of all unique irreducible factors of P.

This theorem also implies a kind of polynomial analogue of Fermat’s Last Theorem for polynomials: except for trivial cases, An + Bn + Cn = 0 implies n ≤ 2 for coprime polynomials A, B, C over a field.

[FLP] title = A Constructive Proof for FLP author = Benjamin Bisping , Paul-David Brodmann , Tim Jungnickel , Christina Rickmann , Henning Seidler , Anke Stüber , Arno Wilhelm-Weidner , Kirstin Peters , Uwe Nestmann date = 2016-05-18 topic = Computer science/Concurrency abstract = The impossibility of distributed consensus with one faulty process is a result with important consequences for real world distributed systems e.g., commits in replicated databases. Since proofs are not immune to faults and even plausible proofs with a profound formalism can conclude wrong results, we validate the fundamental result named FLP after Fischer, Lynch and Paterson. We present a formalization of distributed systems and the aforementioned consensus problem. Our proof is based on Hagen Völzer's paper "A constructive proof for FLP". In addition to the enhanced confidence in the validity of Völzer's proof, we contribute the missing gaps to show the correctness in Isabelle/HOL. We clarify the proof details and even prove fairness of the infinite execution that contradicts consensus. Our Isabelle formalization can also be reused for further proofs of properties of distributed systems. notify = henning.seidler@mailbox.tu-berlin.de [IMAP-CRDT] title = The IMAP CmRDT author = Tim Jungnickel , Lennart Oldenburg <>, Matthias Loibl <> topic = Computer science/Algorithms/Distributed, Computer science/Data structures date = 2017-11-09 notify = tim.jungnickel@tu-berlin.de abstract = We provide our Isabelle/HOL formalization of a Conflict-free Replicated Datatype for Internet Message Access Protocol commands. We show that Strong Eventual Consistency (SEC) is guaranteed by proving the commutativity of concurrent operations. We base our formalization on the recently proposed "framework for establishing Strong Eventual Consistency for Conflict-free Replicated Datatypes" (AFP.CRDT) from Gomes et al. Hence, we provide an additional example of how the recently proposed framework can be used to design and prove CRDTs. [Incredible_Proof_Machine] title = The meta theory of the Incredible Proof Machine author = Joachim Breitner , Denis Lohner date = 2016-05-20 topic = Logic/Proof theory abstract = The Incredible Proof Machine is an interactive visual theorem prover which represents proofs as port graphs. We model this proof representation in Isabelle, and prove that it is just as powerful as natural deduction. notify = mail@joachim-breitner.de [Word_Lib] title = Finite Machine Word Library author = Joel Beeren<>, Matthew Fernandez<>, Xin Gao<>, Gerwin Klein , Rafal Kolanski<>, Japheth Lim<>, Corey Lewis<>, Daniel Matichuk<>, Thomas Sewell<> notify = kleing@unsw.edu.au date = 2016-06-09 topic = Computer science/Data structures abstract = This entry contains an extension to the Isabelle library for fixed-width machine words. In particular, the entry adds quickcheck setup for words, printing as hexadecimals, additional operations, reasoning about alignment, signed words, enumerations of words, normalisation of word numerals, and an extensive library of properties about generic fixed-width words, as well as an instantiation of many of these to the commonly used 32 and 64-bit bases. [Catalan_Numbers] title = Catalan Numbers author = Manuel Eberl notify = eberlm@in.tum.de date = 2016-06-21 topic = Mathematics/Combinatorics abstract =

In this work, we define the Catalan numbers Cn and prove several equivalent definitions (including some closed-form formulae). We also show one of their applications (counting the number of binary trees of size n), prove the asymptotic growth approximation Cn ∼ 4n / (√π · n1.5), and provide reasonably efficient executable code to compute them.

The derivation of the closed-form formulae uses algebraic manipulations of the ordinary generating function of the Catalan numbers, and the asymptotic approximation is then done using generalised binomial coefficients and the Gamma function. Thanks to these highly non-elementary mathematical tools, the proofs are very short and simple.

[Fisher_Yates] title = Fisher–Yates shuffle author = Manuel Eberl notify = eberlm@in.tum.de date = 2016-09-30 topic = Computer science/Algorithms abstract =

This work defines and proves the correctness of the Fisher–Yates algorithm for shuffling – i.e. producing a random permutation – of a list. The algorithm proceeds by traversing the list and in each step swapping the current element with a random element from the remaining list.

[Bertrands_Postulate] title = Bertrand's postulate author = Julian Biendarra<>, Manuel Eberl contributors = Lawrence C. Paulson topic = Mathematics/Number theory date = 2017-01-17 notify = eberlm@in.tum.de abstract =

Bertrand's postulate is an early result on the distribution of prime numbers: For every positive integer n, there exists a prime number that lies strictly between n and 2n. The proof is ported from John Harrison's formalisation in HOL Light. It proceeds by first showing that the property is true for all n greater than or equal to 600 and then showing that it also holds for all n below 600 by case distinction.

[Rewriting_Z] title = The Z Property author = Bertram Felgenhauer<>, Julian Nagele<>, Vincent van Oostrom<>, Christian Sternagel notify = bertram.felgenhauer@uibk.ac.at, julian.nagele@uibk.ac.at, c.sternagel@gmail.com date = 2016-06-30 topic = Logic/Rewriting abstract = We formalize the Z property introduced by Dehornoy and van Oostrom. First we show that for any abstract rewrite system, Z implies confluence. Then we give two examples of proofs using Z: confluence of lambda-calculus with respect to beta-reduction and confluence of combinatory logic. [Resolution_FOL] title = The Resolution Calculus for First-Order Logic author = Anders Schlichtkrull notify = andschl@dtu.dk date = 2016-06-30 topic = Logic/General logic/Mechanization of proofs abstract = This theory is a formalization of the resolution calculus for first-order logic. It is proven sound and complete. The soundness proof uses the substitution lemma, which shows a correspondence between substitutions and updates to an environment. The completeness proof uses semantic trees, i.e. trees whose paths are partial Herbrand interpretations. It employs Herbrand's theorem in a formulation which states that an unsatisfiable set of clauses has a finite closed semantic tree. It also uses the lifting lemma which lifts resolution derivation steps from the ground world up to the first-order world. The theory is presented in a paper in the Journal of Automated Reasoning [Sch18] which extends a paper presented at the International Conference on Interactive Theorem Proving [Sch16]. An earlier version was presented in an MSc thesis [Sch15]. The formalization mostly follows textbooks by Ben-Ari [BA12], Chang and Lee [CL73], and Leitsch [Lei97]. The theory is part of the IsaFoL project [IsaFoL].

[Sch18] Anders Schlichtkrull. "Formalization of the Resolution Calculus for First-Order Logic". Journal of Automated Reasoning, 2018.
[Sch16] Anders Schlichtkrull. "Formalization of the Resolution Calculus for First-Order Logic". In: ITP 2016. Vol. 9807. LNCS. Springer, 2016.
[Sch15] Anders Schlichtkrull. "Formalization of Resolution Calculus in Isabelle". https://people.compute.dtu.dk/andschl/Thesis.pdf. MSc thesis. Technical University of Denmark, 2015.
[BA12] Mordechai Ben-Ari. Mathematical Logic for Computer Science. 3rd. Springer, 2012.
[CL73] Chin-Liang Chang and Richard Char-Tung Lee. Symbolic Logic and Mechanical Theorem Proving. 1st. Academic Press, Inc., 1973.
[Lei97] Alexander Leitsch. The Resolution Calculus. Texts in theoretical computer science. Springer, 1997.
[IsaFoL] IsaFoL authors. IsaFoL: Isabelle Formalization of Logic. https://bitbucket.org/jasmin_blanchette/isafol. extra-history = Change history: [2018-01-24]: added several new versions of the soundness and completeness theorems as described in the paper [Sch18].
[2018-03-20]: added a concrete instance of the unification and completeness theorems using the First-Order Terms AFP-entry from IsaFoR as described in the papers [Sch16] and [Sch18]. [Surprise_Paradox] title = Surprise Paradox author = Joachim Breitner notify = mail@joachim-breitner.de date = 2016-07-17 topic = Logic/Proof theory abstract = In 1964, Fitch showed that the paradox of the surprise hanging can be resolved by showing that the judge’s verdict is inconsistent. His formalization builds on Gödel’s coding of provability. In this theory, we reproduce his proof in Isabelle, building on Paulson’s formalisation of Gödel’s incompleteness theorems. [Ptolemys_Theorem] title = Ptolemy's Theorem author = Lukas Bulwahn notify = lukas.bulwahn@gmail.com date = 2016-08-07 topic = Mathematics/Geometry abstract = This entry provides an analytic proof to Ptolemy's Theorem using polar form transformation and trigonometric identities. In this formalization, we use ideas from John Harrison's HOL Light formalization and the proof sketch on the Wikipedia entry of Ptolemy's Theorem. This theorem is the 95th theorem of the Top 100 Theorems list. [Falling_Factorial_Sum] title = The Falling Factorial of a Sum author = Lukas Bulwahn topic = Mathematics/Combinatorics date = 2017-12-22 notify = lukas.bulwahn@gmail.com abstract = This entry shows that the falling factorial of a sum can be computed with an expression using binomial coefficients and the falling factorial of its summands. The entry provides three different proofs: a combinatorial proof, an induction proof and an algebraic proof using the Vandermonde identity. The three formalizations try to follow their informal presentations from a Mathematics Stack Exchange page as close as possible. The induction and algebraic formalization end up to be very close to their informal presentation, whereas the combinatorial proof first requires the introduction of list interleavings, and significant more detail than its informal presentation. [InfPathElimination] title = Infeasible Paths Elimination by Symbolic Execution Techniques: Proof of Correctness and Preservation of Paths author = Romain Aissat<>, Frederic Voisin<>, Burkhart Wolff notify = wolff@lri.fr date = 2016-08-18 topic = Computer science/Programming languages/Static analysis abstract = TRACER is a tool for verifying safety properties of sequential C programs. TRACER attempts at building a finite symbolic execution graph which over-approximates the set of all concrete reachable states and the set of feasible paths. We present an abstract framework for TRACER and similar CEGAR-like systems. The framework provides 1) a graph- transformation based method for reducing the feasible paths in control-flow graphs, 2) a model for symbolic execution, subsumption, predicate abstraction and invariant generation. In this framework we formally prove two key properties: correct construction of the symbolic states and preservation of feasible paths. The framework focuses on core operations, leaving to concrete prototypes to “fit in” heuristics for combining them. The accompanying paper (published in ITP 2016) can be found at https://www.lri.fr/∼wolff/papers/conf/2016-itp-InfPathsNSE.pdf. [Stirling_Formula] title = Stirling's formula author = Manuel Eberl notify = eberlm@in.tum.de date = 2016-09-01 topic = Mathematics/Analysis abstract = This work contains a proof of Stirling's formula both for the factorial n! ∼ √2πn (n/e)n on natural numbers and the real Gamma function Γ(x) ∼ √2π/x (x/e)x. The proof is based on work by Graham Jameson. [Lp] title = Lp spaces author = Sebastien Gouezel notify = sebastien.gouezel@univ-rennes1.fr date = 2016-10-05 topic = Mathematics/Analysis abstract = Lp is the space of functions whose p-th power is integrable. It is one of the most fundamental Banach spaces that is used in analysis and probability. We develop a framework for function spaces, and then implement the Lp spaces in this framework using the existing integration theory in Isabelle/HOL. Our development contains most fundamental properties of Lp spaces, notably the Hölder and Minkowski inequalities, completeness of Lp, duality, stability under almost sure convergence, multiplication of functions in Lp and Lq, stability under conditional expectation. [Berlekamp_Zassenhaus] title = The Factorization Algorithm of Berlekamp and Zassenhaus author = Jose Divasón , Sebastiaan Joosten , René Thiemann , Akihisa Yamada notify = rene.thiemann@uibk.ac.at date = 2016-10-14 topic = Mathematics/Algebra abstract =

We formalize the Berlekamp-Zassenhaus algorithm for factoring square-free integer polynomials in Isabelle/HOL. We further adapt an existing formalization of Yun’s square-free factorization algorithm to integer polynomials, and thus provide an efficient and certified factorization algorithm for arbitrary univariate polynomials.

The algorithm first performs a factorization in the prime field GF(p) and then performs computations in the integer ring modulo p^k, where both p and k are determined at runtime. Since a natural modeling of these structures via dependent types is not possible in Isabelle/HOL, we formalize the whole algorithm using Isabelle’s recent addition of local type definitions.

Through experiments we verify that our algorithm factors polynomials of degree 100 within seconds.

[Allen_Calculus] title = Allen's Interval Calculus author = Fadoua Ghourabi <> notify = fadouaghourabi@gmail.com date = 2016-09-29 topic = Logic/General logic/Temporal logic, Mathematics/Order abstract = Allen’s interval calculus is a qualitative temporal representation of time events. Allen introduced 13 binary relations that describe all the possible arrangements between two events, i.e. intervals with non-zero finite length. The compositions are pertinent to reasoning about knowledge of time. In particular, a consistency problem of relation constraints is commonly solved with a guideline from these compositions. We formalize the relations together with an axiomatic system. We proof the validity of the 169 compositions of these relations. We also define nests as the sets of intervals that share a meeting point. We prove that nests give the ordering properties of points without introducing a new datatype for points. [1] J.F. Allen. Maintaining Knowledge about Temporal Intervals. In Commun. ACM, volume 26, pages 832–843, 1983. [2] J. F. Allen and P. J. Hayes. A Common-sense Theory of Time. In Proceedings of the 9th International Joint Conference on Artificial Intelligence (IJCAI’85), pages 528–531, 1985. [Source_Coding_Theorem] title = Source Coding Theorem author = Quentin Hibon , Lawrence C. Paulson notify = qh225@cl.cam.ac.uk date = 2016-10-19 topic = Mathematics/Probability theory abstract = This document contains a proof of the necessary condition on the code rate of a source code, namely that this code rate is bounded by the entropy of the source. This represents one half of Shannon's source coding theorem, which is itself an equivalence. [Buffons_Needle] title = Buffon's Needle Problem author = Manuel Eberl topic = Mathematics/Probability theory, Mathematics/Geometry date = 2017-06-06 notify = eberlm@in.tum.de abstract = In the 18th century, Georges-Louis Leclerc, Comte de Buffon posed and later solved the following problem, which is often called the first problem ever solved in geometric probability: Given a floor divided into vertical strips of the same width, what is the probability that a needle thrown onto the floor randomly will cross two strips? This entry formally defines the problem in the case where the needle's position is chosen uniformly at random in a single strip around the origin (which is equivalent to larger arrangements due to symmetry). It then provides proofs of the simple solution in the case where the needle's length is no greater than the width of the strips and the more complicated solution in the opposite case. [SPARCv8] title = A formal model for the SPARCv8 ISA and a proof of non-interference for the LEON3 processor author = Zhe Hou , David Sanan , Alwen Tiu , Yang Liu notify = zhe.hou@ntu.edu.sg, sanan@ntu.edu.sg date = 2016-10-19 topic = Computer science/Security, Computer science/Hardware abstract = We formalise the SPARCv8 instruction set architecture (ISA) which is used in processors such as LEON3. Our formalisation can be specialised to any SPARCv8 CPU, here we use LEON3 as a running example. Our model covers the operational semantics for all the instructions in the integer unit of the SPARCv8 architecture and it supports Isabelle code export, which effectively turns the Isabelle model into a SPARCv8 CPU simulator. We prove the language-based non-interference property for the LEON3 processor. Our model is based on deterministic monad, which is a modified version of the non-deterministic monad from NICTA/l4v. [Separata] title = Separata: Isabelle tactics for Separation Algebra author = Zhe Hou , David Sanan , Alwen Tiu , Rajeev Gore , Ranald Clouston notify = zhe.hou@ntu.edu.sg date = 2016-11-16 topic = Computer science/Programming languages/Logics, Tools abstract = We bring the labelled sequent calculus $LS_{PASL}$ for propositional abstract separation logic to Isabelle. The tactics given here are directly applied on an extension of the Separation Algebra in the AFP. In addition to the cancellative separation algebra, we further consider some useful properties in the heap model of separation logic, such as indivisible unit, disjointness, and cross-split. The tactics are essentially a proof search procedure for the calculus $LS_{PASL}$. We wrap the tactics in an Isabelle method called separata, and give a few examples of separation logic formulae which are provable by separata. [LOFT] title = LOFT — Verified Migration of Linux Firewalls to SDN author = Julius Michaelis , Cornelius Diekmann notify = isabelleopenflow@liftm.de date = 2016-10-21 topic = Computer science/Networks abstract = We present LOFT — Linux firewall OpenFlow Translator, a system that transforms the main routing table and FORWARD chain of iptables of a Linux-based firewall into a set of static OpenFlow rules. Our implementation is verified against a model of a simplified Linux-based router and we can directly show how much of the original functionality is preserved. [Stable_Matching] title = Stable Matching author = Peter Gammie notify = peteg42@gmail.com date = 2016-10-24 topic = Mathematics/Games and economics abstract = We mechanize proofs of several results from the matching with contracts literature, which generalize those of the classical two-sided matching scenarios that go by the name of stable marriage. Our focus is on game theoretic issues. Along the way we develop executable algorithms for computing optimal stable matches. [Modal_Logics_for_NTS] title = Modal Logics for Nominal Transition Systems author = Tjark Weber , Lars-Henrik Eriksson , Joachim Parrow , Johannes Borgström , Ramunas Gutkovas notify = tjark.weber@it.uu.se date = 2016-10-25 topic = Computer science/Concurrency/Process calculi, Logic/General logic/Modal logic abstract = We formalize a uniform semantic substrate for a wide variety of process calculi where states and action labels can be from arbitrary nominal sets. A Hennessy-Milner logic for these systems is defined, and proved adequate for bisimulation equivalence. A main novelty is the construction of an infinitary nominal data type to model formulas with (finitely supported) infinite conjunctions and actions that may contain binding names. The logic is generalized to treat different bisimulation variants such as early, late and open in a systematic way. extra-history = Change history: [2017-01-29]: Formalization of weak bisimilarity added (revision c87cc2057d9c) [Abs_Int_ITP2012] title = Abstract Interpretation of Annotated Commands author = Tobias Nipkow notify = nipkow@in.tum.de date = 2016-11-23 topic = Computer science/Programming languages/Static analysis abstract = This is the Isabelle formalization of the material decribed in the eponymous ITP 2012 paper. It develops a generic abstract interpreter for a while-language, including widening and narrowing. The collecting semantics and the abstract interpreter operate on annotated commands: the program is represented as a syntax tree with the semantic information directly embedded, without auxiliary labels. The aim of the formalization is simplicity, not efficiency or precision. This is motivated by the inclusion of the material in a theorem prover based course on semantics. A similar (but more polished) development is covered in the book Concrete Semantics. [Complx] title = COMPLX: A Verification Framework for Concurrent Imperative Programs author = Sidney Amani<>, June Andronick<>, Maksym Bortin<>, Corey Lewis<>, Christine Rizkallah<>, Joseph Tuong<> notify = sidney.amani@data61.csiro.au, corey.lewis@data61.csiro.au date = 2016-11-29 topic = Computer science/Programming languages/Logics, Computer science/Programming languages/Language definitions abstract = We propose a concurrency reasoning framework for imperative programs, based on the Owicki-Gries (OG) foundational shared-variable concurrency method. Our framework combines the approaches of Hoare-Parallel, a formalisation of OG in Isabelle/HOL for a simple while-language, and Simpl, a generic imperative language embedded in Isabelle/HOL, allowing formal reasoning on C programs. We define the Complx language, extending the syntax and semantics of Simpl with support for parallel composition and synchronisation. We additionally define an OG logic, which we prove sound w.r.t. the semantics, and a verification condition generator, both supporting involved low-level imperative constructs such as function calls and abrupt termination. We illustrate our framework on an example that features exceptions, guards and function calls. We aim to then target concurrent operating systems, such as the interruptible eChronos embedded operating system for which we already have a model-level OG proof using Hoare-Parallel. extra-history = Change history: [2017-01-13]: Improve VCG for nested parallels and sequential sections (revision 30739dbc3dcb) [Paraconsistency] title = Paraconsistency author = Anders Schlichtkrull , Jørgen Villadsen topic = Logic/General logic/Paraconsistent logics date = 2016-12-07 notify = andschl@dtu.dk, jovi@dtu.dk abstract = Paraconsistency is about handling inconsistency in a coherent way. In classical and intuitionistic logic everything follows from an inconsistent theory. A paraconsistent logic avoids the explosion. Quite a few applications in computer science and engineering are discussed in the Intelligent Systems Reference Library Volume 110: Towards Paraconsistent Engineering (Springer 2016). We formalize a paraconsistent many-valued logic that we motivated and described in a special issue on logical approaches to paraconsistency (Journal of Applied Non-Classical Logics 2005). We limit ourselves to the propositional fragment of the higher-order logic. The logic is based on so-called key equalities and has a countably infinite number of truth values. We prove theorems in the logic using the definition of validity. We verify truth tables and also counterexamples for non-theorems. We prove meta-theorems about the logic and finally we investigate a case study. [Proof_Strategy_Language] title = Proof Strategy Language author = Yutaka Nagashima<> topic = Tools date = 2016-12-20 notify = Yutaka.Nagashima@data61.csiro.au abstract = Isabelle includes various automatic tools for finding proofs under certain conditions. However, for each conjecture, knowing which automation to use, and how to tweak its parameters, is currently labour intensive. We have developed a language, PSL, designed to capture high level proof strategies. PSL offloads the construction of human-readable fast-to-replay proof scripts to automatic search, making use of search-time information about each conjecture. Our preliminary evaluations show that PSL reduces the labour cost of interactive theorem proving. This submission contains the implementation of PSL and an example theory file, Example.thy, showing how to write poof strategies in PSL. [Concurrent_Ref_Alg] title = Concurrent Refinement Algebra and Rely Quotients author = Julian Fell , Ian J. Hayes , Andrius Velykis topic = Computer science/Concurrency date = 2016-12-30 notify = Ian.Hayes@itee.uq.edu.au abstract = The concurrent refinement algebra developed here is designed to provide a foundation for rely/guarantee reasoning about concurrent programs. The algebra builds on a complete lattice of commands by providing sequential composition, parallel composition and a novel weak conjunction operator. The weak conjunction operator coincides with the lattice supremum providing its arguments are non-aborting, but aborts if either of its arguments do. Weak conjunction provides an abstract version of a guarantee condition as a guarantee process. We distinguish between models that distribute sequential composition over non-deterministic choice from the left (referred to as being conjunctive in the refinement calculus literature) and those that don't. Least and greatest fixed points of monotone functions are provided to allow recursion and iteration operators to be added to the language. Additional iteration laws are available for conjunctive models. The rely quotient of processes c and i is the process that, if executed in parallel with i implements c. It represents an abstract version of a rely condition generalised to a process. [FOL_Harrison] title = First-Order Logic According to Harrison author = Alexander Birch Jensen , Anders Schlichtkrull , Jørgen Villadsen topic = Logic/General logic/Mechanization of proofs date = 2017-01-01 notify = aleje@dtu.dk, andschl@dtu.dk, jovi@dtu.dk abstract =

We present a certified declarative first-order prover with equality based on John Harrison's Handbook of Practical Logic and Automated Reasoning, Cambridge University Press, 2009. ML code reflection is used such that the entire prover can be executed within Isabelle as a very simple interactive proof assistant. As examples we consider Pelletier's problems 1-46.

Reference: Programming and Verifying a Declarative First-Order Prover in Isabelle/HOL. Alexander Birch Jensen, John Bruntse Larsen, Anders Schlichtkrull & Jørgen Villadsen. AI Communications 31:281-299 2018. https://content.iospress.com/articles/ai-communications/aic764

See also: Students' Proof Assistant (SPA). https://github.com/logic-tools/spa

extra-history = Change history: [2018-07-21]: Proof of Pelletier's problem 34 (Andrews's Challenge) thanks to Asta Halkjær From. [Bernoulli] title = Bernoulli Numbers author = Lukas Bulwahn, Manuel Eberl topic = Mathematics/Analysis, Mathematics/Number theory date = 2017-01-24 notify = eberlm@in.tum.de abstract =

Bernoulli numbers were first discovered in the closed-form expansion of the sum 1m + 2m + … + nm for a fixed m and appear in many other places. This entry provides three different definitions for them: a recursive one, an explicit one, and one through their exponential generating function.

In addition, we prove some basic facts, e.g. their relation to sums of powers of integers and that all odd Bernoulli numbers except the first are zero, and some advanced facts like their relationship to the Riemann zeta function on positive even integers.

We also prove the correctness of the Akiyama–Tanigawa algorithm for computing Bernoulli numbers with reasonable efficiency, and we define the periodic Bernoulli polynomials (which appear e.g. in the Euler–MacLaurin summation formula and the expansion of the log-Gamma function) and prove their basic properties.

[Stone_Relation_Algebras] title = Stone Relation Algebras author = Walter Guttmann topic = Mathematics/Algebra date = 2017-02-07 notify = walter.guttmann@canterbury.ac.nz abstract = We develop Stone relation algebras, which generalise relation algebras by replacing the underlying Boolean algebra structure with a Stone algebra. We show that finite matrices over extended real numbers form an instance. As a consequence, relation-algebraic concepts and methods can be used for reasoning about weighted graphs. We also develop a fixpoint calculus and apply it to compare different definitions of reflexive-transitive closures in semirings. [Stone_Kleene_Relation_Algebras] title = Stone-Kleene Relation Algebras author = Walter Guttmann topic = Mathematics/Algebra date = 2017-07-06 notify = walter.guttmann@canterbury.ac.nz abstract = We develop Stone-Kleene relation algebras, which expand Stone relation algebras with a Kleene star operation to describe reachability in weighted graphs. Many properties of the Kleene star arise as a special case of a more general theory of iteration based on Conway semirings extended by simulation axioms. This includes several theorems representing complex program transformations. We formally prove the correctness of Conway's automata-based construction of the Kleene star of a matrix. We prove numerous results useful for reasoning about weighted graphs. [Abstract_Soundness] title = Abstract Soundness author = Jasmin Christian Blanchette , Andrei Popescu , Dmitriy Traytel topic = Logic/Proof theory date = 2017-02-10 notify = jasmin.blanchette@gmail.com abstract = A formalized coinductive account of the abstract development of Brotherston, Gorogiannis, and Petersen [APLAS 2012], in a slightly more general form since we work with arbitrary infinite proofs, which may be acyclic. This work is described in detail in an article by the authors, published in 2017 in the Journal of Automated Reasoning. The abstract proof can be instantiated for various formalisms, including first-order logic with inductive predicates. [Differential_Dynamic_Logic] title = Differential Dynamic Logic author = Brandon Bohrer topic = Logic/General logic/Modal logic, Computer science/Programming languages/Logics date = 2017-02-13 notify = bbohrer@cs.cmu.edu abstract = We formalize differential dynamic logic, a logic for proving properties of hybrid systems. The proof calculus in this formalization is based on the uniform substitution principle. We show it is sound with respect to our denotational semantics, which provides increased confidence in the correctness of the KeYmaera X theorem prover based on this calculus. As an application, we include a proof term checker embedded in Isabelle/HOL with several example proofs. Published in: Brandon Bohrer, Vincent Rahli, Ivana Vukotic, Marcus Völp, André Platzer: Formally verified differential dynamic logic. CPP 2017. [Elliptic_Curves_Group_Law] title = The Group Law for Elliptic Curves author = Stefan Berghofer topic = Computer science/Security/Cryptography date = 2017-02-28 notify = berghofe@in.tum.de abstract = We prove the group law for elliptic curves in Weierstrass form over fields of characteristic greater than 2. In addition to affine coordinates, we also formalize projective coordinates, which allow for more efficient computations. By specializing the abstract formalization to prime fields, we can apply the curve operations to parameters used in standard security protocols. [Example-Submission] title = Example Submission author = Gerwin Klein topic = Mathematics/Analysis, Mathematics/Number theory date = 2004-02-25 notify = kleing@cse.unsw.edu.au abstract =

This is an example submission to the Archive of Formal Proofs. It shows submission requirements and explains the structure of a simple typical submission.

Note that you can use HTML tags and LaTeX formulae like $\sum_{n=1}^\infty \frac{1}{n^2} = \frac{\pi^2}{6}$ in the abstract. Display formulae like $$ \int_0^1 x^{-x}\,\text{d}x = \sum_{n=1}^\infty n^{-n}$$ are also possible. Please read the submission guidelines before using this.

extra-no-index = no-index: true [CRDT] title = A framework for establishing Strong Eventual Consistency for Conflict-free Replicated Datatypes author = Victor B. F. Gomes , Martin Kleppmann, Dominic P. Mulligan, Alastair R. Beresford topic = Computer science/Algorithms/Distributed, Computer science/Data structures date = 2017-07-07 notify = vb358@cam.ac.uk, dominic.p.mulligan@googlemail.com abstract = In this work, we focus on the correctness of Conflict-free Replicated Data Types (CRDTs), a class of algorithm that provides strong eventual consistency guarantees for replicated data. We develop a modular and reusable framework for verifying the correctness of CRDT algorithms. We avoid correctness issues that have dogged previous mechanised proofs in this area by including a network model in our formalisation, and proving that our theorems hold in all possible network behaviours. Our axiomatic network model is a standard abstraction that accurately reflects the behaviour of real-world computer networks. Moreover, we identify an abstract convergence theorem, a property of order relations, which provides a formal definition of strong eventual consistency. We then obtain the first machine-checked correctness theorems for three concrete CRDTs: the Replicated Growable Array, the Observed-Remove Set, and an Increment-Decrement Counter. [HOLCF-Prelude] title = HOLCF-Prelude author = Joachim Breitner, Brian Huffman<>, Neil Mitchell<>, Christian Sternagel topic = Computer science/Functional programming date = 2017-07-15 notify = c.sternagel@gmail.com, joachim@cis.upenn.edu, hupel@in.tum.de abstract = The Isabelle/HOLCF-Prelude is a formalization of a large part of Haskell's standard prelude in Isabelle/HOLCF. We use it to prove the correctness of the Eratosthenes' Sieve, in its self-referential implementation commonly used to showcase Haskell's laziness; prove correctness of GHC's "fold/build" rule and related rewrite rules; and certify a number of hints suggested by HLint. [Decl_Sem_Fun_PL] title = Declarative Semantics for Functional Languages author = Jeremy Siek topic = Computer science/Programming languages date = 2017-07-21 notify = jsiek@indiana.edu abstract = We present a semantics for an applied call-by-value lambda-calculus that is compositional, extensional, and elementary. We present four different views of the semantics: 1) as a relational (big-step) semantics that is not operational but instead declarative, 2) as a denotational semantics that does not use domain theory, 3) as a non-deterministic interpreter, and 4) as a variant of the intersection type systems of the Torino group. We prove that the semantics is correct by showing that it is sound and complete with respect to operational semantics on programs and that is sound with respect to contextual equivalence. We have not yet investigated whether it is fully abstract. We demonstrate that this approach to semantics is useful with three case studies. First, we use the semantics to prove correctness of a compiler optimization that inlines function application. Second, we adapt the semantics to the polymorphic lambda-calculus extended with general recursion and prove semantic type soundness. Third, we adapt the semantics to the call-by-value lambda-calculus with mutable references.
The paper that accompanies these Isabelle theories is available on arXiv. [DynamicArchitectures] title = Dynamic Architectures author = Diego Marmsoler topic = Computer science/System description languages date = 2017-07-28 notify = diego.marmsoler@tum.de abstract = The architecture of a system describes the system's overall organization into components and connections between those components. With the emergence of mobile computing, dynamic architectures have become increasingly important. In such architectures, components may appear or disappear, and connections may change over time. In the following we mechanize a theory of dynamic architectures and verify the soundness of a corresponding calculus. Therefore, we first formalize the notion of configuration traces as a model for dynamic architectures. Then, the behavior of single components is formalized in terms of behavior traces and an operator is introduced and studied to extract the behavior of a single component out of a given configuration trace. Then, behavior trace assertions are introduced as a temporal specification technique to specify behavior of components. Reasoning about component behavior in a dynamic context is formalized in terms of a calculus for dynamic architectures. Finally, the soundness of the calculus is verified by introducing an alternative interpretation for behavior trace assertions over configuration traces and proving the rules of the calculus. Since projection may lead to finite as well as infinite behavior traces, they are formalized in terms of coinductive lists. Thus, our theory is based on Lochbihler's formalization of coinductive lists. The theory may be applied to verify properties for dynamic architectures. extra-history = Change history: [2018-06-07]: adding logical operators to specify configuration traces (revision 09178f08f050)
[Stewart_Apollonius] title = Stewart's Theorem and Apollonius' Theorem author = Lukas Bulwahn topic = Mathematics/Geometry date = 2017-07-31 notify = lukas.bulwahn@gmail.com abstract = This entry formalizes the two geometric theorems, Stewart's and Apollonius' theorem. Stewart's Theorem relates the length of a triangle's cevian to the lengths of the triangle's two sides. Apollonius' Theorem is a specialisation of Stewart's theorem, restricting the cevian to be the median. The proof applies the law of cosines, some basic geometric facts about triangles and then simply transforms the terms algebraically to yield the conjectured relation. The formalization in Isabelle can closely follow the informal proofs described in the Wikipedia articles of those two theorems. [LambdaMu] title = The LambdaMu-calculus author = Cristina Matache , Victor B. F. Gomes , Dominic P. Mulligan topic = Computer science/Programming languages/Lambda calculi, Logic/General logic/Lambda calculus date = 2017-08-16 notify = victorborgesfg@gmail.com, dominic.p.mulligan@googlemail.com abstract = The propositions-as-types correspondence is ordinarily presented as linking the metatheory of typed λ-calculi and the proof theory of intuitionistic logic. Griffin observed that this correspondence could be extended to classical logic through the use of control operators. This observation set off a flurry of further research, leading to the development of Parigots λμ-calculus. In this work, we formalise λμ- calculus in Isabelle/HOL and prove several metatheoretical properties such as type preservation and progress. [Orbit_Stabiliser] title = Orbit-Stabiliser Theorem with Application to Rotational Symmetries author = Jonas Rädle topic = Mathematics/Algebra date = 2017-08-20 notify = jonas.raedle@tum.de abstract = The Orbit-Stabiliser theorem is a basic result in the algebra of groups that factors the order of a group into the sizes of its orbits and stabilisers. We formalize the notion of a group action and the related concepts of orbits and stabilisers. This allows us to prove the orbit-stabiliser theorem. In the second part of this work, we formalize the tetrahedral group and use the orbit-stabiliser theorem to prove that there are twelve (orientation-preserving) rotations of the tetrahedron. [PLM] title = Representation and Partial Automation of the Principia Logico-Metaphysica in Isabelle/HOL author = Daniel Kirchner topic = Logic/Philosophical aspects date = 2017-09-17 notify = daniel@ekpyron.org abstract =

We present an embedding of the second-order fragment of the Theory of Abstract Objects as described in Edward Zalta's upcoming work Principia Logico-Metaphysica (PLM) in the automated reasoning framework Isabelle/HOL. The Theory of Abstract Objects is a metaphysical theory that reifies property patterns, as they for example occur in the abstract reasoning of mathematics, as abstract objects and provides an axiomatic framework that allows to reason about these objects. It thereby serves as a fundamental metaphysical theory that can be used to axiomatize and describe a wide range of philosophical objects, such as Platonic forms or Leibniz' concepts, and has the ambition to function as a foundational theory of mathematics. The target theory of our embedding as described in chapters 7-9 of PLM employs a modal relational type theory as logical foundation for which a representation in functional type theory is known to be challenging.

Nevertheless we arrive at a functioning representation of the theory in the functional logic of Isabelle/HOL based on a semantical representation of an Aczel-model of the theory. Based on this representation we construct an implementation of the deductive system of PLM which allows to automatically and interactively find and verify theorems of PLM.

Our work thereby supports the concept of shallow semantical embeddings of logical systems in HOL as a universal tool for logical reasoning as promoted by Christoph Benzmüller.

The most notable result of the presented work is the discovery of a previously unknown paradox in the formulation of the Theory of Abstract Objects. The embedding of the theory in Isabelle/HOL played a vital part in this discovery. Furthermore it was possible to immediately offer several options to modify the theory to guarantee its consistency. Thereby our work could provide a significant contribution to the development of a proper grounding for object theory.

[KD_Tree] title = Multidimensional Binary Search Trees author = Martin Rau<> topic = Computer science/Data structures date = 2019-05-30 notify = martin.rau@tum.de, mrtnrau@googlemail.com abstract = This entry provides a formalization of multidimensional binary trees, also known as k-d trees. It includes a balanced build algorithm as well as the nearest neighbor algorithm and the range search algorithm. It is based on the papers Multidimensional binary search trees used for associative searching and An Algorithm for Finding Best Matches in Logarithmic Expected Time. extra-history = Change history: [2020-15-04]: Change representation of k-dimensional points from 'list' to HOL-Analysis.Finite_Cartesian_Product 'vec'. Update proofs to incorporate HOL-Analysis 'dist' and 'cbox' primitives. [Closest_Pair_Points] title = Closest Pair of Points Algorithms author = Martin Rau , Tobias Nipkow topic = Computer science/Algorithms/Geometry date = 2020-01-13 notify = martin.rau@tum.de, nipkow@in.tum.de abstract = This entry provides two related verified divide-and-conquer algorithms solving the fundamental Closest Pair of Points problem in Computational Geometry. Functional correctness and the optimal running time of O(n log n) are proved. Executable code is generated which is empirically competitive with handwritten reference implementations. extra-history = Change history: [2020-14-04]: Incorporate Time_Monad of the AFP entry Root_Balanced_Tree. [Approximation_Algorithms] title = Verified Approximation Algorithms author = Robin Eßmann , Tobias Nipkow , Simon Robillard topic = Computer science/Algorithms/Approximation date = 2020-01-16 notify = nipkow@in.tum.de abstract = We present the first formal verification of approximation algorithms for NP-complete optimization problems: vertex cover, independent set, load balancing, and bin packing. The proofs correct incompletenesses in existing proofs and improve the approximation ratio in one case. [Diophantine_Eqns_Lin_Hom] title = Homogeneous Linear Diophantine Equations author = Florian Messner , Julian Parsert , Jonas Schöpf , Christian Sternagel topic = Computer science/Algorithms/Mathematical, Mathematics/Number theory, Tools license = LGPL date = 2017-10-14 notify = c.sternagel@gmail.com, julian.parsert@gmail.com abstract = We formalize the theory of homogeneous linear diophantine equations, focusing on two main results: (1) an abstract characterization of minimal complete sets of solutions, and (2) an algorithm computing them. Both, the characterization and the algorithm are based on previous work by Huet. Our starting point is a simple but inefficient variant of Huet's lexicographic algorithm incorporating improved bounds due to Clausen and Fortenbacher. We proceed by proving its soundness and completeness. Finally, we employ code equations to obtain a reasonably efficient implementation. Thus, we provide a formally verified solver for homogeneous linear diophantine equations. [Winding_Number_Eval] title = Evaluate Winding Numbers through Cauchy Indices author = Wenda Li topic = Mathematics/Analysis date = 2017-10-17 notify = wl302@cam.ac.uk, liwenda1990@hotmail.com abstract = In complex analysis, the winding number measures the number of times a path (counterclockwise) winds around a point, while the Cauchy index can approximate how the path winds. This entry provides a formalisation of the Cauchy index, which is then shown to be related to the winding number. In addition, this entry also offers a tactic that enables users to evaluate the winding number by calculating Cauchy indices. [Count_Complex_Roots] title = Count the Number of Complex Roots author = Wenda Li topic = Mathematics/Analysis date = 2017-10-17 notify = wl302@cam.ac.uk, liwenda1990@hotmail.com abstract = Based on evaluating Cauchy indices through remainder sequences, this entry provides an effective procedure to count the number of complex roots (with multiplicity) of a polynomial within a rectangle box or a half-plane. Potential applications of this entry include certified complex root isolation (of a polynomial) and testing the Routh-Hurwitz stability criterion (i.e., to check whether all the roots of some characteristic polynomial have negative real parts). [Buchi_Complementation] title = Büchi Complementation author = Julian Brunner topic = Computer science/Automata and formal languages date = 2017-10-19 notify = brunnerj@in.tum.de abstract = This entry provides a verified implementation of rank-based Büchi Complementation. The verification is done in three steps:
  1. Definition of odd rankings and proof that an automaton rejects a word iff there exists an odd ranking for it.
  2. Definition of the complement automaton and proof that it accepts exactly those words for which there is an odd ranking.
  3. Verified implementation of the complement automaton using the Isabelle Collections Framework.
[Transition_Systems_and_Automata] title = Transition Systems and Automata author = Julian Brunner topic = Computer science/Automata and formal languages date = 2017-10-19 notify = brunnerj@in.tum.de abstract = This entry provides a very abstract theory of transition systems that can be instantiated to express various types of automata. A transition system is typically instantiated by providing a set of initial states, a predicate for enabled transitions, and a transition execution function. From this, it defines the concepts of finite and infinite paths as well as the set of reachable states, among other things. Many useful theorems, from basic path manipulation rules to coinduction and run construction rules, are proven in this abstract transition system context. The library comes with instantiations for DFAs, NFAs, and Büchi automata. [Kuratowski_Closure_Complement] title = The Kuratowski Closure-Complement Theorem author = Peter Gammie , Gianpaolo Gioiosa<> topic = Mathematics/Topology date = 2017-10-26 notify = peteg42@gmail.com abstract = We discuss a topological curiosity discovered by Kuratowski (1922): the fact that the number of distinct operators on a topological space generated by compositions of closure and complement never exceeds 14, and is exactly 14 in the case of R. In addition, we prove a theorem due to Chagrov (1982) that classifies topological spaces according to the number of such operators they support. [Hybrid_Multi_Lane_Spatial_Logic] title = Hybrid Multi-Lane Spatial Logic author = Sven Linker topic = Logic/General logic/Modal logic date = 2017-11-06 notify = s.linker@liverpool.ac.uk abstract = We present a semantic embedding of a spatio-temporal multi-modal logic, specifically defined to reason about motorway traffic, into Isabelle/HOL. The semantic model is an abstraction of a motorway, emphasising local spatial properties, and parameterised by the types of sensors deployed in the vehicles. We use the logic to define controller constraints to ensure safety, i.e., the absence of collisions on the motorway. After proving safety with a restrictive definition of sensors, we relax these assumptions and show how to amend the controller constraints to still guarantee safety. [Dirichlet_L] title = Dirichlet L-Functions and Dirichlet's Theorem author = Manuel Eberl topic = Mathematics/Number theory, Mathematics/Algebra date = 2017-12-21 notify = eberlm@in.tum.de abstract =

This article provides a formalisation of Dirichlet characters and Dirichlet L-functions including proofs of their basic properties – most notably their analyticity, their areas of convergence, and their non-vanishing for ℜ(s) ≥ 1. All of this is built in a very high-level style using Dirichlet series. The proof of the non-vanishing follows a very short and elegant proof by Newman, which we attempt to reproduce faithfully in a similar level of abstraction in Isabelle.

This also leads to a relatively short proof of Dirichlet’s Theorem, which states that, if h and n are coprime, there are infinitely many primes p with p ≡ h (mod n).

[Symmetric_Polynomials] title = Symmetric Polynomials author = Manuel Eberl topic = Mathematics/Algebra date = 2018-09-25 notify = eberlm@in.tum.de abstract =

A symmetric polynomial is a polynomial in variables X1,…,Xn that does not discriminate between its variables, i. e. it is invariant under any permutation of them. These polynomials are important in the study of the relationship between the coefficients of a univariate polynomial and its roots in its algebraic closure.

This article provides a definition of symmetric polynomials and the elementary symmetric polynomials e1,…,en and proofs of their basic properties, including three notable ones:

  • Vieta's formula, which gives an explicit expression for the k-th coefficient of a univariate monic polynomial in terms of its roots x1,…,xn, namely ck = (-1)n-k en-k(x1,…,xn).
  • Second, the Fundamental Theorem of Symmetric Polynomials, which states that any symmetric polynomial is itself a uniquely determined polynomial combination of the elementary symmetric polynomials.
  • Third, as a corollary of the previous two, that given a polynomial over some ring R, any symmetric polynomial combination of its roots is also in R even when the roots are not.

Both the symmetry property itself and the witness for the Fundamental Theorem are executable.

[Taylor_Models] title = Taylor Models author = Christoph Traut<>, Fabian Immler topic = Computer science/Algorithms/Mathematical, Computer science/Data structures, Mathematics/Analysis, Mathematics/Algebra date = 2018-01-08 notify = immler@in.tum.de abstract = We present a formally verified implementation of multivariate Taylor models. Taylor models are a form of rigorous polynomial approximation, consisting of an approximation polynomial based on Taylor expansions, combined with a rigorous bound on the approximation error. Taylor models were introduced as a tool to mitigate the dependency problem of interval arithmetic. Our implementation automatically computes Taylor models for the class of elementary functions, expressed by composition of arithmetic operations and basic functions like exp, sin, or square root. [Green] title = An Isabelle/HOL formalisation of Green's Theorem author = Mohammad Abdulaziz , Lawrence C. Paulson topic = Mathematics/Analysis date = 2018-01-11 notify = mohammad.abdulaziz8@gmail.com, lp15@cam.ac.uk abstract = We formalise a statement of Green’s theorem—the first formalisation to our knowledge—in Isabelle/HOL. The theorem statement that we formalise is enough for most applications, especially in physics and engineering. Our formalisation is made possible by a novel proof that avoids the ubiquitous line integral cancellation argument. This eliminates the need to formalise orientations and region boundaries explicitly with respect to the outwards-pointing normal vector. Instead we appeal to a homological argument about equivalences between paths. [Gromov_Hyperbolicity] title = Gromov Hyperbolicity author = Sebastien Gouezel<> topic = Mathematics/Geometry date = 2018-01-16 notify = sebastien.gouezel@univ-rennes1.fr abstract = A geodesic metric space is Gromov hyperbolic if all its geodesic triangles are thin, i.e., every side is contained in a fixed thickening of the two other sides. While this definition looks innocuous, it has proved extremely important and versatile in modern geometry since its introduction by Gromov. We formalize the basic classical properties of Gromov hyperbolic spaces, notably the Morse lemma asserting that quasigeodesics are close to geodesics, the invariance of hyperbolicity under quasi-isometries, we define and study the Gromov boundary and its associated distance, and prove that a quasi-isometry between Gromov hyperbolic spaces extends to a homeomorphism of the boundaries. We also prove a less classical theorem, by Bonk and Schramm, asserting that a Gromov hyperbolic space embeds isometrically in a geodesic Gromov-hyperbolic space. As the original proof uses a transfinite sequence of Cauchy completions, this is an interesting formalization exercise. Along the way, we introduce basic material on isometries, quasi-isometries, Lipschitz maps, geodesic spaces, the Hausdorff distance, the Cauchy completion of a metric space, and the exponential on extended real numbers. [Ordered_Resolution_Prover] title = Formalization of Bachmair and Ganzinger's Ordered Resolution Prover author = Anders Schlichtkrull , Jasmin Christian Blanchette , Dmitriy Traytel , Uwe Waldmann topic = Logic/General logic/Mechanization of proofs date = 2018-01-18 notify = andschl@dtu.dk, j.c.blanchette@vu.nl abstract = This Isabelle/HOL formalization covers Sections 2 to 4 of Bachmair and Ganzinger's "Resolution Theorem Proving" chapter in the Handbook of Automated Reasoning. This includes soundness and completeness of unordered and ordered variants of ground resolution with and without literal selection, the standard redundancy criterion, a general framework for refutational theorem proving, and soundness and completeness of an abstract first-order prover. [BNF_Operations] title = Operations on Bounded Natural Functors author = Jasmin Christian Blanchette , Andrei Popescu , Dmitriy Traytel topic = Tools date = 2017-12-19 notify = jasmin.blanchette@gmail.com,uuomul@yahoo.com,traytel@inf.ethz.ch abstract = This entry formalizes the closure property of bounded natural functors (BNFs) under seven operations. These operations and the corresponding proofs constitute the core of Isabelle's (co)datatype package. To be close to the implemented tactics, the proofs are deliberately formulated as detailed apply scripts. The (co)datatypes together with (co)induction principles and (co)recursors are byproducts of the fixpoint operations LFP and GFP. Composition of BNFs is subdivided into four simpler operations: Compose, Kill, Lift, and Permute. The N2M operation provides mutual (co)induction principles and (co)recursors for nested (co)datatypes. [LLL_Basis_Reduction] title = A verified LLL algorithm author = Ralph Bottesch <>, Jose Divasón , Maximilian Haslbeck , Sebastiaan Joosten , René Thiemann , Akihisa Yamada<> topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra date = 2018-02-02 notify = ralph.bottesch@uibk.ac.at, jose.divason@unirioja.es, maximilian.haslbeck@uibk.ac.at, s.j.c.joosten@utwente.nl, rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp abstract = The Lenstra-Lenstra-Lovász basis reduction algorithm, also known as LLL algorithm, is an algorithm to find a basis with short, nearly orthogonal vectors of an integer lattice. Thereby, it can also be seen as an approximation to solve the shortest vector problem (SVP), which is an NP-hard problem, where the approximation quality solely depends on the dimension of the lattice, but not the lattice itself. The algorithm also possesses many applications in diverse fields of computer science, from cryptanalysis to number theory, but it is specially well-known since it was used to implement the first polynomial-time algorithm to factor polynomials. In this work we present the first mechanized soundness proof of the LLL algorithm to compute short vectors in lattices. The formalization follows a textbook by von zur Gathen and Gerhard. extra-history = Change history: [2018-04-16]: Integrated formal complexity bounds (Haslbeck, Thiemann) [2018-05-25]: Integrated much faster LLL implementation based on integer arithmetic (Bottesch, Haslbeck, Thiemann) [LLL_Factorization] title = A verified factorization algorithm for integer polynomials with polynomial complexity author = Jose Divasón , Sebastiaan Joosten , René Thiemann , Akihisa Yamada topic = Mathematics/Algebra date = 2018-02-06 notify = jose.divason@unirioja.es, s.j.c.joosten@utwente.nl, rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp abstract = Short vectors in lattices and factors of integer polynomials are related. Each factor of an integer polynomial belongs to a certain lattice. When factoring polynomials, the condition that we are looking for an irreducible polynomial means that we must look for a small element in a lattice, which can be done by a basis reduction algorithm. In this development we formalize this connection and thereby one main application of the LLL basis reduction algorithm: an algorithm to factor square-free integer polynomials which runs in polynomial time. The work is based on our previous Berlekamp–Zassenhaus development, where the exponential reconstruction phase has been replaced by the polynomial-time basis reduction algorithm. Thanks to this formalization we found a serious flaw in a textbook. [Treaps] title = Treaps author = Maximilian Haslbeck , Manuel Eberl , Tobias Nipkow topic = Computer science/Data structures date = 2018-02-06 notify = eberlm@in.tum.de abstract =

A Treap is a binary tree whose nodes contain pairs consisting of some payload and an associated priority. It must have the search-tree property w.r.t. the payloads and the heap property w.r.t. the priorities. Treaps are an interesting data structure that is related to binary search trees (BSTs) in the following way: if one forgets all the priorities of a treap, the resulting BST is exactly the same as if one had inserted the elements into an empty BST in order of ascending priority. This means that a treap behaves like a BST where we can pretend the elements were inserted in a different order from the one in which they were actually inserted.

In particular, by choosing these priorities at random upon insertion of an element, we can pretend that we inserted the elements in random order, so that the shape of the resulting tree is that of a random BST no matter in what order we insert the elements. This is the main result of this formalisation.

[Skip_Lists] title = Skip Lists author = Max W. Haslbeck , Manuel Eberl topic = Computer science/Data structures date = 2020-01-09 notify = max.haslbeck@gmx.de abstract =

Skip lists are sorted linked lists enhanced with shortcuts and are an alternative to binary search trees. A skip lists consists of multiple levels of sorted linked lists where a list on level n is a subsequence of the list on level n − 1. In the ideal case, elements are skipped in such a way that a lookup in a skip lists takes O(log n) time. In a randomised skip list the skipped elements are choosen randomly.

This entry contains formalized proofs of the textbook results about the expected height and the expected length of a search path in a randomised skip list.

[Mersenne_Primes] title = Mersenne primes and the Lucas–Lehmer test author = Manuel Eberl topic = Mathematics/Number theory date = 2020-01-17 notify = eberlm@in.tum.de abstract =

This article provides formal proofs of basic properties of Mersenne numbers, i. e. numbers of the form 2n - 1, and especially of Mersenne primes.

In particular, an efficient, verified, and executable version of the Lucas–Lehmer test is developed. This test decides primality for Mersenne numbers in time polynomial in n.

[Hoare_Time] title = Hoare Logics for Time Bounds author = Maximilian P. L. Haslbeck , Tobias Nipkow topic = Computer science/Programming languages/Logics date = 2018-02-26 notify = haslbema@in.tum.de abstract = We study three different Hoare logics for reasoning about time bounds of imperative programs and formalize them in Isabelle/HOL: a classical Hoare like logic due to Nielson, a logic with potentials due to Carbonneaux et al. and a separation logic following work by Atkey, Chaguérand and Pottier. These logics are formally shown to be sound and complete. Verification condition generators are developed and are shown sound and complete too. We also consider variants of the systems where we abstract from multiplicative constants in the running time bounds, thus supporting a big-O style of reasoning. Finally we compare the expressive power of the three systems. [Architectural_Design_Patterns] title = A Theory of Architectural Design Patterns author = Diego Marmsoler topic = Computer science/System description languages date = 2018-03-01 notify = diego.marmsoler@tum.de abstract = The following document formalizes and verifies several architectural design patterns. Each pattern specification is formalized in terms of a locale where the locale assumptions correspond to the assumptions which a pattern poses on an architecture. Thus, pattern specifications may build on top of each other by interpreting the corresponding locale. A pattern is verified using the framework provided by the AFP entry Dynamic Architectures. Currently, the document consists of formalizations of 4 different patterns: the singleton, the publisher subscriber, the blackboard pattern, and the blockchain pattern. Thereby, the publisher component of the publisher subscriber pattern is modeled as an instance of the singleton pattern and the blackboard pattern is modeled as an instance of the publisher subscriber pattern. In general, this entry provides the first steps towards an overall theory of architectural design patterns. extra-history = Change history: [2018-05-25]: changing the major assumption for blockchain architectures from alternative minings to relative mining frequencies (revision 5043c5c71685)
[2019-04-08]: adapting the terminology: honest instead of trusted, dishonest instead of untrusted (revision 7af3431a22ae) [Weight_Balanced_Trees] title = Weight-Balanced Trees author = Tobias Nipkow , Stefan Dirix<> topic = Computer science/Data structures date = 2018-03-13 notify = nipkow@in.tum.de abstract = This theory provides a verified implementation of weight-balanced trees following the work of Hirai and Yamamoto who proved that all parameters in a certain range are valid, i.e. guarantee that insertion and deletion preserve weight-balance. Instead of a general theorem we provide parameterized proofs of preservation of the invariant that work for many (all?) valid parameters. [Fishburn_Impossibility] title = The Incompatibility of Fishburn-Strategyproofness and Pareto-Efficiency author = Felix Brandt , Manuel Eberl , Christian Saile , Christian Stricker topic = Mathematics/Games and economics date = 2018-03-22 notify = eberlm@in.tum.de abstract =

This formalisation contains the proof that there is no anonymous Social Choice Function for at least three agents and alternatives that fulfils both Pareto-Efficiency and Fishburn-Strategyproofness. It was derived from a proof of Brandt et al., which relies on an unverified translation of a fixed finite instance of the original problem to SAT. This Isabelle proof contains a machine-checked version of both the statement for exactly three agents and alternatives and the lifting to the general case.

[BNF_CC] title = Bounded Natural Functors with Covariance and Contravariance author = Andreas Lochbihler , Joshua Schneider topic = Computer science/Functional programming, Tools date = 2018-04-24 notify = mail@andreas-lochbihler.de, joshua.schneider@inf.ethz.ch abstract = Bounded natural functors (BNFs) provide a modular framework for the construction of (co)datatypes in higher-order logic. Their functorial operations, the mapper and relator, are restricted to a subset of the parameters, namely those where recursion can take place. For certain applications, such as free theorems, data refinement, quotients, and generalised rewriting, it is desirable that these operations do not ignore the other parameters. In this article, we formalise the generalisation BNFCC that extends the mapper and relator to covariant and contravariant parameters. We show that
  1. BNFCCs are closed under functor composition and least and greatest fixpoints,
  2. subtypes inherit the BNFCC structure under conditions that generalise those for the BNF case, and
  3. BNFCCs preserve quotients under mild conditions.
These proofs are carried out for abstract BNFCCs similar to the AFP entry BNF Operations. In addition, we apply the BNFCC theory to several concrete functors. [Modular_Assembly_Kit_Security] title = An Isabelle/HOL Formalization of the Modular Assembly Kit for Security Properties author = Oliver Bračevac , Richard Gay , Sylvia Grewe , Heiko Mantel , Henning Sudbrock , Markus Tasch topic = Computer science/Security date = 2018-05-07 notify = tasch@mais.informatik.tu-darmstadt.de abstract = The "Modular Assembly Kit for Security Properties" (MAKS) is a framework for both the definition and verification of possibilistic information-flow security properties at the specification-level. MAKS supports the uniform representation of a wide range of possibilistic information-flow properties and provides support for the verification of such properties via unwinding results and compositionality results. We provide a formalization of this framework in Isabelle/HOL. [AxiomaticCategoryTheory] title = Axiom Systems for Category Theory in Free Logic author = Christoph Benzmüller , Dana Scott topic = Mathematics/Category theory date = 2018-05-23 notify = c.benzmueller@gmail.com abstract = This document provides a concise overview on the core results of our previous work on the exploration of axioms systems for category theory. Extending the previous studies (http://arxiv.org/abs/1609.01493) we include one further axiomatic theory in our experiments. This additional theory has been suggested by Mac Lane in 1948. We show that the axioms proposed by Mac Lane are equivalent to the ones we studied before, which includes an axioms set suggested by Scott in the 1970s and another axioms set proposed by Freyd and Scedrov in 1990, which we slightly modified to remedy a minor technical issue. [OpSets] title = OpSets: Sequential Specifications for Replicated Datatypes author = Martin Kleppmann , Victor B. F. Gomes , Dominic P. Mulligan , Alastair R. Beresford topic = Computer science/Algorithms/Distributed, Computer science/Data structures date = 2018-05-10 notify = vb358@cam.ac.uk abstract = We introduce OpSets, an executable framework for specifying and reasoning about the semantics of replicated datatypes that provide eventual consistency in a distributed system, and for mechanically verifying algorithms that implement these datatypes. Our approach is simple but expressive, allowing us to succinctly specify a variety of abstract datatypes, including maps, sets, lists, text, graphs, trees, and registers. Our datatypes are also composable, enabling the construction of complex data structures. To demonstrate the utility of OpSets for analysing replication algorithms, we highlight an important correctness property for collaborative text editing that has traditionally been overlooked; algorithms that do not satisfy this property can exhibit awkward interleaving of text. We use OpSets to specify this correctness property and prove that although one existing replication algorithm satisfies this property, several other published algorithms do not. [Irrationality_J_Hancl] title = Irrational Rapidly Convergent Series author = Angeliki Koutsoukou-Argyraki , Wenda Li topic = Mathematics/Number theory, Mathematics/Analysis date = 2018-05-23 notify = ak2110@cam.ac.uk, wl302@cam.ac.uk abstract = We formalize with Isabelle/HOL a proof of a theorem by J. Hancl asserting the irrationality of the sum of a series consisting of rational numbers, built up by sequences that fulfill certain properties. Even though the criterion is a number theoretic result, the proof makes use only of analytical arguments. We also formalize a corollary of the theorem for a specific series fulfilling the assumptions of the theorem. [Optimal_BST] title = Optimal Binary Search Trees author = Tobias Nipkow , Dániel Somogyi <> topic = Computer science/Algorithms, Computer science/Data structures date = 2018-05-27 notify = nipkow@in.tum.de abstract = This article formalizes recursive algorithms for the construction of optimal binary search trees given fixed access frequencies. We follow Knuth (1971), Yao (1980) and Mehlhorn (1984). The algorithms are memoized with the help of the AFP article Monadification, Memoization and Dynamic Programming, thus yielding dynamic programming algorithms. [Projective_Geometry] title = Projective Geometry author = Anthony Bordg topic = Mathematics/Geometry date = 2018-06-14 notify = apdb3@cam.ac.uk abstract = We formalize the basics of projective geometry. In particular, we give a proof of the so-called Hessenberg's theorem in projective plane geometry. We also provide a proof of the so-called Desargues's theorem based on an axiomatization of (higher) projective space geometry using the notion of rank of a matroid. This last approach allows to handle incidence relations in an homogeneous way dealing only with points and without the need of talking explicitly about lines, planes or any higher entity. [Localization_Ring] title = The Localization of a Commutative Ring author = Anthony Bordg topic = Mathematics/Algebra date = 2018-06-14 notify = apdb3@cam.ac.uk abstract = We formalize the localization of a commutative ring R with respect to a multiplicative subset (i.e. a submonoid of R seen as a multiplicative monoid). This localization is itself a commutative ring and we build the natural homomorphism of rings from R to its localization. [Minsky_Machines] title = Minsky Machines author = Bertram Felgenhauer<> topic = Logic/Computability date = 2018-08-14 notify = int-e@gmx.de abstract =

We formalize undecidablity results for Minsky machines. To this end, we also formalize recursive inseparability.

We start by proving that Minsky machines can compute arbitrary primitive recursive and recursive functions. We then show that there is a deterministic Minsky machine with one argument and two final states such that the set of inputs that are accepted in one state is recursively inseparable from the set of inputs that are accepted in the other state.

As a corollary, the set of Minsky configurations that reach the first state but not the second recursively inseparable from the set of Minsky configurations that reach the second state but not the first. In particular both these sets are undecidable.

We do not prove that recursive functions can simulate Minsky machines.

[Neumann_Morgenstern_Utility] title = Von-Neumann-Morgenstern Utility Theorem author = Julian Parsert, Cezary Kaliszyk topic = Mathematics/Games and economics license = LGPL date = 2018-07-04 notify = julian.parsert@uibk.ac.at, cezary.kaliszyk@uibk.ac.at abstract = Utility functions form an essential part of game theory and economics. In order to guarantee the existence of utility functions most of the time sufficient properties are assumed in an axiomatic manner. One famous and very common set of such assumptions is that of expected utility theory. Here, the rationality, continuity, and independence of preferences is assumed. The von-Neumann-Morgenstern Utility theorem shows that these assumptions are necessary and sufficient for an expected utility function to exists. This theorem was proven by Neumann and Morgenstern in ``Theory of Games and Economic Behavior'' which is regarded as one of the most influential works in game theory. The formalization includes formal definitions of the underlying concepts including continuity and independence of preferences. [Simplex] title = An Incremental Simplex Algorithm with Unsatisfiable Core Generation author = Filip Marić , Mirko Spasić , René Thiemann topic = Computer science/Algorithms/Optimization date = 2018-08-24 notify = rene.thiemann@uibk.ac.at abstract = We present an Isabelle/HOL formalization and total correctness proof for the incremental version of the Simplex algorithm which is used in most state-of-the-art SMT solvers. It supports extraction of satisfying assignments, extraction of minimal unsatisfiable cores, incremental assertion of constraints and backtracking. The formalization relies on stepwise program refinement, starting from a simple specification, going through a number of refinement steps, and ending up in a fully executable functional implementation. Symmetries present in the algorithm are handled with special care. [Budan_Fourier] title = The Budan-Fourier Theorem and Counting Real Roots with Multiplicity author = Wenda Li topic = Mathematics/Analysis date = 2018-09-02 notify = wl302@cam.ac.uk, liwenda1990@hotmail.com abstract = This entry is mainly about counting and approximating real roots (of a polynomial) with multiplicity. We have first formalised the Budan-Fourier theorem: given a polynomial with real coefficients, we can calculate sign variations on Fourier sequences to over-approximate the number of real roots (counting multiplicity) within an interval. When all roots are known to be real, the over-approximation becomes tight: we can utilise this theorem to count real roots exactly. It is also worth noting that Descartes' rule of sign is a direct consequence of the Budan-Fourier theorem, and has been included in this entry. In addition, we have extended previous formalised Sturm's theorem to count real roots with multiplicity, while the original Sturm's theorem only counts distinct real roots. Compared to the Budan-Fourier theorem, our extended Sturm's theorem always counts roots exactly but may suffer from greater computational cost. [Quaternions] title = Quaternions author = Lawrence C. Paulson topic = Mathematics/Algebra, Mathematics/Geometry date = 2018-09-05 notify = lp15@cam.ac.uk abstract = This theory is inspired by the HOL Light development of quaternions, but follows its own route. Quaternions are developed coinductively, as in the existing formalisation of the complex numbers. Quaternions are quickly shown to belong to the type classes of real normed division algebras and real inner product spaces. And therefore they inherit a great body of facts involving algebraic laws, limits, continuity, etc., which must be proved explicitly in the HOL Light version. The development concludes with the geometric interpretation of the product of imaginary quaternions. [Octonions] title = Octonions author = Angeliki Koutsoukou-Argyraki topic = Mathematics/Algebra, Mathematics/Geometry date = 2018-09-14 notify = ak2110@cam.ac.uk abstract = We develop the basic theory of Octonions, including various identities and properties of the octonions and of the octonionic product, a description of 7D isometries and representations of orthogonal transformations. To this end we first develop the theory of the vector cross product in 7 dimensions. The development of the theory of Octonions is inspired by that of the theory of Quaternions by Lawrence Paulson. However, we do not work within the type class real_algebra_1 because the octonionic product is not associative. [Aggregation_Algebras] title = Aggregation Algebras author = Walter Guttmann topic = Mathematics/Algebra date = 2018-09-15 notify = walter.guttmann@canterbury.ac.nz abstract = We develop algebras for aggregation and minimisation for weight matrices and for edge weights in graphs. We verify the correctness of Prim's and Kruskal's minimum spanning tree algorithms based on these algebras. We also show numerous instances of these algebras based on linearly ordered commutative semigroups. [Prime_Number_Theorem] title = The Prime Number Theorem author = Manuel Eberl , Lawrence C. Paulson topic = Mathematics/Number theory date = 2018-09-19 notify = eberlm@in.tum.de abstract =

This article provides a short proof of the Prime Number Theorem in several equivalent forms, most notably π(x) ~ x/ln x where π(x) is the number of primes no larger than x. It also defines other basic number-theoretic functions related to primes like Chebyshev's functions ϑ and ψ and the “n-th prime number” function pn. We also show various bounds and relationship between these functions are shown. Lastly, we derive Mertens' First and Second Theorem, i. e. ∑p≤x ln p/p = ln x + O(1) and ∑p≤x 1/p = ln ln x + M + O(1/ln x). We also give explicit bounds for the remainder terms.

The proof of the Prime Number Theorem builds on a library of Dirichlet series and analytic combinatorics. We essentially follow the presentation by Newman. The core part of the proof is a Tauberian theorem for Dirichlet series, which is proven using complex analysis and then used to strengthen Mertens' First Theorem to ∑p≤x ln p/p = ln x + c + o(1).

A variant of this proof has been formalised before by Harrison in HOL Light, and formalisations of Selberg's elementary proof exist both by Avigad et al. in Isabelle and by Carneiro in Metamath. The advantage of the analytic proof is that, while it requires more powerful mathematical tools, it is considerably shorter and clearer. This article attempts to provide a short and clear formalisation of all components of that proof using the full range of mathematical machinery available in Isabelle, staying as close as possible to Newman's simple paper proof.

[Signature_Groebner] title = Signature-Based Gröbner Basis Algorithms author = Alexander Maletzky topic = Mathematics/Algebra, Computer science/Algorithms/Mathematical date = 2018-09-20 notify = alexander.maletzky@risc.jku.at abstract =

This article formalizes signature-based algorithms for computing Gröbner bases. Such algorithms are, in general, superior to other algorithms in terms of efficiency, and have not been formalized in any proof assistant so far. The present development is both generic, in the sense that most known variants of signature-based algorithms are covered by it, and effectively executable on concrete input thanks to Isabelle's code generator. Sample computations of benchmark problems show that the verified implementation of signature-based algorithms indeed outperforms the existing implementation of Buchberger's algorithm in Isabelle/HOL.

Besides total correctness of the algorithms, the article also proves that under certain conditions they a-priori detect and avoid all useless zero-reductions, and always return 'minimal' (in some sense) Gröbner bases if an input parameter is chosen in the right way.

The formalization follows the recent survey article by Eder and Faugère.

[Factored_Transition_System_Bounding] title = Upper Bounding Diameters of State Spaces of Factored Transition Systems author = Friedrich Kurz <>, Mohammad Abdulaziz topic = Computer science/Automata and formal languages, Mathematics/Graph theory date = 2018-10-12 notify = friedrich.kurz@tum.de, mohammad.abdulaziz@in.tum.de abstract = A completeness threshold is required to guarantee the completeness of planning as satisfiability, and bounded model checking of safety properties. One valid completeness threshold is the diameter of the underlying transition system. The diameter is the maximum element in the set of lengths of all shortest paths between pairs of states. The diameter is not calculated exactly in our setting, where the transition system is succinctly described using a (propositionally) factored representation. Rather, an upper bound on the diameter is calculated compositionally, by bounding the diameters of small abstract subsystems, and then composing those. We port a HOL4 formalisation of a compositional algorithm for computing a relatively tight upper bound on the system diameter. This compositional algorithm exploits acyclicity in the state space to achieve compositionality, and it was introduced by Abdulaziz et. al. The formalisation that we port is described as a part of another paper by Abdulaziz et. al. As a part of this porting we developed a libray about transition systems, which shall be of use in future related mechanisation efforts. [Smooth_Manifolds] title = Smooth Manifolds author = Fabian Immler , Bohua Zhan topic = Mathematics/Analysis, Mathematics/Topology date = 2018-10-22 notify = immler@in.tum.de, bzhan@ios.ac.cn abstract = We formalize the definition and basic properties of smooth manifolds in Isabelle/HOL. Concepts covered include partition of unity, tangent and cotangent spaces, and the fundamental theorem of path integrals. We also examine some concrete manifolds such as spheres and projective spaces. The formalization makes extensive use of the analysis and linear algebra libraries in Isabelle/HOL, in particular its “types-to-sets” mechanism. [Matroids] title = Matroids author = Jonas Keinholz<> topic = Mathematics/Combinatorics date = 2018-11-16 notify = eberlm@in.tum.de abstract =

This article defines the combinatorial structures known as Independence Systems and Matroids and provides basic concepts and theorems related to them. These structures play an important role in combinatorial optimisation, e. g. greedy algorithms such as Kruskal's algorithm. The development is based on Oxley's `What is a Matroid?'.

[Graph_Saturation] title = Graph Saturation author = Sebastiaan J. C. Joosten<> topic = Logic/Rewriting, Mathematics/Graph theory date = 2018-11-23 notify = sjcjoosten@gmail.com abstract = This is an Isabelle/HOL formalisation of graph saturation, closely following a paper by the author on graph saturation. Nine out of ten lemmas of the original paper are proven in this formalisation. The formalisation additionally includes two theorems that show the main premise of the paper: that consistency and entailment are decided through graph saturation. This formalisation does not give executable code, and it did not implement any of the optimisations suggested in the paper. [Functional_Ordered_Resolution_Prover] title = A Verified Functional Implementation of Bachmair and Ganzinger's Ordered Resolution Prover author = Anders Schlichtkrull , Jasmin Christian Blanchette , Dmitriy Traytel topic = Logic/General logic/Mechanization of proofs date = 2018-11-23 notify = andschl@dtu.dk,j.c.blanchette@vu.nl,traytel@inf.ethz.ch abstract = This Isabelle/HOL formalization refines the abstract ordered resolution prover presented in Section 4.3 of Bachmair and Ganzinger's "Resolution Theorem Proving" chapter in the Handbook of Automated Reasoning. The result is a functional implementation of a first-order prover. [Auto2_HOL] title = Auto2 Prover author = Bohua Zhan topic = Tools date = 2018-11-20 notify = bzhan@ios.ac.cn abstract = Auto2 is a saturation-based heuristic prover for higher-order logic, implemented as a tactic in Isabelle. This entry contains the instantiation of auto2 for Isabelle/HOL, along with two basic examples: solutions to some of the Pelletier’s problems, and elementary number theory of primes. [Order_Lattice_Props] title = Properties of Orderings and Lattices author = Georg Struth topic = Mathematics/Order date = 2018-12-11 notify = g.struth@sheffield.ac.uk abstract = These components add further fundamental order and lattice-theoretic concepts and properties to Isabelle's libraries. They follow by and large the introductory sections of the Compendium of Continuous Lattices, covering directed and filtered sets, down-closed and up-closed sets, ideals and filters, Galois connections, closure and co-closure operators. Some emphasis is on duality and morphisms between structures, as in the Compendium. To this end, three ad-hoc approaches to duality are compared. [Quantales] title = Quantales author = Georg Struth topic = Mathematics/Algebra date = 2018-12-11 notify = g.struth@sheffield.ac.uk abstract = These mathematical components formalise basic properties of quantales, together with some important models, constructions, and concepts, including quantic nuclei and conuclei. [Transformer_Semantics] title = Transformer Semantics author = Georg Struth topic = Mathematics/Algebra, Computer science/Semantics date = 2018-12-11 notify = g.struth@sheffield.ac.uk abstract = These mathematical components formalise predicate transformer semantics for programs, yet currently only for partial correctness and in the absence of faults. A first part for isotone (or monotone), Sup-preserving and Inf-preserving transformers follows Back and von Wright's approach, with additional emphasis on the quantalic structure of algebras of transformers. The second part develops Sup-preserving and Inf-preserving predicate transformers from the powerset monad, via its Kleisli category and Eilenberg-Moore algebras, with emphasis on adjunctions and dualities, as well as isomorphisms between relations, state transformers and predicate transformers. [Concurrent_Revisions] title = Formalization of Concurrent Revisions author = Roy Overbeek topic = Computer science/Concurrency date = 2018-12-25 notify = Roy.Overbeek@cwi.nl abstract = Concurrent revisions is a concurrency control model developed by Microsoft Research. It has many interesting properties that distinguish it from other well-known models such as transactional memory. One of these properties is determinacy: programs written within the model always produce the same outcome, independent of scheduling activity. The concurrent revisions model has an operational semantics, with an informal proof of determinacy. This document contains an Isabelle/HOL formalization of this semantics and the proof of determinacy. [Core_DOM] title = A Formal Model of the Document Object Model author = Achim D. Brucker , Michael Herzberg topic = Computer science/Data structures date = 2018-12-26 notify = adbrucker@0x5f.org abstract = In this AFP entry, we formalize the core of the Document Object Model (DOM). At its core, the DOM defines a tree-like data structure for representing documents in general and HTML documents in particular. It is the heart of any modern web browser. Formalizing the key concepts of the DOM is a prerequisite for the formal reasoning over client-side JavaScript programs and for the analysis of security concepts in modern web browsers. We present a formalization of the core DOM, with focus on the node-tree and the operations defined on node-trees, in Isabelle/HOL. We use the formalization to verify the functional correctness of the most important functions defined in the DOM standard. Moreover, our formalization is 1) extensible, i.e., can be extended without the need of re-proving already proven properties and 2) executable, i.e., we can generate executable code from our specification. [Store_Buffer_Reduction] title = A Reduction Theorem for Store Buffers author = Ernie Cohen , Norbert Schirmer topic = Computer science/Concurrency date = 2019-01-07 notify = norbert.schirmer@web.de abstract = When verifying a concurrent program, it is usual to assume that memory is sequentially consistent. However, most modern multiprocessors depend on store buffering for efficiency, and provide native sequential consistency only at a substantial performance penalty. To regain sequential consistency, a programmer has to follow an appropriate programming discipline. However, naïve disciplines, such as protecting all shared accesses with locks, are not flexible enough for building high-performance multiprocessor software. We present a new discipline for concurrent programming under TSO (total store order, with store buffer forwarding). It does not depend on concurrency primitives, such as locks. Instead, threads use ghost operations to acquire and release ownership of memory addresses. A thread can write to an address only if no other thread owns it, and can read from an address only if it owns it or it is shared and the thread has flushed its store buffer since it last wrote to an address it did not own. This discipline covers both coarse-grained concurrency (where data is protected by locks) as well as fine-grained concurrency (where atomic operations race to memory). We formalize this discipline in Isabelle/HOL, and prove that if every execution of a program in a system without store buffers follows the discipline, then every execution of the program with store buffers is sequentially consistent. Thus, we can show sequential consistency under TSO by ordinary assertional reasoning about the program, without having to consider store buffers at all. [IMP2] title = IMP2 – Simple Program Verification in Isabelle/HOL author = Peter Lammich , Simon Wimmer topic = Computer science/Programming languages/Logics, Computer science/Algorithms date = 2019-01-15 notify = lammich@in.tum.de abstract = IMP2 is a simple imperative language together with Isabelle tooling to create a program verification environment in Isabelle/HOL. The tools include a C-like syntax, a verification condition generator, and Isabelle commands for the specification of programs. The framework is modular, i.e., it allows easy reuse of already proved programs within larger programs. This entry comes with a quickstart guide and a large collection of examples, spanning basic algorithms with simple proofs to more advanced algorithms and proof techniques like data refinement. Some highlights from the examples are:
  • Bisection Square Root,
  • Extended Euclid,
  • Exponentiation by Squaring,
  • Binary Search,
  • Insertion Sort,
  • Quicksort,
  • Depth First Search.
The abstract syntax and semantics are very simple and well-documented. They are suitable to be used in a course, as extension to the IMP language which comes with the Isabelle distribution. While this entry is limited to a simple imperative language, the ideas could be extended to more sophisticated languages. [Farkas] title = Farkas' Lemma and Motzkin's Transposition Theorem author = Ralph Bottesch , Max W. Haslbeck , René Thiemann topic = Mathematics/Algebra date = 2019-01-17 notify = rene.thiemann@uibk.ac.at abstract = We formalize a proof of Motzkin's transposition theorem and Farkas' lemma in Isabelle/HOL. Our proof is based on the formalization of the simplex algorithm which, given a set of linear constraints, either returns a satisfying assignment to the problem or detects unsatisfiability. By reusing facts about the simplex algorithm we show that a set of linear constraints is unsatisfiable if and only if there is a linear combination of the constraints which evaluates to a trivially unsatisfiable inequality. [Auto2_Imperative_HOL] title = Verifying Imperative Programs using Auto2 author = Bohua Zhan topic = Computer science/Algorithms, Computer science/Data structures date = 2018-12-21 notify = bzhan@ios.ac.cn abstract = This entry contains the application of auto2 to verifying functional and imperative programs. Algorithms and data structures that are verified include linked lists, binary search trees, red-black trees, interval trees, priority queue, quicksort, union-find, Dijkstra's algorithm, and a sweep-line algorithm for detecting rectangle intersection. The imperative verification is based on Imperative HOL and its separation logic framework. A major goal of this work is to set up automation in order to reduce the length of proof that the user needs to provide, both for verifying functional programs and for working with separation logic. [UTP] title = Isabelle/UTP: Mechanised Theory Engineering for Unifying Theories of Programming author = Simon Foster , Frank Zeyda<>, Yakoub Nemouchi , Pedro Ribeiro<>, Burkhart Wolff topic = Computer science/Programming languages/Logics date = 2019-02-01 notify = simon.foster@york.ac.uk abstract = Isabelle/UTP is a mechanised theory engineering toolkit based on Hoare and He’s Unifying Theories of Programming (UTP). UTP enables the creation of denotational, algebraic, and operational semantics for different programming languages using an alphabetised relational calculus. We provide a semantic embedding of the alphabetised relational calculus in Isabelle/HOL, including new type definitions, relational constructors, automated proof tactics, and accompanying algebraic laws. Isabelle/UTP can be used to both capture laws of programming for different languages, and put these fundamental theorems to work in the creation of associated verification tools, using calculi like Hoare logics. This document describes the relational core of the UTP in Isabelle/HOL. [HOL-CSP] title = HOL-CSP Version 2.0 author = Safouan Taha , Lina Ye , Burkhart Wolff topic = Computer science/Concurrency/Process calculi, Computer science/Semantics date = 2019-04-26 notify = wolff@lri.fr abstract = This is a complete formalization of the work of Hoare and Roscoe on the denotational semantics of the Failure/Divergence Model of CSP. It follows essentially the presentation of CSP in Roscoe’s Book ”Theory and Practice of Concurrency” [8] and the semantic details in a joint Paper of Roscoe and Brooks ”An improved failures model for communicating processes". The present work is based on a prior formalization attempt, called HOL-CSP 1.0, done in 1997 by H. Tej and B. Wolff with the Isabelle proof technology available at that time. This work revealed minor, but omnipresent foundational errors in key concepts like the process invariant. The present version HOL-CSP profits from substantially improved libraries (notably HOLCF), improved automated proof techniques, and structured proof techniques in Isar and is substantially shorter but more complete. [Probabilistic_Prime_Tests] title = Probabilistic Primality Testing author = Daniel Stüwe<>, Manuel Eberl topic = Mathematics/Number theory date = 2019-02-11 notify = eberlm@in.tum.de abstract =

The most efficient known primality tests are probabilistic in the sense that they use randomness and may, with some probability, mistakenly classify a composite number as prime – but never a prime number as composite. Examples of this are the Miller–Rabin test, the Solovay–Strassen test, and (in most cases) Fermat's test.

This entry defines these three tests and proves their correctness. It also develops some of the number-theoretic foundations, such as Carmichael numbers and the Jacobi symbol with an efficient executable algorithm to compute it.

[Kruskal] title = Kruskal's Algorithm for Minimum Spanning Forest author = Maximilian P.L. Haslbeck , Peter Lammich , Julian Biendarra<> topic = Computer science/Algorithms/Graph date = 2019-02-14 notify = haslbema@in.tum.de, lammich@in.tum.de abstract = This Isabelle/HOL formalization defines a greedy algorithm for finding a minimum weight basis on a weighted matroid and proves its correctness. This algorithm is an abstract version of Kruskal's algorithm. We interpret the abstract algorithm for the cycle matroid (i.e. forests in a graph) and refine it to imperative executable code using an efficient union-find data structure. Our formalization can be instantiated for different graph representations. We provide instantiations for undirected graphs and symmetric directed graphs. [List_Inversions] title = The Inversions of a List author = Manuel Eberl topic = Computer science/Algorithms date = 2019-02-01 notify = eberlm@in.tum.de abstract =

This entry defines the set of inversions of a list, i.e. the pairs of indices that violate sortedness. It also proves the correctness of the well-known O(n log n) divide-and-conquer algorithm to compute the number of inversions.

[Prime_Distribution_Elementary] title = Elementary Facts About the Distribution of Primes author = Manuel Eberl topic = Mathematics/Number theory date = 2019-02-21 notify = eberlm@in.tum.de abstract =

This entry is a formalisation of Chapter 4 (and parts of Chapter 3) of Apostol's Introduction to Analytic Number Theory. The main topics that are addressed are properties of the distribution of prime numbers that can be shown in an elementary way (i. e. without the Prime Number Theorem), the various equivalent forms of the PNT (which imply each other in elementary ways), and consequences that follow from the PNT in elementary ways. The latter include, most notably, asymptotic bounds for the number of distinct prime factors of n, the divisor function d(n), Euler's totient function φ(n), and lcm(1,…,n).

[Safe_OCL] title = Safe OCL author = Denis Nikiforov <> topic = Computer science/Programming languages/Language definitions license = LGPL date = 2019-03-09 notify = denis.nikif@gmail.com abstract =

The theory is a formalization of the OCL type system, its abstract syntax and expression typing rules. The theory does not define a concrete syntax and a semantics. In contrast to Featherweight OCL, it is based on a deep embedding approach. The type system is defined from scratch, it is not based on the Isabelle HOL type system.

The Safe OCL distincts nullable and non-nullable types. Also the theory gives a formal definition of safe navigation operations. The Safe OCL typing rules are much stricter than rules given in the OCL specification. It allows one to catch more errors on a type checking phase.

The type theory presented is four-layered: classes, basic types, generic types, errorable types. We introduce the following new types: non-nullable types (T[1]), nullable types (T[?]), OclSuper. OclSuper is a supertype of all other types (basic types, collections, tuples). This type allows us to define a total supremum function, so types form an upper semilattice. It allows us to define rich expression typing rules in an elegant manner.

The Preliminaries Chapter of the theory defines a number of helper lemmas for transitive closures and tuples. It defines also a generic object model independent from OCL. It allows one to use the theory as a reference for formalization of analogous languages.

[QHLProver] title = Quantum Hoare Logic author = Junyi Liu<>, Bohua Zhan , Shuling Wang<>, Shenggang Ying<>, Tao Liu<>, Yangjia Li<>, Mingsheng Ying<>, Naijun Zhan<> topic = Computer science/Programming languages/Logics, Computer science/Semantics date = 2019-03-24 notify = bzhan@ios.ac.cn abstract = We formalize quantum Hoare logic as given in [1]. In particular, we specify the syntax and denotational semantics of a simple model of quantum programs. Then, we write down the rules of quantum Hoare logic for partial correctness, and show the soundness and completeness of the resulting proof system. As an application, we verify the correctness of Grover’s algorithm. [Transcendence_Series_Hancl_Rucki] title = The Transcendence of Certain Infinite Series author = Angeliki Koutsoukou-Argyraki , Wenda Li topic = Mathematics/Analysis, Mathematics/Number theory date = 2019-03-27 notify = wl302@cam.ac.uk, ak2110@cam.ac.uk abstract = We formalize the proofs of two transcendence criteria by J. Hančl and P. Rucki that assert the transcendence of the sums of certain infinite series built up by sequences that fulfil certain properties. Both proofs make use of Roth's celebrated theorem on diophantine approximations to algebraic numbers from 1955 which we implement as an assumption without having formalised its proof. [Binding_Syntax_Theory] title = A General Theory of Syntax with Bindings author = Lorenzo Gheri , Andrei Popescu topic = Computer science/Programming languages/Lambda calculi, Computer science/Functional programming, Logic/General logic/Mechanization of proofs date = 2019-04-06 notify = a.popescu@mdx.ac.uk, lor.gheri@gmail.com abstract = We formalize a theory of syntax with bindings that has been developed and refined over the last decade to support several large formalization efforts. Terms are defined for an arbitrary number of constructors of varying numbers of inputs, quotiented to alpha-equivalence and sorted according to a binding signature. The theory includes many properties of the standard operators on terms: substitution, swapping and freshness. It also includes bindings-aware induction and recursion principles and support for semantic interpretation. This work has been presented in the ITP 2017 paper “A Formalized General Theory of Syntax with Bindings”. [LTL_Master_Theorem] title = A Compositional and Unified Translation of LTL into ω-Automata author = Benedikt Seidl , Salomon Sickert topic = Computer science/Automata and formal languages date = 2019-04-16 notify = benedikt.seidl@tum.de, s.sickert@tum.de abstract = We present a formalisation of the unified translation approach of linear temporal logic (LTL) into ω-automata from [1]. This approach decomposes LTL formulas into ``simple'' languages and allows a clear separation of concerns: first, we formalise the purely logical result yielding this decomposition; second, we instantiate this generic theory to obtain a construction for deterministic (state-based) Rabin automata (DRA). We extract from this particular instantiation an executable tool translating LTL to DRAs. To the best of our knowledge this is the first verified translation from LTL to DRAs that is proven to be double exponential in the worst case which asymptotically matches the known lower bound.

[1] Javier Esparza, Jan Kretínský, Salomon Sickert. One Theorem to Rule Them All: A Unified Translation of LTL into ω-Automata. LICS 2018 [LambdaAuth] title = Formalization of Generic Authenticated Data Structures author = Matthias Brun<>, Dmitriy Traytel topic = Computer science/Security, Computer science/Programming languages/Lambda calculi date = 2019-05-14 notify = traytel@inf.ethz.ch abstract = Authenticated data structures are a technique for outsourcing data storage and maintenance to an untrusted server. The server is required to produce an efficiently checkable and cryptographically secure proof that it carried out precisely the requested computation. Miller et al. introduced λ• (pronounced lambda auth)—a functional programming language with a built-in primitive authentication construct, which supports a wide range of user-specified authenticated data structures while guaranteeing certain correctness and security properties for all well-typed programs. We formalize λ• and prove its correctness and security properties. With Isabelle's help, we uncover and repair several mistakes in the informal proofs and lemma statements. Our findings are summarized in a paper draft. [IMP2_Binary_Heap] title = Binary Heaps for IMP2 author = Simon Griebel<> topic = Computer science/Data structures, Computer science/Algorithms date = 2019-06-13 notify = s.griebel@tum.de abstract = In this submission array-based binary minimum heaps are formalized. The correctness of the following heap operations is proved: insert, get-min, delete-min and make-heap. These are then used to verify an in-place heapsort. The formalization is based on IMP2, an imperative program verification framework implemented in Isabelle/HOL. The verified heap functions are iterative versions of the partly recursive functions found in "Algorithms and Data Structures – The Basic Toolbox" by K. Mehlhorn and P. Sanders and "Introduction to Algorithms" by T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein. [Groebner_Macaulay] title = Gröbner Bases, Macaulay Matrices and Dubé's Degree Bounds author = Alexander Maletzky topic = Mathematics/Algebra date = 2019-06-15 notify = alexander.maletzky@risc.jku.at abstract = This entry formalizes the connection between Gröbner bases and Macaulay matrices (sometimes also referred to as `generalized Sylvester matrices'). In particular, it contains a method for computing Gröbner bases, which proceeds by first constructing some Macaulay matrix of the initial set of polynomials, then row-reducing this matrix, and finally converting the result back into a set of polynomials. The output is shown to be a Gröbner basis if the Macaulay matrix constructed in the first step is sufficiently large. In order to obtain concrete upper bounds on the size of the matrix (and hence turn the method into an effectively executable algorithm), Dubé's degree bounds on Gröbner bases are utilized; consequently, they are also part of the formalization. [Linear_Inequalities] title = Linear Inequalities author = Ralph Bottesch , Alban Reynaud <>, René Thiemann topic = Mathematics/Algebra date = 2019-06-21 notify = rene.thiemann@uibk.ac.at abstract = We formalize results about linear inqualities, mainly from Schrijver's book. The main results are the proof of the fundamental theorem on linear inequalities, Farkas' lemma, Carathéodory's theorem, the Farkas-Minkowsky-Weyl theorem, the decomposition theorem of polyhedra, and Meyer's result that the integer hull of a polyhedron is a polyhedron itself. Several theorems include bounds on the appearing numbers, and in particular we provide an a-priori bound on mixed-integer solutions of linear inequalities. [Linear_Programming] title = Linear Programming author = Julian Parsert , Cezary Kaliszyk topic = Mathematics/Algebra date = 2019-08-06 notify = julian.parsert@gmail.com, cezary.kaliszyk@uibk.ac.at abstract = We use the previous formalization of the general simplex algorithm to formulate an algorithm for solving linear programs. We encode the linear programs using only linear constraints. Solving these constraints also solves the original linear program. This algorithm is proven to be sound by applying the weak duality theorem which is also part of this formalization. [Differential_Game_Logic] title = Differential Game Logic author = André Platzer topic = Computer science/Programming languages/Logics date = 2019-06-03 notify = aplatzer@cs.cmu.edu abstract = This formalization provides differential game logic (dGL), a logic for proving properties of hybrid game. In addition to the syntax and semantics, it formalizes a uniform substitution calculus for dGL. Church's uniform substitutions substitute a term or formula for a function or predicate symbol everywhere. The uniform substitutions for dGL also substitute hybrid games for a game symbol everywhere. We prove soundness of one-pass uniform substitutions and the axioms of differential game logic with respect to their denotational semantics. One-pass uniform substitutions are faster by postponing soundness-critical admissibility checks with a linear pass homomorphic application and regain soundness by a variable condition at the replacements. The formalization is based on prior non-mechanized soundness proofs for dGL. [Complete_Non_Orders] title = Complete Non-Orders and Fixed Points author = Akihisa Yamada , Jérémy Dubut topic = Mathematics/Order date = 2019-06-27 notify = akihisayamada@nii.ac.jp, dubut@nii.ac.jp abstract = We develop an Isabelle/HOL library of order-theoretic concepts, such as various completeness conditions and fixed-point theorems. We keep our formalization as general as possible: we reprove several well-known results about complete orders, often without any properties of ordering, thus complete non-orders. In particular, we generalize the Knaster–Tarski theorem so that we ensure the existence of a quasi-fixed point of monotone maps over complete non-orders, and show that the set of quasi-fixed points is complete under a mild condition—attractivity—which is implied by either antisymmetry or transitivity. This result generalizes and strengthens a result by Stauti and Maaden. Finally, we recover Kleene’s fixed-point theorem for omega-complete non-orders, again using attractivity to prove that Kleene’s fixed points are least quasi-fixed points. [Priority_Search_Trees] title = Priority Search Trees author = Peter Lammich , Tobias Nipkow topic = Computer science/Data structures date = 2019-06-25 notify = lammich@in.tum.de abstract = We present a new, purely functional, simple and efficient data structure combining a search tree and a priority queue, which we call a priority search tree. The salient feature of priority search trees is that they offer a decrease-key operation, something that is missing from other simple, purely functional priority queue implementations. Priority search trees can be implemented on top of any search tree. This entry does the implementation for red-black trees. This entry formalizes the first part of our ITP-2019 proof pearl Purely Functional, Simple and Efficient Priority Search Trees and Applications to Prim and Dijkstra. [Prim_Dijkstra_Simple] title = Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra author = Peter Lammich , Tobias Nipkow topic = Computer science/Algorithms/Graph date = 2019-06-25 notify = lammich@in.tum.de abstract = We verify purely functional, simple and efficient implementations of Prim's and Dijkstra's algorithms. This constitutes the first verification of an executable and even efficient version of Prim's algorithm. This entry formalizes the second part of our ITP-2019 proof pearl Purely Functional, Simple and Efficient Priority Search Trees and Applications to Prim and Dijkstra. [MFOTL_Monitor] title = Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic author = Joshua Schneider , Dmitriy Traytel topic = Computer science/Algorithms, Logic/General logic/Temporal logic, Computer science/Automata and formal languages date = 2019-07-04 notify = joshua.schneider@inf.ethz.ch, traytel@inf.ethz.ch abstract = A monitor is a runtime verification tool that solves the following problem: Given a stream of time-stamped events and a policy formulated in a specification language, decide whether the policy is satisfied at every point in the stream. We verify the correctness of an executable monitor for specifications given as formulas in metric first-order temporal logic (MFOTL), an expressive extension of linear temporal logic with real-time constraints and first-order quantification. The verified monitor implements a simplified variant of the algorithm used in the efficient MonPoly monitoring tool. The formalization is presented in a forthcoming RV 2019 paper, which also compares the output of the verified monitor to that of other monitoring tools on randomly generated inputs. This case study revealed several errors in the optimized but unverified tools. [FOL_Seq_Calc1] title = A Sequent Calculus for First-Order Logic author = Asta Halkjær From contributors = Alexander Birch Jensen , Anders Schlichtkrull , Jørgen Villadsen topic = Logic/Proof theory date = 2019-07-18 notify = ahfrom@dtu.dk abstract = This work formalizes soundness and completeness of a one-sided sequent calculus for first-order logic. The completeness is shown via a translation from a complete semantic tableau calculus, the proof of which is based on the First-Order Logic According to Fitting theory. The calculi and proof techniques are taken from Ben-Ari's Mathematical Logic for Computer Science. [Szpilrajn] title = Szpilrajn Extension Theorem author = Peter Zeller topic = Mathematics/Order date = 2019-07-27 notify = p_zeller@cs.uni-kl.de abstract = We formalize the Szpilrajn extension theorem, also known as order-extension principal: Every strict partial order can be extended to a strict linear order. [TESL_Language] title = A Formal Development of a Polychronous Polytimed Coordination Language author = Hai Nguyen Van , Frédéric Boulanger , Burkhart Wolff topic = Computer science/System description languages, Computer science/Semantics, Computer science/Concurrency date = 2019-07-30 notify = frederic.boulanger@centralesupelec.fr, burkhart.wolff@lri.fr abstract = The design of complex systems involves different formalisms for modeling their different parts or aspects. The global model of a system may therefore consist of a coordination of concurrent sub-models that use different paradigms. We develop here a theory for a language used to specify the timed coordination of such heterogeneous subsystems by addressing the following issues:

  • the behavior of the sub-systems is observed only at a series of discrete instants,
  • events may occur in different sub-systems at unrelated times, leading to polychronous systems, which do not necessarily have a common base clock,
  • coordination between subsystems involves causality, so the occurrence of an event may enforce the occurrence of other events, possibly after a certain duration has elapsed or an event has occurred a given number of times,
  • the domain of time (discrete, rational, continuous...) may be different in the subsystems, leading to polytimed systems,
  • the time frames of different sub-systems may be related (for instance, time in a GPS satellite and in a GPS receiver on Earth are related although they are not the same).
Firstly, a denotational semantics of the language is defined. Then, in order to be able to incrementally check the behavior of systems, an operational semantics is given, with proofs of progress, soundness and completeness with regard to the denotational semantics. These proofs are made according to a setup that can scale up when new operators are added to the language. In order for specifications to be composed in a clean way, the language should be invariant by stuttering (i.e., adding observation instants at which nothing happens). The proof of this invariance is also given. [Stellar_Quorums] title = Stellar Quorum Systems author = Giuliano Losa topic = Computer science/Algorithms/Distributed date = 2019-08-01 notify = giuliano@galois.com abstract = We formalize the static properties of personal Byzantine quorum systems (PBQSs) and Stellar quorum systems, as described in the paper ``Stellar Consensus by Reduction'' (to appear at DISC 2019). [IMO2019] title = Selected Problems from the International Mathematical Olympiad 2019 author = Manuel Eberl topic = Mathematics/Misc date = 2019-08-05 notify = eberlm@in.tum.de abstract =

This entry contains formalisations of the answers to three of the six problem of the International Mathematical Olympiad 2019, namely Q1, Q4, and Q5.

The reason why these problems were chosen is that they are particularly amenable to formalisation: they can be solved with minimal use of libraries. The remaining three concern geometry and graph theory, which, in the author's opinion, are more difficult to formalise resp. require a more complex library.

[Adaptive_State_Counting] title = Formalisation of an Adaptive State Counting Algorithm author = Robert Sachtleben topic = Computer science/Automata and formal languages, Computer science/Algorithms date = 2019-08-16 notify = rob_sac@uni-bremen.de abstract = This entry provides a formalisation of a refinement of an adaptive state counting algorithm, used to test for reduction between finite state machines. The algorithm has been originally presented by Hierons in the paper Testing from a Non-Deterministic Finite State Machine Using Adaptive State Counting. Definitions for finite state machines and adaptive test cases are given and many useful theorems are derived from these. The algorithm is formalised using mutually recursive functions, for which it is proven that the generated test suite is sufficient to test for reduction against finite state machines of a certain fault domain. Additionally, the algorithm is specified in a simple WHILE-language and its correctness is shown using Hoare-logic. [Jacobson_Basic_Algebra] title = A Case Study in Basic Algebra author = Clemens Ballarin topic = Mathematics/Algebra date = 2019-08-30 notify = ballarin@in.tum.de abstract = The focus of this case study is re-use in abstract algebra. It contains locale-based formalisations of selected parts of set, group and ring theory from Jacobson's Basic Algebra leading to the respective fundamental homomorphism theorems. The study is not intended as a library base for abstract algebra. It rather explores an approach towards abstract algebra in Isabelle. [Hybrid_Systems_VCs] title = Verification Components for Hybrid Systems author = Jonathan Julian Huerta y Munive <> topic = Mathematics/Algebra, Mathematics/Analysis date = 2019-09-10 notify = jjhuertaymunive1@sheffield.ac.uk, jonjulian23@gmail.com abstract = These components formalise a semantic framework for the deductive verification of hybrid systems. They support reasoning about continuous evolutions of hybrid programs in the style of differential dynamics logic. Vector fields or flows model these evolutions, and their verification is done with invariants for the former or orbits for the latter. Laws of modal Kleene algebra or categorical predicate transformers implement the verification condition generation. Examples show the approach at work. [Generic_Join] title = Formalization of Multiway-Join Algorithms author = Thibault Dardinier<> topic = Computer science/Algorithms date = 2019-09-16 notify = tdardini@student.ethz.ch, traytel@inf.ethz.ch abstract = Worst-case optimal multiway-join algorithms are recent seminal achievement of the database community. These algorithms compute the natural join of multiple relational databases and improve in the worst case over traditional query plan optimizations of nested binary joins. In 2014, Ngo, Ré, and Rudra gave a unified presentation of different multi-way join algorithms. We formalized and proved correct their "Generic Join" algorithm and extended it to support negative joins. [Aristotles_Assertoric_Syllogistic] title = Aristotle's Assertoric Syllogistic author = Angeliki Koutsoukou-Argyraki topic = Logic/Philosophical aspects date = 2019-10-08 notify = ak2110@cam.ac.uk abstract = We formalise with Isabelle/HOL some basic elements of Aristotle's assertoric syllogistic following the article from the Stanford Encyclopedia of Philosophy by Robin Smith. To this end, we use a set theoretic formulation (covering both individual and general predication). In particular, we formalise the deductions in the Figures and after that we present Aristotle's metatheoretical observation that all deductions in the Figures can in fact be reduced to either Barbara or Celarent. As the formal proofs prove to be straightforward, the interest of this entry lies in illustrating the functionality of Isabelle and high efficiency of Sledgehammer for simple exercises in philosophy. [VerifyThis2019] title = VerifyThis 2019 -- Polished Isabelle Solutions author = Peter Lammich<>, Simon Wimmer topic = Computer science/Algorithms date = 2019-10-16 notify = lammich@in.tum.de, wimmers@in.tum.de abstract = VerifyThis 2019 (http://www.pm.inf.ethz.ch/research/verifythis.html) was a program verification competition associated with ETAPS 2019. It was the 8th event in the VerifyThis competition series. In this entry, we present polished and completed versions of our solutions that we created during the competition. [ZFC_in_HOL] title = Zermelo Fraenkel Set Theory in Higher-Order Logic author = Lawrence C. Paulson topic = Logic/Set theory date = 2019-10-24 notify = lp15@cam.ac.uk abstract =

This entry is a new formalisation of ZFC set theory in Isabelle/HOL. It is logically equivalent to Obua's HOLZF; the point is to have the closest possible integration with the rest of Isabelle/HOL, minimising the amount of new notations and exploiting type classes.

There is a type V of sets and a function elts :: V => V set mapping a set to its elements. Classes simply have type V set, and a predicate identifies the small classes: those that correspond to actual sets. Type classes connected with orders and lattices are used to minimise the amount of new notation for concepts such as the subset relation, union and intersection. Basic concepts — Cartesian products, disjoint sums, natural numbers, functions, etc. — are formalised.

More advanced set-theoretic concepts, such as transfinite induction, ordinals, cardinals and the transitive closure of a set, are also provided. The definition of addition and multiplication for general sets (not just ordinals) follows Kirby.

The theory provides two type classes with the aim of facilitating developments that combine V with other Isabelle/HOL types: embeddable, the class of types that can be injected into V (including V itself as well as V*V, etc.), and small, the class of types that correspond to some ZF set.

extra-history = Change history: [2020-01-28]: Generalisation of the "small" predicate and order types to arbitrary sets; ordinal exponentiation; introduction of the coercion ord_of_nat :: "nat => V"; numerous new lemmas. (revision 6081d5be8d08) [Interval_Arithmetic_Word32] title = Interval Arithmetic on 32-bit Words author = Brandon Bohrer topic = Computer science/Data structures date = 2019-11-27 notify = bjbohrer@gmail.com, bbohrer@cs.cmu.edu abstract = Interval_Arithmetic implements conservative interval arithmetic computations, then uses this interval arithmetic to implement a simple programming language where all terms have 32-bit signed word values, with explicit infinities for terms outside the representable bounds. Our target use case is interpreters for languages that must have a well-understood low-level behavior. We include a formalization of bounded-length strings which are used for the identifiers of our language. Bounded-length identifiers are useful in some applications, for example the Differential_Dynamic_Logic article, where a Euclidean space indexed by identifiers demands that identifiers are finitely many. [Generalized_Counting_Sort] title = An Efficient Generalization of Counting Sort for Large, possibly Infinite Key Ranges author = Pasquale Noce topic = Computer science/Algorithms, Computer science/Functional programming date = 2019-12-04 notify = pasquale.noce.lavoro@gmail.com abstract = Counting sort is a well-known algorithm that sorts objects of any kind mapped to integer keys, or else to keys in one-to-one correspondence with some subset of the integers (e.g. alphabet letters). However, it is suitable for direct use, viz. not just as a subroutine of another sorting algorithm (e.g. radix sort), only if the key range is not significantly larger than the number of the objects to be sorted. This paper describes a tail-recursive generalization of counting sort making use of a bounded number of counters, suitable for direct use in case of a large, or even infinite key range of any kind, subject to the only constraint of being a subset of an arbitrary linear order. After performing a pen-and-paper analysis of how such algorithm has to be designed to maximize its efficiency, this paper formalizes the resulting generalized counting sort (GCsort) algorithm and then formally proves its correctness properties, namely that (a) the counters' number is maximized never exceeding the fixed upper bound, (b) objects are conserved, (c) objects get sorted, and (d) the algorithm is stable. [Poincare_Bendixson] title = The Poincaré-Bendixson Theorem author = Fabian Immler , Yong Kiam Tan topic = Mathematics/Analysis date = 2019-12-18 notify = fimmler@cs.cmu.edu, yongkiat@cs.cmu.edu abstract = The Poincaré-Bendixson theorem is a classical result in the study of (continuous) dynamical systems. Colloquially, it restricts the possible behaviors of planar dynamical systems: such systems cannot be chaotic. In practice, it is a useful tool for proving the existence of (limiting) periodic behavior in planar systems. The theorem is an interesting and challenging benchmark for formalized mathematics because proofs in the literature rely on geometric sketches and only hint at symmetric cases. It also requires a substantial background of mathematical theories, e.g., the Jordan curve theorem, real analysis, ordinary differential equations, and limiting (long-term) behavior of dynamical systems. [Isabelle_C] title = Isabelle/C author = Frédéric Tuong , Burkhart Wolff topic = Computer science/Programming languages/Language definitions, Computer science/Semantics, Tools date = 2019-10-22 notify = tuong@users.gforge.inria.fr, wolff@lri.fr abstract = We present a framework for C code in C11 syntax deeply integrated into the Isabelle/PIDE development environment. Our framework provides an abstract interface for verification back-ends to be plugged-in independently. Thus, various techniques such as deductive program verification or white-box testing can be applied to the same source, which is part of an integrated PIDE document model. Semantic back-ends are free to choose the supported C fragment and its semantics. In particular, they can differ on the chosen memory model or the specification mechanism for framing conditions. Our framework supports semantic annotations of C sources in the form of comments. Annotations serve to locally control back-end settings, and can express the term focus to which an annotation refers. Both the logical and the syntactic context are available when semantic annotations are evaluated. As a consequence, a formula in an annotation can refer both to HOL or C variables. Our approach demonstrates the degree of maturity and expressive power the Isabelle/PIDE sub-system has achieved in recent years. Our integration technique employs Lex and Yacc style grammars to ensure efficient deterministic parsing. This is the core-module of Isabelle/C; the AFP package for Clean and Clean_wrapper as well as AutoCorres and AutoCorres_wrapper (available via git) are applications of this front-end. [Zeta_3_Irrational] title = The Irrationality of ζ(3) author = Manuel Eberl topic = Mathematics/Number theory date = 2019-12-27 notify = manuel.eberl@tum.de abstract =

This article provides a formalisation of Beukers's straightforward analytic proof that ζ(3) is irrational. This was first proven by Apéry (which is why this result is also often called ‘Apéry's Theorem’) using a more algebraic approach. This formalisation follows Filaseta's presentation of Beukers's proof.

[Hybrid_Logic] title = Formalizing a Seligman-Style Tableau System for Hybrid Logic author = Asta Halkjær From topic = Logic/General logic/Modal logic date = 2019-12-20 notify = ahfrom@dtu.dk abstract = This work is a formalization of soundness and completeness proofs for a Seligman-style tableau system for hybrid logic. The completeness result is obtained via a synthetic approach using maximally consistent sets of tableau blocks. The formalization differs from the cited work in a few ways. First, to avoid the need to backtrack in the construction of a tableau, the formalized system has no unnamed initial segment, and therefore no Name rule. Second, I show that the full Bridge rule is admissible in the system. Third, I start from rules restricted to only extend the branch with new formulas, including only witnessing diamonds that are not already witnessed, and show that the unrestricted rules are admissible. Similarly, I start from simpler versions of the @-rules and show the general ones admissible. Finally, the GoTo rule is restricted using a notion of coins such that each application consumes a coin and coins are earned through applications of the remaining rules. I show that if a branch can be closed then it can be closed starting from a single coin. These restrictions are imposed to rule out some means of nontermination. [Bicategory] title = Bicategories author = Eugene W. Stark topic = Mathematics/Category theory date = 2020-01-06 notify = stark@cs.stonybrook.edu abstract = Taking as a starting point the author's previous work on developing aspects of category theory in Isabelle/HOL, this article gives a compatible formalization of the notion of "bicategory" and develops a framework within which formal proofs of facts about bicategories can be given. The framework includes a number of basic results, including the Coherence Theorem, the Strictness Theorem, pseudofunctors and biequivalence, and facts about internal equivalences and adjunctions in a bicategory. As a driving application and demonstration of the utility of the framework, it is used to give a formal proof of a theorem, due to Carboni, Kasangian, and Street, that characterizes up to biequivalence the bicategories of spans in a category with pullbacks. The formalization effort necessitated the filling-in of many details that were not evident from the brief presentation in the original paper, as well as identifying a few minor corrections along the way. extra-history = Change history: [2020-02-15]: Move ConcreteCategory.thy from Bicategory to Category3 and use it systematically. Make other minor improvements throughout. (revision a51840d36867)
[Subset_Boolean_Algebras] title = A Hierarchy of Algebras for Boolean Subsets author = Walter Guttmann , Bernhard Möller topic = Mathematics/Algebra date = 2020-01-31 notify = walter.guttmann@canterbury.ac.nz abstract = We present a collection of axiom systems for the construction of Boolean subalgebras of larger overall algebras. The subalgebras are defined as the range of a complement-like operation on a semilattice. This technique has been used, for example, with the antidomain operation, dynamic negation and Stone algebras. We present a common ground for these constructions based on a new equational axiomatisation of Boolean algebras. [Goodstein_Lambda] title = Implementing the Goodstein Function in λ-Calculus author = Bertram Felgenhauer topic = Logic/Rewriting date = 2020-02-21 notify = int-e@gmx.de abstract = In this formalization, we develop an implementation of the Goodstein function G in plain λ-calculus, linked to a concise, self-contained specification. The implementation works on a Church-encoded representation of countable ordinals. The initial conversion to hereditary base 2 is not covered, but the material is sufficient to compute the particular value G(16), and easily extends to other fixed arguments. [VeriComp] title = A Generic Framework for Verified Compilers author = Martin Desharnais topic = Computer science/Programming languages/Compiling date = 2020-02-10 notify = martin.desharnais@unibw.de abstract = This is a generic framework for formalizing compiler transformations. It leverages Isabelle/HOL’s locales to abstract over concrete languages and transformations. It states common definitions for language semantics, program behaviours, forward and backward simulations, and compilers. We provide generic operations, such as simulation and compiler composition, and prove general (partial) correctness theorems, resulting in reusable proof components. [Hello_World] title = Hello World author = Cornelius Diekmann , Lars Hupel topic = Computer science/Functional programming date = 2020-03-07 notify = diekmann@net.in.tum.de abstract = In this article, we present a formalization of the well-known "Hello, World!" code, including a formal framework for reasoning about IO. Our model is inspired by the handling of IO in Haskell. We start by formalizing the 🌍 and embrace the IO monad afterwards. Then we present a sample main :: IO (), followed by its proof of correctness. [WOOT_Strong_Eventual_Consistency] title = Strong Eventual Consistency of the Collaborative Editing Framework WOOT author = Emin Karayel , Edgar Gonzàlez topic = Computer science/Algorithms/Distributed date = 2020-03-25 notify = eminkarayel@google.com, edgargip@google.com, me@eminkarayel.de abstract = Commutative Replicated Data Types (CRDTs) are a promising new class of data structures for large-scale shared mutable content in applications that only require eventual consistency. The WithOut Operational Transforms (WOOT) framework is a CRDT for collaborative text editing introduced by Oster et al. (CSCW 2006) for which the eventual consistency property was verified only for a bounded model to date. We contribute a formal proof for WOOTs strong eventual consistency. [Furstenberg_Topology] title = Furstenberg's topology and his proof of the infinitude of primes author = Manuel Eberl topic = Mathematics/Number theory date = 2020-03-22 notify = manuel.eberl@tum.de abstract =

This article gives a formal version of Furstenberg's topological proof of the infinitude of primes. He defines a topology on the integers based on arithmetic progressions (or, equivalently, residue classes). Using some fairly obvious properties of this topology, the infinitude of primes is then easily obtained.

Apart from this, this topology is also fairly ‘nice’ in general: it is second countable, metrizable, and perfect. All of these (well-known) facts are formally proven, including an explicit metric for the topology given by Zulfeqarr.

[Saturation_Framework] title = A Comprehensive Framework for Saturation Theorem Proving author = Sophie Tourret topic = Logic/General logic/Mechanization of proofs date = 2020-04-09 notify = stourret@mpi-inf.mpg.de abstract = This Isabelle/HOL formalization is the companion of the technical report “A comprehensive framework for saturation theorem proving”, itself companion of the eponym IJCAR 2020 paper, written by Uwe Waldmann, Sophie Tourret, Simon Robillard and Jasmin Blanchette. It verifies a framework for formal refutational completeness proofs of abstract provers that implement saturation calculi, such as ordered resolution or superposition, and allows to model entire prover architectures in such a way that the static refutational completeness of a calculus immediately implies the dynamic refutational completeness of a prover implementing the calculus using a variant of the given clause loop. The technical report “A comprehensive framework for saturation theorem proving” is available on the Matryoshka website. The names of the Isabelle lemmas and theorems corresponding to the results in the report are indicated in the margin of the report. [MFODL_Monitor_Optimized] title = Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations author = Thibault Dardinier<>, Lukas Heimes<>, Martin Raszyk , Joshua Schneider , Dmitriy Traytel topic = Computer science/Algorithms, Logic/General logic/Modal logic, Computer science/Automata and formal languages date = 2020-04-09 notify = martin.raszyk@inf.ethz.ch, joshua.schneider@inf.ethz.ch, traytel@inf.ethz.ch abstract = A monitor is a runtime verification tool that solves the following problem: Given a stream of time-stamped events and a policy formulated in a specification language, decide whether the policy is satisfied at every point in the stream. We verify the correctness of an executable monitor for specifications given as formulas in metric first-order dynamic logic (MFODL), which combines the features of metric first-order temporal logic (MFOTL) and metric dynamic logic. Thus, MFODL supports real-time constraints, first-order parameters, and regular expressions. Additionally, the monitor supports aggregation operations such as count and sum. This formalization, which is described in a forthcoming paper at IJCAR 2020, significantly extends previous work on a verified monitor for MFOTL. Apart from the addition of regular expressions and aggregations, we implemented multi-way joins and a specialized sliding window algorithm to further optimize the monitor. [Sliding_Window_Algorithm] title = Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows author = Lukas Heimes<>, Dmitriy Traytel , Joshua Schneider<> topic = Computer science/Algorithms date = 2020-04-10 notify = heimesl@student.ethz.ch, traytel@inf.ethz.ch, joshua.schneider@inf.ethz.ch abstract = Basin et al.'s sliding window algorithm (SWA) is an algorithm for combining the elements of subsequences of a sequence with an associative operator. It is greedy and minimizes the number of operator applications. We formalize the algorithm and verify its functional correctness. We extend the algorithm with additional operations and provide an alternative interface to the slide operation that does not require the entire input sequence. [Lucas_Theorem] title = Lucas's Theorem author = Chelsea Edmonds topic = Mathematics/Number theory date = 2020-04-07 notify = cle47@cam.ac.uk abstract = This work presents a formalisation of a generating function proof for Lucas's theorem. We first outline extensions to the existing Formal Power Series (FPS) library, including an equivalence relation for coefficients modulo n, an alternate binomial theorem statement, and a formalised proof of the Freshman's dream (mod p) lemma. The second part of the work presents the formal proof of Lucas's Theorem. Working backwards, the formalisation first proves a well known corollary of the theorem which is easier to formalise, and then applies induction to prove the original theorem statement. The proof of the corollary aims to provide a good example of a formalised generating function equivalence proof using the FPS library. The final theorem statement is intended to be integrated into the formalised proof of Hilbert's 10th Problem. [ADS_Functor] title = Authenticated Data Structures As Functors author = Andreas Lochbihler , Ognjen Marić topic = Computer science/Data structures date = 2020-04-16 notify = andreas.lochbihler@digitalasset.com, mail@andreas-lochbihler.de abstract = Authenticated data structures allow several systems to convince each other that they are referring to the same data structure, even if each of them knows only a part of the data structure. Using inclusion proofs, knowledgeable systems can selectively share their knowledge with other systems and the latter can verify the authenticity of what is being shared. In this article, we show how to modularly define authenticated data structures, their inclusion proofs, and operations thereon as datatypes in Isabelle/HOL, using a shallow embedding. Modularity allows us to construct complicated trees from reusable building blocks, which we call Merkle functors. Merkle functors include sums, products, and function spaces and are closed under composition and least fixpoints. As a practical application, we model the hierarchical transactions of Canton, a practical interoperability protocol for distributed ledgers, as authenticated data structures. This is a first step towards formalizing the Canton protocol and verifying its integrity and security guarantees. [Power_Sum_Polynomials] title = Power Sum Polynomials author = Manuel Eberl topic = Mathematics/Algebra date = 2020-04-24 notify = eberlm@in.tum.de abstract =

This article provides a formalisation of the symmetric multivariate polynomials known as power sum polynomials. These are of the form pn(X1,…, Xk) = X1n + … + Xkn. A formal proof of the Girard–Newton Theorem is also given. This theorem relates the power sum polynomials to the elementary symmetric polynomials sk in the form of a recurrence relation (-1)k k sk = ∑i∈[0,k) (-1)i si pk-i .

As an application, this is then used to solve a generalised form of a puzzle given as an exercise in Dummit and Foote's Abstract Algebra: For k complex unknowns x1, …, xk, define pj := x1j + … + xkj. Then for each vector a ∈ ℂk, show that there is exactly one solution to the system p1 = a1, …, pk = ak up to permutation of the xi and determine the value of pi for i>k.

[Gaussian_Integers] title = Gaussian Integers author = Manuel Eberl topic = Mathematics/Number theory date = 2020-04-24 notify = eberlm@in.tum.de abstract =

The Gaussian integers are the subring ℤ[i] of the complex numbers, i. e. the ring of all complex numbers with integral real and imaginary part. This article provides a definition of this ring as well as proofs of various basic properties, such as that they form a Euclidean ring and a full classification of their primes. An executable (albeit not very efficient) factorisation algorithm is also provided.

Lastly, this Gaussian integer formalisation is used in two short applications:

  1. The characterisation of all positive integers that can be written as sums of two squares
  2. Euclid's formula for primitive Pythagorean triples

While elementary proofs for both of these are already available in the AFP, the theory of Gaussian integers provides more concise proofs and a more high-level view.

[Forcing] title = Formalization of Forcing in Isabelle/ZF author = Emmanuel Gunther , Miguel Pagano , Pedro Sánchez Terraf topic = Logic/Set theory date = 2020-05-06 notify = gunther@famaf.unc.edu.ar, pagano@famaf.unc.edu.ar, sterraf@famaf.unc.edu.ar abstract = We formalize the theory of forcing in the set theory framework of Isabelle/ZF. Under the assumption of the existence of a countable transitive model of ZFC, we construct a proper generic extension and show that the latter also satisfies ZFC. [Recursion-Addition] title = Recursion Theorem in ZF author = Georgy Dunaev topic = Logic/Set theory date = 2020-05-11 notify = georgedunaev@gmail.com abstract = This document contains a proof of the recursion theorem. This is a mechanization of the proof of the recursion theorem from the text Introduction to Set Theory, by Karel Hrbacek and Thomas Jech. This implementation may be used as the basis for a model of Peano arithmetic in ZF. While recursion and the natural numbers are already available in Isabelle/ZF, this clean development is much easier to follow. [LTL_Normal_Form] title = An Efficient Normalisation Procedure for Linear Temporal Logic: Isabelle/HOL Formalisation author = Salomon Sickert topic = Computer science/Automata and formal languages, Logic/General logic/Temporal logic date = 2020-05-08 notify = s.sickert@tum.de abstract = In the mid 80s, Lichtenstein, Pnueli, and Zuck proved a classical theorem stating that every formula of Past LTL (the extension of LTL with past operators) is equivalent to a formula of the form $\bigwedge_{i=1}^n \mathbf{G}\mathbf{F} \varphi_i \vee \mathbf{F}\mathbf{G} \psi_i$, where $\varphi_i$ and $\psi_i$ contain only past operators. Some years later, Chang, Manna, and Pnueli built on this result to derive a similar normal form for LTL. Both normalisation procedures have a non-elementary worst-case blow-up, and follow an involved path from formulas to counter-free automata to star-free regular expressions and back to formulas. We improve on both points. We present an executable formalisation of a direct and purely syntactic normalisation procedure for LTL yielding a normal form, comparable to the one by Chang, Manna, and Pnueli, that has only a single exponential blow-up. [Matrices_for_ODEs] title = Matrices for ODEs author = Jonathan Julian Huerta y Munive topic = Mathematics/Analysis, Mathematics/Algebra date = 2020-04-19 notify = jonjulian23@gmail.com abstract = Our theories formalise various matrix properties that serve to establish existence, uniqueness and characterisation of the solution to affine systems of ordinary differential equations (ODEs). In particular, we formalise the operator and maximum norm of matrices. Then we use them to prove that square matrices form a Banach space, and in this setting, we show an instance of Picard-Lindelöf’s theorem for affine systems of ODEs. Finally, we use this formalisation to verify three simple hybrid programs. [Irrational_Series_Erdos_Straus] title = Irrationality Criteria for Series by Erdős and Straus author = Angeliki Koutsoukou-Argyraki , Wenda Li topic = Mathematics/Number theory, Mathematics/Analysis date = 2020-05-12 notify = ak2110@cam.ac.uk, wl302@cam.ac.uk, liwenda1990@hotmail.com -abstract = +abstract = We formalise certain irrationality criteria for infinite series of the form: \[\sum_{n=1}^\infty \frac{b_n}{\prod_{i=1}^n a_i} \] where $\{b_n\}$ is a sequence of integers and $\{a_n\}$ a sequence of positive integers - with $a_n >1$ for all large n. The results are due to P. Erdős and E. G. Straus - [1]. - In particular, we formalise Theorem 2.1, Corollary 2.10 and Theorem 3.1. + with $a_n >1$ for all large n. The results are due to P. Erdős and E. G. Straus + [1]. + In particular, we formalise Theorem 2.1, Corollary 2.10 and Theorem 3.1. The latter is an application of Theorem 2.1 involving the prime numbers. [Knuth_Bendix_Order] title = A Formalization of Knuth–Bendix Orders author = Christian Sternagel , René Thiemann topic = Logic/Rewriting date = 2020-05-13 notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at -abstract = +abstract = We define a generalized version of Knuth–Bendix orders, including subterm coefficient functions. For these orders we formalize several properties such as strong normalization, the subterm property, closure properties under substitutions and contexts, as well as ground totality. +[Stateful_Protocol_Composition_and_Typing] +title = Stateful Protocol Composition and Typing +author = Andreas V. Hess , Sebastian Mödersheim , Achim D. Brucker +topic = Computer science/Security +date = 2020-04-08 +notify = avhe@dtu.dk, andreasvhess@gmail.com, samo@dtu.dk, brucker@spamfence.net, andschl@dtu.dk +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. + +[Automated_Stateful_Protocol_Verification] +title = Automated Stateful Protocol Verification +author = Andreas V. Hess , Sebastian Mödersheim , Achim D. Brucker , Anders Schlichtkrull +topic = Computer science/Security, Tools +date = 2020-04-08 +notify = avhe@dtu.dk, andreasvhess@gmail.com, samo@dtu.dk, brucker@spamfence.net, andschl@dtu.dk +abstract = + In protocol verification we observe a wide spectrum from fully + automated methods to interactive theorem proving with proof assistants + like Isabelle/HOL. In this AFP entry, we present a fully-automated + approach for verifying stateful security protocols, i.e., protocols + with mutable state that may span several sessions. The approach + supports reachability goals like secrecy and authentication. We also + include a simple user-friendly transaction-based protocol + specification language that is embedded into Isabelle. + diff --git a/thys/Automated_Stateful_Protocol_Verification/Eisbach_Protocol_Verification.thy b/thys/Automated_Stateful_Protocol_Verification/Eisbach_Protocol_Verification.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/Eisbach_Protocol_Verification.thy @@ -0,0 +1,110 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Eisbach_Protocol_Verification.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section \Useful Eisbach Methods for Automating Protocol Verification\ +theory Eisbach_Protocol_Verification + imports Main "HOL-Eisbach.Eisbach_Tools" +begin + +named_theorems exhausts +named_theorems type_class_instance_lemmata +named_theorems protocol_checks +named_theorems coverage_check_unfold_protocol_lemma +named_theorems coverage_check_unfold_lemmata +named_theorems coverage_check_intro_lemmata +named_theorems transaction_coverage_lemmata + +method UNIV_lemma = + (rule UNIV_eq_I; (subst insert_iff)+; subst empty_iff; smt exhausts)+ + +method type_class_instance = + (intro_classes; auto simp add: type_class_instance_lemmata) + +method protocol_model_subgoal = + (((rule allI, case_tac f); (erule forw_subst)+)?; simp_all) + +method protocol_model_interpretation = + (unfold_locales; protocol_model_subgoal+) + +method check_protocol_intro = + (unfold_locales, unfold protocol_checks[symmetric]) + +method check_protocol_with methods meth = + (check_protocol_intro, meth) + +method check_protocol' = + (check_protocol_with \code_simp+\) + +method check_protocol_unsafe' = + (check_protocol_with \eval+\) + +method check_protocol = + (check_protocol_with \ + code_simp, + code_simp, + code_simp, + code_simp, + code_simp\) + +method check_protocol_unsafe = + (check_protocol_with \ + eval, + eval, + eval, + eval, + eval\) + +method coverage_check_intro = + (((unfold coverage_check_unfold_protocol_lemma)?; + intro coverage_check_intro_lemmata; + simp only: list_all_simps list_all_append list.map concat.simps map_append product_concat_map; + intro conjI TrueI); + (clarsimp+)?; + ((rule transaction_coverage_lemmata)+)?) + +method coverage_check_unfold = + (unfold coverage_check_unfold_protocol_lemma coverage_check_unfold_lemmata + list_all_iff Let_def case_prod_unfold Product_Type.fst_conv Product_Type.snd_conv) + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/Examples.thy b/thys/Automated_Stateful_Protocol_Verification/Examples.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/Examples.thy @@ -0,0 +1,54 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Examples.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\Examples\ +theory Examples + imports "examples/Keyserver" + "examples/Keyserver2" + "examples/Keyserver_Composition" + "examples/PKCS/PKCS_Model03" + "examples/PKCS/PKCS_Model07" + "examples/PKCS/PKCS_Model09" +begin +end diff --git a/thys/Automated_Stateful_Protocol_Verification/PSPSP.thy b/thys/Automated_Stateful_Protocol_Verification/PSPSP.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/PSPSP.thy @@ -0,0 +1,53 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: PSPSP.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\PSPSP\ +theory PSPSP + imports "Stateful_Protocol_Verification" + "Eisbach_Protocol_Verification" + "trac/trac" +begin + +end + diff --git a/thys/Automated_Stateful_Protocol_Verification/ROOT b/thys/Automated_Stateful_Protocol_Verification/ROOT new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/ROOT @@ -0,0 +1,16 @@ +chapter AFP + +session "Automated_Stateful_Protocol_Verification" (AFP) = "Stateful_Protocol_Composition_and_Typing" + + options [timeout = 2400] + sessions + "HOL-Eisbach" + directories + "trac" + "examples" + "examples/PKCS" + theories + "PSPSP" + "Examples" + document_files + "root.tex" + "root.bib" diff --git a/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy b/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy @@ -0,0 +1,4410 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Stateful_Protocol_Model.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\Stateful Protocol Model\ +theory Stateful_Protocol_Model + imports Stateful_Protocol_Composition_and_Typing.Stateful_Compositionality + Transactions Term_Abstraction +begin + +subsection \Locale Setup\ +locale stateful_protocol_model = + fixes arity\<^sub>f::"'fun \ nat" + and arity\<^sub>s::"'sets \ nat" + and public\<^sub>f::"'fun \ bool" + and Ana\<^sub>f::"'fun \ ((('fun,'atom::finite,'sets) prot_fun, nat) term list \ nat list)" + and \\<^sub>f::"'fun \ 'atom option" + and label_witness1::"'lbl" + and label_witness2::"'lbl" + assumes Ana\<^sub>f_assm1: "\f. let (K, M) = Ana\<^sub>f f in (\k \ subterms\<^sub>s\<^sub>e\<^sub>t (set K). + is_Fun k \ (is_Fu (the_Fun k)) \ length (args k) = arity\<^sub>f (the_Fu (the_Fun k)))" + and Ana\<^sub>f_assm2: "\f. let (K, M) = Ana\<^sub>f f in \i \ fv\<^sub>s\<^sub>e\<^sub>t (set K) \ set M. i < arity\<^sub>f f" + and public\<^sub>f_assm: "\f. arity\<^sub>f f > (0::nat) \ public\<^sub>f f" + and \\<^sub>f_assm: "\f. arity\<^sub>f f = (0::nat) \ \\<^sub>f f \ None" + and label_witness_assm: "label_witness1 \ label_witness2" +begin + +lemma Ana\<^sub>f_assm1_alt: + assumes "Ana\<^sub>f f = (K,M)" "k \ subterms\<^sub>s\<^sub>e\<^sub>t (set K)" + shows "(\x. k = Var x) \ (\h T. k = Fun (Fu h) T \ length T = arity\<^sub>f h)" +proof (cases k) + case (Fun g T) + let ?P = "\k. is_Fun k \ is_Fu (the_Fun k) \ length (args k) = arity\<^sub>f (the_Fu (the_Fun k))" + let ?Q = "\K M. \k \ subterms\<^sub>s\<^sub>e\<^sub>t (set K). ?P k" + + have "?Q (fst (Ana\<^sub>f f)) (snd (Ana\<^sub>f f))" using Ana\<^sub>f_assm1 split_beta[of ?Q "Ana\<^sub>f f"] by meson + hence "?Q K M" using assms(1) by simp + hence "?P k" using assms(2) by blast + thus ?thesis using Fun by (cases g) auto +qed simp + +lemma Ana\<^sub>f_assm2_alt: + assumes "Ana\<^sub>f f = (K,M)" "i \ fv\<^sub>s\<^sub>e\<^sub>t (set K) \ set M" + shows "i < arity\<^sub>f f" +using Ana\<^sub>f_assm2 assms by fastforce + + +subsection \Definitions\ +fun arity where + "arity (Fu f) = arity\<^sub>f f" +| "arity (Set s) = arity\<^sub>s s" +| "arity (Val _) = 0" +| "arity (Abs _) = 0" +| "arity Pair = 2" +| "arity (Attack _) = 0" +| "arity OccursFact = 2" +| "arity OccursSec = 0" +| "arity (PubConstAtom _ _) = 0" +| "arity (PubConstSetType _) = 0" +| "arity (PubConstAttackType _) = 0" +| "arity (PubConstBottom _) = 0" +| "arity (PubConstOccursSecType _) = 0" + +fun public where + "public (Fu f) = public\<^sub>f f" +| "public (Set s) = (arity\<^sub>s s > 0)" +| "public (Val n) = snd n" +| "public (Abs _) = False" +| "public Pair = True" +| "public (Attack _) = False" +| "public OccursFact = True" +| "public OccursSec = False" +| "public (PubConstAtom _ _) = True" +| "public (PubConstSetType _) = True" +| "public (PubConstAttackType _) = True" +| "public (PubConstBottom _) = True" +| "public (PubConstOccursSecType _) = True" + +fun Ana where + "Ana (Fun (Fu f) T) = ( + if arity\<^sub>f f = length T \ arity\<^sub>f f > 0 + then let (K,M) = Ana\<^sub>f f in (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M) + else ([], []))" +| "Ana _ = ([], [])" + +definition \\<^sub>v where + "\\<^sub>v v \ ( + if (\t \ subterms (fst v). + case t of (TComp f T) \ arity f > 0 \ arity f = length T | _ \ True) + then fst v + else TAtom Bottom)" + +fun \ where + "\ (Var v) = \\<^sub>v v" +| "\ (Fun f T) = ( + if arity f = 0 + then case f of + (Fu g) \ TAtom (case \\<^sub>f g of Some a \ Atom a | None \ Bottom) + | (Val _) \ TAtom Value + | (Abs _) \ TAtom Value + | (Set _) \ TAtom SetType + | (Attack _) \ TAtom AttackType + | OccursSec \ TAtom OccursSecType + | (PubConstAtom a _) \ TAtom (Atom a) + | (PubConstSetType _) \ TAtom SetType + | (PubConstAttackType _) \ TAtom AttackType + | (PubConstBottom _) \ TAtom Bottom + | (PubConstOccursSecType _) \ TAtom OccursSecType + | _ \ TAtom Bottom + else TComp f (map \ T))" + +lemma \_consts_simps[simp]: + "arity\<^sub>f g = 0 \ \ (Fun (Fu g) []) = TAtom (case \\<^sub>f g of Some a \ Atom a | None \ Bottom)" + "\ (Fun (Val n) []) = TAtom Value" + "\ (Fun (Abs b) []) = TAtom Value" + "arity\<^sub>s s = 0 \ \ (Fun (Set s) []) = TAtom SetType" + "\ (Fun (Attack x) []) = TAtom AttackType" + "\ (Fun OccursSec []) = TAtom OccursSecType" + "\ (Fun (PubConstAtom a t) []) = TAtom (Atom a)" + "\ (Fun (PubConstSetType t) []) = TAtom SetType" + "\ (Fun (PubConstAttackType t) []) = TAtom AttackType" + "\ (Fun (PubConstBottom t) []) = TAtom Bottom" + "\ (Fun (PubConstOccursSecType t) []) = TAtom OccursSecType" +by simp+ + +lemma \_Set_simps[simp]: + "arity\<^sub>s s \ 0 \ \ (Fun (Set s) T) = TComp (Set s) (map \ T)" + "\ (Fun (Set s) T) = TAtom SetType \ \ (Fun (Set s) T) = TComp (Set s) (map \ T)" + "\ (Fun (Set s) T) \ TAtom Value" + "\ (Fun (Set s) T) \ TAtom (Atom a)" + "\ (Fun (Set s) T) \ TAtom AttackType" + "\ (Fun (Set s) T) \ TAtom OccursSecType" + "\ (Fun (Set s) T) \ TAtom Bottom" +by auto + + +subsection \Locale Interpretations\ +lemma Ana_Fu_cases: + assumes "Ana (Fun f T) = (K,M)" + and "f = Fu g" + and "Ana\<^sub>f g = (K',M')" + shows "(K,M) = (if arity\<^sub>f g = length T \ arity\<^sub>f g > 0 + then (K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M') + else ([],[]))" (is ?A) + and "(K,M) = (K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M') \ (K,M) = ([],[])" (is ?B) +proof - + show ?A using assms by (cases "arity\<^sub>f g = length T \ arity\<^sub>f g > 0") auto + thus ?B by metis +qed + +lemma Ana_Fu_intro: + assumes "arity\<^sub>f f = length T" "arity\<^sub>f f > 0" + and "Ana\<^sub>f f = (K',M')" + shows "Ana (Fun (Fu f) T) = (K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')" +using assms by simp + +lemma Ana_Fu_elim: + assumes "Ana (Fun f T) = (K,M)" + and "f = Fu g" + and "Ana\<^sub>f g = (K',M')" + and "(K,M) \ ([],[])" + shows "arity\<^sub>f g = length T" (is ?A) + and "(K,M) = (K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')" (is ?B) +proof - + show ?A using assms by force + moreover have "arity\<^sub>f g > 0" using assms by force + ultimately show ?B using assms by auto +qed + +lemma Ana_nonempty_inv: + assumes "Ana t \ ([],[])" + shows "\f T. t = Fun (Fu f) T \ arity\<^sub>f f = length T \ arity\<^sub>f f > 0 \ + (\K M. Ana\<^sub>f f = (K, M) \ Ana t = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M))" +using assms +proof (induction t rule: Ana.induct) + case (1 f T) + hence *: "arity\<^sub>f f = length T" "0 < arity\<^sub>f f" + "Ana (Fun (Fu f) T) = (case Ana\<^sub>f f of (K, M) \ (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M))" + using Ana.simps(1)[of f T] unfolding Let_def by metis+ + + obtain K M where **: "Ana\<^sub>f f = (K, M)" by (metis surj_pair) + hence "Ana (Fun (Fu f) T) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M)" using *(3) by simp + thus ?case using ** *(1,2) by blast +qed simp_all + +lemma assm1: + assumes "Ana t = (K,M)" + shows "fv\<^sub>s\<^sub>e\<^sub>t (set K) \ fv t" +using assms +proof (induction t rule: term.induct) + case (Fun f T) + have aux: "fv\<^sub>s\<^sub>e\<^sub>t (set K \\<^sub>s\<^sub>e\<^sub>t (!) T) \ fv\<^sub>s\<^sub>e\<^sub>t (set T)" + when K: "\i \ fv\<^sub>s\<^sub>e\<^sub>t (set K). i < length T" + for K::"(('fun,'atom,'sets) prot_fun, nat) term list" + proof + fix x assume "x \ fv\<^sub>s\<^sub>e\<^sub>t (set K \\<^sub>s\<^sub>e\<^sub>t (!) T)" + then obtain k where k: "k \ set K" "x \ fv (k \ (!) T)" by moura + have "\i \ fv k. i < length T" using K k(1) by simp + thus "x \ fv\<^sub>s\<^sub>e\<^sub>t (set T)" + by (metis (no_types, lifting) k(2) contra_subsetD fv_set_mono image_subsetI nth_mem + subst_apply_fv_unfold) + qed + + { fix g assume f: "f = Fu g" and K: "K \ []" + obtain K' M' where *: "Ana\<^sub>f g = (K',M')" by moura + have "(K, M) \ ([], [])" using K by simp + hence "(K, M) = (K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')" "arity\<^sub>f g = length T" + using Ana_Fu_cases(1)[OF Fun.prems f *] + by presburger+ + hence ?case using aux[of K'] Ana\<^sub>f_assm2_alt[OF *] by auto + } thus ?case using Fun by (cases f) fastforce+ +qed simp + +lemma assm2: + assumes "Ana t = (K,M)" + and "\g S'. Fun g S' \ t \ length S' = arity g" + and "k \ set K" + and "Fun f T' \ k" + shows "length T' = arity f" +using assms +proof (induction t rule: term.induct) + case (Fun g T) + obtain h where 2: "g = Fu h" + using Fun.prems(1,3) by (cases g) auto + obtain K' M' where 1: "Ana\<^sub>f h = (K',M')" by moura + have "(K,M) \ ([],[])" using Fun.prems(3) by auto + hence "(K,M) = (K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) M')" + "\i. i \ fv\<^sub>s\<^sub>e\<^sub>t (set K') \ set M' \ i < length T" + using Ana_Fu_cases(1)[OF Fun.prems(1) 2 1] Ana\<^sub>f_assm2_alt[OF 1] + by presburger+ + hence "K = K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T" and 3: "\i\fv\<^sub>s\<^sub>e\<^sub>t (set K'). i < length T" by simp_all + then obtain k' where k': "k' \ set K'" "k = k' \ (!) T" using Fun.prems(3) by moura + hence 4: "Fun f T' \ subterms (k' \ (!) T)" "fv k' \ fv\<^sub>s\<^sub>e\<^sub>t (set K')" + using Fun.prems(4) by auto + show ?case + proof (cases "\i \ fv k'. Fun f T' \ subterms (T ! i)") + case True + hence "Fun f T' \ subterms\<^sub>s\<^sub>e\<^sub>t (set T)" using k' Fun.prems(4) 3 by auto + thus ?thesis using Fun.prems(2) by auto + next + case False + then obtain S where "Fun f S \ subterms k'" "Fun f T' = Fun f S \ (!) T" + using k'(2) Fun.prems(4) subterm_subst_not_img_subterm by force + thus ?thesis using Ana\<^sub>f_assm1_alt[OF 1, of "Fun f S"] k'(1) by (cases f) auto + qed +qed simp + +lemma assm4: + assumes "Ana (Fun f T) = (K, M)" + shows "set M \ set T" +using assms +proof (cases f) + case (Fu g) + obtain K' M' where *: "Ana\<^sub>f g = (K',M')" by moura + have "M = [] \ (arity\<^sub>f g = length T \ M = map ((!) T) M')" + using Ana_Fu_cases(1)[OF assms Fu *] + by (meson prod.inject) + thus ?thesis using Ana\<^sub>f_assm2_alt[OF *] by auto +qed auto + +lemma assm5: "Ana t = (K,M) \ K \ [] \ M \ [] \ Ana (t \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" +proof (induction t rule: term.induct) + case (Fun f T) thus ?case + proof (cases f) + case (Fu g) + obtain K' M' where *: "Ana\<^sub>f g = (K',M')" by moura + have **: "K = K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T" "M = map ((!) T) M'" + "arity\<^sub>f g = length T" "\i \ fv\<^sub>s\<^sub>e\<^sub>t (set K') \ set M'. i < arity\<^sub>f g" "0 < arity\<^sub>f g" + using Fun.prems(2) Ana_Fu_cases(1)[OF Fun.prems(1) Fu *] Ana\<^sub>f_assm2_alt[OF *] + by (meson prod.inject)+ + + have ***: "\i \ fv\<^sub>s\<^sub>e\<^sub>t (set K'). i < length T" "\i \ set M'. i < length T" using **(3,4) by auto + + have "K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ = K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) (map (\t. t \ \) T)" + "M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ = map ((!) (map (\t. t \ \) T)) M'" + using subst_idx_map[OF ***(2), of \] + subst_idx_map'[OF ***(1), of \] + **(1,2) + by fast+ + thus ?thesis using Fu * **(3,5) by auto + qed auto +qed simp + +sublocale intruder_model arity public Ana +apply unfold_locales +by (metis assm1, metis assm2, rule Ana.simps, metis assm4, metis assm5) + +adhoc_overloading INTRUDER_SYNTH intruder_synth +adhoc_overloading INTRUDER_DEDUCT intruder_deduct + +lemma assm6: "arity c = 0 \ \a. \X. \ (Fun c X) = TAtom a" by (cases c) auto + +lemma assm7: "0 < arity f \ \ (Fun f T) = TComp f (map \ T)" by auto + +lemma assm8: "infinite {c. \ (Fun c []::('fun,'atom,'sets) prot_term) = TAtom a \ public c}" + (is "?P a") +proof - + let ?T = "\f. (range f)::('fun,'atom,'sets) prot_fun set" + let ?A = "\f. \x::nat \ UNIV. \y::nat \ UNIV. (f x = f y) = (x = y)" + let ?B = "\f. \x::nat \ UNIV. f x \ ?T f" + let ?C = "\f. \y::('fun,'atom,'sets) prot_fun \ ?T f. \x \ UNIV. y = f x" + let ?D = "\f b. ?T f \ {c. \ (Fun c []::('fun,'atom,'sets) prot_term) = TAtom b \ public c}" + + have sub_lmm: "?P b" when "?A f" "?C f" "?C f" "?D f b" for b f + proof - + have "\g::nat \ ('fun,'atom,'sets) prot_fun. bij_betw g UNIV (?T f)" + using bij_betwI'[of UNIV f "?T f"] that(1,2,3) by blast + hence "infinite (?T f)" by (metis nat_not_finite bij_betw_finite) + thus ?thesis using infinite_super[OF that(4)] by blast + qed + + show ?thesis + proof (cases a) + case (Atom b) thus ?thesis using sub_lmm[of "PubConstAtom b" a] by force + next + case Value thus ?thesis using sub_lmm[of "\n. Val (n,True)" a] by force + next + case SetType thus ?thesis using sub_lmm[of PubConstSetType a] by fastforce + next + case AttackType thus ?thesis using sub_lmm[of PubConstAttackType a] by fastforce + next + case Bottom thus ?thesis using sub_lmm[of PubConstBottom a] by fastforce + next + case OccursSecType thus ?thesis using sub_lmm[of PubConstOccursSecType a] by fastforce + qed +qed + +lemma assm9: "TComp f T \ \ t \ arity f > 0" +proof (induction t rule: term.induct) + case (Var x) + hence "\ (Var x) \ TAtom Bottom" by force + hence "\t \ subterms (fst x). case t of + TComp f T \ arity f > 0 \ arity f = length T + | _ \ True" + using Var \.simps(1)[of x] unfolding \\<^sub>v_def by meson + thus ?case using Var by (fastforce simp add: \\<^sub>v_def) +next + case (Fun g S) + have "arity g \ 0" using Fun.prems Var_subtermeq assm6 by force + thus ?case using Fun by (cases "TComp f T = TComp g (map \ S)") auto +qed + +lemma assm10: "wf\<^sub>t\<^sub>r\<^sub>m (\ (Var x))" +unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (auto simp add: \\<^sub>v_def) + +lemma assm11: "arity f > 0 \ public f" using public\<^sub>f_assm by (cases f) auto + +lemma assm12: "\ (Var (\, n)) = \ (Var (\, m))" by (simp add: \\<^sub>v_def) + +lemma assm13: "arity c = 0 \ Ana (Fun c T) = ([],[])" by (cases c) simp_all + +lemma assm14: + assumes "Ana (Fun f T) = (K,M)" + shows "Ana (Fun f T \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" +proof - + show ?thesis + proof (cases "(K, M) = ([],[])") + case True + { fix g assume f: "f = Fu g" + obtain K' M' where "Ana\<^sub>f g = (K',M')" by moura + hence ?thesis using assms f True by auto + } thus ?thesis using True assms by (cases f) auto + next + case False + then obtain g where **: "f = Fu g" using assms by (cases f) auto + obtain K' M' where *: "Ana\<^sub>f g = (K',M')" by moura + have ***: "K = K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T" "M = map ((!) T) M'" "arity\<^sub>f g = length T" + "\i \ fv\<^sub>s\<^sub>e\<^sub>t (set K') \ set M'. i < arity\<^sub>f g" + using Ana_Fu_cases(1)[OF assms ** *] False Ana\<^sub>f_assm2_alt[OF *] + by (meson prod.inject)+ + have ****: "\i\fv\<^sub>s\<^sub>e\<^sub>t (set K'). i < length T" "\i\set M'. i < length T" using ***(3,4) by auto + have "K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ = K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) (map (\t. t \ \) T)" + "M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ = map ((!) (map (\t. t \ \) T)) M'" + using subst_idx_map[OF ****(2), of \] + subst_idx_map'[OF ****(1), of \] + ***(1,2) + by auto + thus ?thesis using assms * ** ***(3) by auto + qed +qed + +sublocale labeled_stateful_typed_model' arity public Ana \ Pair label_witness1 label_witness2 +by unfold_locales + (metis assm6, metis assm7, metis assm8, metis assm9, + rule assm10, metis assm11, rule arity.simps(5), metis assm14, + metis assm12, metis assm13, metis assm14, rule label_witness_assm) + +subsection \Minor Lemmata\ +lemma \\<^sub>v_TAtom[simp]: "\\<^sub>v (TAtom a, n) = TAtom a" +unfolding \\<^sub>v_def by simp + +lemma \\<^sub>v_TAtom': + assumes "a \ Bottom" + shows "\\<^sub>v (\, n) = TAtom a \ \ = TAtom a" +proof + assume "\\<^sub>v (\, n) = TAtom a" + thus "\ = TAtom a" by (metis (no_types, lifting) assms \\<^sub>v_def fst_conv term.inject(1)) +qed simp + +lemma \\<^sub>v_TAtom_inv: + "\\<^sub>v x = TAtom (Atom a) \ \m. x = (TAtom (Atom a), m)" + "\\<^sub>v x = TAtom Value \ \m. x = (TAtom Value, m)" + "\\<^sub>v x = TAtom SetType \ \m. x = (TAtom SetType, m)" + "\\<^sub>v x = TAtom AttackType \ \m. x = (TAtom AttackType, m)" + "\\<^sub>v x = TAtom OccursSecType \ \m. x = (TAtom OccursSecType, m)" +by (metis \\<^sub>v_TAtom' surj_pair prot_atom.distinct(7), + metis \\<^sub>v_TAtom' surj_pair prot_atom.distinct(15), + metis \\<^sub>v_TAtom' surj_pair prot_atom.distinct(21), + metis \\<^sub>v_TAtom' surj_pair prot_atom.distinct(25), + metis \\<^sub>v_TAtom' surj_pair prot_atom.distinct(30)) + +lemma \\<^sub>v_TAtom'': + "(fst x = TAtom (Atom a)) = (\\<^sub>v x = TAtom (Atom a))" (is "?A = ?A'") + "(fst x = TAtom Value) = (\\<^sub>v x = TAtom Value)" (is "?B = ?B'") + "(fst x = TAtom SetType) = (\\<^sub>v x = TAtom SetType)" (is "?C = ?C'") + "(fst x = TAtom AttackType) = (\\<^sub>v x = TAtom AttackType)" (is "?D = ?D'") + "(fst x = TAtom OccursSecType) = (\\<^sub>v x = TAtom OccursSecType)" (is "?E = ?E'") +proof - + have 1: "?A \ ?A'" "?B \ ?B'" "?C \ ?C'" "?D \ ?D'" "?E \ ?E'" + by (metis \\<^sub>v_TAtom prod.collapse)+ + + have 2: "?A' \ ?A" "?B' \ ?B" "?C' \ ?C" "?D' \ ?D" "?E' \ ?E" + using \\<^sub>v_TAtom \\<^sub>v_TAtom_inv(1) apply fastforce + using \\<^sub>v_TAtom \\<^sub>v_TAtom_inv(2) apply fastforce + using \\<^sub>v_TAtom \\<^sub>v_TAtom_inv(3) apply fastforce + using \\<^sub>v_TAtom \\<^sub>v_TAtom_inv(4) apply fastforce + using \\<^sub>v_TAtom \\<^sub>v_TAtom_inv(5) by fastforce + + show "?A = ?A'" "?B = ?B'" "?C = ?C'" "?D = ?D'" "?E = ?E'" + using 1 2 by metis+ +qed + +lemma \\<^sub>v_Var_image: + "\\<^sub>v ` X = \ ` Var ` X" +by force + +lemma \_Fu_const: + assumes "arity\<^sub>f g = 0" + shows "\a. \ (Fun (Fu g) T) = TAtom (Atom a)" +proof - + have "\\<^sub>f g \ None" using assms \\<^sub>f_assm by blast + thus ?thesis using assms by force +qed + +lemma Fun_Value_type_inv: + fixes T::"('fun,'atom,'sets) prot_term list" + assumes "\ (Fun f T) = TAtom Value" + shows "(\n. f = Val n) \ (\bs. f = Abs bs)" +proof - + have *: "arity f = 0" by (metis const_type_inv assms) + show ?thesis using assms + proof (cases f) + case (Fu g) + hence "arity\<^sub>f g = 0" using * by simp + hence False using Fu \_Fu_const[of g T] assms by auto + thus ?thesis by metis + next + case (Set s) + hence "arity\<^sub>s s = 0" using * by simp + hence False using Set assms by auto + thus ?thesis by metis + qed simp_all +qed + +lemma abs_\: "\ t = \ (t \\<^sub>\ \)" +by (induct t \ rule: abs_apply_term.induct) auto + +lemma Ana\<^sub>f_keys_not_pubval_terms: + assumes "Ana\<^sub>f f = (K, T)" + and "k \ set K" + and "g \ funs_term k" + shows "\is_Val g" +proof + assume "is_Val g" + then obtain n S where *: "Fun (Val n) S \ subterms\<^sub>s\<^sub>e\<^sub>t (set K)" + using assms(2) funs_term_Fun_subterm[OF assms(3)] + by (cases g) auto + show False using Ana\<^sub>f_assm1_alt[OF assms(1) *] by simp +qed + +lemma Ana\<^sub>f_keys_not_abs_terms: + assumes "Ana\<^sub>f f = (K, T)" + and "k \ set K" + and "g \ funs_term k" + shows "\is_Abs g" +proof + assume "is_Abs g" + then obtain a S where *: "Fun (Abs a) S \ subterms\<^sub>s\<^sub>e\<^sub>t (set K)" + using assms(2) funs_term_Fun_subterm[OF assms(3)] + by (cases g) auto + show False using Ana\<^sub>f_assm1_alt[OF assms(1) *] by simp +qed + +lemma Ana\<^sub>f_keys_not_pairs: + assumes "Ana\<^sub>f f = (K, T)" + and "k \ set K" + and "g \ funs_term k" + shows "g \ Pair" +proof + assume "g = Pair" + then obtain S where *: "Fun Pair S \ subterms\<^sub>s\<^sub>e\<^sub>t (set K)" + using assms(2) funs_term_Fun_subterm[OF assms(3)] + by (cases g) auto + show False using Ana\<^sub>f_assm1_alt[OF assms(1) *] by simp +qed + +lemma Ana_Fu_keys_funs_term_subset: + fixes K::"('fun,'atom,'sets) prot_term list" + assumes "Ana (Fun (Fu f) S) = (K, T)" + and "Ana\<^sub>f f = (K', T')" + shows "\(funs_term ` set K) \ \(funs_term ` set K') \ funs_term (Fun (Fu f) S)" +proof - + { fix k assume k: "k \ set K" + then obtain k' where k': + "k' \ set K'" "k = k' \ (!) S" "arity\<^sub>f f = length S" + "subterms k' \ subterms\<^sub>s\<^sub>e\<^sub>t (set K')" + using assms Ana_Fu_elim[OF assms(1) _ assms(2)] by fastforce + + have 1: "funs_term k' \ \(funs_term ` set K')" using k'(1) by auto + + have "i < length S" when "i \ fv k'" for i + using that Ana\<^sub>f_assm2_alt[OF assms(2), of i] k'(1,3) + by auto + hence 2: "funs_term (S ! i) \ funs_term (Fun (Fu f) S)" when "i \ fv k'" for i + using that by force + + have "funs_term k \ \(funs_term ` set K') \ funs_term (Fun (Fu f) S)" + using funs_term_subst[of k' "(!) S"] k'(2) 1 2 by fast + } thus ?thesis by blast +qed + +lemma Ana_Fu_keys_not_pubval_terms: + fixes k::"('fun,'atom,'sets) prot_term" + assumes "Ana (Fun (Fu f) S) = (K, T)" + and "Ana\<^sub>f f = (K', T')" + and "k \ set K" + and "\g \ funs_term (Fun (Fu f) S). is_Val g \ \public g" + shows "\g \ funs_term k. is_Val g \ \public g" +using assms(3,4) Ana\<^sub>f_keys_not_pubval_terms[OF assms(2)] + Ana_Fu_keys_funs_term_subset[OF assms(1,2)] +by blast + +lemma Ana_Fu_keys_not_abs_terms: + fixes k::"('fun,'atom,'sets) prot_term" + assumes "Ana (Fun (Fu f) S) = (K, T)" + and "Ana\<^sub>f f = (K', T')" + and "k \ set K" + and "\g \ funs_term (Fun (Fu f) S). \is_Abs g" + shows "\g \ funs_term k. \is_Abs g" +using assms(3,4) Ana\<^sub>f_keys_not_abs_terms[OF assms(2)] + Ana_Fu_keys_funs_term_subset[OF assms(1,2)] +by blast + +lemma Ana_Fu_keys_not_pairs: + fixes k::"('fun,'atom,'sets) prot_term" + assumes "Ana (Fun (Fu f) S) = (K, T)" + and "Ana\<^sub>f f = (K', T')" + and "k \ set K" + and "\g \ funs_term (Fun (Fu f) S). g \ Pair" + shows "\g \ funs_term k. g \ Pair" +using assms(3,4) Ana\<^sub>f_keys_not_pairs[OF assms(2)] + Ana_Fu_keys_funs_term_subset[OF assms(1,2)] +by blast + +lemma deduct_occurs_in_ik: + fixes t::"('fun,'atom,'sets) prot_term" + assumes t: "M \ occurs t" + and M: "\s \ subterms\<^sub>s\<^sub>e\<^sub>t M. OccursFact \ \(funs_term ` set (snd (Ana s)))" + "\s \ subterms\<^sub>s\<^sub>e\<^sub>t M. OccursSec \ \(funs_term ` set (snd (Ana s)))" + "Fun OccursSec [] \ M" + shows "occurs t \ M" +using private_fun_deduct_in_ik''[of M OccursFact "[Fun OccursSec [], t]" OccursSec] t M +by fastforce + +lemma wellformed_transaction_sem_receives: + fixes T::"('fun,'atom,'sets,'lbl) prot_transaction" + assumes T_valid: "wellformed_transaction T" + and \: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \" + and s: "receive\t\ \ set (unlabel (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + shows "IK \ t \ \" +proof - + let ?R = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + let ?S = "\A. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + let ?S' = "?S (transaction_receive T)" + + obtain l B s where B: + "(l,send\t\) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "prefix ((B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@[(l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \]) (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using s dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2)[of t "transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \"] + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst[of "send\t\" "transaction_receive T" \] + by blast + + have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@[(l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \])) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))@[send\t\]" + using B(1) unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst singleton_lst_proj(4) + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc subst_lsst_append subst_lsst_singleton + by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps ) + + have "strand_sem_stateful IK DB ?S' \" + using \ strand_sem_append_stateful[of IK DB _ _ \] transaction_dual_subst_unfold[of T \] + by fastforce + hence "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))@[send\t\]) \" + using B 1 unfolding prefix_def unlabel_def + by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def map_append strand_sem_append_stateful) + hence t_deduct: "IK \ (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \\<^sub>s\<^sub>e\<^sub>t \) \ t \ \" + using strand_sem_append_stateful[of IK DB "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" "[send\t\]" \] + by simp + + have "\s \ set (unlabel (transaction_receive T)). \t. s = receive\t\" + using T_valid wellformed_transaction_unlabel_cases(1)[OF T_valid] by auto + moreover { fix A::"('fun,'atom,'sets,'lbl) prot_strand" and \ + assume "\s \ set (unlabel A). \t. s = receive\t\" + hence "\s \ set (unlabel (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)). \t. s = receive\t\" + proof (induction A) + case (Cons a A) thus ?case using subst_lsst_cons[of a A \] by (cases a) auto + qed simp + hence "\s \ set (unlabel (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)). \t. s = receive\t\" + by (simp add: list.pred_set is_Receive_def) + hence "\s \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))). \t. s = send\t\" + by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv(2) unlabel_in unlabel_mem_has_label) + } + ultimately have "\s \ set ?R. \t. s = send\t\" by simp + hence "ik\<^sub>s\<^sub>s\<^sub>t ?R = {}" unfolding unlabel_def ik\<^sub>s\<^sub>s\<^sub>t_def by fast + hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) = {}" + using B(2) 1 ik\<^sub>s\<^sub>s\<^sub>t_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append + by (metis (no_types, lifting) Un_empty map_append prefix_def unlabel_def) + thus ?thesis using t_deduct by simp +qed + +lemma wellformed_transaction_sem_selects: + assumes T_valid: "wellformed_transaction T" + and \: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \" + and "select\t,u\ \ set (unlabel (transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + shows "(t \ \, u \ \) \ DB" +proof - + let ?s = "select\t,u\" + let ?R = "transaction_receive T@transaction_selects T" + let ?R' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?R \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + let ?S = "\A. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + let ?S' = "?S (transaction_receive T)@?S (transaction_selects T)" + let ?P = "\a. is_Receive a \ is_Assignment a" + let ?Q = "\a. is_Send a \ is_Assignment a" + + have s: "?s \ set (unlabel (?R \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using assms(3) subst_lsst_append[of "transaction_receive T"] + unlabel_append[of "transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \"] + by auto + + obtain l B s where B: + "(l,?s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "prefix ((B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@[(l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \]) (?R \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using s dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(6)[of assign t u] + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst[of ?s ?R \] + by blast + + have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@[(l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \])) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))@[?s]" + using B(1) unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst singleton_lst_proj(4) + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc subst_lsst_append subst_lsst_singleton + by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps) + + have "strand_sem_stateful IK DB ?S' \" + using \ strand_sem_append_stateful[of IK DB _ _ \] transaction_dual_subst_unfold[of T \] + by fastforce + hence "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))@[?s]) \" + using B 1 strand_sem_append_stateful subst_lsst_append + unfolding prefix_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def + by (metis (no_types) map_append) + hence in_db: "(t \ \, u \ \) \ dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \ DB" + using strand_sem_append_stateful[of IK DB "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" "[?s]" \] + by simp + + have "\a \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))). ?Q a" + proof + fix a assume a: "a \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)))" + + have "\a \ set (unlabel ?R). ?P a" + using wellformed_transaction_unlabel_cases(1)[OF T_valid] + wellformed_transaction_unlabel_cases(2)[OF T_valid] + unfolding unlabel_def + by fastforce + hence "\a \ set (unlabel (?R \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)). ?P a" + using stateful_strand_step_cases_subst(2,8)[of _ \] subst_lsst_unlabel[of ?R \] + by (simp add: subst_apply_stateful_strand_def del: unlabel_append) + hence B_P: "\a \ set (unlabel (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)). ?P a" + using unlabel_mono[OF set_mono_prefix[OF append_prefixD[OF B(2)]]] + by blast + + obtain l where "(l,a) \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using a by (meson unlabel_mem_has_label) + then obtain b where b: "(l,b) \ set (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,b) = (l,a)" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD by blast + hence "?P b" using B_P unfolding unlabel_def by fastforce + thus "?Q a" using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv[OF b(2)] by (cases b) auto + qed + hence "\a \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))). \is_Insert a \ \is_Delete a" by fastforce + thus ?thesis using dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" \ DB] in_db by simp +qed + +lemma wellformed_transaction_sem_pos_checks: + assumes T_valid: "wellformed_transaction T" + and \: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \" + and "\t in u\ \ set (unlabel (transaction_checks T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + shows "(t \ \, u \ \) \ DB" +proof - + let ?s = "\t in u\" + let ?R = "transaction_receive T@transaction_selects T@transaction_checks T" + let ?R' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?R \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + let ?S = "\A. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + let ?S' = "?S (transaction_receive T)@?S (transaction_selects T)@?S (transaction_checks T)" + let ?P = "\a. is_Receive a \ is_Assignment a \ is_Check a" + let ?Q = "\a. is_Send a \ is_Assignment a \ is_Check a" + + have s: "?s \ set (unlabel (?R \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using assms(3) subst_lsst_append[of "transaction_receive T@transaction_selects T"] + unlabel_append[of "transaction_receive T@transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \"] + by auto + + obtain l B s where B: + "(l,?s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "prefix ((B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@[(l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \]) (?R \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using s dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(6)[of check t u] + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst[of ?s ?R \] + by blast + + have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@[(l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \])) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))@[?s]" + using B(1) unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst singleton_lst_proj(4) + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc subst_lsst_append subst_lsst_singleton + by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps ) + + have "strand_sem_stateful IK DB ?S' \" + using \ strand_sem_append_stateful[of IK DB _ _ \] transaction_dual_subst_unfold[of T \] + by fastforce + hence "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))@[?s]) \" + using B 1 strand_sem_append_stateful subst_lsst_append + unfolding prefix_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def + by (metis (no_types) map_append) + hence in_db: "(t \ \, u \ \) \ dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \ DB" + using strand_sem_append_stateful[of IK DB "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" "[?s]" \] + by simp + + have "\a \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))). ?Q a" + proof + fix a assume a: "a \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)))" + + have "\a \ set (unlabel ?R). ?P a" + using wellformed_transaction_unlabel_cases(1,2,3)[OF T_valid] + unfolding unlabel_def + by fastforce + hence "\a \ set (unlabel (?R \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)). ?P a" + using stateful_strand_step_cases_subst(2,8,9)[of _ \] subst_lsst_unlabel[of ?R \] + by (simp add: subst_apply_stateful_strand_def del: unlabel_append) + hence B_P: "\a \ set (unlabel (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)). ?P a" + using unlabel_mono[OF set_mono_prefix[OF append_prefixD[OF B(2)]]] + by blast + + obtain l where "(l,a) \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using a by (meson unlabel_mem_has_label) + then obtain b where b: "(l,b) \ set (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,b) = (l,a)" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD by blast + hence "?P b" using B_P unfolding unlabel_def by fastforce + thus "?Q a" using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv[OF b(2)] by (cases b) auto + qed + hence "\a \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))). \is_Insert a \ \is_Delete a" by fastforce + thus ?thesis using dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" \ DB] in_db by simp +qed + +lemma wellformed_transaction_sem_neg_checks: + assumes T_valid: "wellformed_transaction T" + and \: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \" + and "NegChecks X [] [(t,u)] \ set (unlabel (transaction_checks T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + shows "\\. subst_domain \ = set X \ ground (subst_range \) \ (t \ \ \ \, u \ \ \ \) \ DB" (is ?A) + and "X = [] \ (t \ \, u \ \) \ DB" (is "?B \ ?B'") +proof - + let ?s = "NegChecks X [] [(t,u)]" + let ?R = "transaction_receive T@transaction_selects T@transaction_checks T" + let ?R' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?R \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + let ?S = "\A. unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + let ?S' = "?S (transaction_receive T)@?S (transaction_selects T)@?S (transaction_checks T)" + let ?P = "\a. is_Receive a \ is_Assignment a \ is_Check a" + let ?Q = "\a. is_Send a \ is_Assignment a \ is_Check a" + let ?U = "\\. subst_domain \ = set X \ ground (subst_range \)" + + have s: "?s \ set (unlabel (?R \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using assms(3) subst_lsst_append[of "transaction_receive T@transaction_selects T"] + unlabel_append[of "transaction_receive T@transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \"] + by auto + + obtain l B s where B: + "(l,?s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "prefix ((B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@[(l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \]) (?R \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using s dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(7)[of X "[]" "[(t,u)]"] + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain_subst[of ?s ?R \] + by blast + + have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@[(l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \])) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))@[?s]" + using B(1) unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst singleton_lst_proj(4) + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc subst_lsst_append subst_lsst_singleton + by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps) + + have "strand_sem_stateful IK DB ?S' \" + using \ strand_sem_append_stateful[of IK DB _ _ \] transaction_dual_subst_unfold[of T \] + by fastforce + hence "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))@[?s]) \" + using B 1 strand_sem_append_stateful subst_lsst_append + unfolding prefix_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def + by (metis (no_types) map_append) + hence "negchecks_model \ (dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \ DB) X [] [(t,u)]" + using strand_sem_append_stateful[of IK DB "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" "[?s]" \] + by fastforce + hence in_db: "\\. ?U \ \ (t \ \ \ \, u \ \ \ \) \ dbupd\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \ DB" + unfolding negchecks_model_def + by simp + + have "\a \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))). ?Q a" + proof + fix a assume a: "a \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)))" + + have "\a \ set (unlabel ?R). ?P a" + using wellformed_transaction_unlabel_cases(1,2,3)[OF T_valid] + unfolding unlabel_def + by fastforce + hence "\a \ set (unlabel (?R \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)). ?P a" + using stateful_strand_step_cases_subst(2,8,9)[of _ \] subst_lsst_unlabel[of ?R \] + by (simp add: subst_apply_stateful_strand_def del: unlabel_append) + hence B_P: "\a \ set (unlabel (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)). ?P a" + using unlabel_mono[OF set_mono_prefix[OF append_prefixD[OF B(2)]]] + by blast + + obtain l where "(l,a) \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using a by (meson unlabel_mem_has_label) + then obtain b where b: "(l,b) \ set (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,b) = (l,a)" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_memberD by blast + hence "?P b" using B_P unfolding unlabel_def by fastforce + thus "?Q a" using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_inv[OF b(2)] by (cases b) auto + qed + hence "\a \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))). \is_Insert a \ \is_Delete a" by fastforce + thus ?A using dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" \ DB] in_db by simp + moreover have "\ = Var" "t \ \ = t" + when "subst_domain \ = set []" for t and \::"('fun, 'atom, 'sets) prot_subst" + using that by auto + moreover have "subst_domain Var = set []" "range_vars Var = {}" + by simp_all + ultimately show "?B \ ?B'" unfolding range_vars_alt_def by metis +qed + +lemma wellformed_transaction_fv_in_receives_or_selects: + assumes T: "wellformed_transaction T" + and x: "x \ fv_transaction T" "x \ set (transaction_fresh T)" + shows "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" +proof - + have "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \ + fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \ + fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" + using x(1) fv\<^sub>s\<^sub>s\<^sub>t_append unlabel_append + by (metis transaction_strand_def append_assoc) + thus ?thesis using T x(2) unfolding wellformed_transaction_def by blast +qed + +lemma dual_transaction_ik_is_transaction_send'': + fixes \ \::"('a,'b,'c) prot_subst" + assumes "wellformed_transaction T" + shows "(ik\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a = + (trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a" (is "?A = ?B") +using dual_transaction_ik_is_transaction_send[OF assms] + subst_lsst_unlabel[of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" \] + ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))" \] + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" \] +by (auto simp add: abs_apply_terms_def) + +lemma while_prot_terms_fun_mono: + "mono (\M'. M \ \(subterms ` M') \ \((set \ fst \ Ana) ` M'))" +unfolding mono_def by fast + +lemma while_prot_terms_SMP_overapprox: + fixes M::"('fun,'atom,'sets) prot_terms" + assumes N_supset: "M \ \(subterms ` N) \ \((set \ fst \ Ana) ` N) \ N" + and Value_vars_only: "\x \ fv\<^sub>s\<^sub>e\<^sub>t N. \\<^sub>v x = TAtom Value" + shows "SMP M \ {a \ \ | a \. a \ N \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)}" +proof - + define f where "f \ \M'. M \ \(subterms ` M') \ \((set \ fst \ Ana) ` M')" + define S where "S \ {a \ \ | a \. a \ N \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)}" + + note 0 = Value_vars_only + + have "t \ S" when "t \ SMP M" for t + using that + proof (induction t rule: SMP.induct) + case (MP t) + hence "t \ N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" using N_supset by auto + hence "t \ Var \ S" unfolding S_def by blast + thus ?case by simp + next + case (Subterm t t') + then obtain \ a where a: "a \ \ = t" "a \ N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + by (auto simp add: S_def) + hence "\x \ fv a. \\. \ (Var x) = TAtom \" using 0 by auto + hence *: "\x \ fv a. (\f. \ x = Fun f []) \ (\y. \ x = Var y)" + using a(3) TAtom_term_cases[OF wf_trm_subst_rangeD[OF a(4)]] + by (metis wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + obtain b where b: "b \ \ = t'" "b \ subterms a" + using subterms_subst_subterm[OF *, of t'] Subterm.hyps(2) a(1) + by fast + hence "b \ N" using N_supset a(2) by blast + thus ?case using a b(1) unfolding S_def by blast + next + case (Substitution t \) + then obtain \ a where a: "a \ \ = t" "a \ N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + by (auto simp add: S_def) + have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + by (fact wt_subst_compose[OF a(3) Substitution.hyps(2)], + fact wf_trms_subst_compose[OF a(4) Substitution.hyps(3)]) + moreover have "t \ \ = a \ \ \\<^sub>s \" using a(1) subst_subst_compose[of a \ \] by simp + ultimately show ?case using a(2) unfolding S_def by blast + next + case (Ana t K T k) + then obtain \ a where a: "a \ \ = t" "a \ N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + by (auto simp add: S_def) + obtain Ka Ta where a': "Ana a = (Ka,Ta)" by moura + have *: "K = Ka \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \" + proof (cases a) + case (Var x) + then obtain g U where gU: "t = Fun g U" + using a(1) Ana.hyps(2,3) Ana_var + by (cases t) simp_all + have "\ (Var x) = TAtom Value" using Var a(2) 0 by auto + hence "\ (Fun g U) = TAtom Value" + using a(1,3) Var gU wt_subst_trm''[OF a(3), of a] + by argo + thus ?thesis using gU Fun_Value_type_inv Ana.hyps(2,3) by fastforce + next + case (Fun g U) thus ?thesis using a(1) a' Ana.hyps(2) Ana_subst'[of g U] by simp + qed + then obtain ka where ka: "k = ka \ \" "ka \ set Ka" using Ana.hyps(3) by auto + have "ka \ set ((fst \ Ana) a)" using ka(2) a' by simp + hence "ka \ N" using a(2) N_supset by auto + thus ?case using ka a(3,4) unfolding S_def by blast + qed + thus ?thesis unfolding S_def by blast +qed + + +subsection \The Protocol Transition System, Defined in Terms of the Reachable Constraints\ +definition transaction_fresh_subst where + "transaction_fresh_subst \ T \ \ + subst_domain \ = set (transaction_fresh T) \ + (\t \ subst_range \. \n. t = Fun (Val (n,False)) []) \ + (\t \ subst_range \. t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ + (\t \ subst_range \. t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)) \ + inj_on \ (subst_domain \)" + +(* NB: We need the protocol P as a parameter for this definition---even though we will only apply \ + to a single transaction T of P---because we have to ensure that \(fv(T)) is disjoint from + the bound variables of P and \. *) +definition transaction_renaming_subst where + "transaction_renaming_subst \ P \ \ + \n \ max_var_set (\(vars_transaction ` set P) \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \). \ = var_rename n" + +definition constraint_model where + "constraint_model \ \ \ + constr_sem_stateful \ (unlabel \) \ + interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ + wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + +definition welltyped_constraint_model where + "welltyped_constraint_model \ \ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ constraint_model \ \" + +lemma constraint_model_prefix: + assumes "constraint_model I (A@B)" + shows "constraint_model I A" +by (metis assms strand_sem_append_stateful unlabel_append constraint_model_def) + +lemma welltyped_constraint_model_prefix: + assumes "welltyped_constraint_model I (A@B)" + shows "welltyped_constraint_model I A" +by (metis assms constraint_model_prefix welltyped_constraint_model_def) + +lemma constraint_model_Val_is_Value_term: + assumes "welltyped_constraint_model I A" + and "t \ I = Fun (Val n) []" + shows "t = Fun (Val n) [] \ (\m. t = Var (TAtom Value, m))" +proof - + have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" using assms(1) unfolding welltyped_constraint_model_def by simp + moreover have "\ (Fun (Val n) []) = TAtom Value" by auto + ultimately have *: "\ t = TAtom Value" by (metis (no_types) assms(2) wt_subst_trm'') + + show ?thesis + proof (cases t) + case (Var x) + obtain \ m where x: "x = (\, m)" by (metis surj_pair) + have "\\<^sub>v x = TAtom Value" using * Var by auto + hence "\ = TAtom Value" using x \\<^sub>v_TAtom'[of Value \ m] by simp + thus ?thesis using x Var by metis + next + case (Fun f T) thus ?thesis using assms(2) by auto + qed +qed + +text \ + The set of symbolic constraints reachable in any symbolic run of the protocol \P\. + + \\\ instantiates the fresh variables of transaction \T\ with fresh terms. + \\\ is a variable-renaming whose range consists of fresh variables. +\ +inductive_set reachable_constraints:: + "('fun,'atom,'sets,'lbl) prot \ ('fun,'atom,'sets,'lbl) prot_constr set" + for P::"('fun,'atom,'sets,'lbl) prot" +where + init: + "[] \ reachable_constraints P" +| step: + "\\ \ reachable_constraints P; + T \ set P; + transaction_fresh_subst \ T \; + transaction_renaming_subst \ P \ + \ \ \@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \) \ reachable_constraints P" + + +subsection \Admissible Transactions\ +definition admissible_transaction_checks where + "admissible_transaction_checks T \ + \x \ set (unlabel (transaction_checks T)). + is_Check x \ + (is_InSet x \ + is_Var (the_elem_term x) \ is_Fun_Set (the_set_term x) \ + fst (the_Var (the_elem_term x)) = TAtom Value) \ + (is_NegChecks x \ + bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = [] \ + ((the_eqs x = [] \ length (the_ins x) = 1) \ + (the_ins x = [] \ length (the_eqs x) = 1))) \ + (is_NegChecks x \ the_eqs x = [] \ (let h = hd (the_ins x) in + is_Var (fst h) \ is_Fun_Set (snd h) \ + fst (the_Var (fst h)) = TAtom Value))" + +definition admissible_transaction_selects where + "admissible_transaction_selects T \ + \x \ set (unlabel (transaction_selects T)). + is_InSet x \ the_check x = Assign \ is_Var (the_elem_term x) \ is_Fun_Set (the_set_term x) \ + fst (the_Var (the_elem_term x)) = TAtom Value" + +definition admissible_transaction_updates where + "admissible_transaction_updates T \ + \x \ set (unlabel (transaction_updates T)). + is_Update x \ is_Var (the_elem_term x) \ is_Fun_Set (the_set_term x) \ + fst (the_Var (the_elem_term x)) = TAtom Value" + +definition admissible_transaction_terms where + "admissible_transaction_terms T \ + wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) \ + (\f \ \(funs_term ` trms_transaction T). + \is_Val f \ \is_Abs f \ \is_PubConstSetType f \ f \ Pair \ + \is_PubConstAttackType f \ \is_PubConstBottom f \ \is_PubConstOccursSecType f) \ + (\r \ set (unlabel (transaction_strand T)). + (\f \ \(funs_term ` (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r)). is_Attack f) \ + (let t = the_msg r in is_Send r \ is_Fun t \ is_Attack (the_Fun t) \ args t = []))" + +definition admissible_transaction_occurs_checks where + "admissible_transaction_occurs_checks T \ ( + (\x \ fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \ + receive\occurs (Var x)\ \ set (unlabel (transaction_receive T))) \ + (\x \ set (transaction_fresh T). fst x = TAtom Value \ + send\occurs (Var x)\ \ set (unlabel (transaction_send T))) \ + (\r \ set (unlabel (transaction_receive T)). is_Receive r \ + (OccursFact \ funs_term (the_msg r) \ OccursSec \ funs_term (the_msg r)) \ + (\x \ fv_transaction T - set (transaction_fresh T). + fst x = TAtom Value \ the_msg r = occurs (Var x))) \ + (\r \ set (unlabel (transaction_send T)). is_Send r \ + (OccursFact \ funs_term (the_msg r) \ OccursSec \ funs_term (the_msg r)) \ + (\x \ set (transaction_fresh T). + fst x = TAtom Value \ the_msg r = occurs (Var x))) + )" + +definition admissible_transaction where + "admissible_transaction T \ ( + wellformed_transaction T \ + distinct (transaction_fresh T) \ + list_all (\x. fst x = TAtom Value) (transaction_fresh T) \ + (\x \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T). is_Var (fst x) \ (the_Var (fst x) = Value)) \ + bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = {} \ + (\x \ fv_transaction T - set (transaction_fresh T). + \y \ fv_transaction T - set (transaction_fresh T). + x \ y \ \Var x != Var y\ \ set (unlabel (transaction_checks T)) \ + \Var y != Var x\ \ set (unlabel (transaction_checks T))) \ + admissible_transaction_selects T \ + admissible_transaction_checks T \ + admissible_transaction_updates T \ + admissible_transaction_terms T \ + admissible_transaction_occurs_checks T +)" + +lemma transaction_no_bvars: + assumes "admissible_transaction T" + shows "fv_transaction T = vars_transaction T" + and "bvars_transaction T = {}" +proof - + have "wellformed_transaction T" "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = {}" + using assms unfolding admissible_transaction_def + by blast+ + thus "bvars_transaction T = {}" "fv_transaction T = vars_transaction T" + using bvars_wellformed_transaction_unfold vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t + by fast+ +qed + +lemma transactions_fv_bvars_disj: + assumes "\T \ set P. admissible_transaction T" + shows "(\T \ set P. fv_transaction T) \ (\T \ set P. bvars_transaction T) = {}" +using assms transaction_no_bvars(2) by fast + +lemma transaction_bvars_no_Value_type: + assumes "admissible_transaction T" + and "x \ bvars_transaction T" + shows "\TAtom Value \ \\<^sub>v x" +using assms transaction_no_bvars(2) by blast + +lemma transaction_receive_deduct: + assumes T_adm: "admissible_transaction T" + and \: "constraint_model \ (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + and \: "transaction_fresh_subst \ T A" + and \: "transaction_renaming_subst \ P A" + and t: "receive\t\ \ set (unlabel (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + shows "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" +proof - + define \ where "\ \ \ \\<^sub>s \" + + have t': "send\t\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)))" + using t dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) unfolding \_def by blast + then obtain T1 T2 where T: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) = T1@send\t\#T2" + using t' by (meson split_list) + + have "constr_sem_stateful \ (unlabel A@unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)))" + using \ unlabel_append[of A] unfolding constraint_model_def \_def by simp + hence "constr_sem_stateful \ (unlabel A@T1@[send\t\])" + using strand_sem_append_stateful[of "{}" "{}" "unlabel A@T1@[send\t\]" _ \] + transaction_dual_subst_unfold[of T \] T + by (metis append.assoc append_Cons append_Nil) + hence "ik\<^sub>s\<^sub>s\<^sub>t (unlabel A@T1) \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" + using strand_sem_append_stateful[of "{}" "{}" "unlabel A@T1" "[send\t\]" \] T + by force + moreover have "\is_Receive x" + when x: "x \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)))" for x + proof - + have *: "is_Receive a" when "a \ set (unlabel (transaction_receive T))" for a + using T_adm Ball_set[of "unlabel (transaction_receive T)" is_Receive] that + unfolding admissible_transaction_def wellformed_transaction_def + by blast + + obtain l where l: "(l,x) \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using x unfolding unlabel_def by fastforce + then obtain ly where ly: "ly \ set (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" "(l,x) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ly" + unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto + + obtain j y where j: "ly = (j,y)" by (metis surj_pair) + hence "j = l" using ly(2) by (cases y) auto + hence y: "(l,y) \ set (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" "(l,x) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,y)" + by (metis j ly(1), metis j ly(2)) + + obtain z where z: + "z \ set (unlabel (transaction_receive T))" + "(l,z) \ set (transaction_receive T)" + "(l,y) = (l,z) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" + using y(1) unfolding subst_apply_labeled_stateful_strand_def unlabel_def by force + + have "is_Receive y" using *[OF z(1)] z(3) by (cases z) auto + thus "\is_Receive x" using l y by (cases y) auto + qed + hence "\is_Receive x" when "x \ set T1" for x using T that by simp + hence "ik\<^sub>s\<^sub>s\<^sub>t T1 = {}" unfolding ik\<^sub>s\<^sub>s\<^sub>t_def is_Receive_def by fast + hence "ik\<^sub>s\<^sub>s\<^sub>t (unlabel A@T1) = ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" using ik\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" T1] by simp + ultimately show ?thesis by (simp add: \_def) +qed + +lemma transaction_checks_db: + assumes T: "admissible_transaction T" + and \: "constraint_model \ (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + and \: "transaction_fresh_subst \ T A" + and \: "transaction_renaming_subst \ P A" + shows "\Var (TAtom Value, n) in Fun (Set s) []\ \ set (unlabel (transaction_checks T)) + \ (\ (TAtom Value, n) \ \, Fun (Set s) []) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \)" + (is "?A \ ?B") + and "\Var (TAtom Value, n) not in Fun (Set s) []\ \ set (unlabel (transaction_checks T)) + \ (\ (TAtom Value, n) \ \, Fun (Set s) []) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \)" + (is "?C \ ?D") +proof - + let ?x = "\n. (TAtom Value, n)" + let ?s = "Fun (Set s) []" + let ?T = "transaction_receive T@transaction_selects T@transaction_checks T" + let ?T' = "?T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \" + let ?S = "\S. transaction_receive T@transaction_selects T@S" + let ?S' = "\S. ?S S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \" + + have T_valid: "wellformed_transaction T" using T by (simp add: admissible_transaction_def) + + have "constr_sem_stateful \ (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)))" + using \ unfolding constraint_model_def by simp + moreover have + "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S (T1@[c]) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@ + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T2@transaction_updates T@transaction_send T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + when "transaction_checks T = T1@c#T2" for T1 T2 c \ + using that dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append + unfolding transaction_strand_def + by (metis append.assoc append_Cons append_Nil) + ultimately have T'_model: "constr_sem_stateful \ (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,c)]))))" + when "transaction_checks T = T1@(l,c)#T2" for T1 T2 l c + using strand_sem_append_stateful[of _ _ _ _ \] + by (simp add: that transaction_strand_def) + + show "?A \ ?B" + proof - + assume a: ?A + hence *: "\Var (?x n) in ?s\ \ set (unlabel ?T)" + unfolding transaction_strand_def unlabel_def by simp + then obtain l T1 T2 where T1: "transaction_checks T = T1@(l,\Var (?x n) in ?s\)#T2" + by (metis a split_list unlabel_mem_has_label) + + have "?x n \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" + using a by force + hence "?x n \ set (transaction_fresh T)" + using a transaction_fresh_vars_notin[OF T_valid] by fast + hence "unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,\Var (?x n) in ?s\)]))) = + unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1))@[\\ (?x n) in ?s\]" + using T a \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append unlabel_append + by (fastforce simp add: transaction_fresh_subst_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def + subst_apply_labeled_stateful_strand_def) + moreover have "db\<^sub>s\<^sub>s\<^sub>t (unlabel A) = db\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1)))" + by (simp add: T1 db\<^sub>s\<^sub>s\<^sub>t_transaction_prefix_eq[OF T_valid] del: unlabel_append) + ultimately have "\M. strand_sem_stateful M (set (db\<^sub>s\<^sub>s\<^sub>t (unlabel A) \)) [\\ (?x n) in ?s\] \" + using T'_model[OF T1] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of _ \] strand_sem_append_stateful[of _ _ _ _ \] + by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def del: unlabel_append) + thus ?B by simp + qed + + show "?C \ ?D" + proof - + assume a: ?C + hence *: "\Var (?x n) not in ?s\ \ set (unlabel ?T)" + unfolding transaction_strand_def unlabel_def by simp + then obtain l T1 T2 where T1: "transaction_checks T = T1@(l,\Var (?x n) not in ?s\)#T2" + by (metis a split_list unlabel_mem_has_label) + + have "?x n \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p \Var (?x n) not in ?s\" + using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_cases(9)[of "[]" "Var (?x n)" ?s] by auto + hence "?x n \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" + using a unfolding vars\<^sub>s\<^sub>s\<^sub>t_def by force + hence "?x n \ set (transaction_fresh T)" + using a transaction_fresh_vars_notin[OF T_valid] by fast + hence "unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,\Var (?x n) not in ?s\)]))) = + unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1))@[\\ (?x n) not in ?s\]" + using T a \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append unlabel_append + by (fastforce simp add: transaction_fresh_subst_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def + subst_apply_labeled_stateful_strand_def) + moreover have "db\<^sub>s\<^sub>s\<^sub>t (unlabel A) = db\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1)))" + by (simp add: T1 db\<^sub>s\<^sub>s\<^sub>t_transaction_prefix_eq[OF T_valid] del: unlabel_append) + ultimately have "\M. strand_sem_stateful M (set (db\<^sub>s\<^sub>s\<^sub>t (unlabel A) \)) [\\ (?x n) not in ?s\] \" + using T'_model[OF T1] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of _ \] strand_sem_append_stateful[of _ _ _ _ \] + by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def del: unlabel_append) + thus ?D using stateful_strand_sem_NegChecks_no_bvars(1)[of _ _ _ ?s \] by simp + qed +qed + +lemma transaction_selects_db: + assumes T: "admissible_transaction T" + and \: "constraint_model \ (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + and \: "transaction_fresh_subst \ T A" + and \: "transaction_renaming_subst \ P A" + shows "select\Var (TAtom Value, n), Fun (Set s) []\ \ set (unlabel (transaction_selects T)) + \ (\ (TAtom Value, n) \ \, Fun (Set s) []) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \)" + (is "?A \ ?B") +proof - + let ?x = "\n. (TAtom Value, n)" + let ?s = "Fun (Set s) []" + let ?T = "transaction_receive T@transaction_selects T@transaction_checks T" + let ?T' = "?T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \" + let ?S = "\S. transaction_receive T@S" + let ?S' = "\S. ?S S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \" + + have T_valid: "wellformed_transaction T" using T by (simp add: admissible_transaction_def) + + have "constr_sem_stateful \ (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)))" + using \ unfolding constraint_model_def by simp + moreover have + "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S (T1@[c]) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@ + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (T2@transaction_checks T @ transaction_updates T@transaction_send T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + when "transaction_selects T = T1@c#T2" for T1 T2 c \ + using that dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append + unfolding transaction_strand_def by (metis append.assoc append_Cons append_Nil) + ultimately have T'_model: "constr_sem_stateful \ (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,c)]))))" + when "transaction_selects T = T1@(l,c)#T2" for T1 T2 l c + using strand_sem_append_stateful[of _ _ _ _ \] + by (simp add: that transaction_strand_def) + + show "?A \ ?B" + proof - + assume a: ?A + hence *: "select\Var (?x n), ?s\ \ set (unlabel ?T)" + unfolding transaction_strand_def unlabel_def by simp + then obtain l T1 T2 where T1: "transaction_selects T = T1@(l,select\Var (?x n), ?s\)#T2" + by (metis a split_list unlabel_mem_has_label) + + have "?x n \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" + using a by force + hence "?x n \ set (transaction_fresh T)" + using a transaction_fresh_vars_notin[OF T_valid] by fast + hence "unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' (T1@[(l,select\Var (?x n), ?s\)]))) = + unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1))@[select\\ (?x n), ?s\]" + using T a \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append unlabel_append + by (fastforce simp add: transaction_fresh_subst_def unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def + subst_apply_labeled_stateful_strand_def) + moreover have "db\<^sub>s\<^sub>s\<^sub>t (unlabel A) = db\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (?S' T1)))" + by (simp add: T1 db\<^sub>s\<^sub>s\<^sub>t_transaction_prefix_eq[OF T_valid] del: unlabel_append) + ultimately have "\M. strand_sem_stateful M (set (db\<^sub>s\<^sub>s\<^sub>t (unlabel A) \)) [\\ (?x n) in ?s\] \" + using T'_model[OF T1] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of _ \] strand_sem_append_stateful[of _ _ _ _ \] + by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def del: unlabel_append) + thus ?B by simp + qed +qed + +lemma transactions_have_no_Value_consts: + assumes "admissible_transaction T" + and "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))" + shows "\a T. t = Fun (Val a) T" (is ?A) + and "\a T. t = Fun (Abs a) T" (is ?B) +proof - + have "admissible_transaction_terms T" using assms(1) unfolding admissible_transaction_def by blast + hence "\is_Val f" "\is_Abs f" + when "f \ \(funs_term ` (trms_transaction T))" for f + using that unfolding admissible_transaction_terms_def by blast+ + moreover have "f \ \(funs_term ` (trms_transaction T))" + when "f \ funs_term t" for f + using that assms(2) funs_term_subterms_eq(2)[of "trms_transaction T"] by blast+ + ultimately have *: "\is_Val f" "\is_Abs f" + when "f \ funs_term t" for f + using that by presburger+ + + show ?A using *(1) by force + show ?B using *(2) by force +qed + +lemma transactions_have_no_Value_consts': + assumes "admissible_transaction T" + and "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" + shows "\a T. Fun (Val a) T \ subterms t" + and "\a T. Fun (Abs a) T \ subterms t" +using transactions_have_no_Value_consts[OF assms(1)] assms(2) by fast+ + +lemma transactions_have_no_PubConsts: + assumes "admissible_transaction T" + and "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))" + shows "\a T. t = Fun (PubConstSetType a) T" (is ?A) + and "\a T. t = Fun (PubConstAttackType a) T" (is ?B) + and "\a T. t = Fun (PubConstBottom a) T" (is ?C) + and "\a T. t = Fun (PubConstOccursSecType a) T" (is ?D) +proof - + have "admissible_transaction_terms T" using assms(1) unfolding admissible_transaction_def by blast + hence "\is_PubConstSetType f" "\is_PubConstAttackType f" + "\is_PubConstBottom f" "\is_PubConstOccursSecType f" + when "f \ \(funs_term ` (trms_transaction T))" for f + using that unfolding admissible_transaction_terms_def by blast+ + moreover have "f \ \(funs_term ` (trms_transaction T))" + when "f \ funs_term t" for f + using that assms(2) funs_term_subterms_eq(2)[of "trms_transaction T"] by blast+ + ultimately have *: + "\is_PubConstSetType f" "\is_PubConstAttackType f" + "\is_PubConstBottom f" "\is_PubConstOccursSecType f" + when "f \ funs_term t" for f + using that by presburger+ + + show ?A using *(1) by force + show ?B using *(2) by force + show ?C using *(3) by force + show ?D using *(4) by force +qed + +lemma transactions_have_no_PubConsts': + assumes "admissible_transaction T" + and "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" + shows "\a T. Fun (PubConstSetType a) T \ subterms t" + and "\a T. Fun (PubConstAttackType a) T \ subterms t" + and "\a T. Fun (PubConstBottom a) T \ subterms t" + and "\a T. Fun (PubConstOccursSecType a) T \ subterms t" +using transactions_have_no_PubConsts[OF assms(1)] assms(2) by fast+ + +lemma transaction_inserts_are_Value_vars: + assumes T_valid: "wellformed_transaction T" + and "admissible_transaction_updates T" + and "insert\t,s\ \ set (unlabel (transaction_strand T))" + shows "\n. t = Var (TAtom Value, n)" + and "\u. s = Fun (Set u) []" +proof - + let ?x = "insert\t,s\" + + have "?x \ set (unlabel (transaction_updates T))" + using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x] + by (auto simp add: transaction_strand_def unlabel_def) + hence *: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value" + "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []" + "is_Set (the_Fun (the_set_term ?x))" + using assms(2) unfolding admissible_transaction_updates_def is_Fun_Set_def by fastforce+ + + show "\n. t = Var (TAtom Value, n)" using *(1,2) by (cases t) auto + show "\u. s = Fun (Set u) []" using *(3,4,5) unfolding is_Set_def by (cases s) auto +qed + +lemma transaction_deletes_are_Value_vars: + assumes T_valid: "wellformed_transaction T" + and "admissible_transaction_updates T" + and "delete\t,s\ \ set (unlabel (transaction_strand T))" + shows "\n. t = Var (TAtom Value, n)" + and "\u. s = Fun (Set u) []" +proof - + let ?x = "delete\t,s\" + + have "?x \ set (unlabel (transaction_updates T))" + using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x] + by (auto simp add: transaction_strand_def unlabel_def) + hence *: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value" + "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []" + "is_Set (the_Fun (the_set_term ?x))" + using assms(2) unfolding admissible_transaction_updates_def is_Fun_Set_def by fastforce+ + + show "\n. t = Var (TAtom Value, n)" using *(1,2) by (cases t) auto + show "\u. s = Fun (Set u) []" using *(3,4,5) unfolding is_Set_def by (cases s) auto +qed + +lemma transaction_selects_are_Value_vars: + assumes T_valid: "wellformed_transaction T" + and "admissible_transaction_selects T" + and "select\t,s\ \ set (unlabel (transaction_strand T))" + shows "\n. t = Var (TAtom Value, n) \ (TAtom Value, n) \ set (transaction_fresh T)" (is ?A) + and "\u. s = Fun (Set u) []" (is ?B) +proof - + let ?x = "select\t,s\" + + have *: "?x \ set (unlabel (transaction_selects T))" + using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x] + by (auto simp add: transaction_strand_def unlabel_def) + + have **: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value" + "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []" + "is_Set (the_Fun (the_set_term ?x))" + using * assms(2) unfolding admissible_transaction_selects_def is_Fun_Set_def by fastforce+ + + have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" + using * by force + hence ***: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \ set (transaction_fresh T) = {}" + using T_valid unfolding wellformed_transaction_def by fast + + show ?A using **(1,2) *** by (cases t) auto + show ?B using **(3,4,5) unfolding is_Set_def by (cases s) auto +qed + +lemma transaction_inset_checks_are_Value_vars: + assumes T_valid: "wellformed_transaction T" + and "admissible_transaction_checks T" + and "\t in s\ \ set (unlabel (transaction_strand T))" + shows "\n. t = Var (TAtom Value, n) \ (TAtom Value, n) \ set (transaction_fresh T)" (is ?A) + and "\u. s = Fun (Set u) []" (is ?B) +proof - + let ?x = "\t in s\" + + have *: "?x \ set (unlabel (transaction_checks T))" + using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x] + by (auto simp add: transaction_strand_def unlabel_def) + + have **: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value" + "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []" + "is_Set (the_Fun (the_set_term ?x))" + using * assms(2) unfolding admissible_transaction_checks_def is_Fun_Set_def by fastforce+ + + have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" + using * by force + hence ***: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \ set (transaction_fresh T) = {}" + using T_valid unfolding wellformed_transaction_def by fast + + show ?A using **(1,2) *** by (cases t) auto + show ?B using **(3,4,5) unfolding is_Set_def by (cases s) auto +qed + +lemma transaction_notinset_checks_are_Value_vars: + assumes T_valid: "wellformed_transaction T" + and "admissible_transaction_checks T" + and "\X\\\: F \\: G\ \ set (unlabel (transaction_strand T))" + and "(t,s) \ set G" + shows "\n. t = Var (TAtom Value, n) \ (TAtom Value, n) \ set (transaction_fresh T)" (is ?A) + and "\u. s = Fun (Set u) []" (is ?B) +proof - + let ?x = "\X\\\: F \\: G\" + + have 0: "?x \ set (unlabel (transaction_checks T))" + using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x] + by (auto simp add: transaction_strand_def unlabel_def) + hence 1: "F = [] \ length G = 1" + using assms(2,4) unfolding admissible_transaction_checks_def by fastforce + hence "hd G = (t,s)" using assms(4) by (cases "the_ins ?x") auto + hence **: "is_Var t" "fst (the_Var t) = TAtom Value" "is_Fun s" "args s = []" "is_Set (the_Fun s)" + using 0 1 assms(2) unfolding admissible_transaction_checks_def Let_def is_Fun_Set_def + by fastforce+ + + have "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" + "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x) \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" + using 0 by force+ + moreover have + "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" + "set (transaction_fresh T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}" + "set (transaction_fresh T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {}" + using T_valid unfolding wellformed_transaction_def by fast+ + ultimately have + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x \ set (transaction_fresh T) = {}" + "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p ?x) \ set (transaction_fresh T) = {}" + using wellformed_transaction_wf\<^sub>s\<^sub>s\<^sub>t(2,3)[OF T_valid] + fv_transaction_unfold[of T] bvars_transaction_unfold[of T] + by blast+ + hence ***: "fv t \ set (transaction_fresh T) = {}" + using assms(4) by auto + + show ?A using **(1,2) *** by (cases t) auto + show ?B using **(3,4,5) unfolding is_Set_def by (cases s) auto +qed + +lemma admissible_transaction_strand_step_cases: + assumes T_adm: "admissible_transaction T" + shows "r \ set (unlabel (transaction_receive T)) \ \t. r = receive\t\" + (is "?A \ ?A'") + and "r \ set (unlabel (transaction_selects T)) \ + \x s. r = select\Var x, Fun (Set s) []\ \ + fst x = TAtom Value \ x \ fv_transaction T - set (transaction_fresh T)" + (is "?B \ ?B'") + and "r \ set (unlabel (transaction_checks T)) \ + (\x s. (r = \Var x in Fun (Set s) []\ \ r = \Var x not in Fun (Set s) []\) \ + fst x = TAtom Value \ x \ fv_transaction T - set (transaction_fresh T)) \ + (\s t. r = \s == t\ \ r = \s != t\)" + (is "?C \ ?C'") + and "r \ set (unlabel (transaction_updates T)) \ + \x s. (r = insert\Var x, Fun (Set s) []\ \ r = delete\Var x, Fun (Set s) []\) \ + fst x = TAtom Value" + (is "?D \ ?D'") + and "r \ set (unlabel (transaction_send T)) \ \t. r = send\t\" + (is "?E \ ?E'") +proof - + have T_valid: "wellformed_transaction T" + using T_adm unfolding admissible_transaction_def by metis + + show "?A \ ?A'" + using T_valid Ball_set[of "unlabel (transaction_receive T)" is_Receive] + unfolding wellformed_transaction_def is_Receive_def + by blast + + show "?E \ ?E'" + using T_valid Ball_set[of "unlabel (transaction_send T)" is_Send] + unfolding wellformed_transaction_def is_Send_def + by blast + + show "?B \ ?B'" + proof - + assume r: ?B + have "admissible_transaction_selects T" + using T_adm unfolding admissible_transaction_def by simp + hence *: "is_InSet r" "the_check r = Assign" "is_Var (the_elem_term r)" + "is_Fun (the_set_term r)" "is_Set (the_Fun (the_set_term r))" + "args (the_set_term r) = []" "fst (the_Var (the_elem_term r)) = TAtom Value" + using r unfolding admissible_transaction_selects_def is_Fun_Set_def + by fast+ + + obtain rt rs where r': "r = select\rt,rs\" using *(1,2) by (cases r) auto + obtain x where x: "rt = Var x" "fst x = TAtom Value" using *(3,7) r' by auto + obtain f S where fS: "rs = Fun f S" using *(4) r' by auto + obtain s where s: "f = Set s" using *(5) fS r' by (cases f) auto + hence S: "S = []" using *(6) fS r' by (cases S) auto + + have fv_r1: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p r \ fv_transaction T" + using r fv_transaction_unfold[of T] by auto + + have fv_r2: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p r \ set (transaction_fresh T) = {}" + using r T_valid unfolding wellformed_transaction_def by fastforce + + show ?B' using r' x fS s S fv_r1 fv_r2 by simp + qed + + show "?C \ ?C'" + proof - + assume r: ?C + have adm_checks: "admissible_transaction_checks T" + using assms unfolding admissible_transaction_def by simp + + have fv_r1: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p r \ fv_transaction T" + using r fv_transaction_unfold[of T] by auto + + have fv_r2: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p r \ set (transaction_fresh T) = {}" + using r T_valid unfolding wellformed_transaction_def by fastforce + + have "(is_InSet r \ the_check r = Check) \ + (is_Equality r \ the_check r = Check) \ + is_NegChecks r" + using r adm_checks unfolding admissible_transaction_checks_def by fast + thus ?C' + proof (elim disjE conjE) + assume *: "is_InSet r" "the_check r = Check" + hence **: "is_Var (the_elem_term r)" "is_Fun (the_set_term r)" + "is_Set (the_Fun (the_set_term r))" "args (the_set_term r) = []" + "fst (the_Var (the_elem_term r)) = TAtom Value" + using r adm_checks unfolding admissible_transaction_checks_def is_Fun_Set_def + by fast+ + + obtain rt rs where r': "r = \rt in rs\" using * by (cases r) auto + obtain x where x: "rt = Var x" "fst x = TAtom Value" using **(1,5) r' by auto + obtain f S where fS: "rs = Fun f S" using **(2) r' by auto + obtain s where s: "f = Set s" using **(3) fS r' by (cases f) auto + hence S: "S = []" using **(4) fS r' by auto + + show ?C' using r' x fS s S fv_r1 fv_r2 by simp + next + assume *: "is_NegChecks r" + hence **: "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p r = []" + "(the_eqs r = [] \ length (the_ins r) = 1) \ + (the_ins r = [] \ length (the_eqs r) = 1)" + using r adm_checks unfolding admissible_transaction_checks_def by fast+ + show ?C' using **(2) + proof (elim disjE conjE) + assume ***: "the_eqs r = []" "length (the_ins r) = 1" + then obtain t s where ts: "the_ins r = [(t,s)]" by (cases "the_ins r") auto + hence "hd (the_ins r) = (t,s)" by simp + hence ****: "is_Var (fst (t,s))" "is_Fun (snd (t,s))" + "is_Set (the_Fun (snd (t,s)))" "args (snd (t,s)) = []" + "fst (the_Var (fst (t,s))) = TAtom Value" + using r adm_checks * ***(1) unfolding admissible_transaction_checks_def is_Fun_Set_def + by metis+ + obtain x where x: "t = Var x" "fst x = TAtom Value" using ts ****(1,5) by (cases t) simp_all + obtain f S where fS: "s = Fun f S" using ts ****(2) by (cases s) simp_all + obtain ss where ss: "f = Set ss" using fS ****(3) by (cases f) simp_all + have S: "S = []" using ts fS ss ****(4) by simp + + show ?C' using ts x fS ss S *** **(1) * fv_r1 fv_r2 by (cases r) auto + next + assume ***: "the_ins r = []" "length (the_eqs r) = 1" + then obtain t s where "the_eqs r = [(t,s)]" by (cases "the_eqs r") auto + thus ?C' using *** **(1) * by (cases r) auto + qed + qed (auto simp add: is_Equality_def the_check_def) + qed + + show "?D \ ?D'" + proof - + assume r: ?D + have adm_upds: "admissible_transaction_updates T" + using assms unfolding admissible_transaction_def by simp + + have *: "is_Update r" "is_Var (the_elem_term r)" "is_Fun (the_set_term r)" + "is_Set (the_Fun (the_set_term r))" "args (the_set_term r) = []" + "fst (the_Var (the_elem_term r)) = TAtom Value" + using r adm_upds unfolding admissible_transaction_updates_def is_Fun_Set_def by fast+ + + obtain t s where ts: "r = insert\t,s\ \ r = delete\t,s\" using *(1) by (cases r) auto + obtain x where x: "t = Var x" "fst x = TAtom Value" using ts *(2,6) by (cases t) auto + obtain f T where fT: "s = Fun f T" using ts *(3) by (cases s) auto + obtain ss where ss: "f = Set ss" using ts fT *(4) by (cases f) fastforce+ + have T: "T = []" using ts fT *(5) ss by (cases T) auto + + show ?D' + using ts x fT ss T by blast + qed +qed + +lemma transaction_Value_vars_are_fv: + assumes "admissible_transaction T" + and "x \ vars_transaction T" + and "\\<^sub>v x = TAtom Value" + shows "x \ fv_transaction T" +using assms \\<^sub>v_TAtom''(2)[of x] vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"] +unfolding admissible_transaction_def by fast + +lemma protocol_transaction_vars_TAtom_typed: + assumes P: "admissible_transaction T" + shows "\x \ vars_transaction T. \\<^sub>v x = TAtom Value \ (\a. \\<^sub>v x = TAtom (Atom a))" + and "\x \ fv_transaction T. \\<^sub>v x = TAtom Value \ (\a. \\<^sub>v x = TAtom (Atom a))" + and "\x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" +proof - + have P': "wellformed_transaction T" + using P unfolding admissible_transaction_def by fast + + show "\x \ vars_transaction T. \\<^sub>v x = TAtom Value \ (\a. \\<^sub>v x = TAtom (Atom a))" + using P \\<^sub>v_TAtom'' + unfolding admissible_transaction_def is_Var_def prot_atom.is_Atom_def the_Var_def + by fastforce + thus "\x \ fv_transaction T. \\<^sub>v x = TAtom Value \ (\a. \\<^sub>v x = TAtom (Atom a))" + using vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t by fast + + have "list_all (\x. fst x = Var Value) (transaction_fresh T)" + using P \\<^sub>v_TAtom'' unfolding admissible_transaction_def by fast + thus "\x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + using \\<^sub>v_TAtom''(2) unfolding list_all_iff by fast +qed + +lemma protocol_transactions_no_pubconsts: + assumes "admissible_transaction T" + shows "Fun (Val (n,True)) S \ subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)" +using assms transactions_have_no_Value_consts(1) +by fast + +lemma protocol_transactions_no_abss: + assumes "admissible_transaction T" + shows "Fun (Abs n) S \ subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)" +using assms transactions_have_no_Value_consts(2) +by fast + +lemma admissible_transaction_strand_sem_fv_ineq: + assumes T_adm: "admissible_transaction T" + and \: "strand_sem_stateful IK DB (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \" + and x: "x \ fv_transaction T - set (transaction_fresh T)" + and y: "y \ fv_transaction T - set (transaction_fresh T)" + and x_not_y: "x \ y" + shows "\ x \ \ \ \ y \ \" +proof - + have "\Var x != Var y\ \ set (unlabel (transaction_checks T)) \ + \Var y != Var x\ \ set (unlabel (transaction_checks T))" + using x y x_not_y T_adm unfolding admissible_transaction_def by auto + hence "\Var x != Var y\ \ set (unlabel (transaction_strand T)) \ + \Var y != Var x\ \ set (unlabel (transaction_strand T))" + unfolding transaction_strand_def unlabel_def by auto + hence "\\ x != \ y\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \ + \\ y != \ x\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)))" + using stateful_strand_step_subst_inI(8)[of _ _ "unlabel (transaction_strand T)" \] + subst_lsst_unlabel[of "transaction_strand T" \] + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(7)[of "[]" _ "[]"] + by force + then obtain B where B: + "prefix (B@[\\ x != \ y\]) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \ + prefix (B@[\\ y != \ x\]) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)))" + unfolding prefix_def + by (metis (no_types, hide_lams) append.assoc append_Cons append_Nil split_list) + thus ?thesis + using \ strand_sem_append_stateful[of IK DB _ _ \] + stateful_strand_sem_NegChecks_no_bvars(2) + unfolding prefix_def + by metis +qed + +lemma admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: + assumes "admissible_transaction T" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)" +by (metis wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code assms admissible_transaction_def admissible_transaction_terms_def) + +lemma admissible_transaction_no_Ana_Attack: + assumes "admissible_transaction_terms T" + and "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms_transaction T)" + shows "attack\n\ \ set (snd (Ana t))" +proof - + obtain r where r: "r \ set (unlabel (transaction_strand T))" "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r)" + using assms(2) by force + + obtain K M where t: "Ana t = (K, M)" + by (metis surj_pair) + + show ?thesis + proof + assume n: "attack\n\ \ set (snd (Ana t))" + hence "attack\n\ \ set M" using t by simp + hence n': "attack\n\ \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r)" + using Ana_subterm[OF t] r(2) subterms_subset by fast + hence "\f \ \(funs_term ` trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r). is_Attack f" + using funs_term_Fun_subterm' unfolding is_Attack_def by fast + hence "is_Send r" "is_Fun (the_msg r)" "is_Attack (the_Fun (the_msg r))" "args (the_msg r) = []" + using assms(1) r(1) unfolding admissible_transaction_terms_def by metis+ + hence "t = attack\n\" + using n' r(2) unfolding is_Send_def is_Attack_def by auto + thus False using n by fastforce + qed +qed + +lemma admissible_transaction_occurs_fv_types: + assumes "admissible_transaction T" + and "x \ vars_transaction T" + shows "\a. \ (Var x) = TAtom a \ \ (Var x) \ TAtom OccursSecType" +proof - + have "is_Var (fst x)" "the_Var (fst x) = Value" + using assms unfolding admissible_transaction_def by blast+ + thus ?thesis using \\<^sub>v_TAtom''(2)[of x] by force +qed + +lemma admissible_transaction_Value_vars: + assumes T: "admissible_transaction T" + and x: "x \ fv_transaction T" + shows "\\<^sub>v x = TAtom Value" +proof - + have "x \ vars_transaction T" + using x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"] + by blast + hence "is_Var (fst x)" "the_Var (fst x) = Value" + using T assms unfolding admissible_transaction_def list_all_iff by fast+ + thus "\\<^sub>v x = TAtom Value" using \\<^sub>v_TAtom''(2)[of x] by force +qed + + +subsection \Lemmata: Renaming and Fresh Substitutions\ +lemma transaction_renaming_subst_is_renaming: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_renaming_subst \ P A" + shows "\m. \ (\,n) = Var (\,n+Suc m)" +using assms by (auto simp add: transaction_renaming_subst_def var_rename_def) + +lemma transaction_renaming_subst_is_renaming': + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_renaming_subst \ P A" + shows "\y. \ x = Var y" +using assms by (auto simp add: transaction_renaming_subst_def var_rename_def) + +lemma transaction_renaming_subst_vars_disj: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_renaming_subst \ P A" + shows "fv\<^sub>s\<^sub>e\<^sub>t (\ ` (\(vars_transaction ` set P))) \ (\(vars_transaction ` set P)) = {}" (is ?A) + and "fv\<^sub>s\<^sub>e\<^sub>t (\ ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = {}" (is ?B) + and "T \ set P \ vars_transaction T \ range_vars \ = {}" (is "T \ set P \ ?C1") + and "T \ set P \ bvars_transaction T \ range_vars \ = {}" (is "T \ set P \ ?C2") + and "T \ set P \ fv_transaction T \ range_vars \ = {}" (is "T \ set P \ ?C3") + and "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ range_vars \ = {}" (is ?D1) + and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ range_vars \ = {}" (is ?D2) + and "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ range_vars \ = {}" (is ?D3) +proof - + define X where "X \ \(vars_transaction ` set P) \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + + have 1: "finite X" by (simp add: X_def) + + obtain n where n: "n \ max_var_set X" "\ = var_rename n" + using assms unfolding transaction_renaming_subst_def X_def by moura + hence 2: "\x \ X. snd x < Suc n" + using less_Suc_max_var_set[OF _ 1] unfolding var_rename_def by fastforce + + have 3: "x \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` X)" "fv (\ x) \ X = {}" "x \ range_vars \" when x: "x \ X" for x + using 2 x n unfolding var_rename_def by force+ + + show ?A ?B using 3(1,2) unfolding X_def by auto + + show ?C1 when T: "T \ set P" using T 3(3) unfolding X_def by blast + thus ?C2 ?C3 when T: "T \ set P" + using T by (simp_all add: disjoint_iff_not_equal vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t) + + show ?D1 using 3(3) unfolding X_def by auto + thus ?D2 ?D3 by (simp_all add: disjoint_iff_not_equal vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t) +qed + +lemma transaction_renaming_subst_wt: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_renaming_subst \ P A" + shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" +proof - + { fix x::"('fun,'atom,'sets) prot_var" + obtain \ n where x: "x = (\,n)" by moura + then obtain m where m: "\ x = Var (\,m)" + using assms transaction_renaming_subst_is_renaming by moura + hence "\ (\ x) = \\<^sub>v x" using x by (simp add: \\<^sub>v_def) + } thus ?thesis by (simp add: wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) +qed + +lemma transaction_renaming_subst_is_wf_trm: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_renaming_subst \ P A" + shows "wf\<^sub>t\<^sub>r\<^sub>m (\ v)" +proof - + obtain \ n where "v = (\, n)" by moura + then obtain m where "\ v = Var (\, n + Suc m)" + using transaction_renaming_subst_is_renaming[OF assms] + by moura + thus ?thesis by (metis wf_trm_Var) +qed + +lemma transaction_renaming_subst_range_wf_trms: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_renaming_subst \ P A" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +by (metis transaction_renaming_subst_is_wf_trm[OF assms] wf_trm_subst_range_iff) + +lemma transaction_renaming_subst_range_notin_vars: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_renaming_subst \ P \" + shows "\y. \ x = Var y \ y \ \(vars_transaction ` set P) \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" +proof - + obtain \ n where x: "x = (\,n)" by (metis surj_pair) + + define y where "y \ \m. (\,n+Suc m)" + + have "\m \ max_var_set (\(vars_transaction ` set P) \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \). \ x = Var (y m)" + using assms x by (auto simp add: y_def transaction_renaming_subst_def var_rename_def) + moreover have "finite (\(vars_transaction ` set P) \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" by auto + ultimately show ?thesis using x unfolding y_def by force +qed + +lemma transaction_renaming_subst_var_obtain: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes x: "x \ fv\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + and \: "transaction_renaming_subst \ P \" + shows "\y. \ y = Var x" +proof - + obtain y where y: "y \ fv\<^sub>s\<^sub>s\<^sub>t S" "x \ fv (\ y)" using fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var[OF x] by moura + thus ?thesis using transaction_renaming_subst_is_renaming'[OF \, of y] by fastforce +qed + +lemma transaction_fresh_subst_is_wf_trm: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T A" + shows "wf\<^sub>t\<^sub>r\<^sub>m (\ v)" +proof (cases "v \ subst_domain \") + case True + then obtain n where "\ v = Fun (Val n) []" + using assms unfolding transaction_fresh_subst_def + by moura + thus ?thesis by auto +qed auto + +lemma transaction_fresh_subst_wt: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T A" + and "\x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" +proof - + have 1: "subst_domain \ = set (transaction_fresh T)" + and 2: "\t \ subst_range \. \n. t = Fun (Val n) []" + using assms(1) unfolding transaction_fresh_subst_def by metis+ + + { fix x::"('fun,'atom,'sets) prot_var" + have "\ (Var x) = \ (\ x)" using assms(2) 1 2 by (cases "x \ subst_domain \") force+ + } thus ?thesis by (simp add: wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) +qed + +lemma transaction_fresh_subst_domain: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T \" + shows "subst_domain \ = set (transaction_fresh T)" +using assms unfolding transaction_fresh_subst_def by fast + +lemma transaction_fresh_subst_range_wf_trms: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T \" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +by (metis transaction_fresh_subst_is_wf_trm[OF assms] wf_trm_subst_range_iff) + +lemma transaction_fresh_subst_range_fresh: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T \" + shows "\t \ subst_range \. t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + and "\t \ subst_range \. t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))" +using assms unfolding transaction_fresh_subst_def by meson+ + +lemma transaction_fresh_subst_sends_to_val: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T \" + and "y \ set (transaction_fresh T)" + obtains n where "\ y = Fun (Val n) []" "Fun (Val n) [] \ subst_range \" +proof - + have "\ y \ subst_range \" using assms unfolding transaction_fresh_subst_def by simp + thus ?thesis + using assms that unfolding transaction_fresh_subst_def + by fastforce +qed + +lemma transaction_fresh_subst_sends_to_val': + fixes \ \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T \" + and "y \ set (transaction_fresh T)" + obtains n where "(\ \\<^sub>s \) y \ \ = Fun (Val n) []" "Fun (Val n) [] \ subst_range \" +proof - + obtain n where "\ y = Fun (Val n) []" "Fun (Val n) [] \ subst_range \" + using transaction_fresh_subst_sends_to_val[OF assms] by moura + thus ?thesis using that by (fastforce simp add: subst_compose_def) +qed + +lemma transaction_fresh_subst_grounds_domain: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T \" + and "y \ set (transaction_fresh T)" + shows "fv (\ y) = {}" +proof - + obtain n where "\ y = Fun (Val n) []" + using transaction_fresh_subst_sends_to_val[OF assms] + by moura + thus ?thesis by simp +qed + +lemma transaction_fresh_subst_transaction_renaming_subst_range: + fixes \ \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T \" "transaction_renaming_subst \ P \" + shows "x \ set (transaction_fresh T) \ \n. (\ \\<^sub>s \) x = Fun (Val (n,False)) []" + and "x \ set (transaction_fresh T) \ \y. (\ \\<^sub>s \) x = Var y" +proof - + assume "x \ set (transaction_fresh T)" + then obtain n where "\ x = Fun (Val (n,False)) []" + using assms(1) unfolding transaction_fresh_subst_def by fastforce + thus "\n. (\ \\<^sub>s \) x = Fun (Val (n,False)) []" using subst_compose[of \ \ x] by simp +next + assume "x \ set (transaction_fresh T)" + hence "\ x = Var x" + using assms(1) unfolding transaction_fresh_subst_def by fastforce + thus "\y. (\ \\<^sub>s \) x = Var y" + using transaction_renaming_subst_is_renaming[OF assms(2)] subst_compose[of \ \ x] + by (cases x) force +qed + +lemma transaction_fresh_subst_transaction_renaming_subst_range': + fixes \ \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T \" "transaction_renaming_subst \ P \" + and "t \ subst_range (\ \\<^sub>s \)" + shows "(\n. t = Fun (Val (n,False)) []) \ (\x. t = Var x)" +proof - + obtain x where "x \ subst_domain (\ \\<^sub>s \)" "(\ \\<^sub>s \) x = t" + using assms(3) by auto + thus ?thesis + using transaction_fresh_subst_transaction_renaming_subst_range[OF assms(1,2), of x] + by auto +qed + +lemma transaction_fresh_subst_transaction_renaming_subst_range'': + fixes \ \::"('fun,'atom,'sets) prot_subst" + assumes s: "transaction_fresh_subst \ T \" "transaction_renaming_subst \ P \" + and y: "y \ fv ((\ \\<^sub>s \) x)" + shows "\ x = Var x" + and "\ x = Var y" + and "(\ \\<^sub>s \) x = Var y" +proof - + have "\z. z \ fv (\ x)" + using y subst_compose_fv' + by fast + hence x: "x \ subst_domain \" + using y transaction_fresh_subst_domain[OF s(1)] + transaction_fresh_subst_grounds_domain[OF s(1), of x] + by blast + thus "\ x = Var x" by blast + thus "\ x = Var y" "(\ \\<^sub>s \) x = Var y" + using y transaction_renaming_subst_is_renaming'[OF s(2), of x] + unfolding subst_compose_def by fastforce+ +qed + +lemma transaction_fresh_subst_transaction_renaming_subst_vars_subset: + fixes \ \::"('fun,'atom,'sets) prot_subst" + assumes \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + shows "\(fv_transaction ` set P) \ subst_domain (\ \\<^sub>s \)" (is ?A) + and "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ subst_domain (\ \\<^sub>s \)" (is ?B) + and "T' \ set P \ fv_transaction T' \ subst_domain (\ \\<^sub>s \)" (is "T' \ set P \ ?C") + and "T' \ set P \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T' \\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ \\<^sub>s \)) \ range_vars (\ \\<^sub>s \)" + (is "T' \ set P \ ?D") +proof - + have *: "x \ subst_domain (\ \\<^sub>s \)" for x + proof (cases "x \ subst_domain \") + case True + hence "x \ {x. \y. \ x = Var y \ \ y = Var x}" + using transaction_fresh_subst_domain[OF \] + transaction_fresh_subst_grounds_domain[OF \, of x] + by auto + thus ?thesis using subst_domain_subst_compose[of \ \] by blast + next + case False + hence "(\ \\<^sub>s \) x = \ x" unfolding subst_compose_def by fastforce + moreover have "\ x \ Var x" + using transaction_renaming_subst_is_renaming[OF \, of "fst x" "snd x"] by (cases x) auto + ultimately show ?thesis by fastforce + qed + + show ?A ?B using * by blast+ + + show ?C when T: "T' \ set P" using T * by blast + hence "fv\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T') \\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \) \ range_vars (\ \\<^sub>s \)" + when T: "T' \ set P" + using T fv\<^sub>s\<^sub>s\<^sub>t_subst_subset_range_vars_if_subset_domain by blast + thus ?D when T: "T' \ set P" by (metis T unlabel_subst) +qed + +lemma transaction_fresh_subst_transaction_renaming_subst_vars_disj: + fixes \ \::"('fun,'atom,'sets) prot_subst" + assumes \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + shows "fv\<^sub>s\<^sub>e\<^sub>t ((\ \\<^sub>s \) ` (\(vars_transaction ` set P))) \ (\(vars_transaction ` set P)) = {}" + (is ?A) + and "x \ \(vars_transaction ` set P) \ fv ((\ \\<^sub>s \) x) \ (\(vars_transaction ` set P)) = {}" + (is "?B' \ ?B") + and "T' \ set P \ vars_transaction T' \ range_vars (\ \\<^sub>s \) = {}" (is "T' \ set P \ ?C1") + and "T' \ set P \ bvars_transaction T' \ range_vars (\ \\<^sub>s \) = {}" (is "T' \ set P \ ?C2") + and "T' \ set P \ fv_transaction T' \ range_vars (\ \\<^sub>s \) = {}" (is "T' \ set P \ ?C3") + and "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ range_vars (\ \\<^sub>s \) = {}" (is ?D1) + and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ range_vars (\ \\<^sub>s \) = {}" (is ?D2) + and "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ range_vars (\ \\<^sub>s \) = {}" (is ?D3) +proof - + note 0 = transaction_renaming_subst_vars_disj[OF \] + + show ?A + proof (cases "fv\<^sub>s\<^sub>e\<^sub>t ((\ \\<^sub>s \) ` (\(vars_transaction ` set P))) = {}") + case False + hence "\x \ (\(vars_transaction ` set P)). (\ \\<^sub>s \) x = \ x \ fv ((\ \\<^sub>s \) x) = {}" + using transaction_fresh_subst_transaction_renaming_subst_range''[OF \ \] by auto + thus ?thesis using 0(1) by force + qed blast + thus "?B' \ ?B" by auto + + have 1: "range_vars (\ \\<^sub>s \) \ range_vars \" + using range_vars_subst_compose_subset[of \ \] + transaction_fresh_subst_domain[OF \] + transaction_fresh_subst_grounds_domain[OF \] + by force + + show ?C1 ?C2 ?C3 when T: "T' \ set P" using T 1 0(3,4,5)[of T'] by blast+ + + show ?D1 ?D2 ?D3 using 1 0(6,7,8) by blast+ +qed + +lemma transaction_fresh_subst_transaction_renaming_subst_trms: + fixes \ \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T \" "transaction_renaming_subst \ P \" + and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ subst_domain \ = {}" + and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ subst_domain \ = {}" + shows "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ \\<^sub>s \))) = subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \\<^sub>s\<^sub>e\<^sub>t (\ \\<^sub>s \)" +proof - + have 1: "\x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S). (\f. (\ \\<^sub>s \) x = Fun f []) \ (\y. (\ \\<^sub>s \) x = Var y)" + using transaction_fresh_subst_transaction_renaming_subst_range[OF assms(1,2)] by blast + + have 2: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ subst_domain (\ \\<^sub>s \) = {}" + using assms(3,4) subst_domain_compose[of \ \] by blast + + show ?thesis using subterms_subst_lsst[OF 1 2] by simp +qed + +lemma transaction_fresh_subst_transaction_renaming_wt: + fixes \ \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T \" "transaction_renaming_subst \ P \" + and "\x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" +using transaction_renaming_subst_wt[OF assms(2)] + transaction_fresh_subst_wt[OF assms(1,3)] +by (metis wt_subst_compose) + +lemma transaction_fresh_subst_transaction_renaming_fv: + fixes \ \::"('fun,'atom,'sets) prot_subst" + assumes \: "transaction_fresh_subst \ T A" + and \: "transaction_renaming_subst \ P A" + and x: "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + shows "\y \ fv_transaction T - set (transaction_fresh T). (\ \\<^sub>s \) y = Var x" +proof - + have "x \ fv\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + using x fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + by argo + then obtain y where "y \ fv_transaction T" "x \ fv ((\ \\<^sub>s \) y)" + by (metis fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var) + thus ?thesis + using transaction_fresh_subst_transaction_renaming_subst_range[OF \ \, of y] + by (cases "y \ set (transaction_fresh T)") force+ +qed + +lemma transaction_fresh_subst_transaction_renaming_subst_occurs_fact_send_receive: + fixes t::"('fun,'atom,'sets) prot_term" + assumes \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + and T: "wellformed_transaction T" + shows "send\occurs t\ \ set (unlabel (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) + \ \s. send\occurs s\ \ set (unlabel (transaction_send T)) \ t = s \ \ \\<^sub>s \" + (is "?A \ ?A'") + and "receive\occurs t\ \ set (unlabel (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) + \ \s. receive\occurs s\ \ set (unlabel (transaction_receive T)) \ t = s \ \ \\<^sub>s \" + (is "?B \ ?B'") +proof - + assume ?A + then obtain s where s: "send\s\ \ set (unlabel (transaction_strand T))" "occurs t = s \ \ \\<^sub>s \" + using stateful_strand_step_subst_inv_cases(1)[ + of "occurs t" "unlabel (transaction_strand T)" "\ \\<^sub>s \"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + by auto + + note 0 = s(2) transaction_fresh_subst_transaction_renaming_subst_range[OF \ \] + + have "\u. s = occurs u" + proof (cases s) + case (Var x) + hence "(\n. s \ \ \\<^sub>s \ = Fun (Val (n, False)) []) \ (\y. s \ \ \\<^sub>s \ = Var y)" + using 0(2,3)[of x] by (auto simp del: subst_subst_compose) + thus ?thesis + using 0(1) by simp + next + case (Fun f T) + hence 1: "f = OccursFact" "length T = 2" "T ! 0 \ \ \\<^sub>s \ = Fun OccursSec []" "T ! 1 \ \ \\<^sub>s \ = t" + using 0(1) by auto + have "T ! 0 = Fun OccursSec []" + proof (cases "T ! 0") + case (Var x) thus ?thesis using 0(2,3)[of x] 1(3) by (auto simp del: subst_subst_compose) + qed (use 1(3) in simp) + thus ?thesis using Fun 1 0(1) by (auto simp del: subst_subst_compose) + qed + then obtain u where u: "s = occurs u" by moura + hence "t = u \ \ \\<^sub>s \" using s(2) by fastforce + thus ?A' using s u wellformed_transaction_strand_unlabel_memberD(8)[OF T] by metis +next + assume ?B + then obtain s where s: "receive\s\ \ set (unlabel (transaction_strand T))" "occurs t = s \ \ \\<^sub>s \" + using stateful_strand_step_subst_inv_cases(2)[ + of "occurs t" "unlabel (transaction_strand T)" "\ \\<^sub>s \"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + by auto + + note 0 = s(2) transaction_fresh_subst_transaction_renaming_subst_range[OF \ \] + + have "\u. s = occurs u" + proof (cases s) + case (Var x) + hence "(\n. s \ \ \\<^sub>s \ = Fun (Val (n, False)) []) \ (\y. s \ \ \\<^sub>s \ = Var y)" + using 0(2,3)[of x] by (auto simp del: subst_subst_compose) + thus ?thesis + using 0(1) by simp + next + case (Fun f T) + hence 1: "f = OccursFact" "length T = 2" "T ! 0 \ \ \\<^sub>s \ = Fun OccursSec []" "T ! 1 \ \ \\<^sub>s \ = t" + using 0(1) by auto + have "T ! 0 = Fun OccursSec []" + proof (cases "T ! 0") + case (Var x) thus ?thesis using 0(2,3)[of x] 1(3) by (auto simp del: subst_subst_compose) + qed (use 1(3) in simp) + thus ?thesis using Fun 1 0(1) by (auto simp del: subst_subst_compose) + qed + then obtain u where u: "s = occurs u" by moura + hence "t = u \ \ \\<^sub>s \" using s(2) by fastforce + thus ?B' using s u wellformed_transaction_strand_unlabel_memberD(1)[OF T] by metis +qed + +lemma transaction_fresh_subst_proj: + assumes "transaction_fresh_subst \ T A" + shows "transaction_fresh_subst \ (transaction_proj n T) (proj n A)" +using assms transaction_proj_fresh_eq[of n T] + contra_subsetD[OF subterms\<^sub>s\<^sub>e\<^sub>t_mono[OF transaction_proj_trms_subset[of n T]]] + contra_subsetD[OF subterms\<^sub>s\<^sub>e\<^sub>t_mono[OF trms\<^sub>s\<^sub>s\<^sub>t_proj_subset(1)[of n A]]] +unfolding transaction_fresh_subst_def by metis + +lemma transaction_renaming_subst_proj: + assumes "transaction_renaming_subst \ P A" + shows "transaction_renaming_subst \ (map (transaction_proj n) P) (proj n A)" +proof - + let ?X = "\P A. \(vars_transaction ` set P) \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + define Y where "Y \ ?X (map (transaction_proj n) P) (proj n A)" + define Z where "Z \ ?X P A" + + have "Y \ Z" + using sst_vars_proj_subset(3)[of n A] transaction_proj_vars_subset[of n] + unfolding Y_def Z_def by fastforce + hence "insert 0 (snd ` Y) \ insert 0 (snd ` Z)" by blast + moreover have "finite (insert 0 (snd ` Z))" "finite (insert 0 (snd ` Y))" + unfolding Y_def Z_def by auto + ultimately have 0: "max_var_set Y \ max_var_set Z" using Max_mono by blast + + have "\n\max_var_set Z. \ = var_rename n" + using assms unfolding transaction_renaming_subst_def Z_def by blast + hence "\n\max_var_set Y. \ = var_rename n" using 0 le_trans by fast + thus ?thesis unfolding transaction_renaming_subst_def Y_def by blast +qed + +lemma protocol_transaction_wf_subst: + fixes \ \::"('fun,'atom,'sets) prot_subst" + assumes T: "wf'\<^sub>s\<^sub>s\<^sub>t (set (transaction_fresh T)) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))" + and \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + shows "wf'\<^sub>s\<^sub>s\<^sub>t {} (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)))" +proof - + have 0: "range_vars \ \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) = {}" + "ground (\ ` set (transaction_fresh T))" "ground (\ ` {})" + using transaction_fresh_subst_domain[OF \] transaction_fresh_subst_grounds_domain[OF \] + by fastforce+ + + have "wf'\<^sub>s\<^sub>s\<^sub>t {} ((unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) \\<^sub>s\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>s\<^sub>t \)" + by (metis wf\<^sub>s\<^sub>s\<^sub>t_subst_apply[OF wf\<^sub>s\<^sub>s\<^sub>t_subst_apply[OF T]] 0(2,3)) + thus ?thesis + by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst labeled_stateful_strand_subst_comp[OF 0(1)]) +qed + + +subsection \Lemmata: Reachable Constraints\ +lemma reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: + assumes "\T \ set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)" + and "\ \ reachable_constraints P" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using assms(2) +proof (induction \ rule: reachable_constraints.induct) + case (step \ T \ \) + have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)" + using assms(1) step.hyps(2) by blast + moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + using wf_trms_subst_compose[of \ \] + transaction_renaming_subst_range_wf_trms[OF step.hyps(4)] + transaction_fresh_subst_range_wf_trms[OF step.hyps(3)] + by fastforce + ultimately have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \)" by (metis wf_trms_subst) + hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + using wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_trms\<^sub>s\<^sub>s\<^sub>t_subst unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] by metis + hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)))" + using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq by blast + thus ?case using step.IH unlabel_append[of \] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \"] by auto +qed simp + +lemma reachable_constraints_TAtom_types: + assumes "\ \ reachable_constraints P" + and "\T \ set P. \x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + shows "\\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ (\T \ set P. \\<^sub>v ` fv_transaction T)" (is "?A \") + and "\\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ (\T \ set P. \\<^sub>v ` bvars_transaction T)" (is "?B \") + and "\\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ (\T \ set P. \\<^sub>v ` vars_transaction T)" (is "?C \") +using assms(1) +proof (induction \ rule: reachable_constraints.induct) + case (step \ T \ \) + define T' where "T' \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + + have 2: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" + using transaction_renaming_subst_wt[OF step.hyps(4)] + transaction_fresh_subst_wt[OF step.hyps(3)] + by (metis step.hyps(2) assms(2) wt_subst_compose) + + have 3: "\t \ subst_range (\ \\<^sub>s \). fv t = {} \ (\x. t = Var x)" + using transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)] + by fastforce + + have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + unfolding T'_def + by (metis fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq, + metis bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq, + metis vars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq) + hence "\ ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ \ ` Var ` fv_transaction T" + "\ ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = \ ` Var ` bvars_transaction T" + "\ ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ \ ` Var ` vars_transaction T" + using wt_subst_lsst_vars_type_subset[OF 2 3, of "transaction_strand T"] + by argo+ + hence "\\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ \\<^sub>v ` fv_transaction T" + "\\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = \\<^sub>v ` bvars_transaction T" + "\\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ \\<^sub>v ` vars_transaction T" + by (metis \\<^sub>v_Var_image)+ + hence 4: "\\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ (\T \ set P. \\<^sub>v ` fv_transaction T)" + "\\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ (\T \ set P. \\<^sub>v ` bvars_transaction T)" + "\\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ (\T \ set P. \\<^sub>v ` vars_transaction T)" + using step.hyps(2) by fast+ + + have 5: "\\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ @ T') = (\\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ (\\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" + "\\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ @ T') = (\\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ (\\<^sub>v ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" + "\\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ @ T') = (\\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ (\\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" + using unlabel_append[of \ T'] + fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel T'"] + bvars\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel T'"] + vars\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel T'"] + by auto + + { case 1 thus ?case + using step.IH(1) 4(1) 5(1) + unfolding T'_def by (simp del: subst_subst_compose fv\<^sub>s\<^sub>s\<^sub>t_def) + } + + { case 2 thus ?case + using step.IH(2) 4(2) 5(2) + unfolding T'_def by (simp del: subst_subst_compose bvars\<^sub>s\<^sub>s\<^sub>t_def) + } + + { case 3 thus ?case + using step.IH(3) 4(3) 5(3) + unfolding T'_def by (simp del: subst_subst_compose) + } +qed simp_all + +lemma reachable_constraints_no_bvars: + assumes \: "\ \ reachable_constraints P" + and P: "\T \ set P. bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = {}" + shows "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = {}" +using assms proof (induction) + case init + then show ?case + unfolding unlabel_def by auto +next + case (step \ T \ \) + then have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = {}" + by metis + moreover + have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) = {}" + using step by (metis bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq) + ultimately + show ?case + using bvars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append by (metis sup_bot.left_neutral) +qed + +lemma reachable_constraints_fv_bvars_disj: + assumes \_reach: "\ \ reachable_constraints P" + and P: "\S \ set P. admissible_transaction S" + shows "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = {}" +proof - + let ?X = "\T \ set P. bvars_transaction T" + + note 0 = transactions_fv_bvars_disj[OF P] + + have 1: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ ?X" using \_reach + proof (induction \ rule: reachable_constraints.induct) + case (step \ T \ \) + have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) = bvars_transaction T" + using bvars\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel (transaction_strand T)" "\ \\<^sub>s \"] + bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \"] + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" "\ \\<^sub>s \"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + by argo + hence "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) \ ?X" + using step.hyps(2) + by blast + thus ?case + using step.IH bvars\<^sub>s\<^sub>s\<^sub>t_append + by auto + qed (simp add: unlabel_def bvars\<^sub>s\<^sub>s\<^sub>t_def) + + have 2: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ ?X = {}" using \_reach + proof (induction \ rule: reachable_constraints.induct) + case (step \ T \ \) + have "x \ y" when x: "x \ ?X" and y: "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" for x y + proof - + obtain y' where y': "y' \ fv_transaction T" "y \ fv ((\ \\<^sub>s \) y')" + using y unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + by (metis fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var) + + have "y \ \(vars_transaction ` set P)" + using transaction_fresh_subst_transaction_renaming_subst_range''[OF step.hyps(3,4) y'(2)] + transaction_renaming_subst_range_notin_vars[OF step.hyps(4), of y'] + by auto + thus ?thesis using x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t by fast + qed + hence "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \) \ ?X = {}" + by blast + thus ?case + using step.IH + fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \"] + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" "\ \\<^sub>s \"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)"] + unlabel_append[of \ "transaction_strand T"] + by force + qed (simp add: unlabel_def fv\<^sub>s\<^sub>s\<^sub>t_def) + + show ?thesis using 0 1 2 by blast +qed + +lemma reachable_constraints_vars_TAtom_typed: + assumes \_reach: "\ \ reachable_constraints P" + and P: "\T \ set P. admissible_transaction T" + and x: "x \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" + shows "\\<^sub>v x = TAtom Value \ (\a. \\<^sub>v x = TAtom (Atom a))" +proof - + have \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P \_reach) + + have T_adm: "admissible_transaction T" when "T \ set P" for T + by (meson that Ball_set P) + + have "\T\set P. \x\set (transaction_fresh T). \\<^sub>v x = TAtom Value" + using protocol_transaction_vars_TAtom_typed(3) P by blast + hence *: "\\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ (\T\set P. \\<^sub>v ` vars_transaction T)" + using reachable_constraints_TAtom_types[of \ P, OF \_reach] by auto + + have "\\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ TAtom ` insert Value (range Atom)" + proof - + have "\\<^sub>v x = TAtom Value \ (\a. \\<^sub>v x = TAtom (Atom a))" + when "T \ set P" "x \ vars_transaction T" for T x + using that protocol_transaction_vars_TAtom_typed(1)[of T] P + unfolding admissible_transaction_def + by blast + hence "(\T\set P. \\<^sub>v ` vars_transaction T) \ TAtom ` insert Value (range Atom)" + using P by blast + thus "\\<^sub>v ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ TAtom ` insert Value (range Atom)" + using * by auto + qed + thus ?thesis using x by auto +qed + +lemma reachable_constraints_Value_vars_are_fv: + assumes \_reach: "\ \ reachable_constraints P" + and P: "\T \ set P. admissible_transaction T" + and x: "x \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" + and "\\<^sub>v x = TAtom Value" + shows "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" +proof - + have "\T\set P. bvars_transaction T = {}" + using P unfolding list_all_iff admissible_transaction_def by metis + hence \_no_bvars: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = {}" + using reachable_constraints_no_bvars[OF \_reach] by metis + thus ?thesis using x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \"] by blast +qed + +lemma reachable_constraints_subterms_subst: + assumes \_reach: "\ \ reachable_constraints P" + and \: "welltyped_constraint_model \ \" + and P: "\T \ set P. admissible_transaction T" + shows "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) = (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \\<^sub>s\<^sub>e\<^sub>t \" +proof - + have \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P \_reach) + + from \ have \': "welltyped_constraint_model \ \" + using welltyped_constraint_model_prefix by auto + + have 1: "\x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \). (\f. \ x = Fun f []) \ (\y. \ x = Var y)" + proof + fix x + assume xa: "x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + have "\f T. \ x = Fun f T" + using \ interpretation_grounds[of \ "Var x"] + unfolding welltyped_constraint_model_def constraint_model_def + by (cases "\ x") auto + then obtain f T where fT_p: "\ x = Fun f T" + by auto + hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" + using \ + unfolding welltyped_constraint_model_def constraint_model_def + using wf_trm_subst_rangeD + by metis + moreover + have "x \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" + using xa var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t[of x "unlabel \"] vars_iff_subtermeq[of x] + by auto + hence "\a. \\<^sub>v x = TAtom a" + using reachable_constraints_vars_TAtom_typed[OF \_reach P] by blast + hence "\a. \ (Var x) = TAtom a" + by simp + hence "\a. \ (Fun f T) = TAtom a" + by (metis (no_types, hide_lams) \' welltyped_constraint_model_def fT_p wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + ultimately show "(\f. \ x = Fun f []) \ (\y. \ x = Var y)" + using TAtom_term_cases fT_p by metis + qed + + have "\T\set P. bvars_transaction T = {}" + using assms unfolding list_all_iff admissible_transaction_def by metis + then have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = {}" + using reachable_constraints_no_bvars assms by metis + then have 2: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ subst_domain \ = {}" + by auto + + show ?thesis + using subterms_subst_lsst[OF _ 2] 1 + by simp +qed + +lemma reachable_constraints_val_funs_private: + assumes \_reach: "\ \ reachable_constraints P" + and P: "\T \ set P. admissible_transaction T" + and f: "f \ \(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + shows "is_Val f \ \public f" + and "\is_Abs f" +proof - + have "(is_Val f \ \public f) \ \is_Abs f" using \_reach f + proof (induction \ rule: reachable_constraints.induct) + case (step \ T \ \) + let ?T' = "unlabel (transaction_strand T) \\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \" + let ?T'' = "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \" + + have T: "admissible_transaction_terms T" + using P step.hyps(2) unfolding admissible_transaction_def by metis + + show ?thesis using step + proof (cases "f \ \(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)") + case False + then obtain t where t: "t \ trms\<^sub>s\<^sub>s\<^sub>t ?T'" "f \ funs_term t" + using step.prems trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of ?T''] + trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T'')"] + unlabel_append[of \ "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T''"] unlabel_subst[of "transaction_strand T"] + by fastforce + show ?thesis using trms\<^sub>s\<^sub>s\<^sub>t_funs_term_cases[OF t] + proof + assume "\u \ trms_transaction T. f \ funs_term u" + thus ?thesis using T unfolding admissible_transaction_terms_def by blast + next + assume "\x \ fv_transaction T. f \ funs_term ((\ \\<^sub>s \) x)" + then obtain x where "x \ fv_transaction T" "f \ funs_term ((\ \\<^sub>s \) x)" by moura + thus ?thesis + using transaction_fresh_subst_transaction_renaming_subst_range[OF step.hyps(3,4), of x] + by (force simp del: subst_subst_compose) + qed + qed simp + qed simp + thus "is_Val f \ \public f" "\is_Abs f" by simp_all +qed + +lemma reachable_constraints_occurs_fact_ik_case: + assumes \_reach: "A \ reachable_constraints P" + and P: "\T \ set P. admissible_transaction T" + and occ: "occurs t \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + shows "\n. t = Fun (Val (n,False)) []" +using \_reach occ +proof (induction A rule: reachable_constraints.induct) + case (step A T \ \) + define \ where "\ \ \ \\<^sub>s \" + + have T: "wellformed_transaction T" "admissible_transaction_occurs_checks T" + using P step.hyps(2) unfolding list_all_iff admissible_transaction_def by blast+ + + show ?case + proof (cases "occurs t \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A") + case False + hence "occurs t \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using step.prems unfolding \_def by simp + hence "receive\occurs t\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)))" + unfolding ik\<^sub>s\<^sub>s\<^sub>t_def by force + hence "send\occurs t\ \ set (unlabel (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(1) by blast + then obtain s where s: + "send\s\ \ set (unlabel (transaction_strand T))" "s \ \ = occurs t" + by (metis (no_types) stateful_strand_step_subst_inv_cases(1) unlabel_subst) + + note 0 = transaction_fresh_subst_transaction_renaming_subst_range[OF step.hyps(3,4)] + + have 1: "send\s\ \ set (unlabel (transaction_send T))" + using s(1) wellformed_transaction_strand_unlabel_memberD(8)[OF T(1)] by blast + + have 2: "is_Send (send\s\)" + unfolding is_Send_def by simp + + have 3: "\u. s = occurs u" + proof - + { fix z + have "(\n. \ z = Fun (Val (n, False)) []) \ (\y. \ z = Var y)" + using 0 + unfolding \_def + by blast + hence "\u. \ z = occurs u" "\ z \ Fun OccursSec []" by auto + } note * = this + + obtain u u' where T: "s = Fun OccursFact [u,u']" + using *(1) s(2) by (cases s) auto + thus ?thesis using *(2) s(2) by (cases u) auto + qed + + obtain x where x: "x \ set (transaction_fresh T)" "s = occurs (Var x)" + using T(2) 1 2 3 + unfolding admissible_transaction_occurs_checks_def + by fastforce + + have "t = \ x" + using s(2) x(2) by auto + thus ?thesis + using 0(1)[OF x(1)] unfolding \_def by fast + qed (simp add: step.IH) +qed simp + +lemma reachable_constraints_occurs_fact_send_ex: + assumes \_reach: "A \ reachable_constraints P" + and P: "\T \ set P. admissible_transaction T" + and x: "\\<^sub>v x = TAtom Value" "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + (* shows "\B. prefix B A \ x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \ send\occurs (Var x)\ \ set (unlabel A)" *) + shows "send\occurs (Var x)\ \ set (unlabel A)" +using \_reach x(2) +proof (induction A rule: reachable_constraints.induct) + case (step A T \ \) + have T: "admissible_transaction_occurs_checks T" + using P step.hyps(2) unfolding list_all_iff admissible_transaction_def by blast + + show ?case + proof (cases "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A") + case True + show ?thesis + using step.IH[OF True] unlabel_append[of A] + by auto + next + case False + then obtain y where y: "y \ fv_transaction T - set (transaction_fresh T)" "(\ \\<^sub>s \) y = Var x" + using transaction_fresh_subst_transaction_renaming_fv[OF step.hyps(3,4), of x] + step.prems(1) fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A"] unlabel_append[of A] + by auto + + have "\ y = Var y" using y(1) step.hyps(3) unfolding transaction_fresh_subst_def by auto + hence "\ y = Var x" using y(2) unfolding subst_compose_def by simp + hence y_val: "fst y = TAtom Value" + using x(1) \\<^sub>v_TAtom''[of x] \\<^sub>v_TAtom''[of y] + wt_subst_trm''[OF transaction_renaming_subst_wt[OF step.hyps(4)], of "Var y"] + by force + hence "receive\occurs (Var y)\ \ set (unlabel (transaction_receive T))" + using y(1) T unfolding admissible_transaction_occurs_checks_def by fast + hence *: "receive\occurs (Var y)\ \ set (unlabel (transaction_strand T))" + using transaction_strand_subsets(6) by blast + + have "receive\occurs (Var x)\ \ set (unlabel (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + using y(2) unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + stateful_strand_step_subst_inI(2)[OF *, of "\ \\<^sub>s \"] + by (auto simp del: subst_subst_compose) + hence "send\occurs (Var x)\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)))" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) by blast + thus ?thesis using unlabel_append[of A] by fastforce + qed +qed simp + +lemma reachable_constraints_db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_args_empty: + assumes \: "\ \ reachable_constraints P" + and PP: "list_all wellformed_transaction P" + and admissible_transaction_updates: + "let f = (\T. \x \ set (unlabel (transaction_updates T)). + is_Update x \ is_Var (the_elem_term x) \ is_Fun_Set (the_set_term x) \ + fst (the_Var (the_elem_term x)) = TAtom Value) + in list_all f P" + and d: "(t, s) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + shows "\ss. s = Fun (Set ss) []" + using \ d +proof (induction) + case (step \ TT \ \) + let ?TT = "transaction_strand TT \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \" + let ?TTu = "unlabel ?TT" + let ?TTd = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?TT" + let ?TTdu = "unlabel ?TTd" + from step(6) have "(t, s) \ set (db'\<^sub>s\<^sub>s\<^sub>t ?TTdu \ (db'\<^sub>s\<^sub>s\<^sub>t (unlabel \) \ []))" + unfolding db\<^sub>s\<^sub>s\<^sub>t_def by (simp add: db\<^sub>s\<^sub>s\<^sub>t_append) + hence "(t, s) \ set (db'\<^sub>s\<^sub>s\<^sub>t (unlabel \) \ []) \ + (\t' s'. insert\t',s'\ \ set ?TTdu \ t = t' \ \ \ s = s' \ \)" + using db\<^sub>s\<^sub>s\<^sub>t_in_cases[of t "s" ?TTdu \] by metis + thus ?case + proof + assume "\t' s'. insert\t',s'\ \ set ?TTdu \ t = t' \ \ \ s = s' \ \" + then obtain t' s' where t's'_p: "insert\t',s'\ \ set ?TTdu" "t = t' \ \" "s = s' \ \" by metis + then obtain lll where "(lll, insert\t',s'\) \ set ?TTd" by (meson unlabel_mem_has_label) + hence "(lll, insert\t',s'\) \ set (transaction_strand TT \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_steps_iff(4) by blast + hence "insert\t',s'\ \ set ?TTu" by (meson unlabel_in) + hence "insert\t',s'\ \ set ((unlabel (transaction_strand TT)) \\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + by (simp add: subst_lsst_unlabel) + hence "insert\t',s'\ \ (\x. x \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \\<^sub>s \) ` set (unlabel (transaction_strand TT))" + unfolding subst_apply_stateful_strand_def by auto + then obtain u where "u \ set (unlabel (transaction_strand TT)) \ u \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \\<^sub>s \ = insert\t',s'\" + by auto + hence "\t'' s''. insert\t'',s''\ \ set (unlabel (transaction_strand TT)) \ + t' = t'' \ \ \\<^sub>s \ \ s' = s'' \ \ \\<^sub>s \" + by (cases u) auto + then obtain t'' s'' where t''s''_p: + "insert\t'',s''\ \ set (unlabel (transaction_strand TT)) \ + t' = t'' \ \ \\<^sub>s \ \ s' = s'' \ \ \\<^sub>s \" + by auto + hence "insert\t'',s''\ \ set (unlabel (transaction_updates TT))" + using is_Update_in_transaction_updates[of "insert\t'',s''\" TT] + using PP step(2) unfolding list_all_iff by auto + moreover have "\x\set (unlabel (transaction_updates TT)). is_Fun_Set (the_set_term x)" + using step(2) admissible_transaction_updates unfolding is_Fun_Set_def list_all_iff by auto + ultimately have "is_Fun_Set (the_set_term (insert\t'',s''\))" by auto + moreover have "s' = s'' \ \ \\<^sub>s \" using t''s''_p by blast + ultimately have "is_Fun_Set (the_set_term (insert\t',s'\))" by (auto simp add: is_Fun_Set_subst) + hence "is_Fun_Set s" by (simp add: t's'_p(3) is_Fun_Set_subst) + thus ?case using is_Fun_Set_exi by auto + qed (auto simp add: step db\<^sub>s\<^sub>s\<^sub>t_def) +qed auto + +lemma reachable_constraints_occurs_fact_ik_ground: + assumes \_reach: "A \ reachable_constraints P" + and P: "\T \ set P. admissible_transaction T" + and t: "occurs t \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + shows "fv (occurs t) = {}" +proof - + have 0: "admissible_transaction T" + when "T \ set P" for T + using P that unfolding list_all_iff by simp + + have 1: "wellformed_transaction T" + when "T \ set P" for T + using 0[OF that] unfolding admissible_transaction_def by simp + + have 2: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) = + (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \ (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \)" + when "T \ set P" for T \ and A::"('fun,'atom,'sets,'lbl) prot_constr" + using dual_transaction_ik_is_transaction_send'[OF 1[OF that]] by fastforce + + have 3: "admissible_transaction_occurs_checks T" + when "T \ set P" for T + using 0[OF that] unfolding admissible_transaction_def by simp + + show ?thesis using \_reach t + proof (induction A rule: reachable_constraints.induct) + case (step A T \ \) thus ?case + proof (cases "occurs t \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A") + case False + hence "occurs t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \" + using 2[OF step.hyps(2)] step.prems by blast + hence "send\occurs t\ \ set (unlabel (transaction_send T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + using wellformed_transaction_send_receive_subst_trm_cases(2)[OF 1[OF step.hyps(2)]] + by blast + then obtain s where s: + "send\occurs s\ \ set (unlabel (transaction_send T))" "t = s \ \ \\<^sub>s \" + using transaction_fresh_subst_transaction_renaming_subst_occurs_fact_send_receive(1)[ + OF step.hyps(3,4) 1[OF step.hyps(2)]] + transaction_strand_subst_subsets(10) + by blast + + obtain x where x: "x \ set (transaction_fresh T)" "s = Var x" + using s(1) 3[OF step.hyps(2)] + unfolding admissible_transaction_occurs_checks_def + by fastforce + + have "fv t = {}" + using transaction_fresh_subst_transaction_renaming_subst_range(1)[OF step.hyps(3,4) x(1)] + s(2) x(2) + by (auto simp del: subst_subst_compose) + thus ?thesis by simp + qed simp + qed simp +qed + +lemma reachable_constraints_occurs_fact_ik_funs_terms: + fixes A::"('fun,'atom,'sets,'lbl) prot_constr" + assumes \_reach: "A \ reachable_constraints P" + and \: "welltyped_constraint_model I A" + and P: "\T \ set P. admissible_transaction T" + shows "\s \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t I). OccursFact \ \(funs_term ` set (snd (Ana s)))" (is "?A A") + and "\s \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t I). OccursSec \ \(funs_term ` set (snd (Ana s)))" (is "?B A") + and "Fun OccursSec [] \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t I" (is "?C A") + and "\x \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. I x \ Fun OccursSec []" (is "?D A") +proof - + have T_adm: "admissible_transaction T" when "T \ set P" for T + using P that unfolding list_all_iff by simp + + have T_valid: "wellformed_transaction T" when "T \ set P" for T + using T_adm[OF that] unfolding admissible_transaction_def by blast + + have T_occ: "admissible_transaction_occurs_checks T" when "T \ set P" for T + using T_adm[OF that] unfolding admissible_transaction_def by blast + + have \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" by (metis \ welltyped_constraint_model_def) + + have \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)" + by (metis \ welltyped_constraint_model_def constraint_model_def) + + have \_grounds: "fv (I x) = {}" "\f T. I x = Fun f T" for x + using \ interpretation_grounds[of I, of "Var x"] empty_fv_exists_fun[of "I x"] + unfolding welltyped_constraint_model_def constraint_model_def by auto + + have 00: "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \ vars_transaction T" + "fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))) = fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" + for T::"('fun,'atom,'sets,'lbl) prot_transaction" + using fv_trms\<^sub>s\<^sub>s\<^sub>t_subset(1)[of "unlabel (transaction_send T)"] vars_transaction_unfold + fv_subterms_set[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"] + by blast+ + + have 0: "\x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). \a. \ (Var x) = TAtom a" + "\x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). \ (Var x) \ TAtom OccursSecType" + "\x \ fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))). \a. \ (Var x) = TAtom a" + "\x \ fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))). \ (Var x) \ TAtom OccursSecType" + "\x \ vars_transaction T. \a. \ (Var x) = TAtom a" + "\x \ vars_transaction T. \ (Var x) \ TAtom OccursSecType" + when "T \ set P" for T + using admissible_transaction_occurs_fv_types[OF T_adm[OF that]] 00 + by blast+ + + have 1: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \\<^sub>s\<^sub>e\<^sub>t I = + (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t I) \ (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t I)" + when "T \ set P" for T \ and A::"('fun,'atom,'sets,'lbl) prot_constr" + using dual_transaction_ik_is_transaction_send'[OF T_valid[OF that]] + by fastforce + + have 2: "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t I) = + subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t I" + when "T \ set P" and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" for T \ + using wt_subst_TAtom_subterms_set_subst[OF wt_subst_compose[OF \(1) \_wt] 0(1)[OF that(1)]] + wf_trm_subst_rangeD[OF wf_trms_subst_compose[OF \(2) \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s]] + by auto + + have 3: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + when "T \ set P" "transaction_fresh_subst \ T A" "transaction_renaming_subst \ P A" + for \ \ and T::"('fun,'atom,'sets,'lbl) prot_transaction" + and A::"('fun,'atom,'sets,'lbl) prot_constr" + using protocol_transaction_vars_TAtom_typed(3)[of T] P that(1) + transaction_fresh_subst_transaction_renaming_wt[OF that(2,3)] + transaction_fresh_subst_range_wf_trms[OF that(2)] + transaction_renaming_subst_range_wf_trms[OF that(3)] + wf_trms_subst_compose + by simp_all + + have 4: "\s \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). + OccursFact \ \(funs_term ` set (snd (Ana s))) \ + OccursSec \ \(funs_term ` set (snd (Ana s)))" + when T: "T \ set P" for T + proof + fix t assume t: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" + then obtain s where s: "send\s\ \ set (unlabel (transaction_send T))" "t \ subterms s" + using wellformed_transaction_unlabel_cases(5)[OF T_valid[OF T]] + by fastforce + + have s_occ: "\x. s = occurs (Var x)" when "OccursFact \ funs_term t \ OccursSec \ funs_term t" + proof - + have "OccursFact \ funs_term s \ OccursSec \ funs_term s" + using that subtermeq_imp_funs_term_subset[OF s(2)] + by blast + thus ?thesis + using s T_occ[OF T] + unfolding admissible_transaction_occurs_checks_def + by fastforce + qed + + obtain K T' where K: "Ana t = (K,T')" by moura + + show "OccursFact \ \(funs_term ` set (snd (Ana t))) \ + OccursSec \ \(funs_term ` set (snd (Ana t)))" + proof (rule ccontr) + assume "\(OccursFact \ \(funs_term ` set (snd (Ana t))) \ + OccursSec \ \(funs_term ` set (snd (Ana t))))" + hence a: "OccursFact \ \(funs_term ` set (snd (Ana t))) \ + OccursSec \ \(funs_term ` set (snd (Ana t)))" + by simp + hence "OccursFact \ \(funs_term ` set T') \ OccursSec \ \(funs_term ` set T')" + using K by simp + hence "OccursFact \ funs_term t \ OccursSec \ funs_term t" + using Ana_subterm[OF K] funs_term_subterms_eq(1)[of t] by blast + then obtain x where x: "t \ subterms (occurs (Var x))" + using s(2) s_occ by blast + thus False using a by fastforce + qed + qed + + have 5: "OccursFact \ \(funs_term ` subst_range (\ \\<^sub>s \))" + "OccursSec \ \(funs_term ` subst_range (\ \\<^sub>s \))" + when \\: "transaction_fresh_subst \ T A" "transaction_renaming_subst \ P A" + for \ \ and T::"('fun,'atom,'sets,'lbl) prot_transaction" + and A::"('fun,'atom,'sets,'lbl) prot_constr" + proof - + have "OccursFact \ funs_term t" "OccursSec \ funs_term t" + when "t \ subst_range (\ \\<^sub>s \)" for t + using transaction_fresh_subst_transaction_renaming_subst_range'[OF \\ that] + by auto + thus "OccursFact \ \(funs_term ` subst_range (\ \\<^sub>s \))" + "OccursSec \ \(funs_term ` subst_range (\ \\<^sub>s \))" + by blast+ + qed + + have 6: "I x \ Fun OccursSec []" "\t. I x = occurs t" "\a. \ (I x) = TAtom a \ a \ OccursSecType" + when T: "T \ set P" + and \\: "transaction_fresh_subst \ T A" "transaction_renaming_subst \ P A" + and x: "Var x \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \" + for x \ \ and T::"('fun,'atom,'sets,'lbl) prot_transaction" + and A::"('fun,'atom,'sets,'lbl) prot_constr" + proof - + obtain t where t: "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "t \ (\ \\<^sub>s \) = Var x" + using x by moura + then obtain y where y: "t = Var y" by (cases t) auto + + have "\a. \ t = TAtom a \ a \ OccursSecType" + using 0(1,2)[OF T] t(1) y + by force + thus "\a. \ (I x) = TAtom a \ a \ OccursSecType" + using wt_subst_trm''[OF 3(1)[OF T \\]] wt_subst_trm''[OF \_wt] t(2) + by (metis subst_apply_term.simps(1)) + thus "I x \ Fun OccursSec []" "\t. I x = occurs t" + by auto + qed + + have 7: "I x \ Fun OccursSec []" "\t. I x = occurs t" "\a. \ (I x) = TAtom a \ a \ OccursSecType" + when T: "T \ set P" + and \\: "transaction_fresh_subst \ T A" "transaction_renaming_subst \ P A" + and x: "x \ fv\<^sub>s\<^sub>e\<^sub>t ((\ \\<^sub>s \) ` vars_transaction T)" + for x \ \ and T::"('fun,'atom,'sets,'lbl) prot_transaction" + and A::"('fun,'atom,'sets,'lbl) prot_constr" + proof - + obtain y where y: "y \ vars_transaction T" "x \ fv ((\ \\<^sub>s \) y)" + using x by auto + hence y': "(\ \\<^sub>s \) y = Var x" + using transaction_fresh_subst_transaction_renaming_subst_range'[OF \\] + by (cases "(\ \\<^sub>s \) y \ subst_range (\ \\<^sub>s \)") force+ + + have "\a. \ (Var y) = TAtom a \ a \ OccursSecType" + using 0(5,6)[OF T] y + by force + thus "\a. \ (I x) = TAtom a \ a \ OccursSecType" + using wt_subst_trm''[OF 3(1)[OF T \\]] wt_subst_trm''[OF \_wt] y' + by (metis subst_apply_term.simps(1)) + thus "I x \ Fun OccursSec []" "\t. I x = occurs t" + by auto + qed + + have 8: "I x \ Fun OccursSec []" "\t. I x = occurs t" "\a. \ (I x) = TAtom a \ a \ OccursSecType" + when T: "T \ set P" + and \\: "transaction_fresh_subst \ T A" "transaction_renaming_subst \ P A" + and x: "Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \" + for x \ \ and T::"('fun,'atom,'sets,'lbl) prot_transaction" + and A::"('fun,'atom,'sets,'lbl) prot_constr" + proof - + obtain t where t: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" "t \ (\ \\<^sub>s \) = Var x" + using x by moura + then obtain y where y: "t = Var y" by (cases t) auto + + have "\a. \ t = TAtom a \ a \ OccursSecType" + using 0(3,4)[OF T] t(1) y + by force + thus "\a. \ (I x) = TAtom a \ a \ OccursSecType" + using wt_subst_trm''[OF 3(1)[OF T \\]] wt_subst_trm''[OF \_wt] t(2) + by (metis subst_apply_term.simps(1)) + thus "I x \ Fun OccursSec []" "\t. I x = occurs t" + by auto + qed + + have s_fv: "fv s \ fv\<^sub>s\<^sub>e\<^sub>t ((\ \\<^sub>s \) ` vars_transaction T)" + when s: "s \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \" + and T: "T \ set P" + for s and \ \::"('fun,'atom,'sets) prot_subst" and T::"('fun,'atom,'sets,'lbl) prot_transaction" + proof + fix x assume "x \ fv s" + hence "x \ fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \)" + using s by auto + hence *: "x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \)" + using fv_subterms_set_subst' by fast + have **: "list_all is_Send (unlabel (transaction_send T))" + using T_valid[OF T] unfolding wellformed_transaction_def by blast + have "x \ fv\<^sub>s\<^sub>e\<^sub>t ((\ \\<^sub>s \) ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" + proof - + obtain t where t: "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "x \ fv (t \ \ \\<^sub>s \)" + using * by fastforce + hence "fv t \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" + using fv_trms\<^sub>s\<^sub>s\<^sub>t_subset(1)[of "unlabel (transaction_send T)"] + by auto + thus ?thesis using t(2) subst_apply_fv_subset by fast + qed + thus "x \ fv\<^sub>s\<^sub>e\<^sub>t ((\ \\<^sub>s \) ` vars_transaction T)" + using vars_transaction_unfold[of T] by fastforce + qed + + show "?A A" using \_reach + proof (induction A rule: reachable_constraints.induct) + case (step A T \ \) + have *: "\s \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)). + OccursFact \ \(funs_term ` set (snd (Ana s)))" + using 4[OF step.hyps(2)] by blast + + have "\s \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \ \\<^sub>s\<^sub>e\<^sub>t I. + OccursFact \ \(funs_term ` set (snd (Ana s)))" + proof + fix t assume t: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \ \\<^sub>s\<^sub>e\<^sub>t I" + then obtain s u where su: + "s \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \" "s \ I = t" + "u \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" "u \ \ \\<^sub>s \ = s" + by force + + obtain Ku Tu where KTu: "Ana u = (Ku,Tu)" by moura + + have *: "OccursFact \ \(funs_term ` set Tu)" + "OccursFact \ \(funs_term ` subst_range (\ \\<^sub>s \))" + "OccursFact \ \(funs_term ` \(((set \ snd \ Ana) ` subst_range (\ \\<^sub>s \))))" + using transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)] + 4[OF step.hyps(2)] su(3) KTu + by fastforce+ + + have "OccursFact \ \(funs_term ` set (Tu \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ \\<^sub>s \))" + proof - + { fix f assume f: "f \ \(funs_term ` set (Tu \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ \\<^sub>s \))" + then obtain tf where tf: "tf \ set Tu" "f \ funs_term (tf \ \ \\<^sub>s \)" by moura + hence "f \ funs_term tf \ f \ \(funs_term ` subst_range (\ \\<^sub>s \))" + using funs_term_subst[of tf "\ \\<^sub>s \"] by force + hence "f \ OccursFact" using *(1,2) tf(1) by blast + } thus ?thesis by metis + qed + hence **: "OccursFact \ \(funs_term ` set (snd (Ana s)))" + proof (cases u) + case (Var xu) + hence "s = (\ \\<^sub>s \) xu" using su(4) by (metis subst_apply_term.simps(1)) + thus ?thesis using *(3) by fastforce + qed (use su(4) KTu Ana_subst'[of _ _ Ku Tu "\ \\<^sub>s \"] in simp) + + show "OccursFact \ \(funs_term ` set (snd (Ana t)))" + proof (cases s) + case (Var sx) + then obtain a where a: "\ (I sx) = Var a" + using su(1) 8(3)[OF step.hyps(2,3,4), of sx] by fast + hence "Ana (I sx) = ([],[])" by (metis \_grounds(2) const_type_inv[THEN Ana_const]) + thus ?thesis using Var su(2) by simp + next + case (Fun f S) + hence snd_Ana_t: "snd (Ana t) = snd (Ana s) \\<^sub>l\<^sub>i\<^sub>s\<^sub>t I" + using su(2) Ana_subst'[of f S _ "snd (Ana s)" I] by (cases "Ana s") simp_all + + { fix g assume "g \ \(funs_term ` set (snd (Ana t)))" + hence "g \ \(funs_term ` set (snd (Ana s))) \ + (\x \ fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s))). g \ funs_term (I x))" + using snd_Ana_t funs_term_subst[of _ I] by auto + hence "g \ OccursFact" + proof + assume "\x \ fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s))). g \ funs_term (I x)" + then obtain x where x: "x \ fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s)))" "g \ funs_term (I x)" by moura + have "x \ fv s" using x(1) Ana_vars(2)[of s] by (cases "Ana s") auto + hence "x \ fv\<^sub>s\<^sub>e\<^sub>t ((\ \\<^sub>s \) ` vars_transaction T)" + using s_fv[OF su(1) step.hyps(2)] by blast + then obtain a h U where h: + "I x = Fun h U" "\ (I x) = Var a" "a \ OccursSecType" "arity h = 0" + using \_grounds(2) 7(3)[OF step.hyps(2,3,4)] const_type_inv + by metis + hence "h \ OccursFact" by auto + moreover have "U = []" using h(1,2,4) const_type_inv_wf[of h U a] \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s by fastforce + ultimately show ?thesis using h(1) x(2) by auto + qed (use ** in blast) + } thus ?thesis by blast + qed + qed + thus ?case + using step.IH step.prems 1[OF step.hyps(2), of A "\ \\<^sub>s \"] + 2[OF step.hyps(2) 3[OF step.hyps(2,3,4)]] + by auto + qed simp + + show "?B A" using \_reach + proof (induction A rule: reachable_constraints.induct) + case (step A T \ \) + have "\s \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \ \\<^sub>s\<^sub>e\<^sub>t I. + OccursSec \ \(funs_term ` set (snd (Ana s)))" + proof + fix t assume t: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \ \\<^sub>s\<^sub>e\<^sub>t I" + then obtain s u where su: + "s \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \" "s \ I = t" + "u \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" "u \ \ \\<^sub>s \ = s" + by force + + obtain Ku Tu where KTu: "Ana u = (Ku,Tu)" by moura + + have *: "OccursSec \ \(funs_term ` set Tu)" + "OccursSec \ \(funs_term ` subst_range (\ \\<^sub>s \))" + "OccursSec \ \(funs_term ` \(((set \ snd \ Ana) ` subst_range (\ \\<^sub>s \))))" + using transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)] + 4[OF step.hyps(2)] su(3) KTu + by fastforce+ + + have "OccursSec \ \(funs_term ` set (Tu \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ \\<^sub>s \))" + proof - + { fix f assume f: "f \ \(funs_term ` set (Tu \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ \\<^sub>s \))" + then obtain tf where tf: "tf \ set Tu" "f \ funs_term (tf \ \ \\<^sub>s \)" by moura + hence "f \ funs_term tf \ f \ \(funs_term ` subst_range (\ \\<^sub>s \))" + using funs_term_subst[of tf "\ \\<^sub>s \"] by force + hence "f \ OccursSec" using *(1,2) tf(1) by blast + } thus ?thesis by metis + qed + hence **: "OccursSec \ \(funs_term ` set (snd (Ana s)))" + proof (cases u) + case (Var xu) + hence "s = (\ \\<^sub>s \) xu" using su(4) by (metis subst_apply_term.simps(1)) + thus ?thesis using *(3) by fastforce + qed (use su(4) KTu Ana_subst'[of _ _ Ku Tu "\ \\<^sub>s \"] in simp) + + show "OccursSec \ \(funs_term ` set (snd (Ana t)))" + proof (cases s) + case (Var sx) + then obtain a where a: "\ (I sx) = Var a" + using su(1) 8(3)[OF step.hyps(2,3,4), of sx] by fast + hence "Ana (I sx) = ([],[])" by (metis \_grounds(2) const_type_inv[THEN Ana_const]) + thus ?thesis using Var su(2) by simp + next + case (Fun f S) + hence snd_Ana_t: "snd (Ana t) = snd (Ana s) \\<^sub>l\<^sub>i\<^sub>s\<^sub>t I" + using su(2) Ana_subst'[of f S _ "snd (Ana s)" I] by (cases "Ana s") simp_all + + { fix g assume "g \ \(funs_term ` set (snd (Ana t)))" + hence "g \ \(funs_term ` set (snd (Ana s))) \ + (\x \ fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s))). g \ funs_term (I x))" + using snd_Ana_t funs_term_subst[of _ I] by auto + hence "g \ OccursSec" + proof + assume "\x \ fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s))). g \ funs_term (I x)" + then obtain x where x: "x \ fv\<^sub>s\<^sub>e\<^sub>t (set (snd (Ana s)))" "g \ funs_term (I x)" by moura + have "x \ fv s" using x(1) Ana_vars(2)[of s] by (cases "Ana s") auto + hence "x \ fv\<^sub>s\<^sub>e\<^sub>t ((\ \\<^sub>s \) ` vars_transaction T)" + using s_fv[OF su(1) step.hyps(2)] by blast + then obtain a h U where h: + "I x = Fun h U" "\ (I x) = Var a" "a \ OccursSecType" "arity h = 0" + using \_grounds(2) 7(3)[OF step.hyps(2,3,4)] const_type_inv + by metis + hence "h \ OccursSec" by auto + moreover have "U = []" using h(1,2,4) const_type_inv_wf[of h U a] \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s by fastforce + ultimately show ?thesis using h(1) x(2) by auto + qed (use ** in blast) + } thus ?thesis by blast + qed + qed + thus ?case + using step.IH step.prems 1[OF step.hyps(2), of A "\ \\<^sub>s \"] + 2[OF step.hyps(2) 3[OF step.hyps(2,3,4)]] + by auto + qed simp + + show "?C A" using \_reach + proof (induction A rule: reachable_constraints.induct) + case (step A T \ \) + have *: "Fun OccursSec [] \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" + using wellformed_transaction_unlabel_cases(5)[OF T_valid[OF step.hyps(2)]] + T_occ[OF step.hyps(2)] + unfolding admissible_transaction_occurs_checks_def + by fastforce + + have **: "Fun OccursSec [] \ subst_range (\ \\<^sub>s \)" + using transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)] + by auto + + have "Fun OccursSec [] \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \ \\<^sub>s\<^sub>e\<^sub>t I" + proof + assume "Fun OccursSec [] \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \ \\<^sub>s\<^sub>e\<^sub>t I" + then obtain s where "s \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \" "s \ I = Fun OccursSec []" + by moura + moreover have "Fun OccursSec [] \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \" + proof + assume "Fun OccursSec [] \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \" + then obtain u where "u \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "u \ \ \\<^sub>s \ = Fun OccursSec []" + by moura + thus False using * ** by (cases u) (force simp del: subst_subst_compose)+ + qed + ultimately show False using 6[OF step.hyps(2,3,4)] by (cases s) auto + qed + thus ?case using step.IH step.prems 1[OF step.hyps(2), of A "\ \\<^sub>s \"] by fast + qed simp + + show "?D A" using \_reach + proof (induction A rule: reachable_constraints.induct) + case (step A T \ \) + { fix x assume x: "x \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + hence x': "x \ vars\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + by (metis vars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unlabel_subst) + hence "x \ vars_transaction T \ x \ fv\<^sub>s\<^sub>e\<^sub>t ((\ \\<^sub>s \) ` vars_transaction T)" + using vars\<^sub>s\<^sub>s\<^sub>t_subst_cases[OF x'] by metis + moreover have "I x \ Fun OccursSec []" when "x \ vars_transaction T" + using that 0(5,6)[OF step.hyps(2)] wt_subst_trm''[OF \_wt, of "Var x"] + by fastforce + ultimately have "I x \ Fun OccursSec []" + using 7(1)[OF step.hyps(2,3,4), of x] + by blast + } thus ?case using step.IH by auto + qed simp +qed + +lemma reachable_constraints_occurs_fact_ik_subst_aux: + assumes \_reach: "A \ reachable_constraints P" + and \: "welltyped_constraint_model I A" + and P: "\T \ set P. admissible_transaction T" + and t: "t \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "t \ I = occurs s" + shows "\u. t = occurs u" +proof - + have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" + using \ unfolding welltyped_constraint_model_def constraint_model_def by metis + hence 0: "\ t = \ (occurs s)" + using t(2) wt_subst_trm'' by metis + + have 1: "\\<^sub>v ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ (\T \ set P. \\<^sub>v ` fv_transaction T)" + "\T \ set P. \x \ fv_transaction T. \\<^sub>v x = TAtom Value \ (\a. \\<^sub>v x = TAtom (Atom a))" + using reachable_constraints_TAtom_types(1)[OF \_reach] + protocol_transaction_vars_TAtom_typed(2,3) P + by fast+ + + show ?thesis + proof (cases t) + case (Var x) + thus ?thesis + using 0 1 t(1) var_subterm_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of x "unlabel A"] + by fastforce + next + case (Fun f T) + hence 2: "f = OccursFact" "length T = Suc (Suc 0)" "T ! 0 \ I = Fun OccursSec []" + using t(2) by auto + + have "T ! 0 = Fun OccursSec []" + proof (cases "T ! 0") + case (Var y) + hence "I y = Fun OccursSec []" using Fun 2(3) by simp + moreover have "Var y \ set T" using Var 2(2) length_Suc_conv[of T 1] by auto + hence "y \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" using Fun t(1) by force + hence "y \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + using fv_ik_subset_fv_sst'[of "unlabel A"] vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel A"] + by blast + ultimately have False + using reachable_constraints_occurs_fact_ik_funs_terms(4)[OF \_reach \ P] + by blast + thus ?thesis by simp + qed (use 2(3) in simp) + moreover have "\u u'. T = [u,u']" + using 2(2) by (metis (no_types) length_0_conv length_Suc_conv) + ultimately show ?thesis using Fun 2(1,2) by force + qed +qed + +lemma reachable_constraints_occurs_fact_ik_subst: + assumes \_reach: "A \ reachable_constraints P" + and \: "welltyped_constraint_model I A" + and P: "\T \ set P. admissible_transaction T" + and t: "occurs t \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t I" + shows "occurs t \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" +proof - + have \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" + using \ unfolding welltyped_constraint_model_def constraint_model_def by metis + + obtain s where s: "s \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "s \ I = occurs t" + using t by auto + hence u: "\u. s = occurs u" + using \_wt reachable_constraints_occurs_fact_ik_subst_aux[OF \_reach \ P] + by blast + hence "fv s = {}" + using reachable_constraints_occurs_fact_ik_ground[OF \_reach P] s + by fast + thus ?thesis + using s u subst_ground_ident[of s I] + by argo +qed + +lemma reachable_constraints_occurs_fact_send_in_ik: + assumes \_reach: "A \ reachable_constraints P" + and \: "welltyped_constraint_model I A" + and P: "\T \ set P. admissible_transaction T" + and x: "send\occurs (Var x)\ \ set (unlabel A)" + shows "occurs (I x) \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" +using \_reach \ x +proof (induction A rule: reachable_constraints.induct) + case (step A T \ \) + define \ where "\ \ \ \\<^sub>s \" + define T' where "T' \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + + have T_adm: "admissible_transaction T" + using P step.hyps(2) unfolding list_all_iff by blast + + have T_valid: "wellformed_transaction T" + using T_adm unfolding admissible_transaction_def by blast + + have T_adm_occ: "admissible_transaction_occurs_checks T" + using T_adm unfolding admissible_transaction_def by blast + + have \_is_T_model: "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t I) (set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I)) (unlabel T') I" + using step.prems unlabel_append[of A T'] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel A" I "[]"] + strand_sem_append_stateful[of "{}" "{}" "unlabel A" "unlabel T'" I] + by (simp add: T'_def \_def welltyped_constraint_model_def constraint_model_def db\<^sub>s\<^sub>s\<^sub>t_def) + + show ?case + proof (cases "send\occurs (Var x)\ \ set (unlabel A)") + case False + hence "send\occurs (Var x)\ \ set (unlabel T')" + using step.prems(2) unfolding T'_def \_def by simp + hence "receive\occurs (Var x)\ \ set (unlabel (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(2) unfolding T'_def by blast + then obtain y where y: + "receive\occurs (Var y)\ \ set (unlabel (transaction_receive T))" + "\ y = Var x" + using transaction_fresh_subst_transaction_renaming_subst_occurs_fact_send_receive(2)[ + OF step.hyps(3,4) T_valid] + subst_to_var_is_var[of _ \ x] + unfolding \_def by (force simp del: subst_subst_compose) + hence "receive\occurs (Var y) \ \\ \ set (unlabel (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using subst_lsst_unlabel_member[of "receive\occurs (Var y)\" "transaction_receive T" \] + by fastforce + hence "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t I \ occurs (Var y) \ \ \ I" + using wellformed_transaction_sem_receives[ + OF T_valid, of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t I" "set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I)" \ I "occurs (Var y) \ \"] + \_is_T_model + by (metis T'_def) + hence *: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t I \ occurs (\ y \ I)" + by auto + + have "occurs (\ y \ I) \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + using deduct_occurs_in_ik[OF *] + reachable_constraints_occurs_fact_ik_subst[ + OF step.hyps(1) welltyped_constraint_model_prefix[OF step.prems(1)] P, of "\ y \ I"] + reachable_constraints_occurs_fact_ik_funs_terms[ + OF step.hyps(1) welltyped_constraint_model_prefix[OF step.prems(1)] P] + by blast + thus ?thesis using y(2) by simp + qed (simp add: step.IH[OF welltyped_constraint_model_prefix[OF step.prems(1)]]) +qed simp + +lemma reachable_contraints_fv_bvars_subset: + assumes A: "A \ reachable_constraints P" + shows "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ (\T \ set P. bvars_transaction T)" +using assms +proof (induction A rule: reachable_constraints.induct) + case (step \ T \ \) + let ?T' = "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \" + + show ?case + using step.IH step.hyps(2) + bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of ?T'] + bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" "\ \\<^sub>s \"] + bvars\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T')"] + unlabel_append[of \ "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T'"] + by (metis (no_types, lifting) SUP_upper Un_subset_iff) +qed simp + +lemma reachable_contraints_fv_disj: + assumes A: "A \ reachable_constraints P" + shows "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ (\T \ set P. bvars_transaction T) = {}" +using A +proof (induction A rule: reachable_constraints.induct) + case (step \ T \ \) + define T' where "T' \ transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \" + define X where "X \ \T \ set P. bvars_transaction T" + have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ X = {}" + using transaction_fresh_subst_transaction_renaming_subst_vars_disj(4)[OF step.hyps(3,4)] + transaction_fresh_subst_transaction_renaming_subst_vars_subset(4)[OF step.hyps(3,4,2)] + unfolding T'_def X_def by blast + hence "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \ X = {}" + using step.IH[unfolded X_def[symmetric]] fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of T'] by auto + thus ?case unfolding T'_def X_def by blast +qed simp + +lemma reachable_contraints_fv_bvars_disj: + assumes P: "\T \ set P. wellformed_transaction T" + and A: "A \ reachable_constraints P" + shows "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = {}" +using A +proof (induction A rule: reachable_constraints.induct) + case (step \ T \ \) + define T' where "T' \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + + note 0 = transaction_fresh_subst_transaction_renaming_subst_vars_disj[OF step.hyps(3,4)] + note 1 = transaction_fresh_subst_transaction_renaming_subst_vars_subset[OF step.hyps(3,4)] + + have 2: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = {}" + using 0(7) 1(4)[OF step.hyps(2)] fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq + unfolding T'_def by (metis (no_types) disjoint_iff_not_equal subset_iff) + + have "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ \(bvars_transaction ` set P)" + "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ \(bvars_transaction ` set P) = {}" + using reachable_contraints_fv_bvars_subset[OF reachable_constraints.step[OF step.hyps]] + reachable_contraints_fv_disj[OF reachable_constraints.step[OF step.hyps]] + unfolding T'_def by auto + hence 3: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = {}" by blast + + have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \) \ bvars_transaction T = {}" + using 0(4)[OF step.hyps(2)] 1(4)[OF step.hyps(2)] by blast + hence 4: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = {}" + by (metis (no_types) T'_def fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq + unlabel_subst bvars\<^sub>s\<^sub>s\<^sub>t_subst) + + have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@T') \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@T') = {}" + using 2 3 4 step.IH + unfolding unlabel_append[of \ T'] + fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel T'"] + bvars\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel T'"] + by fast + thus ?case unfolding T'_def by blast +qed simp + +lemma reachable_constraints_wf: + assumes P: + "\T \ set P. wellformed_transaction T" + "\T \ set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)" + and A: "A \ reachable_constraints P" + shows "wf\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" +proof - + have "wellformed_transaction T" + when "T \ set P" for T + using P(1) that by fast+ + hence 0: "wf'\<^sub>s\<^sub>s\<^sub>t (set (transaction_fresh T)) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))" + "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) = {}" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)" + when T: "T \ set P" for T + unfolding admissible_transaction_terms_def + by (metis T wellformed_transaction_wf\<^sub>s\<^sub>s\<^sub>t(1), + metis T wellformed_transaction_wf\<^sub>s\<^sub>s\<^sub>t(2) fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq, + metis T wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code P(2)) + + from A have "wf\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + proof (induction A rule: reachable_constraints.induct) + case (step A T \ \) + let ?T' = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + + have IH: "wf'\<^sub>s\<^sub>s\<^sub>t {} (unlabel A)" "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = {}" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + using step.IH by metis+ + + have 1: "wf'\<^sub>s\<^sub>s\<^sub>t {} (unlabel (A@?T'))" + using protocol_transaction_wf_subst[OF 0(1)[OF step.hyps(2)] step.hyps(3,4)] + wf\<^sub>s\<^sub>s\<^sub>t_vars_mono[of "{}"] wf\<^sub>s\<^sub>s\<^sub>t_append[OF IH(1)] + by simp + + have 2: "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@?T') \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@?T') = {}" + using reachable_contraints_fv_bvars_disj[OF P(1)] + reachable_constraints.step[OF step.hyps] + by blast + + have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?T')" + using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unlabel_subst + wf_trms_subst[ + OF wf_trms_subst_compose[ + OF transaction_fresh_subst_range_wf_trms[OF step.hyps(3)] + transaction_renaming_subst_range_wf_trms[OF step.hyps(4)]], + THEN wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_trms\<^sub>s\<^sub>s\<^sub>t_subst, + OF 0(3)[OF step.hyps(2)]] + by metis + hence 3: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@?T'))" + using IH(3) by auto + + show ?case using 1 2 3 by force + qed simp + thus "wf\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" by metis+ +qed + +lemma reachable_constraints_no_Ana_Attack: + assumes \: "\ \ reachable_constraints P" + and P: "\T \ set P. admissible_transaction T" + and t: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + shows "attack\n\ \ set (snd (Ana t))" +proof - + have T_adm: "admissible_transaction T" when "T \ set P" for T + using P that by blast + + have T_adm_term: "admissible_transaction_terms T" when "T \ set P" for T + using T_adm[OF that] unfolding admissible_transaction_def by blast + + have T_valid: "wellformed_transaction T" when "T \ set P" for T + using T_adm[OF that] unfolding admissible_transaction_def by blast + + show ?thesis + using \ t + proof (induction \ rule: reachable_constraints.induct) + case (step A T \ \) thus ?case + proof (cases "t \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)") + case False + hence "t \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)))" + using step.prems by simp + hence "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \)" + using dual_transaction_ik_is_transaction_send'[OF T_valid[OF step.hyps(2)]] + by metis + hence "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \" + using transaction_fresh_subst_transaction_renaming_subst_trms[ + OF step.hyps(3,4), of "transaction_send T"] + wellformed_transaction_unlabel_cases(5)[OF T_valid[OF step.hyps(2)]] + by fastforce + then obtain s where s: "s \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" "t = s \ \ \\<^sub>s \" + by moura + hence s': "attack\n\ \ set (snd (Ana s))" + using admissible_transaction_no_Ana_Attack[OF T_adm_term[OF step.hyps(2)]] + trms_transaction_unfold[of T] + by blast + + note * = transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)] + + show ?thesis + proof + assume n: "attack\n\ \ set (snd (Ana t))" + thus False + proof (cases s) + case (Var x) thus ?thesis using Var * n s(2) by (force simp del: subst_subst_compose) + next + case (Fun f T) + hence "attack\n\ \ set (snd (Ana s)) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>s \" + using Ana_subst'[of f T _ "snd (Ana s)" "\ \\<^sub>s \"] s(2) s' n + by (cases "Ana s") auto + hence "attack\n\ \ set (snd (Ana s)) \ attack\n\ \ subst_range (\ \\<^sub>s \)" + using const_mem_subst_cases' by fast + thus ?thesis using * s' by blast + qed + qed + qed simp + qed simp +qed + +lemma constraint_model_Value_term_is_Val: + assumes \_reach: "A \ reachable_constraints P" + and \: "welltyped_constraint_model I A" + and P: "\T \ set P. admissible_transaction T" + and x: "\\<^sub>v x = TAtom Value" "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + shows "\n. I x = Fun (Val (n,False)) []" +using reachable_constraints_occurs_fact_send_ex[OF \_reach P x] + reachable_constraints_occurs_fact_send_in_ik[OF \_reach \ P] + reachable_constraints_occurs_fact_ik_case[OF \_reach P] +by fast + +lemma constraint_model_Value_term_is_Val': + assumes \_reach: "A \ reachable_constraints P" + and \: "welltyped_constraint_model I A" + and P: "\T \ set P. admissible_transaction T" + and x: "(TAtom Value, m) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + shows "\n. I (TAtom Value, m) = Fun (Val (n,False)) []" +using constraint_model_Value_term_is_Val[OF \_reach \ P _ x] by simp + +(* We use this lemma to show that fresh constants first occur in \(\) at the point where they were generated *) +lemma constraint_model_Value_var_in_constr_prefix: + assumes \_reach: "\ \ reachable_constraints P" + and \: "welltyped_constraint_model \ \" + and P: "\T \ set P. admissible_transaction T" + shows "\x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \. \\<^sub>v x = TAtom Value + \ (\B. prefix B \ \ x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \ \ x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B))" (is "?P \") +using \_reach \ +proof (induction \ rule: reachable_constraints.induct) + case (step \ T \ \) + have IH: "?P \" using step welltyped_constraint_model_prefix by fast + + define T' where "T' \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + + have T_adm: "admissible_transaction T" + by (metis P step.hyps(2)) + + have T_valid: "wellformed_transaction T" + by (metis T_adm admissible_transaction_def) + + have \_is_T_model: "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \) (set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)) (unlabel T') \" + using step.prems unlabel_append[of \ T'] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel \" \ "[]"] + strand_sem_append_stateful[of "{}" "{}" "unlabel \" "unlabel T'" \] + by (simp add: T'_def welltyped_constraint_model_def constraint_model_def db\<^sub>s\<^sub>s\<^sub>t_def) + + have \_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + by (metis \ welltyped_constraint_model_def constraint_model_def, + metis \ welltyped_constraint_model_def, + metis \ welltyped_constraint_model_def constraint_model_def) + + have 1: "\B. prefix B \ \ x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \ \ x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" + when x: "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" "\\<^sub>v x = TAtom Value" for x + proof - + obtain n where n: "\ x = Fun n []" "is_Val n \ is_Abs n" "\public n" + using constraint_model_Value_term_is_Val[ + OF reachable_constraints.step[OF step.hyps] step.prems P x(2)] + x(1) fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel T'"] unlabel_append[of \ T'] + unfolding T'_def by moura + + have "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + using x(1) fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq unfolding T'_def by fastforce + then obtain y where y: "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" "x \ fv ((\ \\<^sub>s \) y)" + using fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var[of x "unlabel (transaction_strand T)" "\ \\<^sub>s \"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + by auto + + have y_x: "(\ \\<^sub>s \) y = Var x" + using y(2) transaction_fresh_subst_transaction_renaming_subst_range[OF step.hyps(3,4), of y] + by force + + have "\ ((\ \\<^sub>s \) y) = TAtom Value" using x(2) y_x by simp + moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" + using protocol_transaction_vars_TAtom_typed(3) P(1) step.hyps(2) + transaction_fresh_subst_transaction_renaming_wt[OF step.hyps(3,4)] + by fast + ultimately have y_val: "\\<^sub>v y = TAtom Value" + by (metis wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def \.simps(1)) + + have y_not_fresh: "y \ set (transaction_fresh T)" + using y(2) transaction_fresh_subst_transaction_renaming_subst_range(1)[OF step.hyps(3,4)] + by fastforce + + have y_n: "Fun n [] = (\ \\<^sub>s \) y \ \" using n y_x by simp + hence y_n': "Fun n [] = (\ \\<^sub>s \ \\<^sub>s \) y" + by (metis subst_subst_compose[of "Var y" "\ \\<^sub>s \" \] subst_apply_term.simps(1)) + + have "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" + using wellformed_transaction_fv_in_receives_or_selects[OF T_valid] y(1) y_not_fresh by blast + hence n_cases: + "Fun n [] \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ + (\z \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \. \\<^sub>v z = TAtom Value \ \ z = Fun n [])" + proof + assume y_in: "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" + then obtain t where t: "receive\t\ \ set (unlabel (transaction_receive T))" "y \ fv t" + using admissible_transaction_strand_step_cases(1)[OF T_adm] + by force + hence "receive\t \ \ \\<^sub>s \\ \ set (unlabel (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + using subst_lsst_unlabel_member[of "receive\t\" "transaction_receive T" "\ \\<^sub>s \"] + by fastforce + hence *: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \ \\<^sub>s \ \ \" + using wellformed_transaction_sem_receives[ + OF T_valid, of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \" "set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" "\ \\<^sub>s \" \ "t \ \ \\<^sub>s \"] + \_is_T_model + by (metis T'_def) + + have "\a. \ (\ x) = Var a" when "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" for x + using that reachable_constraints_vars_TAtom_typed[OF step.hyps(1) P, of x] + vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \"] wt_subst_trm''[OF \_wt, of "Var x"] + by force + hence "\f. \ x = Fun f []" when "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" for x + using that wf_trm_subst[OF \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s, of "Var x"] wf_trm_Var[of x] const_type_inv_wf + empty_fv_exists_fun[OF interpretation_grounds[OF \_interp], of "Var x"] + by (metis subst_apply_term.simps(1)[of x \]) + hence \_ik_\_vals: "\x \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \). \f. \ x = Fun f []" + using fv_ik_subset_fv_sst'[of "unlabel \"] vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \"] + by blast + hence "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \) = subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>e\<^sub>t \" + using ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel \" \] unlabel_subst[of \ \] + subterms_subst_lsst_ik[of \ \] + by metis + moreover have "v \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" when "v \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" for v + by (meson contra_subsetD fv_ik_subset_fv_sst' that) + moreover have "Fun n [] \ subterms (t \ \ \\<^sub>s \ \ \)" + using imageI[of "Var y" "subterms t" "\x. x \ \ \\<^sub>s \ \\<^sub>s \"] + var_is_subterm[OF t(2)] subterms_subst_subset[of "\ \\<^sub>s \ \\<^sub>s \" t] + subst_subst_compose[of t "\ \\<^sub>s \" \] y_n' + by (auto simp del: subst_subst_compose) + hence "Fun n [] \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \)" + using private_fun_deduct_in_ik[OF *, of n "[]"] n(2,3) + unfolding is_Val_def is_Abs_def + by auto + hence "Fun n [] \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ + (\z \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \). Fun n [] \ subterms (\ z))" + using const_subterm_subst_cases[of n _ \] + by auto + hence "Fun n [] \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ (\z \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \). \ z = Fun n [])" + using \_ik_\_vals by fastforce + hence "Fun n [] \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ + (\z \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \). \\<^sub>v z = TAtom Value \ \ z = Fun n [])" + using \_wt n(2) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def is_Val_def is_Abs_def by force + ultimately show ?thesis using ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel \"] by fast + next + assume y_in: "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" + then obtain s where s: "select\Var y,Fun (Set s) []\ \ set (unlabel (transaction_selects T))" + using admissible_transaction_strand_step_cases(2)[OF T_adm] + by force + hence "select\(\ \\<^sub>s \) y, Fun (Set s) []\ \ set (unlabel (transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + using subst_lsst_unlabel_member + by fastforce + hence n_in_db: "(Fun n [], Fun (Set s) []) \ set (db'\<^sub>s\<^sub>s\<^sub>t (unlabel \) \ [])" + using wellformed_transaction_sem_selects[ + OF T_valid, of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \" "set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" "\ \\<^sub>s \" \ + "(\ \\<^sub>s \) y" "Fun (Set s) []"] + \_is_T_model n y_x + unfolding T'_def db\<^sub>s\<^sub>s\<^sub>t_def + by fastforce + + obtain tn sn where tsn: "insert\tn,sn\ \ set (unlabel \)" "Fun n [] = tn \ \" + using db\<^sub>s\<^sub>s\<^sub>t_in_cases[OF n_in_db] by force + + have "Fun n [] = tn \ (\z. \\<^sub>v z = TAtom Value \ tn = Var z)" + using \_wt tsn(2) n(2) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def is_Val_def is_Abs_def by (cases tn) auto + moreover have "tn \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" "fv tn \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" + using tsn(1) in_subterms_Union by force+ + ultimately show ?thesis using tsn(2) by auto + qed + + have x_nin_\: "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" + proof - + have "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + using x(1) fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq + unfolding T'_def + by fast + hence "x \ fv\<^sub>s\<^sub>s\<^sub>t ((unlabel (transaction_strand T) \\<^sub>s\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>s\<^sub>t \)" + using transaction_fresh_subst_grounds_domain[OF step.hyps(3)] step.hyps(3) + labeled_stateful_strand_subst_comp[of \ "transaction_strand T" \] + unlabel_subst[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" \] + unlabel_subst[of "transaction_strand T" \] + by (simp add: transaction_fresh_subst_def range_vars_alt_def) + then obtain y where y: "\ y = Var x" + using transaction_renaming_subst_var_obtain[OF _ step.hyps(4)] + by blast + thus ?thesis + using transaction_renaming_subst_range_notin_vars[OF step.hyps(4), of y] + vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \"] + by auto + qed + + from n_cases show ?thesis + proof + assume "\z \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \. \\<^sub>v z = TAtom Value \ \ z = Fun n []" + then obtain B where B: "prefix B \" "Fun n [] \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" + by (metis IH n(1)) + thus ?thesis + using n x_nin_\ trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)[of B] + by (metis (no_types, hide_lams) self_append_conv subset_iff subterms\<^sub>s\<^sub>e\<^sub>t_mono prefix_def) + qed (use n x_nin_\ in fastforce) + qed + + have "?P (\@T')" + proof (intro ballI impI) + fix x assume x: "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@T')" "\\<^sub>v x = TAtom Value" + show "\B. prefix B (\@T') \ x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \ \ x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" + proof (cases "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \") + case False + hence x': "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" using x(1) unlabel_append[of \] fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \"] by simp + then obtain B where B: "prefix B \" "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B" "\ x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" + using x(2) 1 by moura + thus ?thesis using prefix_prefix by fast + qed (use x(2) IH prefix_prefix in fast) + qed + thus ?case unfolding T'_def by blast +qed simp + +lemma admissible_transaction_occurs_checks_prop: + assumes \_reach: "\ \ reachable_constraints P" + and \: "welltyped_constraint_model \ \" + and P: "\T \ set P. admissible_transaction T" + and f: "f \ \(funs_term ` (\ ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + shows "is_Val f \ \public f" + and "\is_Abs f" +proof - + obtain x where x: "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" "f \ funs_term (\ x)" using f by moura + obtain T where T: "Fun f T \ \ x" using funs_term_Fun_subterm[OF x(2)] by moura + + have \_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + by (metis \ welltyped_constraint_model_def constraint_model_def, + metis \ welltyped_constraint_model_def, + metis \ welltyped_constraint_model_def constraint_model_def) + + have 1: "\ (Var x) = \ (\ x)" using wt_subst_trm''[OF \_wt, of "Var x"] by simp + hence "\a. \ (\ x) = Var a" + using x(1) reachable_constraints_vars_TAtom_typed[OF \_reach P, of x] + vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \"] + by force + hence "\f. \ x = Fun f []" + using x(1) wf_trm_subst[OF \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s, of "Var x"] wf_trm_Var[of x] const_type_inv_wf + empty_fv_exists_fun[OF interpretation_grounds[OF \_interp], of "Var x"] + by (metis subst_apply_term.simps(1)[of x \]) + hence 2: "\ x = Fun f []" using x(2) by force + + have "(is_Val f \ \public f) \ \is_Abs f" + proof (cases "\\<^sub>v x = TAtom Value") + case True + then obtain B where B: "prefix B \" "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B" "\ x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" + using constraint_model_Value_var_in_constr_prefix[OF \_reach \ P] x(1) + by fast + + have "\ x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using B(1,3) trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel B"] unlabel_append[of B] + unfolding prefix_def by auto + hence "f \ \(funs_term ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using x(2) funs_term_subterms_eq(2)[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \"] by blast + thus ?thesis + using reachable_constraints_val_funs_private[OF \_reach P] + by blast+ + next + case False thus ?thesis using x 1 2 by (cases f) auto + qed + thus "is_Val f \ \public f" "\is_Abs f" by metis+ +qed + +lemma admissible_transaction_occurs_checks_prop': + assumes \_reach: "\ \ reachable_constraints P" + and \: "welltyped_constraint_model \ \" + and P: "\T \ set P. admissible_transaction T" + and f: "f \ \(funs_term ` (\ ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + shows "\n. f = Val (n,True)" + and "\n. f = Abs n" +using admissible_transaction_occurs_checks_prop[OF \_reach \ P f] by auto + +lemma transaction_var_becomes_Val: + assumes \_reach: "\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \) \ reachable_constraints P" + and \: "welltyped_constraint_model \ (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + and \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + and P: "\T \ set P. admissible_transaction T" + and T: "T \ set P" + and x: "x \ fv_transaction T" "fst x = TAtom Value" + shows "\n. Fun (Val (n,False)) [] = (\ \\<^sub>s \) x \ \" +proof - + obtain m where m: "x = (TAtom Value, m)" by (metis x(2) eq_fst_iff) + + have x_not_bvar: "x \ bvars_transaction T" "fv ((\ \\<^sub>s \) x) \ bvars_transaction T = {}" + using x(1) transactions_fv_bvars_disj[OF P] T + transaction_fresh_subst_transaction_renaming_subst_vars_disj(2)[OF \ \, of x] + vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"] + by blast+ + + show ?thesis + proof (cases "x \ subst_domain \") + case True + then obtain n where "\ x = Fun (Val (n, False)) []" + using \ unfolding transaction_fresh_subst_def by fastforce + thus ?thesis using subst_compose[of \ \ x] by simp + next + case False + hence "\ x = Var x" by auto + then obtain n where n: "(\ \\<^sub>s \) x = Var (TAtom Value, n)" + using m transaction_renaming_subst_is_renaming[OF \] subst_compose[of \ \ x] + by force + hence "(TAtom Value, n) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + using x_not_bvar fv\<^sub>s\<^sub>s\<^sub>t_subst_fv_subset[OF x(1), of "\ \\<^sub>s \"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + by force + hence "\n'. \ (TAtom Value, n) = Fun (Val (n',False)) []" + using constraint_model_Value_term_is_Val'[OF \_reach \ P, of n] x + fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \"] + fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \"] unlabel_append[of \] + by fastforce + thus ?thesis using n by simp + qed +qed + +lemma reachable_constraints_SMP_subset: + assumes \: "\ \ reachable_constraints P" + and P: "\T \ set P. \x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + shows "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ SMP (\T \ set P. trms_transaction T)" (is "?A \") + and "SMP (pair`setops\<^sub>s\<^sub>s\<^sub>t (unlabel \)) \ SMP (\T\set P. pair`setops_transaction T)" (is "?B \") +proof - + have "?A \ \ ?B \" using \ + proof (induction \ rule: reachable_constraints.induct) + case (step A T \ \) + define T' where "T' \ transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \" + define M where "M \ \T \ set P. trms_transaction T" + define N where "N \ \T \ set P. pair ` setops_transaction T" + + let ?P = "\t. \s \. s \ M \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = s \ \" + let ?Q = "\t. \s \. s \ N \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = s \ \" + + have IH: "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \ SMP M" "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)) \ SMP N" + using step.IH by (metis M_def, metis N_def) + + have \\_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" + using P(1) step.hyps(2) + transaction_fresh_subst_transaction_renaming_wt[OF step.hyps(3,4)] + by fast + + have \\_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + using transaction_fresh_subst_range_wf_trms[OF step.hyps(3)] + transaction_renaming_subst_range_wf_trms[OF step.hyps(4)] + by (metis wf_trms_subst_compose) + + have 0: "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')) = SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \ SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" + "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'))) = + SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)) \ SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel T'))" + using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of T'] + setops\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of T'] + trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"] + setops\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"] + unlabel_append[of A "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"] + image_Un[of pair "setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "setops\<^sub>s\<^sub>s\<^sub>t (unlabel T')"] + SMP_union[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"] + SMP_union[of "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel T')"] + by argo+ + + have 1: "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \ SMP M" + proof (intro SMP_subset_I ballI) + fix t show "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ ?P t" + using trms\<^sub>s\<^sub>s\<^sub>t_wt_subst_ex[OF \\_wt \\_wf, of t "unlabel (transaction_strand T)"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] step.hyps(2) + unfolding T'_def M_def by auto + qed + + have 2: "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel T')) \ SMP N" + proof (intro SMP_subset_I ballI) + fix t show "t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel T') \ ?Q t" + using setops\<^sub>s\<^sub>s\<^sub>t_wt_subst_ex[OF \\_wt \\_wf, of t "unlabel (transaction_strand T)"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] step.hyps(2) + unfolding T'_def N_def by auto + qed + + have "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')) \ SMP M" + "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'))) \ SMP N" + using 0 1 2 IH by blast+ + thus ?case unfolding T'_def M_def N_def by blast + qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + thus "?A \" "?B \" by metis+ +qed + +lemma reachable_constraints_no_Pair_fun: + assumes A: "A \ reachable_constraints P" + and P: "\T \ set P. admissible_transaction T" + shows "Pair \ \(funs_term ` SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" +using A +proof (induction A rule: reachable_constraints.induct) + case (step A T \ \) + define T' where "T' \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + + have T_adm: "admissible_transaction T" using step.hyps(2) P unfolding list_all_iff by blast + + have \\_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" + using protocol_transaction_vars_TAtom_typed(3) P(1) step.hyps(2) + transaction_fresh_subst_transaction_renaming_wt[OF step.hyps(3,4)] + by fast + + have \\_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + using transaction_fresh_subst_range_wf_trms[OF step.hyps(3)] + transaction_renaming_subst_range_wf_trms[OF step.hyps(4)] + by (metis wf_trms_subst_compose) + + have 0: "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T')) = SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \ SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" + using SMP_union[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"] + unlabel_append[of A T'] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" "unlabel T'"] + by simp + + have 1: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" + using reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s[OF _ reachable_constraints.step[OF step.hyps]] + admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P + trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A"] unlabel_append[of A] + unfolding T'_def by force + + have 2: "Pair \ \(funs_term ` (subst_range (\ \\<^sub>s \)))" + using transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)] by force + + have "Pair \ \(funs_term ` (trms_transaction T))" + using T_adm + unfolding admissible_transaction_def admissible_transaction_terms_def + by blast + hence "Pair \ funs_term t" + when t: "t \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" for t + using 2 trms\<^sub>s\<^sub>s\<^sub>t_funs_term_cases[OF t] + by force + hence 3: "Pair \ funs_term t" when t: "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for t + using t unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \"] + unfolding T'_def by metis + + have "\a. \\<^sub>v x = TAtom a" when "x \ vars_transaction T" for x + using that protocol_transaction_vars_TAtom_typed(1) P step.hyps(2) + by fast + hence "\a. \\<^sub>v x = TAtom a" when "x \ vars\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" for x + using wt_subst_fv\<^sub>s\<^sub>e\<^sub>t_termtype_subterm[OF _ \\_wt \\_wf, of x "vars_transaction T"] + vars\<^sub>s\<^sub>s\<^sub>t_subst_cases[OF that] + by fastforce + hence "\a. \\<^sub>v x = TAtom a" when "x \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" for x + using that unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + vars\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \"] + unfolding T'_def + by simp + hence "\a. \\<^sub>v x = TAtom a" when "x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" for x + using that fv_trms\<^sub>s\<^sub>s\<^sub>t_subset(1) by fast + hence "Pair \ funs_term (\ (Var x))" when "x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" for x + using that by fastforce + moreover have "Pair \ funs_term s" + when s: "Ana s = (K, M)" "Pair \ \(funs_term ` set K)" + for s::"('fun,'atom,'sets) prot_term" and K M + proof (cases s) + case (Fun f S) thus ?thesis using s Ana_Fu_keys_not_pairs[of _ S K M] by (cases f) force+ + qed (use s in simp) + ultimately have "Pair \ funs_term t" when t: "t \ SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" for t + using t 3 SMP_funs_term[OF t _ _ 1, of Pair] funs_term_type_iff by fastforce + thus ?case using 0 step.IH(1) unfolding T'_def by blast +qed simp + +lemma reachable_constraints_setops_form: + assumes A: "A \ reachable_constraints P" + and P: "\T \ set P. admissible_transaction T" + and t: "t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + shows "\c s. t = pair (c, Fun (Set s) []) \ \ c = TAtom Value" +using A t +proof (induction A rule: reachable_constraints.induct) + case (step A T \ \) + + have T_adm: "admissible_transaction T" when "T \ set P" for T + using P that unfolding list_all_iff by simp + + have T_adm': + "admissible_transaction_selects T" + "admissible_transaction_checks T" + "admissible_transaction_updates T" + when "T \ set P" for T + using T_adm[OF that] unfolding admissible_transaction_def by simp_all + + have T_valid: "wellformed_transaction T" when "T \ set P" for T + using T_adm[OF that] unfolding admissible_transaction_def by blast + + have \\_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" + using protocol_transaction_vars_TAtom_typed(3) P(1) step.hyps(2) + transaction_fresh_subst_transaction_renaming_wt[OF step.hyps(3,4)] + by fast + + have \\_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + using transaction_fresh_subst_range_wf_trms[OF step.hyps(3)] + transaction_renaming_subst_range_wf_trms[OF step.hyps(4)] + by (metis wf_trms_subst_compose) + + show ?case using step.IH + proof (cases "t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)") + case False + hence "t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T) \\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + using step.prems setops\<^sub>s\<^sub>s\<^sub>t_append unlabel_append + setops\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + by fastforce + then obtain t' \ where t': + "t' \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))" + "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "t = t' \ \" + using setops\<^sub>s\<^sub>s\<^sub>t_wt_subst_ex[OF \\_wt \\_wf] by blast + then obtain s s' where s: "t' = pair (s,s')" + using setops\<^sub>s\<^sub>s\<^sub>t_are_pairs by fastforce + moreover have "InSet ac s s' = InSet Assign s s' \ InSet ac s s' = InSet Check s s'" for ac + by (cases ac) simp_all + ultimately have "\n. s = Var (Var Value, n)" "\u. s' = Fun (Set u) []" + using t'(1) setops\<^sub>s\<^sub>s\<^sub>t_member_iff[of s s' "unlabel (transaction_strand T)"] + pair_in_pair_image_iff[of s s'] + transaction_inserts_are_Value_vars[ + OF T_valid[OF step.hyps(2)] T_adm'(3)[OF step.hyps(2)], of s s'] + transaction_deletes_are_Value_vars[ + OF T_valid[OF step.hyps(2)] T_adm'(3)[OF step.hyps(2)], of s s'] + transaction_selects_are_Value_vars[ + OF T_valid[OF step.hyps(2)] T_adm'(1)[OF step.hyps(2)], of s s'] + transaction_inset_checks_are_Value_vars[ + OF T_valid[OF step.hyps(2)] T_adm'(2)[OF step.hyps(2)], of s s'] + transaction_notinset_checks_are_Value_vars[ + OF T_valid[OF step.hyps(2)] T_adm'(2)[OF step.hyps(2)], of _ _ _ s s'] + by metis+ + then obtain ss n where ss: "t = pair (\ (Var Value, n), Fun (Set ss) [])" + using t'(4) s unfolding pair_def by force + + have "\ (\ (Var Value, n)) = TAtom Value" "wf\<^sub>t\<^sub>r\<^sub>m (\ (Var Value, n))" + using t'(2) wt_subst_trm''[OF t'(2), of "Var (Var Value, n)"] apply simp + using t'(3) by (cases "(Var Value, n) \ subst_domain \") auto + thus ?thesis using ss by blast + qed simp +qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + +lemma reachable_constraints_setops_type: + fixes t::"('fun,'atom,'sets) prot_term" + assumes A: "A \ reachable_constraints P" + and P: "\T \ set P. admissible_transaction T" + and t: "t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + shows "\ t = TComp Pair [TAtom Value, TAtom SetType]" +proof - + obtain s c where s: "t = pair (c, Fun (Set s) [])" "\ c = TAtom Value" + using reachable_constraints_setops_form[OF A P t] by moura + hence "(Fun (Set s) []::('fun,'atom,'sets) prot_term) \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + using t setops\<^sub>s\<^sub>s\<^sub>t_member_iff[of c "Fun (Set s) []" "unlabel A"] + by force + hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun (Set s) []::('fun,'atom,'sets) prot_term)" + using reachable_constraints_wf(2) P A + unfolding admissible_transaction_def admissible_transaction_terms_def by blast + hence "arity (Set s) = 0" unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by simp + thus ?thesis using s unfolding pair_def by fastforce +qed + +lemma reachable_constraints_setops_same_type_if_unifiable: + assumes A: "A \ reachable_constraints P" + and P: "\T \ set P. admissible_transaction T" + shows "\s \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A). \t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A). + (\\. Unifier \ s t) \ \ s = \ t" + (is "?P A") +using reachable_constraints_setops_type[OF A P] by simp + +lemma reachable_constraints_setops_unfiable_if_wt_instance_unifiable: + assumes A: "A \ reachable_constraints P" + and P: "\T \ set P. admissible_transaction T" + shows "\s \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A). \t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A). + (\\ \ \. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ + Unifier \ (s \ \) (t \ \)) + \ (\\. Unifier \ s t)" +proof (intro ballI impI) + fix s t assume st: "s \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" and + "\\ \ \. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ + Unifier \ (s \ \) (t \ \)" + then obtain \ \ \ where \: + "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + "Unifier \ (s \ \) (t \ \)" + by moura + + obtain fs ft cs ct where c: + "s = pair (cs, Fun (Set fs) [])" "t = pair (ct, Fun (Set ft) [])" + "\ cs = TAtom Value" "\ ct = TAtom Value" + using reachable_constraints_setops_form[OF A P st(1)] + reachable_constraints_setops_form[OF A P st(2)] + by moura + + have "cs \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" "ct \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + using c(1,2) setops_subterm_trms[OF st(1), of cs] setops_subterm_trms[OF st(2), of ct] + Fun_param_is_subterm[of cs "args s"] Fun_param_is_subterm[of ct "args t"] + unfolding pair_def by simp_all + moreover have + "\T \ set P. wellformed_transaction T" + "\T \ set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)" + using P unfolding admissible_transaction_def admissible_transaction_terms_def by fast+ + ultimately have *: "wf\<^sub>t\<^sub>r\<^sub>m cs" "wf\<^sub>t\<^sub>r\<^sub>m ct" + using reachable_constraints_wf(2)[OF _ _ A] wf_trms_subterms by blast+ + + have "(\x. cs = Var x) \ (\c d. cs = Fun c [])" + using const_type_inv_wf c(3) *(1) by (cases cs) auto + moreover have "(\x. ct = Var x) \ (\c d. ct = Fun c [])" + using const_type_inv_wf c(4) *(2) by (cases ct) auto + ultimately show "\\. Unifier \ s t" + using reachable_constraints_setops_form[OF A P] reachable_constraints_setops_type[OF A P] st \ c + unfolding pair_def by auto +qed + +lemma reachable_constraints_tfr: + assumes M: + "M \ \T \ set P. trms_transaction T" + "has_all_wt_instances_of \ M N" + "finite N" + "tfr\<^sub>s\<^sub>e\<^sub>t N" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N" + and P: + "\T \ set P. admissible_transaction T" + "\T \ set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))" + and \: "\ \ reachable_constraints P" + shows "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel \)" +using \ +proof (induction \ rule: reachable_constraints.induct) + case (step A T \ \) + define T' where "T' \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + + have P': + "\T \ set P. \x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + "\T \ set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms_transaction T)" + using P(1) protocol_transaction_vars_TAtom_typed(3) admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s + by blast+ + + have AT'_reach: "A@T' \ reachable_constraints P" + using reachable_constraints.step[OF step.hyps] unfolding T'_def by metis + + have \\_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" + using P'(1) step.hyps(2) transaction_fresh_subst_transaction_renaming_wt[OF step.hyps(3,4)] + by fast + + have \\_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + using transaction_fresh_subst_range_wf_trms[OF step.hyps(3)] + transaction_renaming_subst_range_wf_trms[OF step.hyps(4)] + by (metis wf_trms_subst_compose) + + have \\_bvars_disj: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \ range_vars (\ \\<^sub>s \) = {}" + by (rule transaction_fresh_subst_transaction_renaming_subst_vars_disj(4)[OF step.hyps(3,4,2)]) + + have wf_trms_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" + using admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) + unfolding M(1) by blast + + have "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T'))" + using reachable_constraints_SMP_subset(1)[OF AT'_reach P'(1)] + tfr_subset(3)[OF M(4), of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T')"] + SMP_SMP_subset[of M N] SMP_I'[OF wf_trms_M M(5,2)] + unfolding M(1) by blast + moreover have "\p. Ana (pair p) = ([],[])" unfolding pair_def by auto + ultimately have 1: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T') \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T')))" + using tfr_setops_if_tfr_trms[of "unlabel (A@T')"] + reachable_constraints_no_Pair_fun[OF AT'_reach P(1)] + reachable_constraints_setops_same_type_if_unifiable[OF AT'_reach P(1)] + reachable_constraints_setops_unfiable_if_wt_instance_unifiable[OF AT'_reach P(1)] + by blast + + have "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))" + using step.hyps(2) P(2) tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p + unfolding comp_tfr\<^sub>s\<^sub>s\<^sub>t_def tfr\<^sub>s\<^sub>s\<^sub>t_def by fastforce + hence "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel T')" + using tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_all_wt_subst_apply[OF _ \\_wt \\_wf \\_bvars_disj] + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + unfolding T'_def by argo + hence 2: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (A@T'))" + using step.IH unlabel_append + unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by auto + + have "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))" using 1 2 by (metis tfr\<^sub>s\<^sub>s\<^sub>t_def) + thus ?case by (metis T'_def) +qed simp + +lemma reachable_constraints_tfr': + assumes M: + "M \ \T \ set P. trms_transaction T \ pair' Pair ` setops_transaction T" + "has_all_wt_instances_of \ M N" + "finite N" + "tfr\<^sub>s\<^sub>e\<^sub>t N" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N" + and P: + "\T \ set P. \x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + "\T \ set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)" + "\T \ set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))" + and \: "\ \ reachable_constraints P" + shows "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel \)" +using \ +proof (induction \ rule: reachable_constraints.induct) + case (step A T \ \) + define T' where "T' \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + + have AT'_reach: "A@T' \ reachable_constraints P" + using reachable_constraints.step[OF step.hyps] unfolding T'_def by metis + + have \\_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" + using P(1) step.hyps(2) transaction_fresh_subst_transaction_renaming_wt[OF step.hyps(3,4)] + by fast + + have \\_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + using transaction_fresh_subst_range_wf_trms[OF step.hyps(3)] + transaction_renaming_subst_range_wf_trms[OF step.hyps(4)] + by (metis wf_trms_subst_compose) + + have \\_bvars_disj: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \ range_vars (\ \\<^sub>s \) = {}" + by (rule transaction_fresh_subst_transaction_renaming_subst_vars_disj(4)[OF step.hyps(3,4,2)]) + + have wf_trms_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" + using P(2) setops\<^sub>s\<^sub>s\<^sub>t_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s(2) unfolding M(1) pair_code wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric] by fast + + have "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T')) \ SMP M" "SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))) \ SMP M" + using reachable_constraints_SMP_subset[OF AT'_reach P(1)] + SMP_mono[of "\T \ set P. trms_transaction T" M] + SMP_mono[of "\T \ set P. pair ` setops_transaction T" M] + unfolding M(1) pair_code[symmetric] by blast+ + hence 1: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T') \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T')))" + using tfr_subset(3)[OF M(4), of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T') \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))"] + SMP_union[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@T')" "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))"] + SMP_SMP_subset[of M N] SMP_I'[OF wf_trms_M M(5,2)] + by blast + + have "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))" + using step.hyps(2) P(3) tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p + unfolding comp_tfr\<^sub>s\<^sub>s\<^sub>t_def tfr\<^sub>s\<^sub>s\<^sub>t_def by fastforce + hence "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel T')" + using tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_all_wt_subst_apply[OF _ \\_wt \\_wf \\_bvars_disj] + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + unfolding T'_def by argo + hence 2: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (A@T'))" + using step.IH unlabel_append + unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by auto + + have "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel (A@T'))" using 1 2 by (metis tfr\<^sub>s\<^sub>s\<^sub>t_def) + thus ?case by (metis T'_def) +qed simp + +lemma reachable_constraints_typing_cond\<^sub>s\<^sub>s\<^sub>t: + assumes M: + "M \ \T \ set P. trms_transaction T \ pair' Pair ` setops_transaction T" + "has_all_wt_instances_of \ M N" + "finite N" + "tfr\<^sub>s\<^sub>e\<^sub>t N" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N" + and P: + "\T \ set P. wellformed_transaction T" + "\T \ set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)" + "\T \ set P. \x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + "\T \ set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))" + and \: "\ \ reachable_constraints P" + shows "typing_cond\<^sub>s\<^sub>s\<^sub>t (unlabel \)" +using reachable_constraints_wf[OF P(1,2) \] reachable_constraints_tfr'[OF M P(3,2,4) \] +unfolding typing_cond\<^sub>s\<^sub>s\<^sub>t_def by blast + +context +begin +private lemma reachable_constraints_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_aux: + fixes P + defines "Ts \ concat (map transaction_strand P)" + assumes P_fresh_wf: "\T \ set P. \x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + (is "\T \ set P. ?fresh_wf T") + and A: "A \ reachable_constraints P" + shows "\b \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A). \a \ set Ts. \\. b = a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \ + wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ + (\t \ subst_range \. (\x. t = Var x) \ (\c. t = Fun c []))" + (is "\b \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A). \a \ set Ts. ?P b a") +using A +proof (induction A rule: reachable_constraints.induct) + case (step \ T \ \) + define Q where "Q \ ?P" + define \ where "\ \ \ \\<^sub>s \" + + let ?R = "\A Ts. \b \ set A. \a \ set Ts. Q b a" + + have T_fresh_wf: "?fresh_wf T" using step.hyps(2) P_fresh_wf by blast + + have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + "\t \ subst_range \. (\x. t = Var x) \ (\c. t = Fun c [])" + using wt_subst_compose[ + OF transaction_fresh_subst_wt[OF step.hyps(3) T_fresh_wf] + transaction_renaming_subst_wt[OF step.hyps(4)]] + wf_trms_subst_compose[ + OF transaction_fresh_subst_range_wf_trms[OF step.hyps(3)] + transaction_renaming_subst_range_wf_trms[OF step.hyps(4)]] + transaction_fresh_subst_transaction_renaming_subst_range'[OF step.hyps(3,4)] + unfolding \_def by metis+ + hence "?R (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) (transaction_strand T)" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_self_inverse[of "transaction_strand T"] + by (auto simp add: Q_def subst_apply_labeled_stateful_strand_def) + hence "?R (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) (transaction_strand T)" + by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst) + hence "?R (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) Ts" + using step.hyps(2) unfolding Ts_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by fastforce + thus ?case using step.IH unfolding Q_def \_def by auto +qed simp + +lemma reachable_constraints_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t: + fixes P + defines "f \ \M. {t \ \ | t \. t \ M \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}}" + and "Ts \ concat (map transaction_strand P)" + assumes P_pc: "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \ Pair Ts M S" + and P_wf: "\T \ set P. \x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + and A: "A \ reachable_constraints P" + shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A ((f (set S)) - {m. intruder_synth {} m})" +using par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_if_comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t'[OF P_pc, of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A", THEN par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t] + reachable_constraints_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_aux[OF P_wf A, unfolded Ts_def[symmetric]] +unfolding f_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_self_inverse by fast +end + +lemma reachable_constraints_par_comp_constr: + fixes P f S + defines "f \ \M. {t \ \ | t \. t \ M \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}}" + and "Ts \ concat (map transaction_strand P)" + and "Sec \ (f (set S)) - {m. intruder_synth {} m}" + and "M \ \T \ set P. trms_transaction T \ pair' Pair ` setops_transaction T" + assumes M: + "has_all_wt_instances_of \ M N" + "finite N" + "tfr\<^sub>s\<^sub>e\<^sub>t N" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N" + and P: + "\T \ set P. wellformed_transaction T" + "\T \ set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)" + "\T \ set P. \x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + "\T \ set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))" + "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \ Pair Ts M_fun S" + and \: "\ \ reachable_constraints P" + and \: "constraint_model \ \" + shows "\\\<^sub>\. welltyped_constraint_model \\<^sub>\ \ \ + ((\n. welltyped_constraint_model \\<^sub>\ (proj n \)) \ + (\\'. prefix \' \ \ strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t \' Sec \\<^sub>\))" +proof - + have \': "constr_sem_stateful \ (unlabel \)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + using \ unfolding constraint_model_def by blast+ + + show ?thesis + using reachable_constraints_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t[OF P(5,3)[unfolded Ts_def] \] + reachable_constraints_typing_cond\<^sub>s\<^sub>s\<^sub>t[OF M_def M P(1,2,3,4) \] + par_comp_constr_stateful[OF _ _ \', of Sec] + unfolding f_def Sec_def welltyped_constraint_model_def constraint_model_def by blast +qed + +end + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy b/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy @@ -0,0 +1,3681 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Stateful_Protocol_Verification.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\Stateful Protocol Verification\ +theory Stateful_Protocol_Verification +imports Stateful_Protocol_Model Term_Implication +begin + +subsection \Fixed-Point Intruder Deduction Lemma\ +context stateful_protocol_model +begin + +abbreviation pubval_terms::"('fun,'atom,'sets) prot_terms" where + "pubval_terms \ {t. \f \ funs_term t. is_Val f \ public f}" + +abbreviation abs_terms::"('fun,'atom,'sets) prot_terms" where + "abs_terms \ {t. \f \ funs_term t. is_Abs f}" + +definition intruder_deduct_GSMP:: + "[('fun,'atom,'sets) prot_terms, + ('fun,'atom,'sets) prot_terms, + ('fun,'atom,'sets) prot_term] + \ bool" ("\_;_\ \\<^sub>G\<^sub>S\<^sub>M\<^sub>P _" 50) +where + "\M; T\ \\<^sub>G\<^sub>S\<^sub>M\<^sub>P t \ intruder_deduct_restricted M (\t. t \ GSMP T - (pubval_terms \ abs_terms)) t" + +lemma intruder_deduct_GSMP_induct[consumes 1, case_names AxiomH ComposeH DecomposeH]: + assumes "\M; T\ \\<^sub>G\<^sub>S\<^sub>M\<^sub>P t" "\t. t \ M \ P M t" + "\S f. \length S = arity f; public f; + \s. s \ set S \ \M; T\ \\<^sub>G\<^sub>S\<^sub>M\<^sub>P s; + \s. s \ set S \ P M s; + Fun f S \ GSMP T - (pubval_terms \ abs_terms) + \ \ P M (Fun f S)" + "\t K T' t\<^sub>i. \\M; T\ \\<^sub>G\<^sub>S\<^sub>M\<^sub>P t; P M t; Ana t = (K, T'); \k. k \ set K \ \M; T\ \\<^sub>G\<^sub>S\<^sub>M\<^sub>P k; + \k. k \ set K \ P M k; t\<^sub>i \ set T'\ \ P M t\<^sub>i" + shows "P M t" +proof - + let ?Q = "\t. t \ GSMP T - (pubval_terms \ abs_terms)" + show ?thesis + using intruder_deduct_restricted_induct[of M ?Q t "\M Q t. P M t"] assms + unfolding intruder_deduct_GSMP_def + by blast +qed + +lemma pubval_terms_subst: + assumes "t \ \ \ pubval_terms" "\ ` fv t \ pubval_terms = {}" + shows "t \ pubval_terms" +using assms(1,2) +proof (induction t) + case (Fun f T) + let ?P = "\f. is_Val f \ public f" + from Fun show ?case + proof (cases "?P f") + case False + then obtain t where t: "t \ set T" "t \ \ \ pubval_terms" + using Fun.prems by auto + hence "\ ` fv t \ pubval_terms = {}" using Fun.prems(2) by auto + thus ?thesis using Fun.IH[OF t] t(1) by auto + qed force +qed simp + +lemma abs_terms_subst: + assumes "t \ \ \ abs_terms" "\ ` fv t \ abs_terms = {}" + shows "t \ abs_terms" +using assms(1,2) +proof (induction t) + case (Fun f T) + let ?P = "\f. is_Abs f" + from Fun show ?case + proof (cases "?P f") + case False + then obtain t where t: "t \ set T" "t \ \ \ abs_terms" + using Fun.prems by auto + hence "\ ` fv t \ abs_terms = {}" using Fun.prems(2) by auto + thus ?thesis using Fun.IH[OF t] t(1) by auto + qed force +qed simp + +lemma pubval_terms_subst': + assumes "t \ \ \ pubval_terms" "\n. Val (n,True) \ \(funs_term ` (\ ` fv t))" + shows "t \ pubval_terms" +proof - + have "\public f" + when fs: "f \ funs_term s" "s \ subterms\<^sub>s\<^sub>e\<^sub>t (\ ` fv t)" "is_Val f" + for f s + proof - + obtain T where T: "Fun f T \ subterms s" using funs_term_Fun_subterm[OF fs(1)] by moura + hence "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (\ ` fv t)" using fs(2) in_subterms_subset_Union by blast + thus ?thesis using assms(2) funs_term_Fun_subterm'[of f T] fs(3) by (cases f) force+ + qed + thus ?thesis using pubval_terms_subst[OF assms(1)] by force +qed + +lemma abs_terms_subst': + assumes "t \ \ \ abs_terms" "\n. Abs n \ \(funs_term ` (\ ` fv t))" + shows "t \ abs_terms" +proof - + have "\is_Abs f" when fs: "f \ funs_term s" "s \ subterms\<^sub>s\<^sub>e\<^sub>t (\ ` fv t)" for f s + proof - + obtain T where T: "Fun f T \ subterms s" using funs_term_Fun_subterm[OF fs(1)] by moura + hence "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (\ ` fv t)" using fs(2) in_subterms_subset_Union by blast + thus ?thesis using assms(2) funs_term_Fun_subterm'[of f T] by (cases f) auto + qed + thus ?thesis using abs_terms_subst[OF assms(1)] by force +qed + +lemma pubval_terms_subst_range_disj: + "subst_range \ \ pubval_terms = {} \ \ ` fv t \ pubval_terms = {}" +proof (induction t) + case (Var x) thus ?case by (cases "x \ subst_domain \") auto +qed auto + +lemma abs_terms_subst_range_disj: + "subst_range \ \ abs_terms = {} \ \ ` fv t \ abs_terms = {}" +proof (induction t) + case (Var x) thus ?case by (cases "x \ subst_domain \") auto +qed auto + +lemma pubval_terms_subst_range_comp: + assumes "subst_range \ \ pubval_terms = {}" "subst_range \ \ pubval_terms = {}" + shows "subst_range (\ \\<^sub>s \) \ pubval_terms = {}" +proof - + { fix t f assume t: + "t \ subst_range (\ \\<^sub>s \)" "f \ funs_term t" "is_Val f" "public f" + then obtain x where x: "(\ \\<^sub>s \) x = t" by auto + have "\ x \ pubval_terms" using assms(1) by (cases "\ x \ subst_range \") force+ + hence "(\ \\<^sub>s \) x \ pubval_terms" + using assms(2) pubval_terms_subst[of "\ x" \] pubval_terms_subst_range_disj + by (metis (mono_tags, lifting) subst_compose_def) + hence False using t(2,3,4) x by blast + } thus ?thesis by fast +qed + +lemma pubval_terms_subst_range_comp': + assumes "(\ ` X) \ pubval_terms = {}" "(\ ` fv\<^sub>s\<^sub>e\<^sub>t (\ ` X)) \ pubval_terms = {}" + shows "((\ \\<^sub>s \) ` X) \ pubval_terms = {}" +proof - + { fix t f assume t: + "t \ (\ \\<^sub>s \) ` X" "f \ funs_term t" "is_Val f" "public f" + then obtain x where x: "(\ \\<^sub>s \) x = t" "x \ X" by auto + have "\ x \ pubval_terms" using assms(1) x(2) by force + moreover have "fv (\ x) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` X)" using x(2) by (auto simp add: fv_subset) + hence "\ ` fv (\ x) \ pubval_terms = {}" using assms(2) by auto + ultimately have "(\ \\<^sub>s \) x \ pubval_terms" + using pubval_terms_subst[of "\ x" \] + by (metis (mono_tags, lifting) subst_compose_def) + hence False using t(2,3,4) x by blast + } thus ?thesis by fast +qed + +lemma abs_terms_subst_range_comp: + assumes "subst_range \ \ abs_terms = {}" "subst_range \ \ abs_terms = {}" + shows "subst_range (\ \\<^sub>s \) \ abs_terms = {}" +proof - + { fix t f assume t: "t \ subst_range (\ \\<^sub>s \)" "f \ funs_term t" "is_Abs f" + then obtain x where x: "(\ \\<^sub>s \) x = t" by auto + have "\ x \ abs_terms" using assms(1) by (cases "\ x \ subst_range \") force+ + hence "(\ \\<^sub>s \) x \ abs_terms" + using assms(2) abs_terms_subst[of "\ x" \] abs_terms_subst_range_disj + by (metis (mono_tags, lifting) subst_compose_def) + hence False using t(2,3) x by blast + } thus ?thesis by fast +qed + +lemma abs_terms_subst_range_comp': + assumes "(\ ` X) \ abs_terms = {}" "(\ ` fv\<^sub>s\<^sub>e\<^sub>t (\ ` X)) \ abs_terms = {}" + shows "((\ \\<^sub>s \) ` X) \ abs_terms = {}" +proof - + { fix t f assume t: + "t \ (\ \\<^sub>s \) ` X" "f \ funs_term t" "is_Abs f" + then obtain x where x: "(\ \\<^sub>s \) x = t" "x \ X" by auto + have "\ x \ abs_terms" using assms(1) x(2) by force + moreover have "fv (\ x) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` X)" using x(2) by (auto simp add: fv_subset) + hence "\ ` fv (\ x) \ abs_terms = {}" using assms(2) by auto + ultimately have "(\ \\<^sub>s \) x \ abs_terms" + using abs_terms_subst[of "\ x" \] + by (metis (mono_tags, lifting) subst_compose_def) + hence False using t(2,3) x by blast + } thus ?thesis by fast +qed + +context +begin +private lemma Ana_abs_aux1: + fixes \::"(('fun,'atom,'sets) prot_fun, nat, ('fun,'atom,'sets) prot_var) gsubst" + and \::"nat \ bool \ 'sets set" + assumes "Ana\<^sub>f f = (K,T)" + shows "(K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \) \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ = K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (\n. \ n \\<^sub>\ \)" +proof - + { fix k assume "k \ set K" + hence "k \ subterms\<^sub>s\<^sub>e\<^sub>t (set K)" by force + hence "k \ \ \\<^sub>\ \ = k \ (\n. \ n \\<^sub>\ \)" + proof (induction k) + case (Fun g S) + have "\s. s \ set S \ s \ \ \\<^sub>\ \ = s \ (\n. \ n \\<^sub>\ \)" + using Fun.IH in_subterms_subset_Union[OF Fun.prems] Fun_param_in_subterms[of _ S g] + by (meson contra_subsetD) + thus ?case using Ana\<^sub>f_assm1_alt[OF assms Fun.prems] by (cases g) auto + qed simp + } thus ?thesis unfolding abs_apply_list_def by force +qed + +private lemma Ana_abs_aux2: + fixes \::"nat \ bool \ 'sets set" + and K::"(('fun,'atom,'sets) prot_fun, nat) term list" + and M::"nat list" + and T::"('fun,'atom,'sets) prot_term list" + assumes "\i \ fv\<^sub>s\<^sub>e\<^sub>t (set K) \ set M. i < length T" + and "(K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T) \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ = K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (\n. T ! n \\<^sub>\ \)" + shows "(K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T) \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ = K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) (map (\s. s \\<^sub>\ \) T)" (is "?A1 = ?A2") + and "(map ((!) T) M) \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ = map ((!) (map (\s. s \\<^sub>\ \) T)) M" (is "?B1 = ?B2") +proof - + have "T ! i \\<^sub>\ \ = (map (\s. s \\<^sub>\ \) T) ! i" when "i \ fv\<^sub>s\<^sub>e\<^sub>t (set K)" for i + using that assms(1) by auto + hence "k \ (\i. T ! i \\<^sub>\ \) = k \ (\i. (map (\s. s \\<^sub>\ \) T) ! i)" when "k \ set K" for k + using that term_subst_eq_conv[of k "\i. T ! i \\<^sub>\ \" "\i. (map (\s. s \\<^sub>\ \) T) ! i"] + by auto + thus "?A1 = ?A2" using assms(2) by (force simp add: abs_apply_terms_def) + + have "T ! i \\<^sub>\ \ = map (\s. s \\<^sub>\ \) T ! i" when "i \ set M" for i + using that assms(1) by auto + thus "?B1 = ?B2" by (force simp add: abs_apply_list_def) +qed + +private lemma Ana_abs_aux1_set: + fixes \::"(('fun,'atom,'sets) prot_fun, nat, ('fun,'atom,'sets) prot_var) gsubst" + and \::"nat \ bool \ 'sets set" + assumes "Ana\<^sub>f f = (K,T)" + shows "(set K \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \ = set K \\<^sub>s\<^sub>e\<^sub>t (\n. \ n \\<^sub>\ \)" +proof - + { fix k assume "k \ set K" + hence "k \ subterms\<^sub>s\<^sub>e\<^sub>t (set K)" by force + hence "k \ \ \\<^sub>\ \ = k \ (\n. \ n \\<^sub>\ \)" + proof (induction k) + case (Fun g S) + have "\s. s \ set S \ s \ \ \\<^sub>\ \ = s \ (\n. \ n \\<^sub>\ \)" + using Fun.IH in_subterms_subset_Union[OF Fun.prems] Fun_param_in_subterms[of _ S g] + by (meson contra_subsetD) + thus ?case using Ana\<^sub>f_assm1_alt[OF assms Fun.prems] by (cases g) auto + qed simp + } thus ?thesis unfolding abs_apply_terms_def by force +qed + +private lemma Ana_abs_aux2_set: + fixes \::"nat \ bool \ 'sets set" + and K::"(('fun,'atom,'sets) prot_fun, nat) terms" + and M::"nat set" + and T::"('fun,'atom,'sets) prot_term list" + assumes "\i \ fv\<^sub>s\<^sub>e\<^sub>t K \ M. i < length T" + and "(K \\<^sub>s\<^sub>e\<^sub>t (!) T) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \ = K \\<^sub>s\<^sub>e\<^sub>t (\n. T ! n \\<^sub>\ \)" + shows "(K \\<^sub>s\<^sub>e\<^sub>t (!) T) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \ = K \\<^sub>s\<^sub>e\<^sub>t (!) (map (\s. s \\<^sub>\ \) T)" (is "?A1 = ?A2") + and "((!) T ` M) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \ = (!) (map (\s. s \\<^sub>\ \) T) ` M" (is "?B1 = ?B2") +proof - + have "T ! i \\<^sub>\ \ = (map (\s. s \\<^sub>\ \) T) ! i" when "i \ fv\<^sub>s\<^sub>e\<^sub>t K" for i + using that assms(1) by auto + hence "k \ (\i. T ! i \\<^sub>\ \) = k \ (\i. (map (\s. s \\<^sub>\ \) T) ! i)" when "k \ K" for k + using that term_subst_eq_conv[of k "\i. T ! i \\<^sub>\ \" "\i. (map (\s. s \\<^sub>\ \) T) ! i"] + by auto + thus "?A1 = ?A2" using assms(2) by (force simp add: abs_apply_terms_def) + + have "T ! i \\<^sub>\ \ = map (\s. s \\<^sub>\ \) T ! i" when "i \ M" for i + using that assms(1) by auto + thus "?B1 = ?B2" by (force simp add: abs_apply_terms_def) +qed + +lemma Ana_abs: + fixes t::"('fun,'atom,'sets) prot_term" + assumes "Ana t = (K, T)" + shows "Ana (t \\<^sub>\ \) = (K \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, T \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" + using assms +proof (induction t rule: Ana.induct) + case (1 f S) + obtain K' T' where *: "Ana\<^sub>f f = (K',T')" by moura + show ?case using 1 + proof (cases "arity\<^sub>f f = length S \ arity\<^sub>f f > 0") + case True + hence "K = K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) S" "T = map ((!) S) T'" + and **: "arity\<^sub>f f = length (map (\s. s \\<^sub>\ \) S)" "arity\<^sub>f f > 0" + using 1 * by auto + hence "K \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ = K' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) (map (\s. s \\<^sub>\ \) S)" + "T \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ = map ((!) (map (\s. s \\<^sub>\ \) S)) T'" + using Ana\<^sub>f_assm2_alt[OF *] Ana_abs_aux2[OF _ Ana_abs_aux1[OF *], of T' S \] + unfolding abs_apply_list_def + by auto + moreover have "Fun (Fu f) S \\<^sub>\ \ = Fun (Fu f) (map (\s. s \\<^sub>\ \) S)" by simp + ultimately show ?thesis using Ana_Fu_intro[OF ** *] by metis + qed (auto simp add: abs_apply_list_def) +qed (simp_all add: abs_apply_list_def) +end + +lemma deduct_FP_if_deduct: + fixes M IK FP::"('fun,'atom,'sets) prot_terms" + assumes IK: "IK \ GSMP M - (pubval_terms \ abs_terms)" "\t \ IK \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \. FP \\<^sub>c t" + and t: "IK \ t" "t \ GSMP M - (pubval_terms \ abs_terms)" + shows "FP \ t \\<^sub>\ \" +proof - + let ?P = "\f. is_Val f \ \public f" + let ?GSMP = "GSMP M - (pubval_terms \ abs_terms)" + + have 1: "\m \ IK. m \ ?GSMP" + using IK(1) by blast + + have 2: "\t t'. t \ ?GSMP \ t' \ t \ t' \ ?GSMP" + proof (intro allI impI) + fix t t' assume t: "t \ ?GSMP" "t' \ t" + hence "t' \ GSMP M" using ground_subterm unfolding GSMP_def by auto + moreover have "\public f" + when "f \ funs_term t" "is_Val f" for f + using t(1) that by auto + hence "\public f" + when "f \ funs_term t'" "is_Val f" for f + using that subtermeq_imp_funs_term_subset[OF t(2)] by auto + moreover have "\is_Abs f" when "f \ funs_term t" for f using t(1) that by auto + hence "\is_Abs f" when "f \ funs_term t'" for f + using that subtermeq_imp_funs_term_subset[OF t(2)] by auto + ultimately show "t' \ ?GSMP" by simp + qed + + have 3: "\t K T k. t \ ?GSMP \ Ana t = (K, T) \ k \ set K \ k \ ?GSMP" + proof (intro allI impI) + fix t K T k assume t: "t \ ?GSMP" "Ana t = (K, T)" "k \ set K" + hence "k \ GSMP M" using GSMP_Ana_key by blast + moreover have "\f \ funs_term t. ?P f" using t(1) by auto + with t(2,3) have "\f \ funs_term k. ?P f" + proof (induction t arbitrary: k rule: Ana.induct) + case 1 thus ?case by (metis Ana_Fu_keys_not_pubval_terms surj_pair) + qed auto + moreover have "\f \ funs_term t. \is_Abs f" using t(1) by auto + with t(2,3) have "\f \ funs_term k. \is_Abs f" + proof (induction t arbitrary: k rule: Ana.induct) + case 1 thus ?case by (metis Ana_Fu_keys_not_abs_terms surj_pair) + qed auto + ultimately show "k \ ?GSMP" by simp + qed + + have "\IK; M\ \\<^sub>G\<^sub>S\<^sub>M\<^sub>P t" + unfolding intruder_deduct_GSMP_def + by (rule restricted_deduct_if_deduct'[OF 1 2 3 t]) + thus ?thesis + proof (induction t rule: intruder_deduct_GSMP_induct) + case (AxiomH t) + show ?case using IK(2) abs_in[OF AxiomH.hyps] by force + next + case (ComposeH T f) + have *: "Fun f T \\<^sub>\ \ = Fun f (map (\t. t \\<^sub>\ \) T)" + using ComposeH.hyps(2,4) + by (cases f) auto + + have **: "length (map (\t. t \\<^sub>\ \) T) = arity f" + using ComposeH.hyps(1) + by auto + + show ?case + using intruder_deduct.Compose[OF ** ComposeH.hyps(2)] ComposeH.IH(1) * + by auto + next + case (DecomposeH t K T' t\<^sub>i) + have *: "Ana (t \\<^sub>\ \) = (K \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, T' \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" + using Ana_abs[OF DecomposeH.hyps(2)] + by metis + + have **: "t\<^sub>i \\<^sub>\ \ \ set (T' \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" + using DecomposeH.hyps(4) abs_in abs_list_set_is_set_abs_set[of T'] + by auto + + have ***: "FP \ k" + when k: "k \ set (K \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" for k + proof - + obtain k' where k': "k' \ set K" "k = k' \\<^sub>\ \" + by (metis (no_types) k abs_apply_terms_def imageE abs_list_set_is_set_abs_set) + + show "FP \ k" + using DecomposeH.IH k' by blast + qed + + show ?case + using intruder_deduct.Decompose[OF _ * _ **] + DecomposeH.IH(1) ***(1) + by blast + qed +qed + +end + + +subsection \Computing and Checking Term Implications and Messages\ +context stateful_protocol_model +begin + +abbreviation (input) "absc s \ (Fun (Abs s) []::('fun, 'atom, 'sets) prot_term)" + +fun absdbupd where + "absdbupd [] _ a = a" +| "absdbupd (insert\Var y, Fun (Set s) T\#D) x a = ( + if x = y then absdbupd D x (insert s a) else absdbupd D x a)" +| "absdbupd (delete\Var y, Fun (Set s) T\#D) x a = ( + if x = y then absdbupd D x (a - {s}) else absdbupd D x a)" +| "absdbupd (_#D) x a = absdbupd D x a" + +lemma absdbupd_cons_cases: + "absdbupd (insert\Var x, Fun (Set s) T\#D) x d = absdbupd D x (insert s d)" + "absdbupd (delete\Var x, Fun (Set s) T\#D) x d = absdbupd D x (d - {s})" + "t \ Var x \ (\s T. u = Fun (Set s) T) \ absdbupd (insert\t,u\#D) x d = absdbupd D x d" + "t \ Var x \ (\s T. u = Fun (Set s) T) \ absdbupd (delete\t,u\#D) x d = absdbupd D x d" +proof - + assume *: "t \ Var x \ (\s T. u = Fun (Set s) T)" + let ?P = "absdbupd (insert\t,u\#D) x d = absdbupd D x d" + let ?Q = "absdbupd (delete\t,u\#D) x d = absdbupd D x d" + { fix y f T assume "t = Fun f T \ u = Var y" hence ?P ?Q by auto + } moreover { + fix y f T assume "t = Var y" "u = Fun f T" hence ?P using * by (cases f) auto + } moreover { + fix y f T assume "t = Var y" "u = Fun f T" hence ?Q using * by (cases f) auto + } ultimately show ?P ?Q by (metis term.exhaust)+ +qed simp_all + +lemma absdbupd_filter: "absdbupd S x d = absdbupd (filter is_Update S) x d" +by (induction S x d rule: absdbupd.induct) simp_all + +lemma absdbupd_append: + "absdbupd (A@B) x d = absdbupd B x (absdbupd A x d)" +proof (induction A arbitrary: d) + case (Cons a A) thus ?case + proof (cases a) + case (Insert t u) thus ?thesis + proof (cases "t \ Var x \ (\s T. u = Fun (Set s) T)") + case False + then obtain s T where "t = Var x" "u = Fun (Set s) T" by moura + thus ?thesis by (simp add: Insert Cons.IH absdbupd_cons_cases(1)) + qed (simp_all add: Cons.IH absdbupd_cons_cases(3)) + next + case (Delete t u) thus ?thesis + proof (cases "t \ Var x \ (\s T. u = Fun (Set s) T)") + case False + then obtain s T where "t = Var x" "u = Fun (Set s) T" by moura + thus ?thesis by (simp add: Delete Cons.IH absdbupd_cons_cases(2)) + qed (simp_all add: Cons.IH absdbupd_cons_cases(4)) + qed simp_all +qed simp + +lemma absdbupd_wellformed_transaction: + assumes T: "wellformed_transaction T" + shows "absdbupd (unlabel (transaction_strand T)) = absdbupd (unlabel (transaction_updates T))" +proof - + define S0 where "S0 \ unlabel (transaction_strand T)" + define S1 where "S1 \ unlabel (transaction_receive T)" + define S2 where "S2 \ unlabel (transaction_selects T)" + define S3 where "S3 \ unlabel (transaction_checks T)" + define S4 where "S4 \ unlabel (transaction_updates T)" + define S5 where "S5 \ unlabel (transaction_send T)" + + note S_defs = S0_def S1_def S2_def S3_def S4_def S5_def + + have 0: "list_all is_Receive S1" + "list_all is_Assignment S2" + "list_all is_Check S3" + "list_all is_Update S4" + "list_all is_Send S5" + using T unfolding wellformed_transaction_def S_defs by metis+ + + have "filter is_Update S1 = []" + "filter is_Update S2 = []" + "filter is_Update S3 = []" + "filter is_Update S4 = S4" + "filter is_Update S5 = []" + using list_all_filter_nil[OF 0(1), of is_Update] + list_all_filter_nil[OF 0(2), of is_Update] + list_all_filter_nil[OF 0(3), of is_Update] + list_all_filter_eq[OF 0(4)] + list_all_filter_nil[OF 0(5), of is_Update] + by blast+ + moreover have "S0 = S1@S2@S3@S4@S5" + unfolding S_defs transaction_strand_def unlabel_def by auto + ultimately have "filter is_Update S0 = S4" + using filter_append[of is_Update] list_all_append[of is_Update] + by simp + thus ?thesis + using absdbupd_filter[of S0] + unfolding S_defs by presburger +qed + +fun abs_substs_set:: + "[('fun,'atom,'sets) prot_var list, + 'sets set list, + ('fun,'atom,'sets) prot_var \ 'sets set, + ('fun,'atom,'sets) prot_var \ 'sets set] + \ ((('fun,'atom,'sets) prot_var \ 'sets set) list) list" +where + "abs_substs_set [] _ _ _ = [[]]" +| "abs_substs_set (x#xs) as posconstrs negconstrs = ( + let bs = filter (\a. posconstrs x \ a \ a \ negconstrs x = {}) as + in concat (map (\b. map (\\. (x, b)#\) (abs_substs_set xs as posconstrs negconstrs)) bs))" + +definition abs_substs_fun:: + "[(('fun,'atom,'sets) prot_var \ 'sets set) list, + ('fun,'atom,'sets) prot_var] + \ 'sets set" +where + "abs_substs_fun \ x = (case find (\b. fst b = x) \ of Some (_,a) \ a | None \ {})" + +lemmas abs_substs_set_induct = abs_substs_set.induct[case_names Nil Cons] + +fun transaction_poschecks_comp:: + "(('fun,'atom,'sets) prot_fun, ('fun,'atom,'sets) prot_var) stateful_strand + \ (('fun,'atom,'sets) prot_var \ 'sets set)" +where + "transaction_poschecks_comp [] = (\_. {})" +| "transaction_poschecks_comp (\_: Var x \ Fun (Set s) []\#T) = ( + let f = transaction_poschecks_comp T in f(x := insert s (f x)))" +| "transaction_poschecks_comp (_#T) = transaction_poschecks_comp T" + +fun transaction_negchecks_comp:: + "(('fun,'atom,'sets) prot_fun, ('fun,'atom,'sets) prot_var) stateful_strand + \ (('fun,'atom,'sets) prot_var \ 'sets set)" +where + "transaction_negchecks_comp [] = (\_. {})" +| "transaction_negchecks_comp (\Var x not in Fun (Set s) []\#T) = ( + let f = transaction_negchecks_comp T in f(x := insert s (f x)))" +| "transaction_negchecks_comp (_#T) = transaction_negchecks_comp T" + +definition transaction_check_pre where + "transaction_check_pre FP TI T \ \ + let C = set (unlabel (transaction_checks T)); + S = set (unlabel (transaction_selects T)); + xs = fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)); + \ = \\ x. if fst x = TAtom Value then (absc \ \) x else Var x + in (\x \ set (transaction_fresh T). \ x = {}) \ + (\t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \ \ \)) \ + (\u \ S \ C. + (is_InSet u \ ( + let x = the_elem_term u; s = the_set_term u + in (is_Var x \ is_Fun_Set s) \ the_Set (the_Fun s) \ \ (the_Var x))) \ + ((is_NegChecks u \ bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p u = [] \ the_eqs u = [] \ length (the_ins u) = 1) \ ( + let x = fst (hd (the_ins u)); s = snd (hd (the_ins u)) + in (is_Var x \ is_Fun_Set s) \ the_Set (the_Fun s) \ \ (the_Var x))))" + +definition transaction_check_post where + "transaction_check_post FP TI T \ \ + let xs = fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)); + \ = \\ x. if fst x = TAtom Value then (absc \ \) x else Var x; + u = \\ x. absdbupd (unlabel (transaction_updates T)) x (\ x) + in (\x \ set xs - set (transaction_fresh T). \ x \ u \ x \ List.member TI (\ x, u \ x)) \ + (\t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T). intruder_synth_mod_timpls FP TI (t \ \ (u \)))" + +definition transaction_check_comp:: + "[('fun,'atom,'sets) prot_term list, + 'sets set list, + ('sets set \ 'sets set) list, + ('fun,'atom,'sets,'lbl) prot_transaction] + \ ((('fun,'atom,'sets) prot_var \ 'sets set) list) list" +where + "transaction_check_comp FP OCC TI T \ + let S = unlabel (transaction_strand T); + C = unlabel (transaction_selects T@transaction_checks T); + xs = filter (\x. x \ set (transaction_fresh T) \ fst x = TAtom Value) (fv_list\<^sub>s\<^sub>s\<^sub>t S); + posconstrs = transaction_poschecks_comp C; + negconstrs = transaction_negchecks_comp C; + pre_check = transaction_check_pre FP TI T + in filter (\\. pre_check (abs_substs_fun \)) (abs_substs_set xs OCC posconstrs negconstrs)" + +definition transaction_check:: + "[('fun,'atom,'sets) prot_term list, + 'sets set list, + ('sets set \ 'sets set) list, + ('fun,'atom,'sets,'lbl) prot_transaction] + \ bool" +where + "transaction_check FP OCC TI T \ + list_all (\\. transaction_check_post FP TI T (abs_substs_fun \)) (transaction_check_comp FP OCC TI T)" + +lemma abs_subst_fun_cons: + "abs_substs_fun ((x,b)#\) = (abs_substs_fun \)(x := b)" +unfolding abs_substs_fun_def by fastforce + +lemma abs_substs_cons: + assumes "\ \ set (abs_substs_set xs as poss negs)" "b \ set as" "poss x \ b" "b \ negs x = {}" + shows "(x,b)#\ \ set (abs_substs_set (x#xs) as poss negs)" +using assms by auto + +lemma abs_substs_cons': + assumes \: "\ \ abs_substs_fun ` set (abs_substs_set xs as poss negs)" + and b: "b \ set as" "poss x \ b" "b \ negs x = {}" + shows "\(x := b) \ abs_substs_fun ` set (abs_substs_set (x#xs) as poss negs)" +proof - + obtain \ where \: "\ = abs_substs_fun \" "\ \ set (abs_substs_set xs as poss negs)" + using \ by moura + have "abs_substs_fun ((x, b)#\) \ abs_substs_fun ` set (abs_substs_set (x#xs) as poss negs)" + using abs_substs_cons[OF \(2) b] by blast + thus ?thesis + using \(1) abs_subst_fun_cons[of x b \] by argo +qed + +lemma abs_substs_has_all_abs: + assumes "\x. x \ set xs \ \ x \ set as" + and "\x. x \ set xs \ poss x \ \ x" + and "\x. x \ set xs \ \ x \ negs x = {}" + and "\x. x \ set xs \ \ x = {}" + shows "\ \ abs_substs_fun ` set (abs_substs_set xs as poss negs)" +using assms +proof (induction xs arbitrary: \) + case (Cons x xs) + define \ where "\ \ \y. if y \ set xs then \ y else {}" + + have "\ \ abs_substs_fun ` set (abs_substs_set xs as poss negs)" + using Cons.prems Cons.IH by (simp add: \_def) + moreover have "\ x \ set as" "poss x \ \ x" "\ x \ negs x = {}" + using Cons.prems(1,2,3) by fastforce+ + ultimately have 0: "\(x := \ x) \ abs_substs_fun ` set (abs_substs_set (x#xs) as poss negs)" + by (metis abs_substs_cons') + + have "\ = \(x := \ x)" + proof + fix y show "\ y = (\(x := \ x)) y" + proof (cases "y \ set (x#xs)") + case False thus ?thesis using Cons.prems(4) by (fastforce simp add: \_def) + qed (auto simp add: \_def) + qed + thus ?case by (metis 0) +qed (auto simp add: abs_substs_fun_def) + +lemma abs_substs_abss_bounded: + assumes "\ \ abs_substs_fun ` set (abs_substs_set xs as poss negs)" + and "x \ set xs" + shows "\ x \ set as" + and "poss x \ \ x" + and "\ x \ negs x = {}" +using assms +proof (induct xs as poss negs arbitrary: \ rule: abs_substs_set_induct) + case (Cons y xs as poss negs) + { case 1 thus ?case using Cons.hyps(1) unfolding abs_substs_fun_def by fastforce } + + { case 2 thus ?case + proof (cases "x = y") + case False + then obtain \' where \': + "\' \ abs_substs_fun ` set (abs_substs_set xs as poss negs)" "\' x = \ x" + using 2 unfolding abs_substs_fun_def by force + moreover have "x \ set xs" using 2(2) False by simp + moreover have "\b. b \ set as \ poss y \ b \ b \ negs y = {}" + using 2 False by auto + ultimately show ?thesis using Cons.hyps(2) by fastforce + qed (auto simp add: abs_substs_fun_def) + } + + { case 3 thus ?case + proof (cases "x = y") + case False + then obtain \' where \': + "\' \ abs_substs_fun ` set (abs_substs_set xs as poss negs)" "\' x = \ x" + using 3 unfolding abs_substs_fun_def by force + moreover have "x \ set xs" using 3(2) False by simp + moreover have "\b. b \ set as \ poss y \ b \ b \ negs y = {}" + using 3 False by auto + ultimately show ?thesis using Cons.hyps(3) by fastforce + qed (auto simp add: abs_substs_fun_def) + } +qed (simp_all add: abs_substs_fun_def) + +lemma transaction_poschecks_comp_unfold: + "transaction_poschecks_comp C x = {s. \a. \a: Var x \ Fun (Set s) []\ \ set C}" +proof (induction C) + case (Cons c C) thus ?case + proof (cases "\a y s. c = \a: Var y \ Fun (Set s) []\") + case True + then obtain a y s where c: "c = \a: Var y \ Fun (Set s) []\" by moura + + define f where "f \ transaction_poschecks_comp C" + + have "transaction_poschecks_comp (c#C) = f(y := insert s (f y))" + using c by (simp add: f_def Let_def) + moreover have "f x = {s. \a. \a: Var x \ Fun (Set s) []\ \ set C}" + using Cons.IH unfolding f_def by blast + ultimately show ?thesis using c by auto + next + case False + hence "transaction_poschecks_comp (c#C) = transaction_poschecks_comp C" (is ?P) + using transaction_poschecks_comp.cases[of "c#C" ?P] by force + thus ?thesis using False Cons.IH by auto + qed +qed simp + +lemma transaction_poschecks_comp_notin_fv_empty: + assumes "x \ fv\<^sub>s\<^sub>s\<^sub>t C" + shows "transaction_poschecks_comp C x = {}" +using assms transaction_poschecks_comp_unfold[of C x] by fastforce + +lemma transaction_negchecks_comp_unfold: + "transaction_negchecks_comp C x = {s. \Var x not in Fun (Set s) []\ \ set C}" +proof (induction C) + case (Cons c C) thus ?case + proof (cases "\y s. c = \Var y not in Fun (Set s) []\") + case True + then obtain y s where c: "c = \Var y not in Fun (Set s) []\" by moura + + define f where "f \ transaction_negchecks_comp C" + + have "transaction_negchecks_comp (c#C) = f(y := insert s (f y))" + using c by (simp add: f_def Let_def) + moreover have "f x = {s. \Var x not in Fun (Set s) []\ \ set C}" + using Cons.IH unfolding f_def by blast + ultimately show ?thesis using c by auto + next + case False + hence "transaction_negchecks_comp (c#C) = transaction_negchecks_comp C" (is ?P) + using transaction_negchecks_comp.cases[of "c#C" ?P] + by force + thus ?thesis using False Cons.IH by fastforce + qed +qed simp + +lemma transaction_negchecks_comp_notin_fv_empty: + assumes "x \ fv\<^sub>s\<^sub>s\<^sub>t C" + shows "transaction_negchecks_comp C x = {}" +using assms transaction_negchecks_comp_unfold[of C x] by fastforce + +lemma transaction_check_preI[intro]: + fixes T + defines "\ \ \\ x. if fst x = TAtom Value then (absc \ \) x else Var x" + and "S \ set (unlabel (transaction_selects T))" + and "C \ set (unlabel (transaction_checks T))" + assumes a0: "\x \ set (transaction_fresh T). \ x = {}" + and a1: "\x \ fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \ \ x \ set OCC" + and a2: "\t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \ \ \)" + and a3: "\a x s. \a: Var x \ Fun (Set s) []\ \ S \ C \ s \ \ x" + and a4: "\x s. \Var x not in Fun (Set s) []\ \ S \ C \ s \ \ x" + shows "transaction_check_pre FP TI T \" +proof - + let ?P = "\u. is_InSet u \ ( + let x = the_elem_term u; s = the_set_term u + in (is_Var x \ is_Fun_Set s) \ the_Set (the_Fun s) \ \ (the_Var x))" + + let ?Q = "\u. (is_NegChecks u \ bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p u = [] \ the_eqs u = [] \ length (the_ins u) = 1) \ ( + let x = fst (hd (the_ins u)); s = snd (hd (the_ins u)) + in (is_Var x \ is_Fun_Set s) \ the_Set (the_Fun s) \ \ (the_Var x))" + + have 1: "?P u" when u: "u \ S \ C" for u + apply (unfold Let_def, intro impI, elim conjE) + using u a3 Fun_Set_InSet_iff[of u] by metis + + have 2: "?Q u" when u: "u \ S \ C" for u + apply (unfold Let_def, intro impI, elim conjE) + using u a4 Fun_Set_NotInSet_iff[of u] by metis + + show ?thesis + using a0 a1 a2 1 2 fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"] + unfolding transaction_check_pre_def \_def S_def C_def Let_def + by blast +qed + +lemma transaction_check_pre_InSetE: + assumes T: "transaction_check_pre FP TI T \" + and u: "u = \a: Var x \ Fun (Set s) []\" + "u \ set (unlabel (transaction_selects T)) \ set (unlabel (transaction_checks T))" + shows "s \ \ x" +proof - + have "is_InSet u \ is_Var (the_elem_term u) \ is_Fun_Set (the_set_term u) \ + the_Set (the_Fun (the_set_term u)) \ \ (the_Var (the_elem_term u))" + using T u unfolding transaction_check_pre_def Let_def by blast + thus ?thesis using Fun_Set_InSet_iff[of u a x s] u by argo +qed + +lemma transaction_check_pre_NotInSetE: + assumes T: "transaction_check_pre FP TI T \" + and u: "u = \Var x not in Fun (Set s) []\" + "u \ set (unlabel (transaction_selects T)) \ set (unlabel (transaction_checks T))" + shows "s \ \ x" +proof - + have "is_NegChecks u \ bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p u = [] \ the_eqs u = [] \ length (the_ins u) = 1 \ + is_Var (fst (hd (the_ins u))) \ is_Fun_Set (snd (hd (the_ins u))) \ + the_Set (the_Fun (snd (hd (the_ins u)))) \ \ (the_Var (fst (hd (the_ins u))))" + using T u unfolding transaction_check_pre_def Let_def by blast + thus ?thesis using Fun_Set_NotInSet_iff[of u x s] u by argo +qed + +lemma transaction_check_compI[intro]: + assumes T: "transaction_check_pre FP TI T \" + and T_adm: "admissible_transaction T" + and x1: "\x. (x \ fv_transaction T - set (transaction_fresh T) \ fst x = TAtom Value) + \ \ x \ set OCC" + and x2: "\x. (x \ fv_transaction T - set (transaction_fresh T) \ fst x \ TAtom Value) + \ \ x = {}" + shows "\ \ abs_substs_fun ` set (transaction_check_comp FP OCC TI T)" +proof - + define S where "S \ unlabel (transaction_strand T)" + define C where "C \ unlabel (transaction_selects T@transaction_checks T)" + define C' where "C' \ set (unlabel (transaction_selects T)) \ + set (unlabel (transaction_checks T))" + + let ?xs = "fv_list\<^sub>s\<^sub>s\<^sub>t S" + + define poss where "poss \ transaction_poschecks_comp C" + define negs where "negs \ transaction_negchecks_comp C" + define ys where "ys \ filter (\x. x \ set (transaction_fresh T) \ fst x = TAtom Value) ?xs" + + have C_C'_eq: "set C = C'" + using unlabel_append[of "transaction_selects T" "transaction_checks T"] + unfolding C_def C'_def by simp + + have ys: "{x \ fv_transaction T - set (transaction_fresh T). fst x = TAtom Value} = set ys" + using fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of S] + unfolding ys_def S_def by force + + have "\ x \ set OCC" + when x: "x \ set ys" for x + using x1 x ys by blast + moreover have "\ x = {}" + when x: "x \ set ys" for x + using x2 x ys by blast + moreover have "poss x \ \ x" when x: "x \ set ys" for x + proof - + have "s \ \ x" when u: "u = \a: Var x \ Fun (Set s) []\" "u \ C'" for u a s + using T u transaction_check_pre_InSetE[of FP TI T \] + unfolding C'_def by blast + thus ?thesis + using transaction_poschecks_comp_unfold[of C x] C_C'_eq + unfolding poss_def by blast + qed + moreover have "\ x \ negs x = {}" when x: "x \ set ys" for x + proof (cases "x \ fv\<^sub>s\<^sub>s\<^sub>t C") + case True + hence "s \ \ x" when u: "u = \Var x not in Fun (Set s) []\" "u \ C'" for u s + using T u transaction_check_pre_NotInSetE[of FP TI T \] + unfolding C'_def by blast + thus ?thesis + using transaction_negchecks_comp_unfold[of C x] C_C'_eq + unfolding negs_def by blast + next + case False + hence "negs x = {}" + using x C_C'_eq transaction_negchecks_comp_notin_fv_empty + unfolding negs_def by blast + thus ?thesis by blast + qed + ultimately have "\ \ abs_substs_fun ` set (abs_substs_set ys OCC poss negs)" + using abs_substs_has_all_abs[of ys \ OCC poss negs] + by fast + thus ?thesis + using T + unfolding transaction_check_comp_def Let_def S_def C_def ys_def poss_def negs_def + by fastforce +qed + +context +begin +private lemma transaction_check_comp_in_aux: + fixes T + defines "S \ set (unlabel (transaction_selects T))" + and "C \ set (unlabel (transaction_checks T))" + assumes T_adm: "admissible_transaction T" + and a1: "\x \ fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \ (\s. + select\Var x, Fun (Set s) []\ \ S \ s \ \ x)" + and a2: "\x \ fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \ (\s. + \Var x in Fun (Set s) []\ \ C \ s \ \ x)" + and a3: "\x \ fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \ (\s. + \Var x not in Fun (Set s) []\ \ C \ s \ \ x)" + shows "\a x s. \a: Var x \ Fun (Set s) []\ \ S \ C \ s \ \ x" (is ?A) + and "\x s. \Var x not in Fun (Set s) []\ \ S \ C \ s \ \ x" (is ?B) +proof - + have T_valid: "wellformed_transaction T" + and T_adm_S: "admissible_transaction_selects T" + and T_adm_C: "admissible_transaction_checks T" + using T_adm unfolding admissible_transaction_def by blast+ + + note * = admissible_transaction_strand_step_cases(2,3)[OF T_adm] + + have 1: "fst x = TAtom Value" "x \ fv_transaction T - set (transaction_fresh T)" + when x: "\a: Var x \ Fun (Set s) []\ \ S \ C" for a x s + using * x unfolding S_def C_def by fast+ + + have 2: "fst x = TAtom Value" "x \ fv_transaction T - set (transaction_fresh T)" + when x: "\Var x not in Fun (Set s) []\ \ S \ C" for x s + using * x unfolding S_def C_def by fast+ + + have 3: "select\Var x, Fun (Set s) []\ \ S" + when x: "select\Var x, Fun (Set s) []\ \ S \ C" for x s + using * x unfolding S_def C_def by fast + + have 4: "\Var x in Fun (Set s) []\ \ C" + when x: "\Var x in Fun (Set s) []\ \ S \ C" for x s + using * x unfolding S_def C_def by fast + + have 5: "\Var x not in Fun (Set s) []\ \ C" + when x: "\Var x not in Fun (Set s) []\ \ S \ C" for x s + using * x unfolding S_def C_def by fast + + show ?A + proof (intro allI impI) + fix a x s assume u: "\a: Var x \ Fun (Set s) []\ \ S \ C" + thus "s \ \ x" using 1 3 4 a1 a2 by (cases a) metis+ + qed + + show ?B + proof (intro allI impI) + fix x s assume u: "\Var x not in Fun (Set s) []\ \ S \ C" + thus "s \ \ x" using 2 5 a3 by meson + qed +qed + +lemma transaction_check_comp_in: + fixes T + defines "\ \ \\ x. if fst x = TAtom Value then (absc \ \) x else Var x" + and "S \ set (unlabel (transaction_selects T))" + and "C \ set (unlabel (transaction_checks T))" + assumes T_adm: "admissible_transaction T" + and a1: "\x \ set (transaction_fresh T). \ x = {}" + and a2: "\t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \ \ \)" + and a3: "\x \ fv_transaction T - set (transaction_fresh T). \s. + select\Var x, Fun (Set s) []\ \ S \ s \ \ x" + and a4: "\x \ fv_transaction T - set (transaction_fresh T). \s. + \Var x in Fun (Set s) []\ \ C \ s \ \ x" + and a5: "\x \ fv_transaction T - set (transaction_fresh T). \s. + \Var x not in Fun (Set s) []\ \ C \ s \ \ x" + and a6: "\x \ fv_transaction T - set (transaction_fresh T). + fst x = TAtom Value \ \ x \ set OCC" + shows "\\ \ abs_substs_fun ` set (transaction_check_comp FP OCC TI T). \x \ fv_transaction T. + fst x = TAtom Value \ \ x = \ x" +proof - + let ?xs = "fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))" + let ?ys = "filter (\x. x \ set (transaction_fresh T)) ?xs" + + define \' where "\' \ \x. + if x \ fv_transaction T - set (transaction_fresh T) \ fst x = TAtom Value + then \ x + else {}" + + have T_valid: "wellformed_transaction T" + using T_adm unfolding admissible_transaction_def by blast + + have \\_Fun: "is_Fun (t \ \ \) \ is_Fun (t \ \ \')" for t + unfolding \'_def \_def + by (induct t) auto + + have "\t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \ \ \')" + proof (intro ballI impI) + fix t assume t: "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" + + have 1: "intruder_synth_mod_timpls FP TI (t \ \ \)" + using t a2 + by auto + + obtain r where r: + "r \ set (unlabel (transaction_receive T))" + "t \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p r" + using t by auto + hence "r = receive\t\" + using wellformed_transaction_unlabel_cases(1)[OF T_valid] + by fastforce + hence 2: "fv t \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" using r by force + + have "fv t \ fv_transaction T" + by (metis (no_types, lifting) 2 transaction_strand_def sst_vars_append_subset(1) + unlabel_append subset_Un_eq sup.bounded_iff) + moreover have "fv t \ set (transaction_fresh T) = {}" + using 2 T_valid vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_receive T)"] + unfolding wellformed_transaction_def + by fast + ultimately have "\ \ x = \ \' x" when "x \ fv t" for x + using that unfolding \'_def \_def by fastforce + hence 3: "t \ \ \ = t \ \ \'" + using term_subst_eq by blast + + show "intruder_synth_mod_timpls FP TI (t \ \ \')" using 1 3 by simp + qed + moreover have + "\x \ fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \ (\s. + select\Var x, Fun (Set s) []\ \ S \ s \ \' x)" + "\x \ fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \ (\s. + \Var x in Fun (Set s) []\ \ C \ s \ \' x)" + "\x \ fv_transaction T - set (transaction_fresh T). fst x = TAtom Value \ (\s. + \Var x not in Fun (Set s) []\ \ C \ s \ \' x)" + using a3 a4 a5 + unfolding \'_def \_def S_def C_def + by meson+ + hence "\a x s. \a: Var x \ Fun (Set s) []\ \ S \ C \ s \ \' x" + "\x s. \Var x not in Fun (Set s) []\ \ S \ C \ s \ \' x" + using transaction_check_comp_in_aux[OF T_adm, of \'] + unfolding S_def C_def + by fast+ + ultimately have 4: "transaction_check_pre FP TI T \'" + using a6 transaction_check_preI[of T \' OCC FP TI] + unfolding \'_def \_def S_def C_def by simp + + have 5: "\x \ fv_transaction T. fst x = TAtom Value \ \ x = \' x" + using a1 by (auto simp add: \'_def) + + have 6: "\' \ abs_substs_fun ` set (transaction_check_comp FP OCC TI T)" + using transaction_check_compI[OF 4 T_adm] a6 + unfolding \'_def + by auto + + show ?thesis using 5 6 by blast +qed +end + +end + + +subsection \Automatically Checking Protocol Security in a Typed Model\ +context stateful_protocol_model +begin + +definition abs_intruder_knowledge ("\\<^sub>i\<^sub>k") where + "\\<^sub>i\<^sub>k S \ \ (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \)" + +definition abs_value_constants ("\\<^sub>v\<^sub>a\<^sub>l\<^sub>s") where + "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s S \ \ {t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \\<^sub>s\<^sub>e\<^sub>t \. \n. t = Fun (Val n) []} \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \)" + +definition abs_term_implications ("\\<^sub>t\<^sub>i") where + "\\<^sub>t\<^sub>i \ T \ \ \ \ {(s,t) | s t x. + s \ t \ x \ fv_transaction T \ x \ set (transaction_fresh T) \ + Fun (Abs s) [] = (\ \\<^sub>s \) x \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) \ + Fun (Abs t) [] = (\ \\<^sub>s \) x \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) \)}" + +lemma abs_intruder_knowledge_append: + "\\<^sub>i\<^sub>k (A@B) \ = + (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) \) \ + (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) \)" +by (metis unlabel_append abs_set_union image_Un ik\<^sub>s\<^sub>s\<^sub>t_append abs_intruder_knowledge_def) + +lemma abs_value_constants_append: + fixes A B::"('a,'b,'c,'d) prot_strand" + shows "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s (A@B) \ = + {t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \\<^sub>s\<^sub>e\<^sub>t \. \n. t = Fun (Val n) []} \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) \) \ + {t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B) \\<^sub>s\<^sub>e\<^sub>t \. \n. t = Fun (Val n) []} \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) \)" +proof - + define a0 where "a0 \ \\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B)) \)" + define M where "M \ \a::('a,'b,'c,'d) prot_strand. + {t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t a) \\<^sub>s\<^sub>e\<^sub>t \. \n. t = Fun (Val n) []}" + + have "M (A@B) = M A \ M B" + using unlabel_append[of A B] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel A" "unlabel B"] + image_Un[of "\x. x \ \" "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)"] + unfolding M_def by force + hence "M (A@B) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0 = (M A \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0) \ (M B \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0)" by (simp add: abs_set_union) + thus ?thesis unfolding abs_value_constants_def a0_def M_def by blast +qed + +lemma transaction_renaming_subst_has_no_pubconsts_abss: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_renaming_subst \ P A" + shows "subst_range \ \ pubval_terms = {}" (is ?A) + and "subst_range \ \ abs_terms = {}" (is ?B) +proof - + { fix t assume "t \ subst_range \" + then obtain x where "t = Var x" + using transaction_renaming_subst_is_renaming[OF assms] + by force + hence "t \ pubval_terms" "t \ abs_terms" by simp_all + } thus ?A ?B by auto +qed + +lemma transaction_fresh_subst_has_no_pubconsts_abss: + fixes \::"('fun,'atom,'sets) prot_subst" + assumes "transaction_fresh_subst \ T \" + shows "subst_range \ \ pubval_terms = {}" (is ?A) + and "subst_range \ \ abs_terms = {}" (is ?B) +proof - + { fix t assume "t \ subst_range \" + then obtain n where "t = Fun (Val (n,False)) []" + using assms unfolding transaction_fresh_subst_def + by force + hence "t \ pubval_terms" "t \ abs_terms" by simp_all + } thus ?A ?B by auto +qed + +lemma reachable_constraints_no_pubconsts_abss: + assumes "\ \ reachable_constraints P" + and P: "\T \ set P. \n. Val (n,True) \ \(funs_term ` trms_transaction T)" + "\T \ set P. \n. Abs n \ \(funs_term ` trms_transaction T)" + "\T \ set P. \x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + "\T \ set P. bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = {}" + and \: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + "\n. Val (n,True) \ \(funs_term ` (\ ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + "\n. Abs n \ \(funs_term ` (\ ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + shows "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \ \ GSMP (\T \ set P. trms_transaction T) - (pubval_terms \ abs_terms)" + (is "?A \ ?B") +using assms(1) \(4,5) +proof (induction \ rule: reachable_constraints.induct) + case (step \ T \ \) + define trms_P where "trms_P \ (\T \ set P. trms_transaction T)" + define T' where "T' \ transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \" + + have \': "\n. Val (n,True) \ \ (funs_term ` (\ ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + "\n. Abs n \ \ (funs_term ` (\ ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using step.prems fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \"] unlabel_append[of \] + by auto + + have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" + using transaction_renaming_subst_wt[OF step.hyps(4)] + transaction_fresh_subst_wt[OF step.hyps(3)] + by (metis step.hyps(2) P(3) wt_subst_compose) + hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (rm_vars (set X) (\ \\<^sub>s \))" for X + using wt_subst_rm_vars[of "\ \\<^sub>s \" "set X"] + by metis + hence wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t ((rm_vars (set X) (\ \\<^sub>s \)) \\<^sub>s \)" for X + using \(2) wt_subst_compose by fast + + have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + using transaction_fresh_subst_range_wf_trms[OF step.hyps(3)] + transaction_renaming_subst_range_wf_trms[OF step.hyps(4)] + by (metis wf_trms_subst_compose) + hence wftrms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range ((rm_vars (set X) (\ \\<^sub>s \)) \\<^sub>s \))" for X + using wf_trms_subst_compose[OF wf_trms_subst_rm_vars' \(3)] by fast + + have "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \\<^sub>s\<^sub>e\<^sub>t \ \ ?B" + proof + fix t assume "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T') \\<^sub>s\<^sub>e\<^sub>t \" + hence "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \\<^sub>s\<^sub>e\<^sub>t \" using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq by blast + then obtain s X where s: + "s \ trms_transaction T" + "t = s \ rm_vars (set X) (\ \\<^sub>s \) \\<^sub>s \" + "set X \ bvars_transaction T" + using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst'' unfolding T'_def by blast + + define \ where "\ \ rm_vars (set X) (\ \\<^sub>s \)" + + have 1: "s \ trms_P" using step.hyps(2) s(1) unfolding trms_P_def by auto + + have s_nin: "s \ pubval_terms" "s \ abs_terms" + using 1 P(1,2) funs_term_Fun_subterm + unfolding trms_P_def is_Val_def is_Abs_def + by fastforce+ + + have 2: "(\ ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')) \ pubval_terms = {}" + "(\ ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')) \ abs_terms = {}" + "subst_range (\ \\<^sub>s \) \ pubval_terms = {}" + "subst_range (\ \\<^sub>s \) \ abs_terms = {}" + "subst_range \ \ pubval_terms = {}" + "subst_range \ \ abs_terms = {}" + "(\ ` fv s) \ pubval_terms = {}" + "(\ ` fv s) \ abs_terms = {}" + unfolding T'_def \_def + using step.prems funs_term_Fun_subterm + apply (fastforce simp add: is_Val_def, + fastforce simp add: is_Abs_def) + using pubval_terms_subst_range_comp[OF + transaction_fresh_subst_has_no_pubconsts_abss(1)[OF step.hyps(3)] + transaction_renaming_subst_has_no_pubconsts_abss(1)[OF step.hyps(4)]] + abs_terms_subst_range_comp[OF + transaction_fresh_subst_has_no_pubconsts_abss(2)[OF step.hyps(3)] + transaction_renaming_subst_has_no_pubconsts_abss(2)[OF step.hyps(4)]] + unfolding is_Val_def is_Abs_def + by force+ + + have "(\ ` fv (s \ \)) \ pubval_terms = {}" + "(\ ` fv (s \ \)) \ abs_terms = {}" + proof - + have "\ = \ \\<^sub>s \" "bvars_transaction T = {}" "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" + using s(3) P(4) step.hyps(2) rm_vars_empty + vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel T'"] + bvars\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel (transaction_strand T)" "\ \\<^sub>s \"] + unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + unfolding \_def T'_def by simp_all + hence "fv (s \ \) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'" + using trms\<^sub>s\<^sub>s\<^sub>t_fv_subst_subset[OF s(1), of \] unlabel_subst[of "transaction_strand T" \] + unfolding T'_def by auto + moreover have "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" + using fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')"] + unlabel_append[of \ "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t T'"] + fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of T'] + by simp_all + hence "\ ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ pubval_terms = {}" "\ ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \ abs_terms = {}" + using 2(1,2) by blast+ + ultimately show "(\ ` fv (s \ \)) \ pubval_terms = {}" "(\ ` fv (s \ \)) \ abs_terms = {}" + by blast+ + qed + hence \\\_disj: "((\ \\<^sub>s \) ` fv s) \ pubval_terms = {}" + "((\ \\<^sub>s \) ` fv s) \ abs_terms = {}" + using pubval_terms_subst_range_comp'[of \ "fv s" \] + abs_terms_subst_range_comp'[of \ "fv s" \] + 2(7,8) + by (simp_all add: subst_apply_fv_unfold) + + have 3: "t \ pubval_terms" "t \ abs_terms" + using s(2) s_nin \\\_disj + pubval_terms_subst[of s "rm_vars (set X) (\ \\<^sub>s \) \\<^sub>s \"] + pubval_terms_subst_range_disj[of "rm_vars (set X) (\ \\<^sub>s \) \\<^sub>s \" s] + abs_terms_subst[of s "rm_vars (set X) (\ \\<^sub>s \) \\<^sub>s \"] + abs_terms_subst_range_disj[of "rm_vars (set X) (\ \\<^sub>s \) \\<^sub>s \" s] + unfolding \_def + by blast+ + + have "t \ SMP trms_P" "fv t = {}" + by (metis s(2) SMP.Substitution[OF SMP.MP[OF 1] wt wftrms, of X], + metis s(2) subst_subst_compose[of s "rm_vars (set X) (\ \\<^sub>s \)" \] + interpretation_grounds[OF \(1), of "s \ rm_vars (set X) (\ \\<^sub>s \)"]) + hence 4: "t \ GSMP trms_P" unfolding GSMP_def by simp + + show "t \ ?B" using 3 4 by (auto simp add: trms_P_def) + qed + thus ?case + using step.IH[OF \'] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \"] unlabel_append[of \] + image_Un[of "\x. x \ \" "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \"] + by (simp add: T'_def) +qed simp + +lemma \\<^sub>t\<^sub>i_covers_\\<^sub>0_aux: + assumes \_reach: "\ \ reachable_constraints P" + and T: "T \ set P" + and \: "welltyped_constraint_model \ (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + and \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + and P: "\T \ set P. admissible_transaction T" + and t: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + "t = Fun (Val n) [] \ t = Var x" + and neq: + "t \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) \ + t \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) \)" + shows "\y \ fv_transaction T - set (transaction_fresh T). + t \ \ = (\ \\<^sub>s \) y \ \ \ \\<^sub>v y = TAtom Value" +proof - + let ?\' = "\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + let ?\ = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))" + let ?\' = "?\ \\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \" + let ?\'' = "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + + have \_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and \_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + by (metis \ welltyped_constraint_model_def constraint_model_def, + metis \ welltyped_constraint_model_def, + metis \ welltyped_constraint_model_def constraint_model_def) + + have T_adm: "admissible_transaction T" + using T P(1) by blast + hence T_valid: "wellformed_transaction T" + unfolding admissible_transaction_def by blast + + have T_adm_upds: "admissible_transaction_updates T" + by (metis P(1) T admissible_transaction_def) + + have T_fresh_vars_value_typed: "\x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + using T P(1) protocol_transaction_vars_TAtom_typed(3)[of T] P(1) by simp + + have wt_\\: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" + using wt_subst_compose transaction_fresh_subst_wt[OF \ T_fresh_vars_value_typed] + transaction_renaming_subst_wt[OF \] + by blast + + have \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \_reach) + hence t_wf: "wf\<^sub>t\<^sub>r\<^sub>m t" using t by auto + + have \_no_val_bvars: "\TAtom Value \ \\<^sub>v x" + when "x \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" for x + using P(1) reachable_constraints_no_bvars \_reach + vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \"] that + unfolding admissible_transaction_def by fast + + have x': "x \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" when "t = Var x" + using that t by (simp add: var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t) + + have "\f \ funs_term (t \ \). is_Val f" + using abs_eq_if_no_Val neq by metis + hence "\n T. Fun (Val n) T \ t \ \" + using funs_term_Fun_subterm + unfolding is_Val_def by fast + hence "TAtom Value \ \ (Var x)" when "t = Var x" + using wt_subst_trm''[OF \_wt, of "Var x"] that + subtermeq_imp_subtermtypeeq[of "t \ \"] wf_trm_subst[OF \_wf, of t] t_wf + by fastforce + hence x_val: "\\<^sub>v x = TAtom Value" when "t = Var x" + using reachable_constraints_vars_TAtom_typed[OF \_reach P x'] that + by fastforce + hence x_fv: "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" when "t = Var x" using x' + using reachable_constraints_Value_vars_are_fv[OF \_reach P x'] that + by blast + then obtain m where m: "t \ \ = Fun (Val m) []" + using constraint_model_Value_term_is_Val[ + OF \_reach welltyped_constraint_model_prefix[OF \] P, of x] + t(2) x_val + by force + hence 0: "\\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) m \ \\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t (unlabel \@?\'') \) m" + using neq by (simp add: unlabel_def) + + have t_val: "\ t = TAtom Value" using x_val t by force + + obtain u s where s: "t \ \ = u \ \" "insert\u,s\ \ set ?\' \ delete\u,s\ \ set ?\'" + using to_abs_neq_imp_db_update[OF 0] m + by (metis (no_types, lifting) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst subst_lsst_unlabel) + then obtain u' s' where s': + "u = u' \ \ \\<^sub>s \" "s = s' \ \ \\<^sub>s \" + "insert\u',s'\ \ set ?\ \ delete\u',s'\ \ set ?\" + using stateful_strand_step_subst_inv_cases(4,5) + by blast + hence s'': "insert\u',s'\ \ set (unlabel (transaction_strand T)) \ + delete\u',s'\ \ set (unlabel (transaction_strand T))" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(4,5)[of u' s' "transaction_strand T"] + by simp_all + then obtain y where y: "y \ fv_transaction T" "u' = Var y" + using transaction_inserts_are_Value_vars[OF T_valid T_adm_upds, of u' s'] + transaction_deletes_are_Value_vars[OF T_valid T_adm_upds, of u' s'] + stateful_strand_step_fv_subset_cases(4,5)[of u' s' "unlabel (transaction_strand T)"] + by auto + hence 1: "t \ \ = (\ \\<^sub>s \) y \ \" using y s(1) s'(1) by (metis subst_apply_term.simps(1)) + + have 2: "y \ set (transaction_fresh T)" when "(\ \\<^sub>s \) y \ \ \ \ y" + using transaction_fresh_subst_grounds_domain[OF \, of y] subst_compose[of \ \ y] that + by (auto simp add: subst_ground_ident) + + have 3: "y \ set (transaction_fresh T)" when "(\ \\<^sub>s \) y \ \ \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using 2 that \ unfolding transaction_fresh_subst_def by fastforce + + have 4: "\x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \. \\<^sub>v x = TAtom Value \ + (\B. prefix B \ \ x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \ \ x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B))" + by (metis welltyped_constraint_model_prefix[OF \] + constraint_model_Value_var_in_constr_prefix[OF \_reach _ P]) + + have 5: "\\<^sub>v y = TAtom Value" + using 1 t_val + wt_subst_trm''[OF wt_\\, of "Var y"] + wt_subst_trm''[OF \_wt, of t] + wt_subst_trm''[OF \_wt, of "(\ \\<^sub>s \) y"] + by (auto simp del: subst_subst_compose) + + have "y \ set (transaction_fresh T)" + proof (cases "t = Var x") + case True (* \ x occurs in \ but not in subst_range \, so y cannot be fresh *) + hence *: "\ x = Fun (Val m) []" "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" "\ x = (\ \\<^sub>s \) y \ \" + using m t(1) 1 x_fv x' by (force, blast, force) + + obtain B where B: "prefix B \" "\ x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" + using *(2) 4 x_val[OF True] by fastforce + hence "\t \ subst_range \. t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" + using transaction_fresh_subst_range_fresh(1)[OF \] trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)[of B] + unfolding prefix_def by fast + thus ?thesis using *(1,3) B(2) 2 by (metis subst_imgI term.distinct(1)) + next + case False + hence "t \ \ \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" using t by simp + thus ?thesis using 1 3 by argo + qed + thus ?thesis using 1 5 y(1) by fast +qed + +lemma \\<^sub>t\<^sub>i_covers_\\<^sub>0_Var: + assumes \_reach: "\ \ reachable_constraints P" + and T: "T \ set P" + and \: "welltyped_constraint_model \ (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + and \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + and P: "\T \ set P. admissible_transaction T" + and x: "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" + shows "\ x \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) \) \ + timpl_closure_set {\ x \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)} (\\<^sub>t\<^sub>i \ T \ \ \)" +proof - + define a0 where "a0 \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + define a0' where "a0' \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) \)" + define a3 where "a3 \ \\<^sub>t\<^sub>i \ T \ \ \" + + have \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \_reach) + + have T_adm: "admissible_transaction T" by (metis P(1) T) + + have \_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + by (metis \ welltyped_constraint_model_def constraint_model_def, + metis \ welltyped_constraint_model_def, + metis \ welltyped_constraint_model_def constraint_model_def) + + have "\\<^sub>v x = Var Value \ (\a. \\<^sub>v x = Var (prot_atom.Atom a))" + using reachable_constraints_vars_TAtom_typed[OF \_reach P, of x] + x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \"] + by auto + + hence "\ x \\<^sub>\ a0' \ timpl_closure_set {\ x \\<^sub>\ a0} a3" + proof + assume x_val: "\\<^sub>v x = TAtom Value" + show "\ x \\<^sub>\ a0' \ timpl_closure_set {\ x \\<^sub>\ a0} a3" + proof (cases "\ x \\<^sub>\ a0 = \ x \\<^sub>\ a0'") + case False + hence "\y \ fv_transaction T - set (transaction_fresh T). + \ x = (\ \\<^sub>s \) y \ \ \ \\<^sub>v y = TAtom Value" + using \\<^sub>t\<^sub>i_covers_\\<^sub>0_aux[OF \_reach T \ \ \ P fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t[OF x], of _ x] + unfolding a0_def a0'_def + by fastforce + then obtain y where y: + "y \ fv_transaction T - set (transaction_fresh T)" + "\ x = (\ \\<^sub>s \) y \ \" + "\ x \\<^sub>\ a0 = (\ \\<^sub>s \) y \ \ \\<^sub>\ a0" + "\ x \\<^sub>\ a0' = (\ \\<^sub>s \) y \ \ \\<^sub>\ a0'" + "\\<^sub>v y = TAtom Value" + by metis + then obtain n where n: "(\ \\<^sub>s \) y \ \ = Fun (Val (n,False)) []" + using \\<^sub>v_TAtom''(2)[of y] x x_val + transaction_var_becomes_Val[ + OF reachable_constraints.step[OF \_reach T \ \] \ \ \ P T, of y] + by force + + have "a0 (n,False) \ a0' (n,False)" + "y \ fv_transaction T" + "y \ set (transaction_fresh T)" + "absc (a0 (n,False)) = (\ \\<^sub>s \) y \ \ \\<^sub>\ a0" + "absc (a0' (n,False)) = (\ \\<^sub>s \) y \ \ \\<^sub>\ a0'" + using y n False by force+ + hence 1: "(a0 (n,False), a0' (n,False)) \ a3" + unfolding a0_def a0'_def a3_def abs_term_implications_def + by blast + + have 2: "\ x \\<^sub>\ a0' \ set \a0 (n,False) --\ a0' (n,False)\\\ x \\<^sub>\ a0\" + using y n timpl_apply_const by auto + + show ?thesis + using timpl_closure.TI[OF timpl_closure.FP 1] 2 + term_variants_pred_iff_in_term_variants[ + of "(\_. [])(Abs (a0 (n, False)) := [Abs (a0' (n, False))])"] + unfolding timpl_closure_set_def timpl_apply_term_def + by auto + qed (auto intro: timpl_closure_setI) + next + assume "\a. \\<^sub>v x = TAtom (Atom a)" + then obtain a where x_atom: "\\<^sub>v x = TAtom (Atom a)" by moura + + obtain f T where fT: "\ x = Fun f T" + using interpretation_grounds[OF \_interp, of "Var x"] + by (cases "\ x") auto + + have fT_atom: "\ (Fun f T) = TAtom (Atom a)" + using wt_subst_trm''[OF \_wt, of "Var x"] x_atom fT + by simp + + have T: "T = []" + using fT wf_trm_subst[OF \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s, of "Var x"] const_type_inv_wf[OF fT_atom] + by fastforce + + have f: "\is_Val f" using fT_atom unfolding is_Val_def by auto + + have "\ x \\<^sub>\ b = \ x" for b + using T fT abs_term_apply_const(2)[OF f] + by auto + thus "\ x \\<^sub>\ a0' \ timpl_closure_set {\ x \\<^sub>\ a0} a3" + by (auto intro: timpl_closure_setI) + qed + thus ?thesis by (metis a0_def a0'_def a3_def) +qed + +lemma \\<^sub>t\<^sub>i_covers_\\<^sub>0_Val: + assumes \_reach: "\ \ reachable_constraints P" + and T: "T \ set P" + and \: "welltyped_constraint_model \ (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + and \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + and P: "\T \ set P. admissible_transaction T" + and n: "Fun (Val n) [] \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + shows "Fun (Val n) [] \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) \) \ + timpl_closure_set {Fun (Val n) [] \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)} (\\<^sub>t\<^sub>i \ T \ \ \)" +proof - + define T' where "T' \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + define a0 where "a0 \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + define a0' where "a0' \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@T') \)" + define a3 where "a3 \ \\<^sub>t\<^sub>i \ T \ \ \" + + have \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \_reach) + + have T_adm: "admissible_transaction T" by (metis P(1) T) + + have "Fun (Abs (a0' n)) [] \ timpl_closure_set {Fun (Abs (a0 n)) []} a3" + proof (cases "a0 n = a0' n") + case False + then obtain x where x: + "x \ fv_transaction T - set (transaction_fresh T)" "Fun (Val n) [] = (\ \\<^sub>s \) x \ \" + using \\<^sub>t\<^sub>i_covers_\\<^sub>0_aux[OF \_reach T \ \ \ P n] + by (fastforce simp add: a0_def a0'_def T'_def) + hence "absc (a0 n) = (\ \\<^sub>s \) x \ \ \\<^sub>\ a0" "absc (a0' n) = (\ \\<^sub>s \) x \ \ \\<^sub>\ a0'" by simp_all + hence 1: "(a0 n, a0' n) \ a3" + using False x(1) + unfolding a0_def a0'_def a3_def abs_term_implications_def T'_def + by blast + show ?thesis + using timpl_apply_Abs[of "[]" "[]" "a0 n" "a0' n"] + timpl_closure.TI[OF timpl_closure.FP[of "Fun (Abs (a0 n)) []" a3] 1] + term_variants_pred_iff_in_term_variants[of "(\_. [])(Abs (a0 n) := [Abs (a0' n)])"] + unfolding timpl_closure_set_def timpl_apply_term_def + by force + qed (auto intro: timpl_closure_setI) + thus ?thesis by (simp add: a0_def a0'_def a3_def T'_def) +qed + +lemma \\<^sub>t\<^sub>i_covers_\\<^sub>0_ik: + assumes \_reach: "\ \ reachable_constraints P" + and T: "T \ set P" + and \: "welltyped_constraint_model \ (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + and \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + and P: "\T \ set P. admissible_transaction T" + and t: "t \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" + shows "t \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) \) \ + timpl_closure_set {t \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)} (\\<^sub>t\<^sub>i \ T \ \ \)" +proof - + define a0 where "a0 \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + define a0' where "a0' \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) \)" + define a3 where "a3 \ \\<^sub>t\<^sub>i \ T \ \ \" + + let ?U = "\T a. map (\s. s \ \ \\<^sub>\ a) T" + + have \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \_reach) + + have T_adm: "admissible_transaction T" by (metis P(1) T) + + have "t \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" "wf\<^sub>t\<^sub>r\<^sub>m t" using \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s t ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset by force+ + hence "\t0 \ subterms t. t0 \ \ \\<^sub>\ a0' \ timpl_closure_set {t0 \ \ \\<^sub>\ a0} a3" + proof (induction t) + case (Var x) thus ?case + using \\<^sub>t\<^sub>i_covers_\\<^sub>0_Var[OF \_reach T \ \ \ P, of x] + ik\<^sub>s\<^sub>s\<^sub>t_var_is_fv[of x "unlabel \"] vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \"] + by (simp add: a0_def a0'_def a3_def) + next + case (Fun f S) + have IH: "\t0 \ subterms t. t0 \ \ \\<^sub>\ a0' \ timpl_closure_set {t0 \ \ \\<^sub>\ a0} a3" + when "t \ set S" for t + using that Fun.prems(1) wf_trm_param[OF Fun.prems(2)] Fun.IH + by (meson in_subterms_subset_Union params_subterms subsetCE) + hence "t \\<^sub>\ a0' \ timpl_closure_set {t \\<^sub>\ a0} a3" + when "t \ set (map (\s. s \ \) S)" for t + using that by auto + hence "t \\<^sub>\ a0' \ timpl_closure (t \\<^sub>\ a0) a3" + when "t \ set (map (\s. s \ \) S)" for t + using that timpl_closureton_is_timpl_closure by auto + hence "(t \\<^sub>\ a0, t \\<^sub>\ a0') \ timpl_closure' a3" + when "t \ set (map (\s. s \ \) S)" for t + using that timpl_closure_is_timpl_closure' by auto + hence IH': "((?U S a0) ! i, (?U S a0') ! i) \ timpl_closure' a3" + when "i < length (map (\s. s \ \ \\<^sub>\ a0) S)" for i + using that by auto + + show ?case + proof (cases "\n. f = Val n") + case True + then obtain n where "Fun f S = Fun (Val n) []" + using Fun.prems(2) unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by force + moreover have "Fun f S \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset Fun.prems(1) by blast + ultimately show ?thesis + using \\<^sub>t\<^sub>i_covers_\\<^sub>0_Val[OF \_reach T \ \ \ P] + by (simp add: a0_def a0'_def a3_def) + next + case False + hence "Fun f S \ \ \\<^sub>\ a = Fun f (map (\t. t \ \ \\<^sub>\ a) S)" for a by (cases f) simp_all + hence "(Fun f S \ \ \\<^sub>\ a0, Fun f S \ \ \\<^sub>\ a0') \ timpl_closure' a3" + using timpl_closure_FunI[OF IH'] + by simp + hence "Fun f S \ \ \\<^sub>\ a0' \ timpl_closure_set {Fun f S \ \ \\<^sub>\ a0} a3" + using timpl_closureton_is_timpl_closure + timpl_closure_is_timpl_closure' + by metis + thus ?thesis using IH by simp + qed + qed + thus ?thesis by (simp add: a0_def a0'_def a3_def) +qed + +lemma transaction_prop1: + assumes "\ \ abs_substs_fun ` set (transaction_check_comp FP OCC TI T)" + and "x \ fv_transaction T" + and "x \ set (transaction_fresh T)" + and "\ x \ absdbupd (unlabel (transaction_updates T)) x (\ x)" + and "transaction_check FP OCC TI T" + and TI: + "set TI = {(a,b) \ (set TI)\<^sup>+. a \ b}" + shows "(\ x, absdbupd (unlabel (transaction_updates T)) x (\ x)) \ (set TI)\<^sup>+" +proof - + let ?upd = "\x. absdbupd (unlabel (transaction_updates T)) x (\ x)" + + have 0: "fv_transaction T = set (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T)))" + by (metis fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"]) + + have 1: "transaction_check_post FP TI T \" + using assms(1,5) + unfolding transaction_check_def list_all_iff + by blast + + have "(\ x, ?upd x) \ set TI \ (\ x, ?upd x) \ (set TI)\<^sup>+" + using TI using assms(4) by blast + thus ?thesis + using assms(2,3,4) 0 1 in_trancl_closure_iff_in_trancl_fun[of _ _ TI] + unfolding transaction_check_post_def List.member_def + by (metis (no_types, lifting) DiffI) +qed + +lemma transaction_prop2: + assumes \: "\ \ abs_substs_fun ` set (transaction_check_comp FP OCC TI T)" + and x: "x \ fv_transaction T" "fst x = TAtom Value" + and T_check: "transaction_check FP OCC TI T" + and T_adm: "admissible_transaction T" + and FP: + "analyzed (timpl_closure_set (set FP) (set TI))" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)" + and OCC: + "\t \ timpl_closure_set (set FP) (set TI). \f \ funs_term t. is_Abs f \ f \ Abs ` set OCC" + "timpl_closure_set (absc ` set OCC) (set TI) \ absc ` set OCC" + and TI: + "set TI = {(a,b) \ (set TI)\<^sup>+. a \ b}" + shows "x \ set (transaction_fresh T) \ \ x \ set OCC" (is "?A' \ ?A") + and "absdbupd (unlabel (transaction_updates T)) x (\ x) \ set OCC" (is ?B) +proof - + let ?xs = "fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))" + let ?ys = "filter (\x. x \ set (transaction_fresh T) \ fst x = TAtom Value) ?xs" + let ?C = "unlabel (transaction_selects T@transaction_checks T)" + let ?poss = "transaction_poschecks_comp ?C" + let ?negs = "transaction_negchecks_comp ?C" + let ?\upd = "\y. absdbupd (unlabel (transaction_updates T)) y (\ y)" + + have T_wf: "wellformed_transaction T" + and T_occ: "admissible_transaction_occurs_checks T" + using T_adm by (metis admissible_transaction_def)+ + + have 0: "{x \ fv_transaction T - set (transaction_fresh T). fst x = TAtom Value} = set ?ys" + using fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_strand T)"] + by force + + have 1: "transaction_check_pre FP TI T \" + using \ unfolding transaction_check_comp_def Let_def by fastforce + + have 2: "transaction_check_post FP TI T \" + using \ T_check unfolding transaction_check_def list_all_iff by blast + + have 3: "\ \ abs_substs_fun ` set (abs_substs_set ?ys OCC ?poss ?negs)" + using \ unfolding transaction_check_comp_def Let_def by force + + show A: ?A when ?A' using that 0 3 x abs_substs_abss_bounded by blast + + have 4: "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" + when x': "x \ set (transaction_fresh T)" + using T_wf x' unfolding wellformed_transaction_def by fast + + have "intruder_synth_mod_timpls FP TI (occurs (absc (?\upd x)))" + when x': "x \ set (transaction_fresh T)" + using 2 x' x T_occ + unfolding transaction_check_post_def admissible_transaction_occurs_checks_def + by fastforce + hence "timpl_closure_set (set FP) (set TI) \\<^sub>c occurs (absc (?\upd x))" + when x': "x \ set (transaction_fresh T)" + using x' intruder_synth_mod_timpls_is_synth_timpl_closure_set[ + OF TI, of FP "occurs (absc (?\upd x))"] + by argo + hence "Abs (?\upd x) \ \(funs_term ` timpl_closure_set (set FP) (set TI))" + when x': "x \ set (transaction_fresh T)" + using x' ideduct_synth_priv_fun_in_ik[ + of "timpl_closure_set (set FP) (set TI)" "occurs (absc (?\upd x))"] + by simp + hence "\t \ timpl_closure_set (set FP) (set TI). Abs (?\upd x) \ funs_term t" + when x': "x \ set (transaction_fresh T)" + using x' by force + hence 5: "?\upd x \ set OCC" when x': "x \ set (transaction_fresh T)" + using x' OCC by fastforce + + have 6: "?\upd x \ set OCC" when x': "x \ set (transaction_fresh T)" + proof (cases "\ x = ?\upd x") + case False + hence "(\ x, ?\upd x) \ (set TI)\<^sup>+" "\ x \ set OCC" + using A 2 x' x TI + unfolding transaction_check_post_def fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t Let_def + in_trancl_closure_iff_in_trancl_fun[symmetric] + List.member_def + by blast+ + thus ?thesis using timpl_closure_set_absc_subset_in[OF OCC(2)] by blast + qed (simp add: A x' x(1)) + + show ?B by (metis 5 6) +qed + +lemma transaction_prop3: + assumes \_reach: "\ \ reachable_constraints P" + and T: "T \ set P" + and \: "welltyped_constraint_model \ (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + and \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + and FP: + "analyzed (timpl_closure_set (set FP) (set TI))" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)" + "\t \ \\<^sub>i\<^sub>k \ \. timpl_closure_set (set FP) (set TI) \\<^sub>c t" + and OCC: + "\t \ timpl_closure_set (set FP) (set TI). \f \ funs_term t. is_Abs f \ f \ Abs ` set OCC" + "timpl_closure_set (absc ` set OCC) (set TI) \ absc ` set OCC" + "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \ \ absc ` set OCC" + and TI: + "set TI = {(a,b) \ (set TI)\<^sup>+. a \ b}" + and P: + "\T \ set P. admissible_transaction T" + shows "\x \ set (transaction_fresh T). (\ \\<^sub>s \) x \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) = absc {}" (is ?A) + and "\t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). + intruder_synth_mod_timpls FP TI (t \ (\ \\<^sub>s \) \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \))" (is ?B) + and "\x \ fv_transaction T - set (transaction_fresh T). + \s. select\Var x,Fun (Set s) []\ \ set (unlabel (transaction_selects T)) + \ (\ss. (\ \\<^sub>s \) x \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) = absc ss \ s \ ss)" (is ?C) + and "\x \ fv_transaction T - set (transaction_fresh T). + \s. \Var x in Fun (Set s) []\ \ set (unlabel (transaction_checks T)) + \ (\ss. (\ \\<^sub>s \) x \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) = absc ss \ s \ ss)" (is ?D) + and "\x \ fv_transaction T - set (transaction_fresh T). + \s. \Var x not in Fun (Set s) []\ \ set (unlabel (transaction_checks T)) + \ (\ss. (\ \\<^sub>s \) x \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) = absc ss \ s \ ss)" (is ?E) + and "\x \ fv_transaction T - set (transaction_fresh T). \\<^sub>v x = TAtom Value \ + (\ \\<^sub>s \) x \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) \ absc ` set OCC" (is ?F) +proof - + let ?T' = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + + define a0 where "a0 \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + define a0' where "a0' \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@?T') \)" + define fv_AT' where "fv_AT' \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@?T')" + + have T_adm: "admissible_transaction T" + using T P(1) by blast + hence T_valid: "wellformed_transaction T" + unfolding admissible_transaction_def by blast + + have T_adm': + "admissible_transaction_selects T" + "admissible_transaction_checks T" + "admissible_transaction_updates T" + using T_adm unfolding admissible_transaction_def by simp_all + + have \': "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + "\n. Val (n,True) \ \(funs_term ` (\ ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + "\n. Abs n \ \(funs_term ` (\ ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + "\n. Val (n,True) \ \(funs_term ` (\ ` fv_AT'))" + "\n. Abs n \ \(funs_term ` (\ ` fv_AT'))" + using \ admissible_transaction_occurs_checks_prop'[ + OF \_reach welltyped_constraint_model_prefix[OF \] P] + admissible_transaction_occurs_checks_prop'[ + OF reachable_constraints.step[OF \_reach T \ \] \ P] + unfolding welltyped_constraint_model_def constraint_model_def is_Val_def is_Abs_def fv_AT'_def + by fastforce+ + + have \

': "\T \ set P. \n. Val (n,True) \ \(funs_term ` trms_transaction T)" + "\T \ set P. \n. Abs n \ \(funs_term ` trms_transaction T)" + "\T \ set P. \x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + and "\T \ set P. \x \ fv_transaction T. \\<^sub>v x = TAtom Value \ (\a. \\<^sub>v x = TAtom (Atom a))" + using protocol_transaction_vars_TAtom_typed + protocol_transactions_no_pubconsts + protocol_transactions_no_abss + funs_term_Fun_subterm P + by fast+ + hence T_no_pubconsts: "\n. Val (n,True) \ \(funs_term ` trms_transaction T)" + and T_no_abss: "\n. Abs n \ \(funs_term ` trms_transaction T)" + and T_fresh_vars_value_typed: "\x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + and T_fv_const_typed: "\x \ fv_transaction T. \\<^sub>v x = TAtom Value \ (\a. \\<^sub>v x = TAtom (Atom a))" + using T by simp_all + + have wt_\\\: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \ \\<^sub>s \)" + using \'(2) wt_subst_compose transaction_fresh_subst_wt[OF \ T_fresh_vars_value_typed] + transaction_renaming_subst_wt[OF \] + by blast + + have 1: "(\ \\<^sub>s \) y \ \ = \ y" when "y \ set (transaction_fresh T)" for y + using transaction_fresh_subst_grounds_domain[OF \ that] subst_compose[of \ \ y] + by (simp add: subst_ground_ident) + + have 2: "(\ \\<^sub>s \) y \ \ \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" when "y \ set (transaction_fresh T)" for y + using 1[OF that] that \ unfolding transaction_fresh_subst_def by auto + + have 3: "\x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \. \\<^sub>v x = TAtom Value \ + (\B. prefix B \ \ x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \ \ x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B))" + by (metis welltyped_constraint_model_prefix[OF \] + constraint_model_Value_var_in_constr_prefix[OF \_reach _ P]) + + have 4: "\n. (\ \\<^sub>s \) y \ \ = Fun (Val n) []" + when "y \ fv_transaction T" "\\<^sub>v y = TAtom Value" for y + using transaction_var_becomes_Val[OF reachable_constraints.step[OF \_reach T \ \] \ \ \ P T] + that T_fv_const_typed \\<^sub>v_TAtom''[of y] + by metis + + have \_is_T_model: "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \) (set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)) (unlabel ?T') \" + using \ unlabel_append[of \ ?T'] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel \" \ "[]"] + strand_sem_append_stateful[of "{}" "{}" "unlabel \" "unlabel ?T'" \] + by (simp add: welltyped_constraint_model_def constraint_model_def db\<^sub>s\<^sub>s\<^sub>t_def) + + have T_rcv_no_val_bvars: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ subst_domain (\ \\<^sub>s \) = {}" + using transaction_no_bvars[OF T_adm] bvars_transaction_unfold[of T] by blast + + show ?A + proof + fix y assume y: "y \ set (transaction_fresh T)" + then obtain yn where yn: "(\ \\<^sub>s \) y \ \ = Fun (Val yn) []" "Fun (Val yn) [] \ subst_range \" + by (metis transaction_fresh_subst_sends_to_val'[OF \]) + + { \ \since \y\ is fresh \(\ \\<^sub>s \) y \ \\ cannot be part of the database state of \\ \\\ + fix t' s assume t': "insert\t',s\ \ set (unlabel \)" "t' \ \ = Fun (Val yn) []" + then obtain z where t'_z: "t' = Var z" using 2[OF y] yn(1) by (cases t') auto + hence z: "z \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" "\ z = (\ \\<^sub>s \) y \ \" using t' yn(1) by force+ + hence z': "\\<^sub>v z = TAtom Value" + by (metis \.simps(1) \_consts_simps(2) t'(2) t'_z wt_subst_trm'' \'(2)) + + obtain B where B: "prefix B \" "\ z \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" using z z' 3 by fastforce + hence "\t \ subst_range \. t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" + using transaction_fresh_subst_range_fresh(1)[OF \] trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)[of B] + unfolding prefix_def by fast + hence False using B(2) 1[OF y] z yn(1) by (metis subst_imgI term.distinct(1)) + } hence "\s. ((\ \\<^sub>s \) y \ \, s) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + using db\<^sub>s\<^sub>s\<^sub>t_in_cases[of "(\ \\<^sub>s \) y \ \" _ "unlabel \" \ "[]"] yn(1) + by (force simp add: db\<^sub>s\<^sub>s\<^sub>t_def) + thus "(\ \\<^sub>s \) y \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) = absc {}" + using to_abs_empty_iff_notin_db[of yn "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ []"] yn(1) + by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def) + qed + + show receives_covered: ?B + proof + fix t assume t: "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" + hence t_in_T: "t \ trms_transaction T" + using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_prefix_subset(1)[of "transaction_receive T"] + unfolding transaction_strand_def by fast + + have t_rcv: "receive\t \ \ \\<^sub>s \\ \ set (unlabel (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + using subst_lsst_unlabel_member[of "receive\t\" "transaction_receive T" "\ \\<^sub>s \"] + wellformed_transaction_unlabel_cases(1)[OF T_valid] trms\<^sub>s\<^sub>s\<^sub>t_in[OF t] + by fastforce + hence *: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \ \\<^sub>s \ \ \" + using wellformed_transaction_sem_receives[OF T_valid \_is_T_model] + by simp + + have t_fv: "fv (t \ \ \\<^sub>s \) \ fv_AT'" + using fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \"] unlabel_append[of \] + fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \"] + t_rcv fv_transaction_subst_unfold[of T " \ \\<^sub>s \"] + unfolding fv_AT'_def by force + + have **: "\t \ (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0. timpl_closure_set (set FP) (set TI) \\<^sub>c t" + using FP(3) by (auto simp add: a0_def abs_intruder_knowledge_def) + + note lms1 = pubval_terms_subst[OF _ pubval_terms_subst_range_disj[ + OF transaction_fresh_subst_has_no_pubconsts_abss(1)[OF \], of t]] + pubval_terms_subst[OF _ pubval_terms_subst_range_disj[ + OF transaction_renaming_subst_has_no_pubconsts_abss(1)[OF \], of "t \ \"]] + + note lms2 = abs_terms_subst[OF _ abs_terms_subst_range_disj[ + OF transaction_fresh_subst_has_no_pubconsts_abss(2)[OF \], of t]] + abs_terms_subst[OF _ abs_terms_subst_range_disj[ + OF transaction_renaming_subst_has_no_pubconsts_abss(2)[OF \], of "t \ \"]] + + have "t \ (\T\set P. trms_transaction T)" "fv (t \ \ \\<^sub>s \ \ \) = {}" + using t_in_T T interpretation_grounds[OF \'(1)] by fast+ + moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \ \\<^sub>s \))" + using wf_trm_subst_rangeI[of \, OF transaction_fresh_subst_is_wf_trm[OF \]] + wf_trm_subst_rangeI[of \, OF transaction_renaming_subst_is_wf_trm[OF \]] + wf_trms_subst_compose[of \ \, THEN wf_trms_subst_compose[OF _ \'(3)]] + by blast + moreover + have "t \ pubval_terms" + using t_in_T T_no_pubconsts funs_term_Fun_subterm + unfolding is_Val_def by fastforce + hence "t \ \ \\<^sub>s \ \ pubval_terms" + using lms1 + by auto + hence "t \ \ \\<^sub>s \ \ \ \ pubval_terms" + using \'(6) t_fv pubval_terms_subst'[of "t \ \ \\<^sub>s \" \] + by auto + moreover have "t \ abs_terms" + using t_in_T T_no_abss funs_term_Fun_subterm + unfolding is_Abs_def by force + hence "t \ \ \\<^sub>s \ \ abs_terms" + using lms2 + by auto + hence "t \ \ \\<^sub>s \ \ \ \ abs_terms" + using \'(7) t_fv abs_terms_subst'[of "t \ \ \\<^sub>s \" \] + by auto + ultimately have ***: + "t \ \ \\<^sub>s \ \ \ \ GSMP (\T\set P. trms_transaction T) - (pubval_terms \ abs_terms)" + using SMP.Substitution[OF SMP.MP[of t "\T\set P. trms_transaction T"], of "\ \\<^sub>s \ \\<^sub>s \"] + subst_subst_compose[of t "\ \\<^sub>s \" \] wt_\\\ + unfolding GSMP_def by fastforce + + have "\T\set P. bvars_transaction T = {}" + using transaction_no_bvars P unfolding list_all_iff by blast + hence ****: + "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \ \ GSMP (\T\set P. trms_transaction T) - (pubval_terms \ abs_terms)" + using reachable_constraints_no_pubconsts_abss[OF \_reach \

' _ \'(1,2,3,4,5)] + ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel \"] + by blast + + show "intruder_synth_mod_timpls FP TI (t \ \ \\<^sub>s \ \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \))" + using deduct_FP_if_deduct[OF **** ** * ***] deducts_eq_if_analyzed[OF FP(1)] + intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI, of FP] + unfolding a0_def by force + qed + + show ?C + proof (intro ballI allI impI) + fix y s + assume y: "y \ fv_transaction T - set (transaction_fresh T)" + and s: "select\Var y, Fun (Set s) []\ \ set (unlabel (transaction_selects T))" + hence "select\Var y, Fun (Set s) []\ \ set (unlabel (transaction_strand T))" + unfolding transaction_strand_def unlabel_def by auto + hence y_val: "\\<^sub>v y = TAtom Value" + using transaction_selects_are_Value_vars[OF T_valid T_adm'(1)] + by fastforce + + have "select\(\ \\<^sub>s \) y, Fun (Set s) []\ \ set (unlabel (transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ \\<^sub>s \)))" + using subst_lsst_unlabel_member[OF s] + by fastforce + hence "((\ \\<^sub>s \) y \ \, Fun (Set s) []) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + using wellformed_transaction_sem_selects[ + OF T_valid \_is_T_model, + of "(\ \\<^sub>s \) y" "Fun (Set s) []"] + by simp + thus "\ss. (\ \\<^sub>s \) y \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) = absc ss \ s \ ss" + using to_abs_alt_def[of "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \"] 4[of y] y y_val by auto + qed + + show ?D + proof (intro ballI allI impI) + fix y s + assume y: "y \ fv_transaction T - set (transaction_fresh T)" + and s: "\Var y in Fun (Set s) []\ \ set (unlabel (transaction_checks T))" + hence "\Var y in Fun (Set s) []\ \ set (unlabel (transaction_strand T))" + unfolding transaction_strand_def unlabel_def by auto + hence y_val: "\\<^sub>v y = TAtom Value" + using transaction_inset_checks_are_Value_vars[OF T_valid T_adm'(2)] + by fastforce + + have "\(\ \\<^sub>s \) y in Fun (Set s) []\ \ set (unlabel (transaction_checks T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ \\<^sub>s \)))" + using subst_lsst_unlabel_member[OF s] + by fastforce + hence "((\ \\<^sub>s \) y \ \, Fun (Set s) []) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + using wellformed_transaction_sem_pos_checks[ + OF T_valid \_is_T_model, + of "(\ \\<^sub>s \) y" "Fun (Set s) []"] + by simp + thus "\ss. (\ \\<^sub>s \) y \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) = absc ss \ s \ ss" + using to_abs_alt_def[of "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \"] 4[of y] y y_val by auto + qed + + show ?E + proof (intro ballI allI impI) + fix y s + assume y: "y \ fv_transaction T - set (transaction_fresh T)" + and s: "\Var y not in Fun (Set s) []\ \ set (unlabel (transaction_checks T))" + hence "\Var y not in Fun (Set s) []\ \ set (unlabel (transaction_strand T))" + unfolding transaction_strand_def unlabel_def by auto + hence y_val: "\\<^sub>v y = TAtom Value" + using transaction_notinset_checks_are_Value_vars[OF T_valid T_adm'(2)] + by fastforce + + have "\(\ \\<^sub>s \) y not in Fun (Set s) []\ \ set (unlabel (transaction_checks T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ \\<^sub>s \)))" + using subst_lsst_unlabel_member[OF s] + by fastforce + hence "((\ \\<^sub>s \) y \ \, Fun (Set s) []) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + using wellformed_transaction_sem_neg_checks(2)[ + OF T_valid \_is_T_model, + of "[]" "(\ \\<^sub>s \) y" "Fun (Set s) []"] + by simp + moreover have "list_all admissible_transaction_updates P" + using Ball_set[of P "admissible_transaction"] P(1) + Ball_set[of P admissible_transaction_updates] + unfolding admissible_transaction_def + by fast + moreover have "list_all wellformed_transaction P" + using P(1) Ball_set[of P "admissible_transaction"] Ball_set[of P wellformed_transaction] + unfolding admissible_transaction_def + by blast + ultimately have "((\ \\<^sub>s \) y \ \, Fun (Set s) S) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" for S + using reachable_constraints_db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_args_empty[OF \_reach] + unfolding admissible_transaction_updates_def + by auto + thus "\ss. (\ \\<^sub>s \) y \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) = absc ss \ s \ ss" + using to_abs_alt_def[of "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \"] 4[of y] y y_val by auto + qed + + show ?F + proof (intro ballI impI) + fix y assume y: "y \ fv_transaction T - set (transaction_fresh T)" "\\<^sub>v y = TAtom Value" + then obtain yn where yn: "(\ \\<^sub>s \) y \ \ = Fun (Val yn) []" using 4 by moura + hence y_abs: "(\ \\<^sub>s \) y \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) = Fun (Abs (\\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) yn)) []" by simp + + have *: "\r \ set (unlabel (transaction_selects T)). \x s. r = select\Var x, Fun (Set s) []\" + using admissible_transaction_strand_step_cases(2)[OF T_adm] by fast + + have "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" + using wellformed_transaction_fv_in_receives_or_selects[OF T_valid] y by blast + thus "(\ \\<^sub>s \) y \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) \ absc ` set OCC" + proof + assume "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" + then obtain t where t: "receive\t\ \ set (unlabel (transaction_receive T))" "y \ fv t" + using wellformed_transaction_unlabel_cases(1)[OF T_valid] + by (force simp add: unlabel_def) + + have **: "(\ \\<^sub>s \) y \ \ \ subterms (t \ \ \\<^sub>s \ \\<^sub>s \)" + "timpl_closure_set (set FP) (set TI) \\<^sub>c t \ \ \\<^sub>s \ \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + using fv_subterms_substI[OF t(2), of "\ \\<^sub>s \ \\<^sub>s \"] subst_compose[of "\ \\<^sub>s \" \ y] + subterms_subst_subset[of "\ \\<^sub>s \ \\<^sub>s \" t] receives_covered t(1) + unfolding intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI, symmetric] + by auto + + have "Abs (\\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) yn) \ \(funs_term ` (timpl_closure_set (set FP) (set TI)))" + using y_abs abs_subterms_in[OF **(1), of "\\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)"] + ideduct_synth_priv_fun_in_ik[ + OF **(2) funs_term_Fun_subterm'[of "Abs (\\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) yn)" "[]"]] + by force + hence "(\ \\<^sub>s \) y \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) \ subterms\<^sub>s\<^sub>e\<^sub>t (timpl_closure_set (set FP) (set TI))" + using y_abs wf_trms_subterms[OF timpl_closure_set_wf_trms[OF FP(2), of "set TI"]] + funs_term_Fun_subterm[of "Abs (\\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \) yn)"] + unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by fastforce + hence "funs_term ((\ \\<^sub>s \) y \ \ \\<^sub>\ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)) + \ (\t \ timpl_closure_set (set FP) (set TI). funs_term t)" + using funs_term_subterms_eq(2)[of "timpl_closure_set (set FP) (set TI)"] by blast + thus ?thesis using y_abs OCC(1) by fastforce + next + assume "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" + then obtain l s where "(l,select\Var y, Fun (Set s) []\) \ set (transaction_selects T)" + using * by (auto simp add: unlabel_def) + then obtain U where U: + "prefix (U@[(l,select\Var y, Fun (Set s) []\)]) (transaction_selects T)" + using in_set_conv_decomp[of "(l, select\Var y,Fun (Set s) []\)" "transaction_selects T"] + by (auto simp add: prefix_def) + hence "select\Var y, Fun (Set s) []\ \ set (unlabel (transaction_selects T))" + by (force simp add: prefix_def unlabel_def) + hence "select\(\ \\<^sub>s \) y, Fun (Set s) []\ \ set (unlabel (transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + using subst_lsst_unlabel_member + by fastforce + hence "(Fun (Val yn) [], Fun (Set s) []) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + using yn wellformed_transaction_sem_selects[ + OF T_valid \_is_T_model, of "(\ \\<^sub>s \) y" "Fun (Set s) []"] + by fastforce + hence "Fun (Val yn) [] \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>e\<^sub>t \" + using db\<^sub>s\<^sub>s\<^sub>t_in_cases[of "Fun (Val yn) []"] + by (fastforce simp add: db\<^sub>s\<^sub>s\<^sub>t_def) + thus ?thesis + using OCC(3) yn abs_in[of "Fun (Val yn) []" _ "\\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)"] + unfolding abs_value_constants_def + by (metis (mono_tags, lifting) mem_Collect_eq subsetCE) + qed + qed +qed + +lemma transaction_prop4: + assumes \_reach: "\ \ reachable_constraints P" + and T: "T \ set P" + and \: "welltyped_constraint_model \ (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + and \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + and P: "\T \ set P. admissible_transaction T" + and x: "x \ set (transaction_fresh T)" + and y: "y \ fv_transaction T - set (transaction_fresh T)" "\\<^sub>v y = TAtom Value" + shows "(\ \\<^sub>s \) x \ \ \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" (is ?A) + and "(\ \\<^sub>s \) y \ \ \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" (is ?B) +proof - + let ?T' = "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + + from \ have \': "welltyped_constraint_model \ \" + using welltyped_constraint_model_prefix by auto + + have T_P_addm: "admissible_transaction T'" when T': "T' \ set P " for T' + by (meson T' P) + + have T_adm: "admissible_transaction T" + by (metis (full_types) P T) + + from T_adm have T_valid: "wellformed_transaction T" + unfolding admissible_transaction_def by blast + + have be: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = {}" + using T_P_addm \_reach reachable_constraints_no_bvars transaction_no_bvars(2) by blast + + have T_no_bvars: "fv_transaction T = vars_transaction T" + using transaction_no_bvars[OF T_adm] by simp + + have \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" by (metis \ welltyped_constraint_model_def) + + obtain xn where xn: "\ x = Fun (Val xn) []" + using \ x unfolding transaction_fresh_subst_def by force + + then have xnxn: "(\ \\<^sub>s \) x = Fun (Val xn) []" + unfolding subst_compose_def by auto + + from xn xnxn have a0: "(\ \\<^sub>s \) x \ \ = Fun (Val xn) []" + by auto + + have b0: "\\<^sub>v x = TAtom Value" + using P x T protocol_transaction_vars_TAtom_typed(3) + by metis + + note 0 = a0 b0 + + have xT: "x \ fv_transaction T" + using x transaction_fresh_vars_subset[OF T_valid] + by fast + + have \_x_nin_A: "\ x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + proof - + have "\ x \ subst_range \" + by (metis \ transaction_fresh_subst_sends_to_val x) + moreover + have "(\t \ subst_range \. t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using \ transaction_fresh_subst_def[of \ T \] by auto + ultimately + show ?thesis + by auto + qed + + have *: "y \ set (transaction_fresh T)" + using assms by auto + + have **: "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" + using * y wellformed_transaction_fv_in_receives_or_selects[OF T_valid] + by blast + + have y_fv: "y \ fv_transaction T" using y fv_transaction_unfold by blast + + have y_val: "fst y = TAtom Value" using y(2) \\<^sub>v_TAtom''(2) by blast + + have "list_all (\x. fst x = Var Value) (transaction_fresh T)" + using x T_adm unfolding admissible_transaction_def by fast + hence x_val: "fst x = TAtom Value" using x unfolding list_all_iff by blast + + have "\ x \ \ \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + proof (rule ccontr) + assume "\\ x \ \ \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + then have a: "\ x \ \ \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + by auto + + then have \_x_I_in_A: "\ x \ \ \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>e\<^sub>t \" + using reachable_constraints_subterms_subst[OF \_reach \' P] by blast + + have "\u. u \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ \ u = \ x" + proof - + from \_x_I_in_A have "\tu. tu \ \ (subterms ` (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ tu \ \ = \ x \ \" + by force + then obtain tu where tu: "tu \ \ (subterms ` (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ tu \ \ = \ x \ \" + by auto + then have "tu \ \ x" + using \_x_nin_A by auto + moreover + have "tu \ \ = \ x" + using tu by (simp add: xn) + ultimately + have "\u. tu = Var u" + unfolding xn by (cases tu) auto + then obtain u where "tu = Var u" + by auto + have "u \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ \ u = \ x" + proof - + have "u \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" + using \tu = Var u\ tu var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t by fastforce + then have "u \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" + using be vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \"] by blast + moreover + have "\ u = \ x" + using \tu = Var u\ \tu \ \ = \ x\ by auto + ultimately + show ?thesis + by auto + qed + then show "\u. u \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ \ u = \ x" + by metis + qed + then obtain u where u: + "u \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" "\ u = \ x" + by auto + then have u_TA: "\\<^sub>v u = TAtom Value" + using P(1) T x_val \\<^sub>v_TAtom''(2)[of x] + wt_subst_trm''[OF \_wt, of "Var u"] wt_subst_trm''[of \ "Var x"] + transaction_fresh_subst_wt[OF \] protocol_transaction_vars_TAtom_typed(3) + by force + have "\B. prefix B \ \ u \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \ \ u \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" + using u u_TA + by (metis welltyped_constraint_model_prefix[OF \] + constraint_model_Value_var_in_constr_prefix[OF \_reach _ P]) + then obtain B where "prefix B \ \ u \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t B \ \ u \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t B)" + by blast + moreover have "\(subterms ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t xs) \ \(subterms ` trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ys)" + when "prefix xs ys" + for xs ys::"('fun,'atom,'sets,'lbl) prot_strand" + using that subterms\<^sub>s\<^sub>e\<^sub>t_mono trms\<^sub>s\<^sub>s\<^sub>t_mono unlabel_mono set_mono_prefix by metis + ultimately have "\ u \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + by blast + then have "\ x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using u by auto + then show "False" + using \_x_nin_A by auto + qed + then show ?A + unfolding subst_compose_def xn by auto + + from ** show ?B + proof + define T' where "T' \ transaction_receive T" + define \ where "\ \ \ \\<^sub>s \" + + assume y: "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" + hence "Var y \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" by (metis T'_def fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t) + then obtain z where z: "z \ set (unlabel T')" "Var y \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p z)" + by (induct T') auto + + have "is_Receive z" + using T_adm Ball_set[of "unlabel T'" is_Receive] z(1) + unfolding admissible_transaction_def wellformed_transaction_def T'_def + by blast + then obtain ty where "z = receive\ty\" by (cases z) auto + hence ty: "receive\ty \ \\ \ set (unlabel (T' \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" "\ y \ subterms (ty \ \)" + using z subst_mono unfolding subst_apply_labeled_stateful_strand_def unlabel_def by force+ + hence y_deduct: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \ \ ty \ \ \ \" + using transaction_receive_deduct[OF T_adm _ \ \] + by (metis \ T'_def \_def welltyped_constraint_model_def) + + obtain zn where zn: "(\ \\<^sub>s \) y \ \ = Fun (Val (zn, False)) []" + using transaction_var_becomes_Val[ + OF reachable_constraints.step[OF \_reach T \ \] \ \ \ P T, of y] + transaction_fresh_subst_transaction_renaming_subst_range(2)[OF \ \ *] + y_fv y_val + by (metis subst_apply_term.simps(1)) + + have "(\ \\<^sub>s \) y \ \ \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \)" + using private_fun_deduct_in_ik[OF y_deduct, of "Val (zn, False)"] + by (metis \_def ty(2) zn subst_mono public.simps(3) snd_eqD) + thus ?B + using ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel \" \] unlabel_subst[of \ \] + subterms\<^sub>s\<^sub>e\<^sub>t_mono[OF ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel (\ \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)"]] + by fastforce + next + assume y': "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" + then obtain s where s: "select\Var y,s\ \ set (unlabel (transaction_selects T))" + "fst y = TAtom Value" + using admissible_transaction_strand_step_cases(1,2)[OF T_adm] by fastforce + + obtain z zn where zn: "(\ \\<^sub>s \) y = Var z" "\ z = Fun (Val zn) []" + using transaction_var_becomes_Val[ + OF reachable_constraints.step[OF \_reach T \ \] \ \ \ P T] + transaction_fresh_subst_transaction_renaming_subst_range(2)[OF \ \ *] + y_fv T_no_bvars(1) s(2) + by (metis subst_apply_term.simps(1)) + + have transaction_selects_db_here: + "\n s. select\Var (TAtom Value, n), Fun (Set s) []\ \ set (unlabel (transaction_selects T)) + \ (\ (TAtom Value, n) \ \, Fun (Set s) []) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + using transaction_selects_db[OF T_adm _ \ \] \ + unfolding welltyped_constraint_model_def by auto + + have "\n. y = (Var Value, n)" + using T \\<^sub>v_TAtom_inv(2) y_fv y(2) + by blast + moreover + have "admissible_transaction_selects T" + using T_adm admissible_transaction_def + by blast + then have "is_Fun_Set (the_set_term (select\Var y,s\))" + using s unfolding admissible_transaction_selects_def + by auto + then have "\ss. s = Fun (Set ss) []" + using is_Fun_Set_exi + by auto + ultimately + obtain n ss where nss: "y = (TAtom Value, n)" "s = Fun (Set ss) []" + by auto + then have "select\Var (TAtom Value, n), Fun (Set ss) []\ \ set (unlabel (transaction_selects T))" + using s by auto + then have in_db: "(\ (TAtom Value, n) \ \, Fun (Set ss) []) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + using transaction_selects_db_here[of n ss] by auto + have "(\ z, s) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + proof - + have "(\ y \ \, s) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + using in_db nss by auto + moreover + have "\ y = Var z" + using zn + by (metis (no_types, hide_lams) \ subst_compose_def subst_imgI subst_to_var_is_var + term.distinct(1) transaction_fresh_subst_def var_comp(2)) + then have "\ y \ \ = \ z" + by auto + ultimately + show "(\ z, s) \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + by auto + qed + then have "\t' s'. insert\t',s'\ \ set (unlabel \) \ \ z = t' \ \ \ s = s' \ \" + using db\<^sub>s\<^sub>s\<^sub>t_in_cases[of "\ z" s "unlabel \" \ "[]"] unfolding db\<^sub>s\<^sub>s\<^sub>t_def by auto + then obtain t' s' where t's': "insert\t',s'\ \ set (unlabel \) \ \ z = t' \ \ \ s = s' \ \" + by auto + then have "t' \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + by force + then have "t' \ \ \ (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \\<^sub>s\<^sub>e\<^sub>t \" + by auto + then have "\ z \ (subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \\<^sub>s\<^sub>e\<^sub>t \" + using t's' by auto + then have "\ z \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\ \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + using reachable_constraints_subterms_subst[ + OF \_reach welltyped_constraint_model_prefix[OF \] P] + by auto + then show ?B + using zn(1) by simp + qed +qed + +lemma transaction_prop5: + fixes T \ \ \ \ T' a0 a0' \ + defines "T' \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + and "a0 \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + and "a0' \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@T') \)" + and "\ \ \\ x. if fst x = TAtom Value then (absc \ \) x else Var x" + assumes \_reach: "\ \ reachable_constraints P" + and T: "T \ set P" + and \: "welltyped_constraint_model \ (\@T')" + and \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + and FP: + "analyzed (timpl_closure_set (set FP) (set TI))" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)" + "\t \ \\<^sub>i\<^sub>k \ \. timpl_closure_set (set FP) (set TI) \\<^sub>c t" + and OCC: + "\t \ timpl_closure_set (set FP) (set TI). \f \ funs_term t. is_Abs f \ f \ Abs ` set OCC" + "timpl_closure_set (absc ` set OCC) (set TI) \ absc ` set OCC" + "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \ \ absc ` set OCC" + and TI: + "set TI = {(a,b) \ (set TI)\<^sup>+. a \ b}" + and P: + "\T \ set P. admissible_transaction T" + and step: "list_all (transaction_check FP OCC TI) P" + shows "\\ \ abs_substs_fun ` set (transaction_check_comp FP OCC TI T). + \x \ fv_transaction T. \\<^sub>v x = TAtom Value \ + (\ \\<^sub>s \) x \ \ \\<^sub>\ a0 = absc (\ x) \ + (\ \\<^sub>s \) x \ \ \\<^sub>\ a0' = absc (absdbupd (unlabel (transaction_updates T)) x (\ x))" +proof - + define comp0 where "comp0 \ abs_substs_fun ` set (transaction_check_comp FP OCC TI T)" + define check0 where "check0 \ transaction_check FP OCC TI T" + define upd where "upd \ \\ x. absdbupd (unlabel (transaction_updates T)) x (\ x)" + define b0 where "b0 \ \x. THE b. absc b = (\ \\<^sub>s \) x \ \ \\<^sub>\ a0" + + note all_defs = comp0_def check0_def a0_def a0'_def upd_def b0_def \_def T'_def + + have \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \)" for \ + unfolding \_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def + by fastforce + + have \_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + by (metis reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) \_reach) + + have \_interp: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and \_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + by (metis \ welltyped_constraint_model_def constraint_model_def, + metis \ welltyped_constraint_model_def, + metis \ welltyped_constraint_model_def constraint_model_def) + + have \_is_T_model: "strand_sem_stateful (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \) (set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)) (unlabel T') \" + using \ unlabel_append[of \ T'] db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t[of "unlabel \" \ "[]"] + strand_sem_append_stateful[of "{}" "{}" "unlabel \" "unlabel T'" \] + by (simp add: welltyped_constraint_model_def constraint_model_def db\<^sub>s\<^sub>s\<^sub>t_def) + + have T_adm: "admissible_transaction T" + using T P(1) Ball_set[of P "admissible_transaction"] + by blast + hence T_valid: "wellformed_transaction T" + unfolding admissible_transaction_def by blast + + have T_no_bvars: "fv_transaction T = vars_transaction T" "bvars_transaction T = {}" + using transaction_no_bvars[OF T_adm] by simp_all + + have T_vars_const_typed: "\x \ fv_transaction T. \\<^sub>v x = TAtom Value \ (\a. \\<^sub>v x = TAtom (Atom a))" + and T_fresh_vars_value_typed: "\x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + using T P protocol_transaction_vars_TAtom_typed(2,3)[of T] by simp_all + + have wt_\\\: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \ \\<^sub>s \)" and wt_\\: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" + using \_wt wt_subst_compose transaction_fresh_subst_wt[OF \ T_fresh_vars_value_typed] + transaction_renaming_subst_wt[OF \] + by blast+ + + have T_vars_vals: "\x \ fv_transaction T. \n. (\ \\<^sub>s \) x \ \ = Fun (Val (n, False)) []" + proof + fix x assume x: "x \ fv_transaction T" + show "\n. (\ \\<^sub>s \) x \ \ = Fun (Val (n, False)) []" + proof (cases "x \ subst_domain \") + case True + then obtain n where "\ x = Fun (Val (n, False)) []" + using \ unfolding transaction_fresh_subst_def + by moura + thus ?thesis by (simp add: subst_compose_def) + next + case False + hence *: "(\ \\<^sub>s \) x = \ x" by (auto simp add: subst_compose_def) + + obtain y where y: "\\<^sub>v x = \\<^sub>v y" "\ x = Var y" + using transaction_renaming_subst_wt[OF \] + transaction_renaming_subst_is_renaming[OF \] + by (metis \.simps(1) prod.exhaust wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + hence "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + using x * T_no_bvars(2) unlabel_subst[of "transaction_strand T" "\ \\<^sub>s \"] + fv\<^sub>s\<^sub>s\<^sub>t_subst_fv_subset[of x "unlabel (transaction_strand T)" "\ \\<^sub>s \"] + by auto + hence "y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + using fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \"] + fv\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \"] unlabel_append[of \] + by auto + thus ?thesis + using x y * T P (* T_vars_const_typed *) + constraint_model_Value_term_is_Val[ + OF reachable_constraints.step[OF \_reach T \ \] \[unfolded T'_def] P(1), of y] + admissible_transaction_Value_vars[of T] + by simp + qed + qed + + have T_vars_absc: "\x \ fv_transaction T. \!n. (\ \\<^sub>s \) x \ \ \\<^sub>\ a0 = absc n" + using T_vars_vals by fastforce + hence "(absc \ b0) x = (\ \\<^sub>s \) x \ \ \\<^sub>\ a0" when "x \ fv_transaction T" for x + using that unfolding b0_def by fastforce + hence T_vars_absc': "t \ (absc \ b0) = t \ (\ \\<^sub>s \) \ \ \\<^sub>\ a0" + when "fv t \ fv_transaction T" "\n T. Fun (Val n) T \ subterms t" for t + using that(1) abs_term_subst_eq'[OF _ that(2), of "\ \\<^sub>s \ \\<^sub>s \" a0 "absc \ b0"] + subst_compose[of "\ \\<^sub>s \" \] subst_subst_compose[of t "\ \\<^sub>s \" \] + by fastforce + + have "\\ \ comp0. \x \ fv_transaction T. fst x = TAtom Value \ b0 x = \ x" + proof - + let ?S = "set (unlabel (transaction_selects T))" + let ?C = "set (unlabel (transaction_checks T))" + let ?xs = "fv_transaction T - set (transaction_fresh T)" + + note * = transaction_prop3[OF \_reach T \[unfolded T'_def] \ \ FP OCC TI P(1)] + + have **: + "\x \ set (transaction_fresh T). b0 x = {}" + "\t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T). intruder_synth_mod_timpls FP TI (t \ \ b0)" + (is ?B) + proof - + show ?B + proof (intro ballI impI) + fix t assume t: "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" + hence t': "fv t \ fv_transaction T" "\n T. Fun (Val n) T \ subterms t" + using trms_transaction_unfold[of T] vars_transaction_unfold[of T] + trms\<^sub>s\<^sub>s\<^sub>t_fv_vars\<^sub>s\<^sub>s\<^sub>t_subset[of t "unlabel (transaction_strand T)"] + transactions_have_no_Value_consts'[OF T_adm] + wellformed_transaction_send_receive_fv_subset(1)[OF T_valid t(1)] + by blast+ + + have "intruder_synth_mod_timpls FP TI (t \ (absc \ b0))" + using t(1) t' *(2) T_vars_absc' + by (metis a0_def) + moreover have "(absc \ b0) x = (\ b0) x" when "x \ fv t" for x + using that T P admissible_transaction_Value_vars[of T] + \fv t \ fv_transaction T\ \\<^sub>v_TAtom''(2)[of x] + unfolding \_def by fastforce + hence "t \ (absc \ b0) = t \ \ b0" + using term_subst_eq[of t "absc \ b0" "\ b0"] by argo + ultimately show "intruder_synth_mod_timpls FP TI (t \ \ b0)" + using intruder_synth.simps[of "set FP"] by (cases "t \ \ b0") metis+ + qed + qed (simp add: *(1) a0_def b0_def) + + have ***: "\x \ ?xs. \s. select\Var x,Fun (Set s) []\ \ ?S \ s \ b0 x" + "\x \ ?xs. \s. \Var x in Fun (Set s) []\ \ ?C \ s \ b0 x" + "\x \ ?xs. \s. \Var x not in Fun (Set s) []\ \ ?C \ s \ b0 x" + "\x \ ?xs. fst x = TAtom Value \ b0 x \ set OCC" + unfolding a0_def b0_def + using *(3,4) apply (force, force) + using *(5) apply force + using *(6) admissible_transaction_Value_vars[OF bspec[OF P T]] by force + + show ?thesis + using transaction_check_comp_in[OF T_adm **[unfolded \_def] ***] + unfolding comp0_def + by metis + qed + hence 1: "\\ \ comp0. \x \ fv_transaction T. + fst x = TAtom Value \ (\ \\<^sub>s \) x \ \ \\<^sub>\ a0 = absc (\ x)" + using T_vars_absc unfolding b0_def a0_def by fastforce + + obtain \ where \: + "\ \ comp0" "\x \ fv_transaction T. fst x = TAtom Value \ (\ \\<^sub>s \) x \ \ \\<^sub>\ a0 = absc (\ x)" + using 1 by moura + + have 2: "\ x \ \ \\<^sub>\ \\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D) = absc (absdbupd (unlabel A) x d)" + when "\ x \ \ \\<^sub>\ \\<^sub>0 D = absc d" + and "\t u. insert\t,u\ \ set (unlabel A) \ (\y s. t = Var y \ u = Fun (Set s) [])" + and "\t u. delete\t,u\ \ set (unlabel A) \ (\y s. t = Var y \ u = Fun (Set s) [])" + and "\y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \ x \ \ = \ y \ \ \ x = y" + and "\y \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \n. \ y \ \ = Fun (Val n) []" + and x: "\ x \ \ = Fun (Val n) []" + and D: "\d \ set D. \s. snd d = Fun (Set s) []" + for A::"('fun,'atom,'sets,'nat) prot_strand" and x \ D n d + using that(2,3,4,5) + proof (induction A rule: List.rev_induct) + case (snoc a A) + then obtain l b where a: "a = (l,b)" by (metis surj_pair) + + have IH: "\\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D) n = absdbupd (unlabel A) x d" + using snoc unlabel_append[of A "[a]"] a x + by (simp del: unlabel_append) + + have b_prems: "\y \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p b. \ x \ \ = \ y \ \ \ x = y" + "\y \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p b. \n. \ y \ \ = Fun (Val n) []" + using snoc.prems(3,4) a by (simp_all add: unlabel_def) + + have *: "filter is_Update (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) = + filter is_Update (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)))" + "filter is_Update (unlabel (A@[a])) = filter is_Update (unlabel A)" + when "\is_Update b" + using that a + by (cases b, simp_all add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def unlabel_def subst_apply_labeled_stateful_strand_def)+ + + note ** = IH a dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_append[of A "[a]" \] + + note *** = * absdbupd_filter[of "unlabel (A@[a])"] + absdbupd_filter[of "unlabel A"] + db\<^sub>s\<^sub>s\<^sub>t_filter[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))"] + db\<^sub>s\<^sub>s\<^sub>t_filter[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))"] + + note **** = **(2,3) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_snoc[of A a \] + unlabel_append[of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" "[dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \]"] + db\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" "unlabel [dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \]" \ D] + + have "\\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D) n = absdbupd (unlabel (A@[a])) x d" using ** *** + proof (cases b) + case (Insert t t') + then obtain y s m where y: "t = Var y" "t' = Fun (Set s) []" "\ y \ \ = Fun (Val m) []" + using snoc.prems(1) b_prems(2) a by (fastforce simp add: unlabel_def) + hence a': "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D = + List.insert ((Fun (Val m) [], Fun (Set s) [])) (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ D)" + "unlabel [dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \] = [insert\\ y, Fun (Set s) []\]" + "unlabel [a] = [insert\Var y, Fun (Set s) []\]" + using **** Insert by simp_all + + show ?thesis + proof (cases "x = y") + case True + hence "\ x \ \ = \ y \ \" by simp + hence "\\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D) n = + insert s (\\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D) n)" + by (metis (no_types, lifting) y(3) a'(1) x dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst to_abs_list_insert') + thus ?thesis using True IH a'(3) absdbupd_append[of "unlabel A"] by (simp add: unlabel_def) + next + case False + hence "\ x \ \ \ \ y \ \" using b_prems(1) y Insert by simp + hence "\\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D) n = \\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D) n" + by (metis (no_types, lifting) y(3) a'(1) x dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst to_abs_list_insert) + thus ?thesis using False IH a'(3) absdbupd_append[of "unlabel A"] by (simp add: unlabel_def) + qed + next + case (Delete t t') + then obtain y s m where y: "t = Var y" "t' = Fun (Set s) []" "\ y \ \ = Fun (Val m) []" + using snoc.prems(2) b_prems(2) a by (fastforce simp add: unlabel_def) + hence a': "db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D = + List.removeAll ((Fun (Val m) [], Fun (Set s) [])) (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ D)" + "unlabel [dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \] = [delete\\ y, Fun (Set s) []\]" + "unlabel [a] = [delete\Var y, Fun (Set s) []\]" + using **** Delete by simp_all + + have "\s S. snd d = Fun (Set s) []" when "d \ set (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ D)" for d + using snoc.prems(1,2) db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_ex[OF that _ _ D] by (simp add: unlabel_def) + moreover { + fix t::"('fun,'atom,'sets) prot_term" + and D::"(('fun,'atom,'sets) prot_term \ ('fun,'atom,'sets) prot_term) list" + assume "\d \ set D. \s. snd d = Fun (Set s) []" + hence "removeAll (t, Fun (Set s) []) D = filter (\d. \S. d = (t, Fun (Set s) S)) D" + by (induct D) auto + } ultimately have a'': + "List.removeAll ((Fun (Val m) [], Fun (Set s) [])) (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ D) = + filter (\d. \S. d = (Fun (Val m) [], Fun (Set s) S)) (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ D)" + by simp + + show ?thesis + proof (cases "x = y") + case True + hence "\ x \ \ = \ y \ \" by simp + hence "\\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D) n = + (\\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D) n) - {s}" + using y(3) a'' a'(1) x by (simp add: dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst to_abs_list_remove_all') + thus ?thesis using True IH a'(3) absdbupd_append[of "unlabel A"] by (simp add: unlabel_def) + next + case False + hence "\ x \ \ \ \ y \ \" using b_prems(1) y Delete by simp + hence "\\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@[a] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D) n = \\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ D) n" + by (metis (no_types, lifting) y(3) a'(1) x dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst to_abs_list_remove_all) + thus ?thesis using False IH a'(3) absdbupd_append[of "unlabel A"] by (simp add: unlabel_def) + qed + qed simp_all + thus ?case by (simp add: x) + qed (simp add: that(1)) + + have 3: "x = y" + when xy: "(\ \\<^sub>s \) x \ \ = (\ \\<^sub>s \) y \ \" "x \ fv_transaction T" "y \ fv_transaction T" + for x y + proof - + have "x \ set (transaction_fresh T) \ y \ set (transaction_fresh T) \ ?thesis" + using xy admissible_transaction_strand_sem_fv_ineq[OF T_adm \_is_T_model[unfolded T'_def]] + by fast + moreover { + assume *: "x \ set (transaction_fresh T)" "y \ set (transaction_fresh T)" + then obtain xn yn where "\ x = Fun (Val xn) []" "\ y = Fun (Val yn) []" + by (metis transaction_fresh_subst_sends_to_val[OF \]) + hence "\ x = \ y" using that(1) by (simp add: subst_compose) + moreover have "inj_on \ (subst_domain \)" "x \ subst_domain \" "y \ subst_domain \" + using * \ unfolding transaction_fresh_subst_def by auto + ultimately have ?thesis unfolding inj_on_def by blast + } moreover have False when "x \ set (transaction_fresh T)" "y \ set (transaction_fresh T)" + using that(2) xy T_no_bvars admissible_transaction_Value_vars[OF bspec[OF P T], of y] + transaction_prop4[OF \_reach T \[unfolded T'_def] \ \ P that(1), of y] + by auto + moreover have False when "x \ set (transaction_fresh T)" "y \ set (transaction_fresh T)" + using that(1) xy T_no_bvars admissible_transaction_Value_vars[OF bspec[OF P T], of x] + transaction_prop4[OF \_reach T \[unfolded T'_def] \ \ P that(2), of x] + by fastforce + ultimately show ?thesis by metis + qed + + have 4: "\y s. t = Var y \ u = Fun (Set s) []" + when "insert\t,u\ \ set (unlabel (transaction_strand T))" for t u + using that admissible_transaction_strand_step_cases(4)[OF T_adm] T_valid + by blast + + have 5: "\y s. t = Var y \ u = Fun (Set s) []" + when "delete\t,u\ \ set (unlabel (transaction_strand T))" for t u + using that admissible_transaction_strand_step_cases(4)[OF T_adm] T_valid + by blast + + have 6: "\n. (\ \\<^sub>s \) y \ \ = Fun (Val (n, False)) []" when "y \ fv_transaction T" for y + using that by (simp add: T_vars_vals) + + have "list_all wellformed_transaction P" "list_all admissible_transaction_updates P" + using P(1) Ball_set[of P "admissible_transaction"] Ball_set[of P wellformed_transaction] + Ball_set[of P admissible_transaction_updates] + unfolding admissible_transaction_def by fastforce+ + hence 7: "\s. snd d = Fun (Set s) []" when "d \ set (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" for d + using that reachable_constraints_db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_args_empty[OF \_reach] + unfolding admissible_transaction_updates_def by (cases d) simp + + have "(\ \\<^sub>s \) x \ \ \\<^sub>\ a0' = absc (upd \ x)" + when x: "x \ fv_transaction T" "fst x = TAtom Value" for x + proof - + have "(\ \\<^sub>s \) x \ \ \\<^sub>\ \\<^sub>0 (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) \ (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)) + = absc (absdbupd (unlabel (transaction_strand T)) x (\ x))" + using 2[of "\ \\<^sub>s \" x "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \" "\ x" "transaction_strand T"] + 3[OF _ x(1)] 4 5 6[OF that(1)] 6 7 x \(2) + unfolding all_defs by blast + thus ?thesis + using x db\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \"] absdbupd_wellformed_transaction[OF T_valid] + unfolding all_defs db\<^sub>s\<^sub>s\<^sub>t_def by force + qed + thus ?thesis using \ \\<^sub>v_TAtom''(2) unfolding all_defs by blast +qed + +lemma transaction_prop6: + fixes T \ \ \ \ T' a0 a0' + defines "T' \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + and "a0 \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + and "a0' \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@T') \)" + assumes \_reach: "\ \ reachable_constraints P" + and T: "T \ set P" + and \: "welltyped_constraint_model \ (\@T')" + and \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + and FP: + "analyzed (timpl_closure_set (set FP) (set TI))" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)" + "\t \ \\<^sub>i\<^sub>k \ \. timpl_closure_set (set FP) (set TI) \\<^sub>c t" + and OCC: + "\t \ timpl_closure_set (set FP) (set TI). \f \ funs_term t. is_Abs f \ f \ Abs ` set OCC" + "timpl_closure_set (absc ` set OCC) (set TI) \ absc ` set OCC" + "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \ \ absc ` set OCC" + and TI: + "set TI = {(a,b) \ (set TI)\<^sup>+. a \ b}" + and P: + "\T \ set P. admissible_transaction T" + and step: "list_all (transaction_check FP OCC TI) P" + shows "\t \ timpl_closure_set (\\<^sub>i\<^sub>k \ \) (\\<^sub>t\<^sub>i \ T \ \ \). + timpl_closure_set (set FP) (set TI) \\<^sub>c t" (is ?A) + and "timpl_closure_set (\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \) (\\<^sub>t\<^sub>i \ T \ \ \) \ absc ` set OCC" (is ?B) + and "\t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T). is_Fun (t \ (\ \\<^sub>s \) \ \ \\<^sub>\ a0') \ + timpl_closure_set (set FP) (set TI) \\<^sub>c t \ (\ \\<^sub>s \) \ \ \\<^sub>\ a0'" (is ?C) + and "\x \ fv_transaction T. \\<^sub>v x = TAtom Value \ + (\ \\<^sub>s \) x \ \ \\<^sub>\ a0' \ absc ` set OCC" (is ?D) +proof - + define comp0 where "comp0 \ abs_substs_fun ` set (transaction_check_comp FP OCC TI T)" + define check0 where "check0 \ transaction_check FP OCC TI T" + + define upd where "upd \ \\ x. absdbupd (unlabel (transaction_updates T)) x (\ x)" + + define \ where "\ \ \\ x. if fst x = TAtom Value then (absc \ \) x else Var x" + + have T_adm: "admissible_transaction T" using T P(1) by metis + hence T_valid: "wellformed_transaction T" by (metis admissible_transaction_def) + + have \_prop: "\ \ x = absc (\ x)" when "\\<^sub>v x = TAtom Value" for \ x + using that \\<^sub>v_TAtom''(2)[of x] unfolding \_def by simp + + (* The set-membership status of all value constants in T under \, \, \ are covered by the check *) + have 0: "\\ \ comp0. \x \ fv_transaction T. \\<^sub>v x = TAtom Value \ + (\ \\<^sub>s \) x \ \ \\<^sub>\ a0 = absc (\ x) \ + (\ \\<^sub>s \) x \ \ \\<^sub>\ a0' = absc (upd \ x)" + using transaction_prop5[OF \_reach T \[unfolded T'_def] \ \ FP OCC TI P step] + unfolding a0_def a0'_def T'_def upd_def comp0_def + by blast + + (* All set-membership changes are covered by the term implication graph *) + have 1: "(\ x, upd \ x) \ (set TI)\<^sup>+" + when "\ \ comp0" "\ x \ upd \ x" "x \ fv_transaction T" "x \ set (transaction_fresh T)" + for x \ + using T that step Ball_set[of P "transaction_check FP OCC TI"] + transaction_prop1[of \ FP OCC TI T x] TI + unfolding upd_def comp0_def + by blast + + (* All set-membership changes are covered by the fixed point *) + have 2: (* "\ x \ set OCC" *) "upd \ x \ set OCC" + when "\ \ comp0" "x \ fv_transaction T" "fst x = TAtom Value" for x \ + using T that step Ball_set[of P "transaction_check FP OCC TI"] + T_adm FP OCC TI transaction_prop2[of \ FP OCC TI T x] + unfolding upd_def comp0_def + by blast+ + + obtain \ where \: + "\ \ comp0" + "\x \ fv_transaction T. \\<^sub>v x = TAtom Value \ + (\ \\<^sub>s \) x \ \ \\<^sub>\ a0 = absc (\ x) \ + (\ \\<^sub>s \) x \ \ \\<^sub>\ a0' = absc (upd \ x)" + using 0 by moura + + have "\x. ab = (\ x, upd \ x) \ x \ fv_transaction T - set (transaction_fresh T) \ \ x \ upd \ x" + when ab: "ab \ \\<^sub>t\<^sub>i \ T \ \ \" for ab + proof - + obtain a b where ab': "ab = (a,b)" by (metis surj_pair) + then obtain x where x: + "a \ b" "x \ fv_transaction T" "x \ set (transaction_fresh T)" + "absc a = (\ \\<^sub>s \) x \ \ \\<^sub>\ a0" "absc b = (\ \\<^sub>s \) x \ \ \\<^sub>\ a0'" + using ab unfolding abs_term_implications_def a0_def a0'_def T'_def by blast + hence "absc a = absc (\ x)" "absc b = absc (upd \ x)" + using \(2) admissible_transaction_Value_vars[OF bspec[OF P T] x(2)] + by metis+ + thus ?thesis using x ab' by blast + qed + hence \\<^sub>t\<^sub>i_TI_subset: "\\<^sub>t\<^sub>i \ T \ \ \ \ {(a,b) \ (set TI)\<^sup>+. a \ b}" using 1[OF \(1)] by blast + + have "timpl_closure_set (timpl_closure_set (set FP) (set TI)) (\\<^sub>t\<^sub>i \ T \ \ \) \\<^sub>c t" + when t: "t \ timpl_closure_set (\\<^sub>i\<^sub>k \ \) (\\<^sub>t\<^sub>i \ T \ \ \)" for t + using timpl_closure_set_is_timpl_closure_union[of "\\<^sub>i\<^sub>k \ \" "\\<^sub>t\<^sub>i \ T \ \ \"] + intruder_synth_timpl_closure_set FP(3) t + by blast + thus ?A + using ideduct_synth_mono[OF _ timpl_closure_set_mono[OF + subset_refl[of "timpl_closure_set (set FP) (set TI)"] + \\<^sub>t\<^sub>i_TI_subset]] + timpl_closure_set_timpls_trancl_eq'[of "timpl_closure_set (set FP) (set TI)" "set TI"] + unfolding timpl_closure_set_idem + by force + + have "timpl_closure_set (\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \) (\\<^sub>t\<^sub>i \ T \ \ \) \ + timpl_closure_set (absc ` set OCC) {(a,b) \ (set TI)\<^sup>+. a \ b}" + using timpl_closure_set_mono[OF _ \\<^sub>t\<^sub>i_TI_subset] OCC(3) by blast + thus ?B using OCC(2) timpl_closure_set_timpls_trancl_subset' by blast + + have "transaction_check_post FP TI T \" + using T \(1) step + unfolding transaction_check_def comp0_def list_all_iff + by blast + hence 3: "timpl_closure_set (set FP) (set TI) \\<^sub>c t \ \ (upd \)" + when "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "is_Fun (t \ \ (upd \))" for t + using that + unfolding transaction_check_post_def upd_def \_def + intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI, symmetric] + by meson + + have 4: "\x \ fv t. (\ \\<^sub>s \ \\<^sub>s \) x \\<^sub>\ a0' = \ (upd \) x" + when "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" for t + using wellformed_transaction_send_receive_fv_subset(2)[OF T_valid that] + \(2) subst_compose[of "\ \\<^sub>s \" \] \_prop + admissible_transaction_Value_vars[OF bspec[OF P T]] + by fastforce + + have 5: "\n T. Fun (Val n) T \ subterms t" when "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" for t + using that transactions_have_no_Value_consts'[OF T_adm] trms_transaction_unfold[of T] + by blast + + show ?D using 2[OF \(1)] \(2) \\<^sub>v_TAtom''(2) unfolding a0'_def T'_def by blast + + show ?C using 3 abs_term_subst_eq'[OF 4 5] by simp +qed + +lemma reachable_constraints_covered_step: + fixes \::"('fun,'atom,'sets,'lbl) prot_constr" + assumes \_reach: "\ \ reachable_constraints P" + and T: "T \ set P" + and \: "welltyped_constraint_model \ (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \))" + and \: "transaction_fresh_subst \ T \" + and \: "transaction_renaming_subst \ P \" + and FP: + "analyzed (timpl_closure_set (set FP) (set TI))" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)" + "\t \ \\<^sub>i\<^sub>k \ \. timpl_closure_set (set FP) (set TI) \\<^sub>c t" + "ground (set FP)" + and OCC: + "\t \ timpl_closure_set (set FP) (set TI). \f \ funs_term t. is_Abs f \ f \ Abs ` set OCC" + "timpl_closure_set (absc ` set OCC) (set TI) \ absc ` set OCC" + "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \ \ absc ` set OCC" + and TI: + "set TI = {(a,b) \ (set TI)\<^sup>+. a \ b}" + and P: + "\T \ set P. admissible_transaction T" + and transactions_covered: "list_all (transaction_check FP OCC TI) P" + shows "\t \ \\<^sub>i\<^sub>k (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) \. + timpl_closure_set (set FP) (set TI) \\<^sub>c t" (is ?A) + and "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s (\@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)) \ \ absc ` set OCC" (is ?B) +proof - + note step_props = transaction_prop6[OF \_reach T \ \ \ FP(1,2,3) OCC TI P transactions_covered] + + define T' where "T' \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \)" + define a0 where "a0 \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" + define a0' where "a0' \ \\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@T') \)" + + define vals where "vals \ \S::('fun,'atom,'sets,'lbl) prot_constr. + {t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \\<^sub>s\<^sub>e\<^sub>t \. \n. t = Fun (Val n) []}" + + define vals_sym where "vals_sym \ \S::('fun,'atom,'sets,'lbl) prot_constr. + {t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S). (\n. t = Fun (Val n) []) \ (\m. t = Var (TAtom Value,m))}" + + have \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" by (metis \ welltyped_constraint_model_def) + + have \_grounds: "fv (t \ \) = {}" for t + using \ interpretation_grounds[of \] + unfolding welltyped_constraint_model_def constraint_model_def by auto + + have T_fresh_vars_value_typed: "\x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + using protocol_transaction_vars_TAtom_typed[OF bspec[OF P(1) T]] by simp_all + + have wt_\\\: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \ \\<^sub>s \)" and wt_\\: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" + using \_wt wt_subst_compose transaction_fresh_subst_wt[OF \ T_fresh_vars_value_typed] + transaction_renaming_subst_wt[OF \] + by blast+ + + have "\T\set P. bvars_transaction T = {}" + using P unfolding list_all_iff admissible_transaction_def by metis + hence \_no_bvars: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = {}" + using reachable_constraints_no_bvars[OF \_reach] by metis + + have \_vals: "\n. \ (TAtom Value, m) = Fun (Val n) []" + when "(TAtom Value, m) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" for m + using constraint_model_Value_term_is_Val'[ + OF \_reach welltyped_constraint_model_prefix[OF \] P(1)] + \_no_bvars vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel \"] that + by blast + + have vals_sym_vals: "t \ \ \ vals \" when t: "t \ vals_sym \" for t + proof (cases t) + case (Var x) + then obtain m where *: "x = (TAtom Value,m)" using t unfolding vals_sym_def by blast + moreover have "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" using t unfolding vals_sym_def by blast + hence "t \ \ \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>e\<^sub>t \" "\n. \ (Var Value, m) = Fun (Val n) []" + using Var * \_vals[of m] var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t[of x "unlabel \"] + \\<^sub>v_TAtom[of Value m] reachable_constraints_Value_vars_are_fv[OF \_reach P(1), of x] + by blast+ + ultimately show ?thesis using Var unfolding vals_def by auto + next + case (Fun f T) + then obtain n where "f = Val n" "T = []" using t unfolding vals_sym_def by blast + moreover have "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" using t unfolding vals_sym_def by blast + hence "t \ \ \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>e\<^sub>t \" using Fun by blast + ultimately show ?thesis using Fun unfolding vals_def by auto + qed + + have vals_vals_sym: "\s. s \ vals_sym \ \ t = s \ \" when "t \ vals \" for t + using that constraint_model_Val_is_Value_term[OF \] + unfolding vals_def vals_sym_def by fast + + have T_adm: "admissible_transaction T" and T_valid: "wellformed_transaction T" + apply (metis P(1) T) + using P(1) T Ball_set[of P "admissible_transaction"] + unfolding admissible_transaction_def by fastforce + + have 0: + "\\<^sub>i\<^sub>k (\@T') \ = (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0' \ (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0'" + "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s (\@T') \ = vals \ \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0' \ vals T' \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0'" + by (metis abs_intruder_knowledge_append a0'_def, + metis abs_value_constants_append[of \ T' \] a0'_def vals_def) + + have 1: "(ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t T' \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0' = + (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t (\ \\<^sub>s \) \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0'" + by (metis T'_def dual_transaction_ik_is_transaction_send''[OF T_valid]) + + have 2: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \ subst_domain \ = {}" + "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \ subst_domain \ = {}" + using T_adm unfolding admissible_transaction_def + by blast+ + + have "vals T' \ (\ \\<^sub>s \) ` fv_transaction T \\<^sub>s\<^sub>e\<^sub>t \" + proof + fix t assume "t \ vals T'" + then obtain s n where s: + "s \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t T')" "t = s \ \" "t = Fun (Val n) []" + unfolding vals_def by fast + then obtain u where u: + "u \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))" + "s = u \ (\ \\<^sub>s \)" + using transaction_fresh_subst_transaction_renaming_subst_trms[OF \ \ 2] + trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq[of "transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \"] + unfolding T'_def by blast + + have *: "t = u \ (\ \\<^sub>s \ \\<^sub>s \)" by (metis subst_subst_compose s(2) u(2)) + then obtain x where x: "u = Var x" + using s(3) transactions_have_no_Value_consts(1)[OF T_adm u(1)] by (cases u) force+ + hence **: "x \ vars_transaction T" + by (metis u(1) var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t) + + have "\\<^sub>v x = TAtom Value" + using * x s(3) wt_subst_trm''[OF wt_\\\, of u] + by simp + thus "t \ (\ \\<^sub>s \) ` fv_transaction T \\<^sub>s\<^sub>e\<^sub>t \" + using transaction_Value_vars_are_fv[OF T_adm **] x * + by (metis subst_comp_set_image rev_image_eqI subst_apply_term.simps(1)) + qed + hence 3: "vals T' \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0' \ ((\ \\<^sub>s \) ` fv_transaction T \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0'" + by (simp add: abs_apply_terms_def image_mono) + + have "t \ \ \\<^sub>\ a0' \ timpl_closure_set (\\<^sub>i\<^sub>k \ \) (\\<^sub>t\<^sub>i \ T \ \ \)" + when "t \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" for t + using that abs_in[OF imageI[OF that]] + \\<^sub>t\<^sub>i_covers_\\<^sub>0_ik[OF \_reach T \ \ \ P(1)] + timpl_closure_set_mono[of "{t \ \ \\<^sub>\ a0}" "\\<^sub>i\<^sub>k \ \" "\\<^sub>t\<^sub>i \ T \ \ \" "\\<^sub>t\<^sub>i \ T \ \ \"] + unfolding a0_def a0'_def T'_def abs_intruder_knowledge_def by fast + hence A: "\\<^sub>i\<^sub>k (\@T') \ \ + timpl_closure_set (\\<^sub>i\<^sub>k \ \) (\\<^sub>t\<^sub>i \ T \ \ \) \ + (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t (\ \\<^sub>s \) \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0'" + using 0(1) 1 by (auto simp add: abs_apply_terms_def) + + have "t \ \ \\<^sub>\ a0' \ timpl_closure_set {t \ \ \\<^sub>\ a0} (\\<^sub>t\<^sub>i \ T \ \ \)" + when t: "t \ vals_sym \" for t + proof - + have "(\n. t = Fun (Val n) [] \ t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ + (\n. t = Var (TAtom Value,n) \ (TAtom Value,n) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + (is "?P \ ?Q") + using t var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t[of _ "unlabel \"] + \\<^sub>v_TAtom[of Value] reachable_constraints_Value_vars_are_fv[OF \_reach P(1)] + unfolding vals_sym_def by fast + thus ?thesis + proof + assume ?P + then obtain n where n: "t = Fun (Val n) []" "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" by moura + thus ?thesis + using \\<^sub>t\<^sub>i_covers_\\<^sub>0_Val[OF \_reach T \ \ \ P(1), of n] + unfolding a0_def a0'_def T'_def by fastforce + next + assume ?Q + thus ?thesis + using \\<^sub>t\<^sub>i_covers_\\<^sub>0_Var[OF \_reach T \ \ \ P(1)] + unfolding a0_def a0'_def T'_def by fastforce + qed + qed + moreover have "t \ \ \\<^sub>\ a0 \ \\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \" + when "t \ vals_sym \" for t + using that abs_in vals_sym_vals + unfolding a0_def abs_value_constants_def vals_sym_def vals_def + by (metis (mono_tags, lifting)) + ultimately have "t \ \ \\<^sub>\ a0' \ timpl_closure_set (\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \) (\\<^sub>t\<^sub>i \ T \ \ \)" + when t: "t \ vals_sym \" for t + using t timpl_closure_set_mono[of "{t \ \ \\<^sub>\ a0}" "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \" "\\<^sub>t\<^sub>i \ T \ \ \" "\\<^sub>t\<^sub>i \ T \ \ \"] + by blast + hence "t \\<^sub>\ a0' \ timpl_closure_set (\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \) (\\<^sub>t\<^sub>i \ T \ \ \)" + when t: "t \ vals \" for t + using vals_vals_sym[OF t] by blast + hence B: "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s (\@T') \ \ + timpl_closure_set (\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \) (\\<^sub>t\<^sub>i \ T \ \ \) \ + ((\ \\<^sub>s \) ` fv_transaction T \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a0'" + using 0(2) 3 + by (simp add: abs_apply_terms_def image_subset_iff) + + have 4: "fv (t \ \ \\<^sub>s \ \ \ \\<^sub>\ a) = {}" for t a + using \_grounds[of "t \ \ \\<^sub>s \"] abs_fv[of "t \ \ \\<^sub>s \ \ \" a] + by argo + + have "is_Fun (t \ \ \\<^sub>s \ \ \ \\<^sub>\ a0')" for t + using 4[of t a0'] by force + thus ?A + using A step_props(1,3) + unfolding T'_def a0_def a0'_def abs_apply_terms_def + by blast + + show ?B + using B step_props(2,4) admissible_transaction_Value_vars[OF bspec[OF P T]] + by (auto simp add: T'_def a0_def a0'_def abs_apply_terms_def) +qed + +lemma reachable_constraints_covered: + assumes \_reach: "\ \ reachable_constraints P" + and \: "welltyped_constraint_model \ \" + and FP: + "analyzed (timpl_closure_set (set FP) (set TI))" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)" + "ground (set FP)" + and OCC: + "\t \ timpl_closure_set (set FP) (set TI). \f \ funs_term t. is_Abs f \ f \ Abs ` set OCC" + "timpl_closure_set (absc ` set OCC) (set TI) \ absc ` set OCC" + and TI: + "set TI = {(a,b) \ (set TI)\<^sup>+. a \ b}" + and P: + "\T \ set P. admissible_transaction T" + and transactions_covered: "list_all (transaction_check FP OCC TI) P" + shows "\t \ \\<^sub>i\<^sub>k \ \. timpl_closure_set (set FP) (set TI) \\<^sub>c t" + and "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \ \ absc ` set OCC" +using \_reach \ +proof (induction rule: reachable_constraints.induct) + case init + { case 1 show ?case by (simp add: abs_intruder_knowledge_def) } + { case 2 show ?case by (simp add: abs_value_constants_def) } +next + case (step \ T \ \) + { case 1 + hence "welltyped_constraint_model \ \" + by (metis welltyped_constraint_model_prefix) + hence IH: "\t \ \\<^sub>i\<^sub>k \ \. timpl_closure_set (set FP) (set TI) \\<^sub>c t" + "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \ \ absc ` set OCC" + using step.IH by metis+ + show ?case + using reachable_constraints_covered_step[ + OF step.hyps(1,2) "1.prems" step.hyps(3,4) FP(1,2) IH(1) + FP(3) OCC IH(2) TI P transactions_covered] + by metis + } + { case 2 + hence "welltyped_constraint_model \ \" + by (metis welltyped_constraint_model_prefix) + hence IH: "\t \ \\<^sub>i\<^sub>k \ \. timpl_closure_set (set FP) (set TI) \\<^sub>c t" + "\\<^sub>v\<^sub>a\<^sub>l\<^sub>s \ \ \ absc ` set OCC" + using step.IH by metis+ + show ?case + using reachable_constraints_covered_step[ + OF step.hyps(1,2) "2.prems" step.hyps(3,4) FP(1,2) IH(1) + FP(3) OCC IH(2) TI P transactions_covered] + by metis + } +qed + +lemma attack_in_fixpoint_if_attack_in_ik: + fixes FP::"('fun,'atom,'sets) prot_terms" + assumes "\t \ IK \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a. FP \\<^sub>c t" + and "attack\n\ \ IK" + shows "attack\n\ \ FP" +proof - + have "attack\n\ \\<^sub>\ a \ IK \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a" by (rule abs_in[OF assms(2)]) + hence "FP \\<^sub>c attack\n\ \\<^sub>\ a" using assms(1) by blast + moreover have "attack\n\ \\<^sub>\ a = attack\n\" by simp + ultimately have "FP \\<^sub>c attack\n\" by metis + thus ?thesis using ideduct_synth_priv_const_in_ik[of FP "Attack n"] by simp +qed + +lemma attack_in_fixpoint_if_attack_in_timpl_closure_set: + fixes FP::"('fun,'atom,'sets) prot_terms" + assumes "attack\n\ \ timpl_closure_set FP TI" + shows "attack\n\ \ FP" +proof - + have "\f \ funs_term (attack\n\). \is_Abs f" by auto + thus ?thesis using timpl_closure_set_no_Abs_in_set[OF assms] by blast +qed + +theorem prot_secure_if_fixpoint_covered_typed: + assumes FP: + "analyzed (timpl_closure_set (set FP) (set TI))" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)" + "ground (set FP)" + and OCC: + "\t \ timpl_closure_set (set FP) (set TI). \f \ funs_term t. is_Abs f \ f \ Abs ` set OCC" + "timpl_closure_set (absc ` set OCC) (set TI) \ absc ` set OCC" + and TI: + "set TI = {(a,b) \ (set TI)\<^sup>+. a \ b}" + and P: + "\T \ set P. admissible_transaction T" + and transactions_covered: "list_all (transaction_check FP OCC TI) P" + and attack_notin_FP: "attack\n\ \ set FP" + and \: "\ \ reachable_constraints P" + shows "\\. welltyped_constraint_model \ (\@[(l, send\attack\n\\)])" (is "\\. ?P \") +proof + assume "\\. ?P \" + then obtain \ where \: "welltyped_constraint_model \ (\@[(l, send\attack\n\\)])" + by moura + hence \': "constr_sem_stateful \ (unlabel (\@[(l, send\attack\n\\)]))" + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + unfolding welltyped_constraint_model_def constraint_model_def by metis+ + + have 0: "attack\n\ \ ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \" + using welltyped_constraint_model_prefix[OF \] + reachable_constraints_covered(1)[OF \ _ FP OCC TI P transactions_covered] + attack_in_fixpoint_if_attack_in_ik[ + of "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \" "\\<^sub>0 (db\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \)" "timpl_closure_set (set FP) (set TI)" n] + attack_in_fixpoint_if_attack_in_timpl_closure_set + attack_notin_FP + unfolding abs_intruder_knowledge_def by blast + + have 1: "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \ \ attack\n\" + using \ strand_sem_append_stateful[of "{}" "{}" "unlabel \" _ \] + unfolding welltyped_constraint_model_def constraint_model_def by force + + have 2: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \)" + using reachable_constraints_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s[OF _ \] admissible_transactions_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s P(1) + ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset[of "unlabel \"] wf_trms_subst[OF \'(3)] + by fast + + have 3: "\x \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \). \TAtom AttackType \ \\<^sub>v x" + using reachable_constraints_vars_TAtom_typed[OF \ P(1)] + fv_ik_subset_vars_sst'[of "unlabel \"] + by fastforce + + have 4: "attack\n\ \ set (snd (Ana t)) \\<^sub>s\<^sub>e\<^sub>t \" when t: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" for t + proof + assume "attack\n\ \ set (snd (Ana t)) \\<^sub>s\<^sub>e\<^sub>t \" + then obtain s where s: "s \ set (snd (Ana t))" "s \ \ = attack\n\" by moura + + obtain x where x: "s = Var x" + by (cases s) (use s reachable_constraints_no_Ana_Attack[OF \ P(1) t] in auto) + + have "x \ fv t" using x Ana_subterm'[OF s(1)] vars_iff_subtermeq by force + hence "x \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" using t fv_subterms by fastforce + hence "\\<^sub>v x \ TAtom AttackType" using 3 by fastforce + thus False using s(2) x wt_subst_trm''[OF \'(4), of "Var x"] by fastforce + qed + + have 5: "attack\n\ \ set (snd (Ana t))" when t: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \)" for t + proof + assume "attack\n\ \ set (snd (Ana t))" + then obtain s where s: + "s \ subterms\<^sub>s\<^sub>e\<^sub>t (\ ` fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" "attack\n\ \ set (snd (Ana s))" + using Ana_subst_subterms_cases[OF t] 4 by fast + then obtain x where x: "x \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" "s \ \ x" by moura + hence "\ x \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s\<^sub>e\<^sub>t \)" + using var_is_subterm[of x] subterms_subst_subset'[of \ "ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t \"] + by force + hence *: "wf\<^sub>t\<^sub>r\<^sub>m (\ x)" "wf\<^sub>t\<^sub>r\<^sub>m s" + using wf_trms_subterms[OF 2] wf_trm_subtermeq[OF _ x(2)] + by auto + + show False + using term.order_trans[ + OF subtermeq_imp_subtermtypeeq[OF *(2) Ana_subterm'[OF s(2)]] + subtermeq_imp_subtermtypeeq[OF *(1) x(2)]] + 3 x(1) wt_subst_trm''[OF \'(4), of "Var x"] + by force + qed + + show False + using 0 private_const_deduct[OF _ 1] 5 + by simp +qed + +end + + +subsection \Theorem: A Protocol is Secure if it is Covered by a Fixed-Point\ +context stateful_protocol_model +begin + +theorem prot_secure_if_fixpoint_covered: + fixes P + assumes FP: + "analyzed (timpl_closure_set (set FP) (set TI))" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)" + "ground (set FP)" + and OCC: + "\t \ timpl_closure_set (set FP) (set TI). \f \ funs_term t. is_Abs f \ f \ Abs ` set OCC" + "timpl_closure_set (absc ` set OCC) (set TI) \ absc ` set OCC" + and TI: + "set TI = {(a,b) \ (set TI)\<^sup>+. a \ b}" + and M: + "has_all_wt_instances_of \ (\T \ set P. trms_transaction T) N" + "finite N" + "tfr\<^sub>s\<^sub>e\<^sub>t N" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N" + and P: + "\T \ set P. admissible_transaction T" + "\T \ set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))" + and transactions_covered: "list_all (transaction_check FP OCC TI) P" + and attack_notin_FP: "attack\n\ \ set FP" + and A: "\ \ reachable_constraints P" + shows "\\. constraint_model \ (\@[(l, send\attack\n\\)])" + (is "\\. ?P \ \") +proof + assume "\\. ?P \ \" + then obtain \ where I: + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + "constr_sem_stateful \ (unlabel (\@[(l, send\attack\n\\)]))" + unfolding constraint_model_def by moura + + let ?n = "[(l, send\attack\n\\)]" + let ?A = "\@?n" + + have "\T \ set P. wellformed_transaction T" + "\T \ set P. admissible_transaction_terms T" + using P(1) unfolding admissible_transaction_def by blast+ + moreover have "\T \ set P. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)" + using P(1) unfolding admissible_transaction_def admissible_transaction_terms_def by blast + ultimately have 0: "wf\<^sub>s\<^sub>s\<^sub>t (unlabel \)" "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel \)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using reachable_constraints_tfr[OF _ M P A] reachable_constraints_wf[OF _ _ A] by metis+ + + have 1: "wf\<^sub>s\<^sub>s\<^sub>t (unlabel ?A)" "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel ?A)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?A)" + proof - + show "wf\<^sub>s\<^sub>s\<^sub>t (unlabel ?A)" + using 0(1) wf\<^sub>s\<^sub>s\<^sub>t_append_suffix'[of "{}" "unlabel \" "unlabel ?n"] unlabel_append[of \ ?n] + by simp + + show "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?A)" + using 0(3) trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel ?n"] unlabel_append[of \ ?n] + by fastforce + + have "\t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?n \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ?n). \c. t = Fun c []" + "\t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?n \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ?n). Ana t = ([],[])" + by (simp_all add: setops\<^sub>s\<^sub>s\<^sub>t_def) + hence "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel \) \ + (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ?n \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ?n)))" + using 0(2) tfr_consts_mono unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by blast + hence "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\@?n) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel (\@?n)))" + using unlabel_append[of \ ?n] trms\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel ?n"] + setops\<^sub>s\<^sub>s\<^sub>t_append[of "unlabel \" "unlabel ?n"] + by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + thus "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel ?A)" + using 0(2) unlabel_append[of ?A ?n] + unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by auto + qed + + obtain \\<^sub>\ where I': + "welltyped_constraint_model \\<^sub>\ ?A" + using stateful_typing_result[OF 1 I(1,3)] + by (metis welltyped_constraint_model_def constraint_model_def) + + note a = FP OCC TI P(1) transactions_covered attack_notin_FP A + + show False + using prot_secure_if_fixpoint_covered_typed[OF a] I' + by force +qed + +end + + +subsection \Automatic Fixed-Point Computation\ +context stateful_protocol_model +begin + +definition compute_fixpoint_fun' where + "compute_fixpoint_fun' P (n::nat option) enable_traces S0 \ + let sy = intruder_synth_mod_timpls; + + FP' = \S. fst (fst S); + TI' = \S. snd (fst S); + OCC' = \S. remdups ( + (map (\t. the_Abs (the_Fun (args t ! 1))) + (filter (\t. is_Fun t \ the_Fun t = OccursFact) (FP' S)))@ + (map snd (TI' S))); + + equal_states = \S S'. set (FP' S) = set (FP' S') \ set (TI' S) = set (TI' S'); + + trace' = \S. snd S; + + close = \M f. let g = remdups \ f in while (\A. set (g A) \ set A) g M; + close' = \M f. let g = remdups \ f in while (\A. set (g A) \ set A) g M; + trancl_minus_refl = \TI. + let aux = \ts p. map (\q. (fst p,snd q)) (filter ((=) (snd p) \ fst) ts) + in filter (\p. fst p \ snd p) (close' TI (\ts. concat (map (aux ts) ts)@ts)); + snd_Ana = \N M TI. let N' = filter (\t. \k \ set (fst (Ana t)). sy M TI k) N in + filter (\t. \sy M TI t) + (concat (map (\t. filter (\s. s \ set (snd (Ana t))) (args t)) N')); + Ana_cl = \FP TI. + close FP (\M. (M@snd_Ana M M TI)); + TI_cl = \FP TI. + close FP (\M. (M@filter (\t. \sy M TI t) + (concat (map (\m. concat (map (\(a,b). \a --\ b\\m\) TI)) M)))); + Ana_cl' = \FP TI. + let N = \M. comp_timpl_closure_list (filter (\t. \k\set (fst (Ana t)). \sy M TI k) M) TI + in close FP (\M. M@snd_Ana (N M) M TI); + + \ = \S. transaction_check_comp (FP' S) (OCC' S) (TI' S); + result = \S T \. + let not_fresh = \x. x \ set (transaction_fresh T); + xs = filter not_fresh (fv_list\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))); + u = \\ x. absdbupd (unlabel (transaction_strand T)) x (\ x) + in (remdups (filter (\t. \sy (FP' S) (TI' S) t) + (map (\t. the_msg t \ (absc \ u \)) + (filter is_Send (unlabel (transaction_send T))))), + remdups (filter (\s. fst s \ snd s) (map (\x. (\ x, u \ x)) xs))); + update_state = \S. if list_ex (\t. is_Fun t \ is_Attack (the_Fun t)) (FP' S) then S + else let results = map (\T. map (\\. result S T (abs_substs_fun \)) (\ S T)) P; + newtrace_flt = (\n. let x = results ! n; y = map fst x; z = map snd x + in set (concat y) - set (FP' S) \ {} \ set (concat z) - set (TI' S) \ {}); + trace = + if enable_traces + then trace' S@[filter newtrace_flt [0..x. fst x \ snd x) (concat (map snd U)@TI' S))), + trace); + W = ((Ana_cl (TI_cl (FP' V) (TI' V)) (TI' V), + trancl_minus_refl (TI' V)), + trace' V) + in if \equal_states W S then W + else ((Ana_cl' (FP' W) (TI' W), TI' W), trace' W); + + S = ((\h. case n of None \ while (\S. \equal_states S (h S)) h | Some m \ h ^^ m) + update_state S0) + in ((FP' S, OCC' S, TI' S), trace' S)" + +definition compute_fixpoint_fun where + "compute_fixpoint_fun P \ fst (compute_fixpoint_fun' P None False (([],[]),[]))" + +end + + +subsection \Locales for Protocols Proven Secure through Fixed-Point Coverage\ +type_synonym ('f,'a,'s) fixpoint_triple = + "('f,'a,'s) prot_term list \ 's set list \ ('s set \ 's set) list" + +context stateful_protocol_model +begin + +definition "attack_notin_fixpoint (FPT::('fun,'atom,'sets) fixpoint_triple) \ + list_all (\t. \f \ funs_term t. \is_Attack f) (fst FPT)" + +definition "protocol_covered_by_fixpoint (FPT::('fun,'atom,'sets) fixpoint_triple) P \ + let (FP, OCC, TI) = FPT + in list_all (transaction_check FP OCC TI) P" + +definition "analyzed_fixpoint (FPT::('fun,'atom,'sets) fixpoint_triple) \ + let (FP, _, TI) = FPT + in analyzed_closed_mod_timpls FP TI" + +definition "wellformed_protocol' (P::('fun,'atom,'sets,'lbl) prot) N \ + list_all admissible_transaction P \ + has_all_wt_instances_of \ (\T \ set P. trms_transaction T) (set N) \ + comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \ N \ + list_all (\T. list_all (comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ Pair) (unlabel (transaction_strand T))) P" + +definition "wellformed_protocol (P::('fun,'atom,'sets,'lbl) prot) \ + let f = \M. remdups (concat (map subterms_list M@map (fst \ Ana) M)); + N0 = remdups (concat (map (trms_list\<^sub>s\<^sub>s\<^sub>t \ unlabel \ transaction_strand) P)); + N = while (\A. set (f A) \ set A) f N0 + in wellformed_protocol' P N" + +definition "wellformed_fixpoint (FPT::('fun,'atom,'sets) fixpoint_triple) \ + let (FP, OCC, TI) = FPT; OCC' = set OCC + in list_all (\t. wf\<^sub>t\<^sub>r\<^sub>m' arity t \ fv t = {}) FP \ + list_all (\a. a \ OCC') (map snd TI) \ + list_all (\(a,b). list_all (\(c,d). b = c \ a \ d \ List.member TI (a,d)) TI) TI \ + list_all (\p. fst p \ snd p) TI \ + list_all (\t. \f \ funs_term t. is_Abs f \ the_Abs f \ OCC') FP" + +lemma protocol_covered_by_fixpoint_I1[intro]: + assumes "list_all (protocol_covered_by_fixpoint FPT) P" + shows "protocol_covered_by_fixpoint FPT (concat P)" +using assms by (auto simp add: protocol_covered_by_fixpoint_def list_all_iff) + +lemma protocol_covered_by_fixpoint_I2[intro]: + assumes "protocol_covered_by_fixpoint FPT P1" + and "protocol_covered_by_fixpoint FPT P2" + shows "protocol_covered_by_fixpoint FPT (P1@P2)" +using assms by (auto simp add: protocol_covered_by_fixpoint_def) + +lemma protocol_covered_by_fixpoint_I3[intro]: + assumes "\T \ set P. \\::('fun,'atom,'sets) prot_var \ 'sets set. + transaction_check_pre FP TI T \ \ transaction_check_post FP TI T \" + shows "protocol_covered_by_fixpoint (FP,OCC,TI) P" +using assms +unfolding protocol_covered_by_fixpoint_def transaction_check_def transaction_check_comp_def + list_all_iff Let_def case_prod_unfold Product_Type.fst_conv Product_Type.snd_conv +by fastforce + +lemmas protocol_covered_by_fixpoint_intros = + protocol_covered_by_fixpoint_I1 + protocol_covered_by_fixpoint_I2 + protocol_covered_by_fixpoint_I3 + +lemma prot_secure_if_prot_checks: + fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list" + and FP_OCC_TI:: "('fun, 'atom, 'sets) fixpoint_triple" + assumes attack_notin_fixpoint: "attack_notin_fixpoint FP_OCC_TI" + and transactions_covered: "protocol_covered_by_fixpoint FP_OCC_TI P" + and analyzed_fixpoint: "analyzed_fixpoint FP_OCC_TI" + and wellformed_protocol: "wellformed_protocol' P N" + and wellformed_fixpoint: "wellformed_fixpoint FP_OCC_TI" + shows "\\ \ reachable_constraints P. \\. constraint_model \ (\@[(l, send\attack\n\\)])" +proof - + define FP where "FP \ let (FP,_,_) = FP_OCC_TI in FP" + define OCC where "OCC \ let (_,OCC,_) = FP_OCC_TI in OCC" + define TI where "TI \ let (_,_,TI) = FP_OCC_TI in TI" + + have attack_notin_FP: "attack\n\ \ set FP" + using attack_notin_fixpoint[unfolded attack_notin_fixpoint_def] + unfolding list_all_iff FP_def by force + + have 1: "\(a,b) \ set TI. \(c,d) \ set TI. b = c \ a \ d \ (a,d) \ set TI" + using wellformed_fixpoint + unfolding wellformed_fixpoint_def wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric] Let_def TI_def + list_all_iff member_def case_prod_unfold + by auto + + have 0: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set FP)" + and 2: "\(a,b) \ set TI. a \ b" + and 3: "snd ` set TI \ set OCC" + and 4: "\t \ set FP. \f \ funs_term t. is_Abs f \ f \ Abs ` set OCC" + and 5: "ground (set FP)" + using wellformed_fixpoint + unfolding wellformed_fixpoint_def wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric] is_Abs_def the_Abs_def + list_all_iff Let_def case_prod_unfold set_map FP_def OCC_def TI_def + by (fast, fast, blast, fastforce, simp) + + have 8: "finite (set N)" + and 9: "has_all_wt_instances_of \ (\T \ set P. trms_transaction T) (set N)" + and 10: "tfr\<^sub>s\<^sub>e\<^sub>t (set N)" + and 11: "\T \ set P. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))" + and 12: "\T \ set P. admissible_transaction T" + using wellformed_protocol tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[of N] + unfolding Let_def list_all_iff wellformed_protocol_def wellformed_protocol'_def + wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric] tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p[symmetric] + by fast+ + + have 13: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set N)" + using wellformed_protocol + unfolding wellformed_protocol_def wellformed_protocol'_def + wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric] comp_tfr\<^sub>s\<^sub>e\<^sub>t_def list_all_iff + finite_SMP_representation_def + by blast + + note TI0 = trancl_eqI'[OF 1 2] + + have "analyzed (timpl_closure_set (set FP) (set TI))" + using analyzed_fixpoint[unfolded analyzed_fixpoint_def] + analyzed_closed_mod_timpls_is_analyzed_timpl_closure_set[OF TI0 0] + unfolding FP_def TI_def + by force + note FP0 = this 0 5 + + note OCC0 = funs_term_OCC_TI_subset(1)[OF 4 3] + timpl_closure_set_supset'[OF funs_term_OCC_TI_subset(2)[OF 4 3]] + + note M0 = 9 8 10 13 + + have "list_all (transaction_check FP OCC TI) P" + using transactions_covered[unfolded protocol_covered_by_fixpoint_def] + unfolding FP_def OCC_def TI_def + by force + note P0 = 12 11 this attack_notin_FP + + show ?thesis by (metis prot_secure_if_fixpoint_covered[OF FP0 OCC0 TI0 M0 P0]) +qed + +end + +locale secure_stateful_protocol = + pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \\<^sub>f label_witness1 label_witness2 + for arity\<^sub>f::"'fun \ nat" + and arity\<^sub>s::"'sets \ nat" + and public\<^sub>f::"'fun \ bool" + and Ana\<^sub>f::"'fun \ ((('fun,'atom::finite,'sets) prot_fun, nat) term list \ nat list)" + and \\<^sub>f::"'fun \ 'atom option" + and label_witness1::"'lbl" + and label_witness2::"'lbl" + + + fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list" + and FP_OCC_TI:: "('fun, 'atom, 'sets) fixpoint_triple" + and P_SMP::"('fun, 'atom, 'sets) prot_term list" + assumes attack_notin_fixpoint: "pm.attack_notin_fixpoint FP_OCC_TI" + and transactions_covered: "pm.protocol_covered_by_fixpoint FP_OCC_TI P" + and analyzed_fixpoint: "pm.analyzed_fixpoint FP_OCC_TI" + and wellformed_protocol: "pm.wellformed_protocol' P P_SMP" + and wellformed_fixpoint: "pm.wellformed_fixpoint FP_OCC_TI" +begin + +theorem protocol_secure: + "\\ \ pm.reachable_constraints P. \\. pm.constraint_model \ (\@[(l, send\attack\n\\)])" +by (rule pm.prot_secure_if_prot_checks[OF + attack_notin_fixpoint transactions_covered + analyzed_fixpoint wellformed_protocol wellformed_fixpoint]) + +end + +locale secure_stateful_protocol' = + pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \\<^sub>f label_witness1 label_witness2 + for arity\<^sub>f::"'fun \ nat" + and arity\<^sub>s::"'sets \ nat" + and public\<^sub>f::"'fun \ bool" + and Ana\<^sub>f::"'fun \ ((('fun,'atom::finite,'sets) prot_fun, nat) term list \ nat list)" + and \\<^sub>f::"'fun \ 'atom option" + and label_witness1::"'lbl" + and label_witness2::"'lbl" + + + fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list" + and FP_OCC_TI:: "('fun, 'atom, 'sets) fixpoint_triple" + assumes attack_notin_fixpoint': "pm.attack_notin_fixpoint FP_OCC_TI" + and transactions_covered': "pm.protocol_covered_by_fixpoint FP_OCC_TI P" + and analyzed_fixpoint': "pm.analyzed_fixpoint FP_OCC_TI" + and wellformed_protocol': "pm.wellformed_protocol P" + and wellformed_fixpoint': "pm.wellformed_fixpoint FP_OCC_TI" +begin + +sublocale secure_stateful_protocol + arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \\<^sub>f label_witness1 label_witness2 P + FP_OCC_TI + "let f = \M. remdups (concat (map subterms_list M@map (fst \ pm.Ana) M)); + N0 = remdups (concat (map (trms_list\<^sub>s\<^sub>s\<^sub>t \ unlabel \ transaction_strand) P)) + in while (\A. set (f A) \ set A) f N0" +apply unfold_locales +using attack_notin_fixpoint' transactions_covered' analyzed_fixpoint' + wellformed_protocol'[unfolded pm.wellformed_protocol_def Let_def] wellformed_fixpoint' +unfolding Let_def by blast+ + +end + +locale secure_stateful_protocol'' = + pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \\<^sub>f label_witness1 label_witness2 + for arity\<^sub>f::"'fun \ nat" + and arity\<^sub>s::"'sets \ nat" + and public\<^sub>f::"'fun \ bool" + and Ana\<^sub>f::"'fun \ ((('fun,'atom::finite,'sets) prot_fun, nat) term list \ nat list)" + and \\<^sub>f::"'fun \ 'atom option" + and label_witness1::"'lbl" + and label_witness2::"'lbl" + + + fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list" + assumes checks: "let FPT = pm.compute_fixpoint_fun P + in pm.attack_notin_fixpoint FPT \ pm.protocol_covered_by_fixpoint FPT P \ + pm.analyzed_fixpoint FPT \ pm.wellformed_protocol P \ pm.wellformed_fixpoint FPT" +begin + +sublocale secure_stateful_protocol' + arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \\<^sub>f label_witness1 label_witness2 P "pm.compute_fixpoint_fun P" +using checks[unfolded Let_def case_prod_unfold] by unfold_locales meson+ + +end + +locale secure_stateful_protocol''' = + pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \\<^sub>f label_witness1 label_witness2 + for arity\<^sub>f::"'fun \ nat" + and arity\<^sub>s::"'sets \ nat" + and public\<^sub>f::"'fun \ bool" + and Ana\<^sub>f::"'fun \ ((('fun,'atom::finite,'sets) prot_fun, nat) term list \ nat list)" + and \\<^sub>f::"'fun \ 'atom option" + and label_witness1::"'lbl" + and label_witness2::"'lbl" + + + fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list" + and FP_OCC_TI:: "('fun, 'atom, 'sets) fixpoint_triple" + and P_SMP::"('fun, 'atom, 'sets) prot_term list" + assumes checks': "let P' = P; FPT = FP_OCC_TI; P'_SMP = P_SMP + in pm.attack_notin_fixpoint FPT \ + pm.protocol_covered_by_fixpoint FPT P' \ + pm.analyzed_fixpoint FPT \ + pm.wellformed_protocol' P' P'_SMP \ + pm.wellformed_fixpoint FPT" +begin + +sublocale secure_stateful_protocol + arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \\<^sub>f label_witness1 label_witness2 P FP_OCC_TI P_SMP +using checks'[unfolded Let_def case_prod_unfold] by unfold_locales meson+ + +end + +locale secure_stateful_protocol'''' = + pm: stateful_protocol_model arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \\<^sub>f label_witness1 label_witness2 + for arity\<^sub>f::"'fun \ nat" + and arity\<^sub>s::"'sets \ nat" + and public\<^sub>f::"'fun \ bool" + and Ana\<^sub>f::"'fun \ ((('fun,'atom::finite,'sets) prot_fun, nat) term list \ nat list)" + and \\<^sub>f::"'fun \ 'atom option" + and label_witness1::"'lbl" + and label_witness2::"'lbl" + + + fixes P::"('fun, 'atom, 'sets, 'lbl) prot_transaction list" + and FP_OCC_TI:: "('fun, 'atom, 'sets) fixpoint_triple" + assumes checks'': "let P' = P; FPT = FP_OCC_TI + in pm.attack_notin_fixpoint FPT \ + pm.protocol_covered_by_fixpoint FPT P' \ + pm.analyzed_fixpoint FPT \ + pm.wellformed_protocol P' \ + pm.wellformed_fixpoint FPT" +begin + +sublocale secure_stateful_protocol' + arity\<^sub>f arity\<^sub>s public\<^sub>f Ana\<^sub>f \\<^sub>f label_witness1 label_witness2 P FP_OCC_TI +using checks''[unfolded Let_def case_prod_unfold] by unfold_locales meson+ + +end + + +subsection \Automatic Protocol Composition\ +context stateful_protocol_model +begin + +definition wellformed_composable_protocols where + "wellformed_composable_protocols (P::('fun,'atom,'sets,'lbl) prot list) N \ + let + Ts = concat P; + steps = concat (map transaction_strand Ts); + MP0 = \T \ set Ts. trms_transaction T \ pair' Pair ` setops_transaction T + in + list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) N \ + has_all_wt_instances_of \ MP0 (set N) \ + comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \ N \ + list_all (comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ Pair \ snd) steps \ + list_all (\T. wellformed_transaction T) Ts \ + list_all (\T. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)) Ts \ + list_all (\T. list_all (\x. \\<^sub>v x = TAtom Value) (transaction_fresh T)) Ts" + +definition composable_protocols where + "composable_protocols (P::('fun,'atom,'sets,'lbl) prot list) Ms S \ + let + Ts = concat P; + steps = concat (map transaction_strand Ts); + MP0 = \T \ set Ts. trms_transaction T \ pair' Pair ` setops_transaction T; + M_fun = (\l. case find ((=) l \ fst) Ms of Some M \ snd M | None \ []) + in comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \ Pair steps M_fun S" + +lemma composable_protocols_par_comp_constr: + fixes S f + defines "f \ \M. {t \ \ | t \. t \ M \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}}" + and "Sec \ (f (set S)) - {m. intruder_synth {} m}" + assumes Ps_pc: "wellformed_composable_protocols Ps N" "composable_protocols Ps Ms S" + shows "\\ \ reachable_constraints (concat Ps). \\. constraint_model \ \ \ + (\\\<^sub>\. welltyped_constraint_model \\<^sub>\ \ \ + ((\n. welltyped_constraint_model \\<^sub>\ (proj n \)) \ + (\\'. prefix \' \ \ strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t \' Sec \\<^sub>\)))" + (is "\\ \ _. \_. _ \ ?Q \ \") +proof (intro allI ballI impI) + fix \ \ + assume \: "\ \ reachable_constraints (concat Ps)" and \: "constraint_model \ \" + + let ?Ts = "concat Ps" + let ?steps = "concat (map transaction_strand ?Ts)" + let ?MP0 = "\T \ set ?Ts. trms_transaction T \ pair' Pair ` setops_transaction T" + let ?M_fun = "\l. case find ((=) l \ fst) Ms of Some M \ snd M | None \ []" + + have M: + "has_all_wt_instances_of \ ?MP0 (set N)" + "finite (set N)" "tfr\<^sub>s\<^sub>e\<^sub>t (set N)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set N)" + using Ps_pc tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[of N] + unfolding composable_protocols_def wellformed_composable_protocols_def + Let_def list_all_iff wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric] + by fast+ + + have P: + "\T \ set ?Ts. wellformed_transaction T" + "\T \ set ?Ts. wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity (trms_transaction T)" + "\T \ set ?Ts. \x \ set (transaction_fresh T). \\<^sub>v x = TAtom Value" + "\T \ set ?Ts. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (transaction_strand T))" + "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \ Pair ?steps ?M_fun S" + using Ps_pc tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p + unfolding wellformed_composable_protocols_def composable_protocols_def + Let_def list_all_iff unlabel_def wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric] + by (meson, meson, meson, fastforce, blast) + + show "?Q \ \" + using reachable_constraints_par_comp_constr[OF M P \ \] + unfolding Sec_def f_def by fast +qed + +end + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/Term_Abstraction.thy b/thys/Automated_Stateful_Protocol_Verification/Term_Abstraction.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/Term_Abstraction.thy @@ -0,0 +1,246 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Term_Abstraction.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\Term Abstraction\ +theory Term_Abstraction + imports Transactions +begin + +subsection \Definitions\ +fun to_abs ("\\<^sub>0") where + "\\<^sub>0 [] _ = {}" +| "\\<^sub>0 ((Fun (Val m) [],Fun (Set s) S)#D) n = + (if m = n then insert s (\\<^sub>0 D n) else \\<^sub>0 D n)" +| "\\<^sub>0 (_#D) n = \\<^sub>0 D n" + +fun abs_apply_term (infixl "\\<^sub>\" 67) where + "Var x \\<^sub>\ \ = Var x" +| "Fun (Val n) T \\<^sub>\ \ = Fun (Abs (\ n)) (map (\t. t \\<^sub>\ \) T)" +| "Fun f T \\<^sub>\ \ = Fun f (map (\t. t \\<^sub>\ \) T)" + +definition abs_apply_list (infixl "\\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t" 67) where + "M \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ \ map (\t. t \\<^sub>\ \) M" + +definition abs_apply_terms (infixl "\\<^sub>\\<^sub>s\<^sub>e\<^sub>t" 67) where + "M \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \ \ (\t. t \\<^sub>\ \) ` M" + +definition abs_apply_pairs (infixl "\\<^sub>\\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s" 67) where + "F \\<^sub>\\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \ \ map (\(s,t). (s \\<^sub>\ \, t \\<^sub>\ \)) F" + +definition abs_apply_strand_step (infixl "\\<^sub>\\<^sub>s\<^sub>t\<^sub>p" 67) where + "s \\<^sub>\\<^sub>s\<^sub>t\<^sub>p \ \ (case s of + (l,send\t\) \ (l,send\t \\<^sub>\ \\) + | (l,receive\t\) \ (l,receive\t \\<^sub>\ \\) + | (l,\ac: t \ t'\) \ (l,\ac: (t \\<^sub>\ \) \ (t' \\<^sub>\ \)\) + | (l,insert\t,t'\) \ (l,insert\t \\<^sub>\ \,t' \\<^sub>\ \\) + | (l,delete\t,t'\) \ (l,delete\t \\<^sub>\ \,t' \\<^sub>\ \\) + | (l,\ac: t \ t'\) \ (l,\ac: (t \\<^sub>\ \) \ (t' \\<^sub>\ \)\) + | (l,\X\\\: F \\: F'\) \ (l,\X\\\: (F \\<^sub>\\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \\: (F' \\<^sub>\\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)\))" + +definition abs_apply_strand (infixl "\\<^sub>\\<^sub>s\<^sub>t" 67) where + "S \\<^sub>\\<^sub>s\<^sub>t \ \ map (\x. x \\<^sub>\\<^sub>s\<^sub>t\<^sub>p \) S" + + +subsection \Lemmata\ +lemma to_abs_alt_def: + "\\<^sub>0 D n = {s. \S. (Fun (Val n) [], Fun (Set s) S) \ set D}" +by (induct D n rule: to_abs.induct) auto + +lemma abs_term_apply_const[simp]: + "is_Val f \ Fun f [] \\<^sub>\ a = Fun (Abs (a (the_Val f))) []" + "\is_Val f \ Fun f [] \\<^sub>\ a = Fun f []" +by (cases f; auto)+ + +lemma abs_fv: "fv (t \\<^sub>\ a) = fv t" +by (induct t a rule: abs_apply_term.induct) auto + +lemma abs_eq_if_no_Val: + assumes "\f \ funs_term t. \is_Val f" + shows "t \\<^sub>\ a = t \\<^sub>\ b" +using assms +proof (induction t) + case (Fun f T) thus ?case by (cases f) simp_all +qed simp + +lemma abs_list_set_is_set_abs_set: "set (M \\<^sub>\\<^sub>l\<^sub>i\<^sub>s\<^sub>t \) = (set M) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \" +unfolding abs_apply_list_def abs_apply_terms_def by simp + +lemma abs_set_empty[simp]: "{} \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \ = {}" +unfolding abs_apply_terms_def by simp + +lemma abs_in: + assumes "t \ M" + shows "t \\<^sub>\ \ \ M \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \" +using assms unfolding abs_apply_terms_def +by (induct t \ rule: abs_apply_term.induct) blast+ + +lemma abs_set_union: "(A \ B) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a = (A \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a) \ (B \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a)" +unfolding abs_apply_terms_def +by auto + +lemma abs_subterms: "subterms (t \\<^sub>\ \) = subterms t \\<^sub>\\<^sub>s\<^sub>e\<^sub>t \" +proof (induction t) + case (Fun f T) thus ?case by (cases f) (auto simp add: abs_apply_terms_def) +qed (simp add: abs_apply_terms_def) + +lemma abs_subterms_in: "s \ subterms t \ s \\<^sub>\ a \ subterms (t \\<^sub>\ a)" +proof (induction t) + case (Fun f T) thus ?case by (cases f) auto +qed simp + +lemma abs_ik_append: "(ik\<^sub>s\<^sub>s\<^sub>t (A@B) \\<^sub>s\<^sub>e\<^sub>t I) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a = (ik\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t I) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a \ (ik\<^sub>s\<^sub>s\<^sub>t B \\<^sub>s\<^sub>e\<^sub>t I) \\<^sub>\\<^sub>s\<^sub>e\<^sub>t a" +unfolding abs_apply_terms_def ik\<^sub>s\<^sub>s\<^sub>t_def +by auto + +lemma to_abs_in: + assumes "(Fun (Val n) [], Fun (Set s) []) \ set D" + shows "s \ \\<^sub>0 D n" +using assms by (induct rule: to_abs.induct) auto + +lemma to_abs_empty_iff_notin_db: + "Fun (Val n) [] \\<^sub>\ \\<^sub>0 D = Fun (Abs {}) [] \ (\s S. (Fun (Val n) [], Fun (Set s) S) \ set D)" +by (simp add: to_abs_alt_def) + +lemma to_abs_list_insert: + assumes "Fun (Val n) [] \ t" + shows "\\<^sub>0 D n = \\<^sub>0 (List.insert (t,s) D) n" +using assms to_abs_alt_def[of D n] to_abs_alt_def[of "List.insert (t,s) D" n] +by auto + +lemma to_abs_list_insert': + "insert s (\\<^sub>0 D n) = \\<^sub>0 (List.insert (Fun (Val n) [], Fun (Set s) S) D) n" +using to_abs_alt_def[of D n] + to_abs_alt_def[of "List.insert (Fun (Val n) [], Fun (Set s) S) D" n] +by auto + +lemma to_abs_list_remove_all: + assumes "Fun (Val n) [] \ t" + shows "\\<^sub>0 D n = \\<^sub>0 (List.removeAll (t,s) D) n" +using assms to_abs_alt_def[of D n] to_abs_alt_def[of "List.removeAll (t,s) D" n] +by auto + +lemma to_abs_list_remove_all': + "\\<^sub>0 D n - {s} = \\<^sub>0 (filter (\d. \S. d = (Fun (Val n) [], Fun (Set s) S)) D) n" +using to_abs_alt_def[of D n] + to_abs_alt_def[of "filter (\d. \S. d = (Fun (Val n) [], Fun (Set s) S)) D" n] +by auto + +lemma to_abs_db\<^sub>s\<^sub>s\<^sub>t_append: + assumes "\u s. insert\u, s\ \ set B \ Fun (Val n) [] \ u \ \" + and "\u s. delete\u, s\ \ set B \ Fun (Val n) [] \ u \ \" + shows "\\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t A \ D) n = \\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \ D) n" +using assms +proof (induction B rule: List.rev_induct) + case (snoc b B) + hence IH: "\\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t A \ D) n = \\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \ D) n" by auto + have *: "\u s. b = insert\u,s\ \ Fun (Val n) [] \ u \ \" + "\u s. b = delete\u,s\ \ Fun (Val n) [] \ u \ \" + using snoc.prems by simp_all + show ?case + proof (cases b) + case (Insert u s) + hence **: "db'\<^sub>s\<^sub>s\<^sub>t (A@B@[b]) \ D = List.insert (u \ \,s \ \) (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \ D)" + using db\<^sub>s\<^sub>s\<^sub>t_append[of "A@B" "[b]"] by simp + have "Fun (Val n) [] \ u \ \" using *(1) Insert by auto + thus ?thesis using IH ** to_abs_list_insert by metis + next + case (Delete u s) + hence **: "db'\<^sub>s\<^sub>s\<^sub>t (A@B@[b]) \ D = List.removeAll (u \ \,s \ \) (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \ D)" + using db\<^sub>s\<^sub>s\<^sub>t_append[of "A@B" "[b]"] by simp + have "Fun (Val n) [] \ u \ \" using *(2) Delete by auto + thus ?thesis using IH ** to_abs_list_remove_all by metis + qed (simp_all add: db\<^sub>s\<^sub>s\<^sub>t_no_upd_append[of "[b]" "A@B"] IH) +qed simp + +lemma to_abs_neq_imp_db_update: + assumes "\\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t A I) n \ \\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t (A@B) I) n" + shows "\u s. u \ I = Fun (Val n) [] \ (insert\u,s\ \ set B \ delete\u,s\ \ set B)" +proof - + { fix D have ?thesis when "\\<^sub>0 D n \ \\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t B I D) n" using that + proof (induction B I D rule: db'\<^sub>s\<^sub>s\<^sub>t.induct) + case 2 thus ?case + by (metis db'\<^sub>s\<^sub>s\<^sub>t.simps(2) list.set_intros(1,2) subst_apply_pair_pair to_abs_list_insert) + next + case 3 thus ?case + by (metis db'\<^sub>s\<^sub>s\<^sub>t.simps(3) list.set_intros(1,2) subst_apply_pair_pair to_abs_list_remove_all) + qed simp_all + } thus ?thesis using assms by (metis db\<^sub>s\<^sub>s\<^sub>t_append db\<^sub>s\<^sub>s\<^sub>t_def) +qed + +lemma abs_term_subst_eq: + fixes \ \::"(('a,'b,'c) prot_fun, ('d,'e prot_atom) term \ nat) subst" + assumes "\x \ fv t. \ x \\<^sub>\ a = \ x \\<^sub>\ b" + and "\n T. Fun (Val n) T \ subterms t" + shows "t \ \ \\<^sub>\ a = t \ \ \\<^sub>\ b" +using assms +proof (induction t) + case (Fun f T) thus ?case + proof (cases f) + case (Val n) + hence False using Fun.prems(2) by blast + thus ?thesis by metis + qed auto +qed simp + +lemma abs_term_subst_eq': + fixes \ \::"(('a,'b,'c) prot_fun, ('d,'e prot_atom) term \ nat) subst" + assumes "\x \ fv t. \ x \\<^sub>\ a = \ x" + and "\n T. Fun (Val n) T \ subterms t" + shows "t \ \ \\<^sub>\ a = t \ \" +using assms +proof (induction t) + case (Fun f T) thus ?case + proof (cases f) + case (Val n) + hence False using Fun.prems(2) by blast + thus ?thesis by metis + qed auto +qed simp + +lemma abs_val_in_funs_term: + assumes "f \ funs_term t" "is_Val f" + shows "Abs (\ (the_Val f)) \ funs_term (t \\<^sub>\ \)" +using assms by (induct t \ rule: abs_apply_term.induct) auto + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/Term_Implication.thy b/thys/Automated_Stateful_Protocol_Verification/Term_Implication.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/Term_Implication.thy @@ -0,0 +1,2579 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Term_Implication.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\Term Implication\ +theory Term_Implication + imports Stateful_Protocol_Model Term_Variants +begin + +subsection \Single Term Implications\ +definition timpl_apply_term ("\_ --\ _\\_\") where + "\a --\ b\\t\ \ term_variants ((\_. [])(Abs a := [Abs b])) t" + +definition timpl_apply_terms ("\_ --\ _\\_\\<^sub>s\<^sub>e\<^sub>t") where + "\a --\ b\\M\\<^sub>s\<^sub>e\<^sub>t \ \((set o timpl_apply_term a b) ` M)" + +lemma timpl_apply_Fun: + assumes "\i. i < length T \ S ! i \ set \a --\ b\\T ! i\" + and "length T = length S" + shows "Fun f S \ set \a --\ b\\Fun f T\" +using assms term_variants_Fun term_variants_pred_iff_in_term_variants +by (metis timpl_apply_term_def) + +lemma timpl_apply_Abs: + assumes "\i. i < length T \ S ! i \ set \a --\ b\\T ! i\" + and "length T = length S" + shows "Fun (Abs b) S \ set \a --\ b\\Fun (Abs a) T\" +using assms(1) term_variants_P[OF assms(2), of "(\_. [])(Abs a := [Abs b])" "Abs b" "Abs a"] +unfolding timpl_apply_term_def term_variants_pred_iff_in_term_variants[symmetric] +by fastforce + +lemma timpl_apply_refl: "t \ set \a --\ b\\t\" +unfolding timpl_apply_term_def +by (metis term_variants_pred_refl term_variants_pred_iff_in_term_variants) + +lemma timpl_apply_const: "Fun (Abs b) [] \ set \a --\ b\\Fun (Abs a) []\" +using term_variants_pred_iff_in_term_variants term_variants_pred_const +unfolding timpl_apply_term_def by auto + +lemma timpl_apply_const': + "c = a \ set \a --\ b\\Fun (Abs c) []\ = {Fun (Abs b) [], Fun (Abs c) []}" + "c \ a \ set \a --\ b\\Fun (Abs c) []\ = {Fun (Abs c) []}" +using term_variants_pred_const_cases[of "(\_. [])(Abs a := [Abs b])" "Abs c"] + term_variants_pred_iff_in_term_variants[of "(\_. [])(Abs a := [Abs b])"] +unfolding timpl_apply_term_def by auto + +lemma timpl_apply_term_subst: + "s \ set \a --\ b\\t\ \ s \ \ \ set \a --\ b\\t \ \\" +by (metis term_variants_pred_iff_in_term_variants term_variants_pred_subst timpl_apply_term_def) + +lemma timpl_apply_inv: + assumes "Fun h S \ set \a --\ b\\Fun f T\" + shows "length T = length S" + and "\i. i < length T \ S ! i \ set \a --\ b\\T ! i\" + and "f \ h \ f = Abs a \ h = Abs b" +using assms term_variants_pred_iff_in_term_variants[of "(\_. [])(Abs a := [Abs b])"] +unfolding timpl_apply_term_def +by (metis (full_types) term_variants_pred_inv(1), + metis (full_types) term_variants_pred_inv(2), + fastforce dest: term_variants_pred_inv(3)) + +lemma timpl_apply_inv': + assumes "s \ set \a --\ b\\Fun f T\" + shows "\g S. s = Fun g S" +proof - + have *: "term_variants_pred ((\_. [])(Abs a := [Abs b])) (Fun f T) s" + using assms term_variants_pred_iff_in_term_variants[of "(\_. [])(Abs a := [Abs b])"] + unfolding timpl_apply_term_def by force + show ?thesis using term_variants_pred.cases[OF *, of ?thesis] by fastforce +qed + +lemma timpl_apply_term_Var_iff: + "Var x \ set \a --\ b\\t\ \ t = Var x" +using term_variants_pred_inv_Var term_variants_pred_iff_in_term_variants +unfolding timpl_apply_term_def by metis + + + +subsection \Term Implication Closure\ +inductive_set timpl_closure for t TI where + FP: "t \ timpl_closure t TI" +| TI: "\u \ timpl_closure t TI; (a,b) \ TI; term_variants_pred ((\_. [])(Abs a := [Abs b])) u s\ + \ s \ timpl_closure t TI" + +definition "timpl_closure_set M TI \ (\t \ M. timpl_closure t TI)" + +inductive_set timpl_closure'_step for TI where + "\(a,b) \ TI; term_variants_pred ((\_. [])(Abs a := [Abs b])) t s\ + \ (t,s) \ timpl_closure'_step TI" + +definition "timpl_closure' TI \ (timpl_closure'_step TI)\<^sup>*" + +definition comp_timpl_closure where + "comp_timpl_closure FP TI \ + let f = \X. FP \ (\x \ X. \(a,b) \ TI. set \a --\ b\\x\) + in while (\X. f X \ X) f {}" + +definition comp_timpl_closure_list where + "comp_timpl_closure_list FP TI \ + let f = \X. remdups (concat (map (\x. concat (map (\(a,b). \a --\ b\\x\) TI)) X)) + in while (\X. set (f X) \ set X) f FP" + +lemma timpl_closure_setI: + "t \ M \ t \ timpl_closure_set M TI" +unfolding timpl_closure_set_def by (auto intro: timpl_closure.FP) + +lemma timpl_closure_set_empty_timpls: + "timpl_closure t {} = {t}" (is "?A = ?B") +proof (intro subset_antisym subsetI) + fix s show "s \ ?A \ s \ ?B" + by (induct s rule: timpl_closure.induct) auto +qed (simp add: timpl_closure.FP) + +lemmas timpl_closure_set_is_timpl_closure_union = meta_eq_to_obj_eq[OF timpl_closure_set_def] + +lemma term_variants_pred_eq_case_Abs: + fixes a b + defines "P \ (\_. [])(Abs a := [Abs b])" + assumes "term_variants_pred P t s" "\f \ funs_term s. \is_Abs f" + shows "t = s" +using assms(2,3) P_def +proof (induction P t s rule: term_variants_pred.induct) + case (term_variants_Fun T S f) + have "\is_Abs h" when i: "i < length S" and h: "h \ funs_term (S ! i)" for i h + using i h term_variants_Fun.hyps(4) by auto + hence "T ! i = S ! i" when i: "i < length T" for i using i term_variants_Fun.hyps(1,3) by auto + hence "T = S" using term_variants_Fun.hyps(1) nth_equalityI[of T S] by fast + thus ?case using term_variants_Fun.hyps(1) by blast +qed (simp_all add: term_variants_pred_refl) + +lemma timpl_closure'_step_inv: + assumes "(t,s) \ timpl_closure'_step TI" + obtains a b where "(a,b) \ TI" "term_variants_pred ((\_. [])(Abs a := [Abs b])) t s" +using assms by (auto elim: timpl_closure'_step.cases) + +lemma timpl_closure_mono: + assumes "TI \ TI'" + shows "timpl_closure t TI \ timpl_closure t TI'" +proof + fix s show "s \ timpl_closure t TI \ s \ timpl_closure t TI'" + apply (induct rule: timpl_closure.induct) + using assms by (auto intro: timpl_closure.intros) +qed + +lemma timpl_closure_set_mono: + assumes "M \ M'" "TI \ TI'" + shows "timpl_closure_set M TI \ timpl_closure_set M' TI'" +using assms(1) timpl_closure_mono[OF assms(2)] unfolding timpl_closure_set_def by fast + +lemma timpl_closure_idem: + "timpl_closure_set (timpl_closure t TI) TI = timpl_closure t TI" (is "?A = ?B") +proof + have "s \ timpl_closure t TI" + when "s \ timpl_closure u TI" "u \ timpl_closure t TI" + for s u + using that + by (induction rule: timpl_closure.induct) + (auto intro: timpl_closure.intros) + thus "?A \ ?B" unfolding timpl_closure_set_def by blast + + show "?B \ ?A" + unfolding timpl_closure_set_def + by (blast intro: timpl_closure.FP) +qed + +lemma timpl_closure_set_idem: + "timpl_closure_set (timpl_closure_set M TI) TI = timpl_closure_set M TI" +using timpl_closure_idem[of _ TI]unfolding timpl_closure_set_def by auto + +lemma timpl_closure_set_mono_timpl_closure_set: + assumes N: "N \ timpl_closure_set M TI" + shows "timpl_closure_set N TI \ timpl_closure_set M TI" +using timpl_closure_set_mono[OF N, of TI TI] timpl_closure_set_idem[of M TI] +by simp + +lemma timpl_closure_is_timpl_closure': + "s \ timpl_closure t TI \ (t,s) \ timpl_closure' TI" +proof + show "s \ timpl_closure t TI \ (t,s) \ timpl_closure' TI" + unfolding timpl_closure'_def + by (induct rule: timpl_closure.induct) + (auto intro: rtrancl_into_rtrancl timpl_closure'_step.intros) + + show "(t,s) \ timpl_closure' TI \ s \ timpl_closure t TI" + unfolding timpl_closure'_def + by (induct rule: rtrancl_induct) + (auto dest: timpl_closure'_step_inv + intro: timpl_closure.FP timpl_closure.TI) +qed + +lemma timpl_closure'_mono: + assumes "TI \ TI'" + shows "timpl_closure' TI \ timpl_closure' TI'" +using timpl_closure_mono[OF assms] + timpl_closure_is_timpl_closure'[of _ _ TI] + timpl_closure_is_timpl_closure'[of _ _ TI'] +by fast + +lemma timpl_closureton_is_timpl_closure: + "timpl_closure_set {t} TI = timpl_closure t TI" +by (simp add: timpl_closure_set_is_timpl_closure_union) + +lemma timpl_closure'_timpls_trancl_subset: + "timpl_closure' (c\<^sup>+) \ timpl_closure' c" +unfolding timpl_closure'_def +proof + fix s t::"(('a,'b,'c) prot_fun,'d) term" + show "(s,t) \ (timpl_closure'_step (c\<^sup>+))\<^sup>* \ (s,t) \ (timpl_closure'_step c)\<^sup>*" + proof (induction rule: rtrancl_induct) + case (step u t) + obtain a b where ab: + "(a,b) \ c\<^sup>+" "term_variants_pred ((\_. [])(Abs a := [Abs b])) u t" + using step.hyps(2) timpl_closure'_step_inv by blast + hence "(u,t) \ (timpl_closure'_step c)\<^sup>*" + proof (induction arbitrary: t rule: trancl_induct) + case (step d e) + obtain s where s: + "term_variants_pred ((\_. [])(Abs a := [Abs d])) u s" + "term_variants_pred ((\_. [])(Abs d := [Abs e])) s t" + using term_variants_pred_dense'[OF step.prems, of "Abs d"] by blast + + have "(u,s) \ (timpl_closure'_step c)\<^sup>*" + "(s,t) \ timpl_closure'_step c" + using step.hyps(2) s(2) step.IH[OF s(1)] + by (auto intro: timpl_closure'_step.intros) + thus ?case by simp + qed (auto intro: timpl_closure'_step.intros) + thus ?case using step.IH by simp + qed simp +qed + +lemma timpl_closure'_timpls_trancl_subset': + "timpl_closure' {(a,b) \ c\<^sup>+. a \ b} \ timpl_closure' c" +using timpl_closure'_timpls_trancl_subset + timpl_closure'_mono[of "{(a,b) \ c\<^sup>+. a \ b}" "c\<^sup>+"] +by fast + +lemma timpl_closure_set_timpls_trancl_subset: + "timpl_closure_set M (c\<^sup>+) \ timpl_closure_set M c" +using timpl_closure'_timpls_trancl_subset[of c] + timpl_closure_is_timpl_closure'[of _ _ c] + timpl_closure_is_timpl_closure'[of _ _ "c\<^sup>+"] + timpl_closure_set_is_timpl_closure_union[of M c] + timpl_closure_set_is_timpl_closure_union[of M "c\<^sup>+"] +by fastforce + +lemma timpl_closure_set_timpls_trancl_subset': + "timpl_closure_set M {(a,b) \ c\<^sup>+. a \ b} \ timpl_closure_set M c" +using timpl_closure'_timpls_trancl_subset'[of c] + timpl_closure_is_timpl_closure'[of _ _ c] + timpl_closure_is_timpl_closure'[of _ _ "{(a,b) \ c\<^sup>+. a \ b}"] + timpl_closure_set_is_timpl_closure_union[of M c] + timpl_closure_set_is_timpl_closure_union[of M "{(a,b) \ c\<^sup>+. a \ b}"] +by fastforce + +lemma timpl_closure'_timpls_trancl_supset': + "timpl_closure' c \ timpl_closure' {(a,b) \ c\<^sup>+. a \ b}" +unfolding timpl_closure'_def +proof + let ?cl = "{(a,b) \ c\<^sup>+. a \ b}" + + fix s t::"(('e,'f,'c) prot_fun,'g) term" + show "(s,t) \ (timpl_closure'_step c)\<^sup>* \ (s,t) \ (timpl_closure'_step ?cl)\<^sup>*" + proof (induction rule: rtrancl_induct) + case (step u t) + obtain a b where ab: + "(a,b) \ c" "term_variants_pred ((\_. [])(Abs a := [Abs b])) u t" + using step.hyps(2) timpl_closure'_step_inv by blast + hence "(a,b) \ c\<^sup>+" by simp + hence "(u,t) \ (timpl_closure'_step ?cl)\<^sup>*" using ab(2) + proof (induction arbitrary: t rule: trancl_induct) + case (base d) show ?case + proof (cases "a = d") + case True thus ?thesis + using base term_variants_pred_refl_inv[of _ u t] + by force + next + case False thus ?thesis + using base timpl_closure'_step.intros[of a d ?cl] + by fast + qed + next + case (step d e) + obtain s where s: + "term_variants_pred ((\_. [])(Abs a := [Abs d])) u s" + "term_variants_pred ((\_. [])(Abs d := [Abs e])) s t" + using term_variants_pred_dense'[OF step.prems, of "Abs d"] by blast + + show ?case + proof (cases "d = e") + case True + thus ?thesis + using step.prems step.IH[of t] + by blast + next + case False + hence "(u,s) \ (timpl_closure'_step ?cl)\<^sup>*" + "(s,t) \ timpl_closure'_step ?cl" + using step.hyps(2) s(2) step.IH[OF s(1)] + by (auto intro: timpl_closure'_step.intros) + thus ?thesis by simp + qed + qed + thus ?case using step.IH by simp + qed simp +qed + +lemma timpl_closure'_timpls_trancl_supset: + "timpl_closure' c \ timpl_closure' (c\<^sup>+)" +using timpl_closure'_timpls_trancl_supset'[of c] + timpl_closure'_mono[of "{(a,b) \ c\<^sup>+. a \ b}" "c\<^sup>+"] +by fast + +lemma timpl_closure'_timpls_trancl_eq: + "timpl_closure' (c\<^sup>+) = timpl_closure' c" +using timpl_closure'_timpls_trancl_subset timpl_closure'_timpls_trancl_supset +by blast + +lemma timpl_closure'_timpls_trancl_eq': + "timpl_closure' {(a,b) \ c\<^sup>+. a \ b} = timpl_closure' c" +using timpl_closure'_timpls_trancl_subset' timpl_closure'_timpls_trancl_supset' +by blast + +lemma timpl_closure'_timpls_rtrancl_subset: + "timpl_closure' (c\<^sup>*) \ timpl_closure' c" +unfolding timpl_closure'_def +proof + fix s t::"(('a,'b,'c) prot_fun,'d) term" + show "(s,t) \ (timpl_closure'_step (c\<^sup>*))\<^sup>* \ (s,t) \ (timpl_closure'_step c)\<^sup>*" + proof (induction rule: rtrancl_induct) + case (step u t) + obtain a b where ab: + "(a,b) \ c\<^sup>*" "term_variants_pred ((\_. [])(Abs a := [Abs b])) u t" + using step.hyps(2) timpl_closure'_step_inv by blast + hence "(u,t) \ (timpl_closure'_step c)\<^sup>*" + proof (induction arbitrary: t rule: rtrancl_induct) + case base + hence "u = t" using term_variants_pred_refl_inv by fastforce + thus ?case by simp + next + case (step d e) + obtain s where s: + "term_variants_pred ((\_. [])(Abs a := [Abs d])) u s" + "term_variants_pred ((\_. [])(Abs d := [Abs e])) s t" + using term_variants_pred_dense'[OF step.prems, of "Abs d"] by blast + + have "(u,s) \ (timpl_closure'_step c)\<^sup>*" + "(s,t) \ timpl_closure'_step c" + using step.hyps(2) s(2) step.IH[OF s(1)] + by (auto intro: timpl_closure'_step.intros) + thus ?case by simp + qed + thus ?case using step.IH by simp + qed simp +qed + +lemma timpl_closure'_timpls_rtrancl_supset: + "timpl_closure' c \ timpl_closure' (c\<^sup>*)" +unfolding timpl_closure'_def +proof + fix s t::"(('e,'f,'c) prot_fun,'g) term" + show "(s,t) \ (timpl_closure'_step c)\<^sup>* \ (s,t) \ (timpl_closure'_step (c\<^sup>*))\<^sup>*" + proof (induction rule: rtrancl_induct) + case (step u t) + obtain a b where ab: + "(a,b) \ c" "term_variants_pred ((\_. [])(Abs a := [Abs b])) u t" + using step.hyps(2) timpl_closure'_step_inv by blast + hence "(a,b) \ c\<^sup>*" by simp + hence "(u,t) \ (timpl_closure'_step (c\<^sup>*))\<^sup>*" using ab(2) + proof (induction arbitrary: t rule: rtrancl_induct) + case (base t) thus ?case using term_variants_pred_refl_inv[of _ u t] by fastforce + next + case (step d e) + obtain s where s: + "term_variants_pred ((\_. [])(Abs a := [Abs d])) u s" + "term_variants_pred ((\_. [])(Abs d := [Abs e])) s t" + using term_variants_pred_dense'[OF step.prems, of "Abs d"] by blast + + show ?case + proof (cases "d = e") + case True + thus ?thesis + using step.prems step.IH[of t] + by blast + next + case False + hence "(u,s) \ (timpl_closure'_step (c\<^sup>*))\<^sup>*" + "(s,t) \ timpl_closure'_step (c\<^sup>*)" + using step.hyps(2) s(2) step.IH[OF s(1)] + by (auto intro: timpl_closure'_step.intros) + thus ?thesis by simp + qed + qed + thus ?case using step.IH by simp + qed simp +qed + +lemma timpl_closure'_timpls_rtrancl_eq: + "timpl_closure' (c\<^sup>*) = timpl_closure' c" +using timpl_closure'_timpls_rtrancl_subset timpl_closure'_timpls_rtrancl_supset +by blast + +lemma timpl_closure_timpls_trancl_eq: + "timpl_closure t (c\<^sup>+) = timpl_closure t c" +using timpl_closure'_timpls_trancl_eq[of c] + timpl_closure_is_timpl_closure'[of _ _ c] + timpl_closure_is_timpl_closure'[of _ _ "c\<^sup>+"] +by fastforce + +lemma timpl_closure_set_timpls_trancl_eq: + "timpl_closure_set M (c\<^sup>+) = timpl_closure_set M c" +using timpl_closure_timpls_trancl_eq + timpl_closure_set_is_timpl_closure_union[of M c] + timpl_closure_set_is_timpl_closure_union[of M "c\<^sup>+"] +by fastforce + +lemma timpl_closure_set_timpls_trancl_eq': + "timpl_closure_set M {(a,b) \ c\<^sup>+. a \ b} = timpl_closure_set M c" +using timpl_closure'_timpls_trancl_eq'[of c] + timpl_closure_is_timpl_closure'[of _ _ c] + timpl_closure_is_timpl_closure'[of _ _ "{(a,b) \ c\<^sup>+. a \ b}"] + timpl_closure_set_is_timpl_closure_union[of M c] + timpl_closure_set_is_timpl_closure_union[of M "{(a,b) \ c\<^sup>+. a \ b}"] +by fastforce + +lemma timpl_closure_Var_in_iff: + "Var x \ timpl_closure t TI \ t = Var x" (is "?A \ ?B") +proof + have "s \ timpl_closure t TI \ s = Var x \ s = t" for s + apply (induction rule: timpl_closure.induct) + by (simp, metis term_variants_pred_inv_Var(2)) + thus "?A \ ?B" by blast +qed (blast intro: timpl_closure.FP) + +lemma timpl_closure_set_Var_in_iff: + "Var x \ timpl_closure_set M TI \ Var x \ M" +unfolding timpl_closure_set_def by (simp add: timpl_closure_Var_in_iff[of x _ TI]) + +lemma timpl_closure_Var_inv: + assumes "t \ timpl_closure (Var x) TI" + shows "t = Var x" +using assms +proof (induction rule: timpl_closure.induct) + case (TI u a b s) thus ?case using term_variants_pred_inv_Var by fast +qed simp + +lemma timpls_Un_mono: "mono (\X. FP \ (\x \ X. \(a,b) \ TI. set \a --\ b\\x\))" +by (auto intro!: monoI) + +lemma timpl_closure_set_lfp: + fixes M TI + defines "f \ \X. M \ (\x \ X. \(a,b) \ TI. set \a --\ b\\x\)" + shows "lfp f = timpl_closure_set M TI" +proof + note 0 = timpls_Un_mono[of M TI, unfolded f_def[symmetric]] + + let ?N = "timpl_closure_set M TI" + + show "lfp f \ ?N" + proof (induction rule: lfp_induct) + case 2 thus ?case + proof + fix t assume "t \ f (lfp f \ ?N)" + hence "t \ M \ t \ (\x \ ?N. \(a,b) \ TI. set \a --\ b\\x\)" (is "?A \ ?B") + unfolding f_def by blast + thus "t \ ?N" + proof + assume ?B + then obtain s a b where s: "s \ ?N" "(a,b) \ TI" "t \ set \a --\ b\\s\" by moura + thus ?thesis + using term_variants_pred_iff_in_term_variants[of "(\_. [])(Abs a := [Abs b])" s] + unfolding timpl_closure_set_def timpl_apply_term_def + by (auto intro: timpl_closure.intros) + qed (auto simp add: timpl_closure_set_def intro: timpl_closure.intros) + qed + qed (rule 0) + + have "t \ lfp f" when t: "t \ timpl_closure s TI" and s: "s \ M" for t s + using t + proof (induction t rule: timpl_closure.induct) + case (TI u a b v) thus ?case + using term_variants_pred_iff_in_term_variants[of "(\_. [])(Abs a := [Abs b])"] + lfp_fixpoint[OF 0] + unfolding timpl_apply_term_def f_def by fastforce + qed (use s lfp_fixpoint[OF 0] f_def in blast) + thus "?N \ lfp f" unfolding timpl_closure_set_def by blast +qed + +lemma timpl_closure_set_supset: + assumes "\t \ FP. t \ closure" + and "\t \ closure. \(a,b) \ TI. \s \ set \a --\ b\\t\. s \ closure" + shows "timpl_closure_set FP TI \ closure" +proof - + have "t \ closure" when t: "t \ timpl_closure s TI" and s: "s \ FP" for t s + using t + proof (induction rule: timpl_closure.induct) + case FP thus ?case using s assms(1) by blast + next + case (TI u a b s') thus ?case + using assms(2) term_variants_pred_iff_in_term_variants[of "(\_. [])(Abs a := [Abs b])"] + unfolding timpl_apply_term_def by fastforce + qed + thus ?thesis unfolding timpl_closure_set_def by blast +qed + +lemma timpl_closure_set_supset': + assumes "\t \ FP. \(a,b) \ TI. \s \ set \a --\ b\\t\. s \ FP" + shows "timpl_closure_set FP TI \ FP" +using timpl_closure_set_supset[OF _ assms] by blast + +lemma timpl_closure'_param: + assumes "(t,s) \ timpl_closure' c" + and fg: "f = g \ (\a b. (a,b) \ c \ f = Abs a \ g = Abs b)" + shows "(Fun f (S@t#T), Fun g (S@s#T)) \ timpl_closure' c" +using assms(1) unfolding timpl_closure'_def +proof (induction rule: rtrancl_induct) + case base thus ?case + proof (cases "f = g") + case False + then obtain a b where ab: "(a,b) \ c" "f = Abs a" "g = Abs b" + using fg by moura + show ?thesis + using term_variants_pred_param[OF term_variants_pred_refl[of "(\_. [])(Abs a := [Abs b])" t]] + timpl_closure'_step.intros[OF ab(1)] ab(2,3) + by fastforce + qed simp +next + case (step u s) + obtain a b where ab: "(a,b) \ c" "term_variants_pred ((\_. [])(Abs a := [Abs b])) u s" + using timpl_closure'_step_inv[OF step.hyps(2)] by blast + have "(Fun g (S@u#T), Fun g (S@s#T)) \ timpl_closure'_step c" + using ab(1) term_variants_pred_param[OF ab(2), of g g S T] + by (auto simp add: timpl_closure'_def intro: timpl_closure'_step.intros) + thus ?case using rtrancl_into_rtrancl[OF step.IH] fg by blast +qed + +lemma timpl_closure'_param': + assumes "(t,s) \ timpl_closure' c" + shows "(Fun f (S@t#T), Fun f (S@s#T)) \ timpl_closure' c" +using timpl_closure'_param[OF assms] by simp + +lemma timpl_closure_FunI: + assumes IH: "\i. i < length T \ (T ! i, S ! i) \ timpl_closure' c" + and len: "length T = length S" + and fg: "f = g \ (\a b. (a,b) \ c\<^sup>+ \ f = Abs a \ g = Abs b)" + shows "(Fun f T, Fun g S) \ timpl_closure' c" +proof - + have aux: "(Fun f T, Fun g (take n S@drop n T)) \ timpl_closure' c" + when "n \ length T" for n + using that + proof (induction n) + case 0 + have "(T ! n, T ! n) \ timpl_closure' c" when n: "n < length T" for n + using n unfolding timpl_closure'_def by simp + hence "(Fun f T, Fun g T) \ timpl_closure' c" + proof (cases "f = g") + case False + then obtain a b where ab: "(a, b) \ c\<^sup>+" "f = Abs a" "g = Abs b" + using fg by moura + show ?thesis + using timpl_closure'_step.intros[OF ab(1), of "Fun f T" "Fun g T"] ab(2,3) + term_variants_P[OF _ term_variants_pred_refl[of "(\_. [])(Abs a := [Abs b])"], + of T g f] + timpl_closure'_timpls_trancl_eq + unfolding timpl_closure'_def + by (metis fun_upd_same list.set_intros(1) r_into_rtrancl) + qed (simp add: timpl_closure'_def) + thus ?case by simp + next + case (Suc n) + hence IH': "(Fun f T, Fun g (take n S@drop n T)) \ timpl_closure' c" + and n: "n < length T" "n < length S" + by (simp_all add: len) + + obtain T1 T2 where T: "T = T1@T ! n#T2" "length T1 = n" + using length_prefix_ex'[OF n(1)] by auto + + obtain S1 S2 where S: "S = S1@S ! n#S2" "length S1 = n" + using length_prefix_ex'[OF n(2)] by auto + + have "take n S@drop n T = S1@T ! n#T2" "take (Suc n) S@drop (Suc n) T = S1@S ! n#T2" + using n T S append_eq_conv_conj + by (metis, metis (no_types, hide_lams) Cons_nth_drop_Suc append.assoc append_Cons + append_Nil take_Suc_conv_app_nth) + moreover have "(T ! n, S ! n) \ timpl_closure' c" using IH Suc.prems by simp + ultimately show ?case + using timpl_closure'_param IH'(1) + by (metis (no_types, lifting) timpl_closure'_def rtrancl_trans) + qed + + show ?thesis using aux[of "length T"] len by simp +qed + +lemma timpl_closure_FunI': + assumes IH: "\i. i < length T \ (T ! i, S ! i) \ timpl_closure' c" + and len: "length T = length S" + shows "(Fun f T, Fun f S) \ timpl_closure' c" +using timpl_closure_FunI[OF IH len] by simp + +lemma timpl_closure_FunI2: + fixes f g::"('a, 'b, 'c) prot_fun" + assumes IH: "\i. i < length T \ \u. (T!i, u) \ timpl_closure' c \ (S!i, u) \ timpl_closure' c" + and len: "length T = length S" + and fg: "f = g \ (\a b d. (a, d) \ c\<^sup>+ \ (b, d) \ c\<^sup>+ \ f = Abs a \ g = Abs b)" + shows "\h U. (Fun f T, Fun h U) \ timpl_closure' c \ (Fun g S, Fun h U) \ timpl_closure' c" +proof - + let ?P = "\i u. (T ! i, u) \ timpl_closure' c \ (S ! i, u) \ timpl_closure' c" + + define U where "U \ map (\i. SOME u. ?P i u) [0.. timpl_closure' c \ (S ! i, U ! i) \ timpl_closure' c" + when i: "i < length U" for i + using i someI_ex[of "?P i"] IH[of i] U1 len + unfolding U_def by simp + + show ?thesis + proof (cases "f = g") + case False + then obtain a b d where abd: "(a, d) \ c\<^sup>+" "(b, d) \ c\<^sup>+" "f = Abs a" "g = Abs b" + using fg by moura + + define h::"('a, 'b, 'c) prot_fun" where "h = Abs d" + + have "f = h \ (\a b. (a, b) \ c\<^sup>+ \ f = Abs a \ h = Abs b)" + "g = h \ (\a b. (a, b) \ c\<^sup>+ \ g = Abs a \ h = Abs b)" + using abd unfolding h_def by blast+ + thus ?thesis by (metis timpl_closure_FunI len U1 U2) + qed (metis timpl_closure_FunI' len U1 U2) +qed + +lemma timpl_closure_FunI3: + fixes f g::"('a, 'b, 'c) prot_fun" + assumes IH: "\i. i < length T \ \u. (T!i, u) \ timpl_closure' c \ (S!i, u) \ timpl_closure' c" + and len: "length T = length S" + and fg: "f = g \ (\a b d. (a, d) \ c \ (b, d) \ c \ f = Abs a \ g = Abs b)" + shows "\h U. (Fun f T, Fun h U) \ timpl_closure' c \ (Fun g S, Fun h U) \ timpl_closure' c" +using timpl_closure_FunI2[OF IH len] fg unfolding timpl_closure'_timpls_trancl_eq by blast + +lemma timpl_closure_fv_eq: + assumes "s \ timpl_closure t T" + shows "fv s = fv t" +using assms +by (induct rule: timpl_closure.induct) + (metis, metis term_variants_pred_fv_eq) + +lemma (in stateful_protocol_model) timpl_closure_subst: + assumes t: "wf\<^sub>t\<^sub>r\<^sub>m t" "\x \ fv t. \a. \\<^sub>v x = TAtom (Atom a)" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "timpl_closure (t \ \) T = timpl_closure t T \\<^sub>s\<^sub>e\<^sub>t \" +proof + have "s \ timpl_closure t T \\<^sub>s\<^sub>e\<^sub>t \" + when "s \ timpl_closure (t \ \) T" for s + using that + proof (induction s rule: timpl_closure.induct) + case FP thus ?case using timpl_closure.FP[of t T] by simp + next + case (TI u a b s) + then obtain u' where u': "u' \ timpl_closure t T" "u = u' \ \" by moura + + have u'_fv: "\x \ fv u'. \a. \\<^sub>v x = TAtom (Atom a)" + using timpl_closure_fv_eq[OF u'(1)] t(2) by simp + hence u_fv: "\x \ fv u. \a. \\<^sub>v x = TAtom (Atom a)" + using u'(2) wt_subst_trm''[OF \(1)] wt_subst_const_fv_type_eq[OF _ \(1,2), of u'] + by fastforce + + have "\x \ fv u' \ fv s. (\y. \ x = Var y) \ (\f. \ x = Fun f [] \ Abs a \ f)" + proof (intro ballI) + fix x assume x: "x \ fv u' \ fv s" + then obtain c where c: "\\<^sub>v x = TAtom (Atom c)" + using u'_fv u_fv term_variants_pred_fv_eq[OF TI.hyps(3)] + by blast + + show "(\y. \ x = Var y) \ (\f. \ x = Fun f [] \ Abs a \ f)" + proof (cases "\ x") + case (Fun f T) + hence **: "\ (Fun f T) = TAtom (Atom c)" and "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" + using c wt_subst_trm''[OF \(1), of "Var x"] \(2) + by fastforce+ + hence "\ x = Fun f []" using Fun const_type_inv_wf by metis + thus ?thesis using ** by force + qed metis + qed + hence *: "\x \ fv u' \ fv s. + (\y. \ x = Var y) \ (\f. \ x = Fun f [] \ ((\_. [])(Abs a := [Abs b])) f = [])" + by fastforce + + obtain s' where s': "term_variants_pred ((\_. [])(Abs a := [Abs b])) u' s'" "s = s' \ \" + using term_variants_pred_subst'[OF _ *] u'(2) TI.hyps(3) + by blast + + show ?case using timpl_closure.TI[OF u'(1) TI.hyps(2) s'(1)] s'(2) by blast + qed + thus "timpl_closure (t \ \) T \ timpl_closure t T \\<^sub>s\<^sub>e\<^sub>t \" by fast + + have "s \ timpl_closure (t \ \) T" + when s: "s \ timpl_closure t T \\<^sub>s\<^sub>e\<^sub>t \" for s + proof - + obtain s' where s': "s' \ timpl_closure t T" "s = s' \ \" using s by moura + have "s' \ \ \ timpl_closure (t \ \) T" using s'(1) + proof (induction s' rule: timpl_closure.induct) + case FP thus ?case using timpl_closure.FP[of "t \ \" T] by simp + next + case (TI u' a b s') show ?case + using timpl_closure.TI[OF TI.IH TI.hyps(2)] + term_variants_pred_subst[OF TI.hyps(3)] + by blast + qed + thus ?thesis using s'(2) by metis + qed + thus "timpl_closure t T \\<^sub>s\<^sub>e\<^sub>t \ \ timpl_closure (t \ \) T" by fast +qed + +lemma (in stateful_protocol_model) timpl_closure_subst_subset: + assumes t: "t \ M" + and M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" "\x \ fv\<^sub>s\<^sub>e\<^sub>t M. \a. \\<^sub>v x = TAtom (Atom a)" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "ground (subst_range \)" "subst_domain \ \ fv\<^sub>s\<^sub>e\<^sub>t M" + and M_supset: "timpl_closure t T \ M" + shows "timpl_closure (t \ \) T \ M \\<^sub>s\<^sub>e\<^sub>t \" +proof - + have t': "wf\<^sub>t\<^sub>r\<^sub>m t" "\x \ fv t. \a. \\<^sub>v x = TAtom (Atom a)" using t M by auto + show ?thesis using timpl_closure_subst[OF t' \(1,2), of T] M_supset by blast +qed + +lemma (in stateful_protocol_model) timpl_closure_set_subst_subset: + assumes M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" "\x \ fv\<^sub>s\<^sub>e\<^sub>t M. \a. \\<^sub>v x = TAtom (Atom a)" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "ground (subst_range \)" "subst_domain \ \ fv\<^sub>s\<^sub>e\<^sub>t M" + and M_supset: "timpl_closure_set M T \ M" + shows "timpl_closure_set (M \\<^sub>s\<^sub>e\<^sub>t \) T \ M \\<^sub>s\<^sub>e\<^sub>t \" +using timpl_closure_subst_subset[OF _ M \, of _ T] M_supset + timpl_closure_set_is_timpl_closure_union[of "M \\<^sub>s\<^sub>e\<^sub>t \" T] + timpl_closure_set_is_timpl_closure_union[of M T] +by auto + +lemma timpl_closure_set_Union: + "timpl_closure_set (\Ms) T = (\M \ Ms. timpl_closure_set M T)" +using timpl_closure_set_is_timpl_closure_union[of "\Ms" T] + timpl_closure_set_is_timpl_closure_union[of _ T] +by force + +lemma timpl_closure_set_Union_subst_set: + assumes "s \ timpl_closure_set (\{M \\<^sub>s\<^sub>e\<^sub>t \ | \. P \}) T" + shows "\\. P \ \ s \ timpl_closure_set (M \\<^sub>s\<^sub>e\<^sub>t \) T" +using assms timpl_closure_set_is_timpl_closure_union[of "(\{M \\<^sub>s\<^sub>e\<^sub>t \ | \. P \})" T] + timpl_closure_set_is_timpl_closure_union[of _ T] +by blast + +lemma timpl_closure_set_Union_subst_singleton: + assumes "s \ timpl_closure_set {t \ \ | \. P \} T" + shows "\\. P \ \ s \ timpl_closure_set {t \ \} T" +using assms timpl_closure_set_is_timpl_closure_union[of "{t \ \ |\. P \}" T] + timpl_closureton_is_timpl_closure[of _ T] +by fast + +lemma timpl_closure'_inv: + assumes "(s, t) \ timpl_closure' TI" + shows "(\x. s = Var x \ t = Var x) \ (\f g S T. s = Fun f S \ t = Fun g T \ length S = length T)" +using assms unfolding timpl_closure'_def +proof (induction rule: rtrancl_induct) + case base thus ?case by (cases s) auto +next + case (step t u) + obtain a b where ab: "(a, b) \ TI" "term_variants_pred ((\_. [])(Abs a := [Abs b])) t u" + using timpl_closure'_step_inv[OF step.hyps(2)] by blast + show ?case using step.IH + proof + assume "\x. s = Var x \ t = Var x" + thus ?case using step.hyps(2) term_variants_pred_inv_Var ab by fastforce + next + assume "\f g S T. s = Fun f S \ t = Fun g T \ length S = length T" + then obtain f g S T where st: "s = Fun f S" "t = Fun g T" "length S = length T" by moura + thus ?case + using ab step.hyps(2) term_variants_pred_inv'[of "(\_. [])(Abs a := [Abs b])" g T u] + by auto + qed +qed + +lemma timpl_closure'_inv': + assumes "(s, t) \ timpl_closure' TI" + shows "(\x. s = Var x \ t = Var x) \ + (\f g S T. s = Fun f S \ t = Fun g T \ length S = length T \ + (\i < length T. (S ! i, T ! i) \ timpl_closure' TI) \ + (f \ g \ is_Abs f \ is_Abs g \ (the_Abs f, the_Abs g) \ TI\<^sup>+))" + (is "?A s t \ ?B s t (timpl_closure' TI)") +using assms unfolding timpl_closure'_def +proof (induction rule: rtrancl_induct) + case base thus ?case by (cases s) auto +next + case (step t u) + obtain a b where ab: "(a, b) \ TI" "term_variants_pred ((\_. [])(Abs a := [Abs b])) t u" + using timpl_closure'_step_inv[OF step.hyps(2)] by blast + show ?case using step.IH + proof + assume "?A s t" + thus ?case using step.hyps(2) term_variants_pred_inv_Var ab by fastforce + next + assume "?B s t ((timpl_closure'_step TI)\<^sup>*)" + then obtain f g S T where st: + "s = Fun f S" "t = Fun g T" "length S = length T" + "\i. i < length T \ (S ! i, T ! i) \ (timpl_closure'_step TI)\<^sup>*" + "f \ g \ is_Abs f \ is_Abs g \ (the_Abs f, the_Abs g) \ TI\<^sup>+" + by moura + obtain h U where u: + "u = Fun h U" "length T = length U" + "\i. i < length T \ term_variants_pred ((\_. [])(Abs a := [Abs b])) (T ! i) (U ! i)" + "g \ h \ is_Abs g \ is_Abs h \ (the_Abs g, the_Abs h) \ TI\<^sup>+" + using ab(2) st(2) r_into_trancl[OF ab(1)] + term_variants_pred_inv'(1,2,3,4)[of "(\_. [])(Abs a := [Abs b])" g T u] + term_variants_pred_inv'(5)[of "(\_. [])(Abs a := [Abs b])" g T u "Abs a" "Abs b"] + unfolding is_Abs_def the_Abs_def by force + + have "(S ! i, U ! i) \ (timpl_closure'_step TI)\<^sup>*" when i: "i < length U" for i + using u(2) i rtrancl.rtrancl_into_rtrancl[OF + st(4)[of i] timpl_closure'_step.intros[OF ab(1) u(3)[of i]]] + by argo + moreover have "length S = length U" using st u by argo + moreover have "is_Abs f \ is_Abs h \ (the_Abs f, the_Abs h) \ TI\<^sup>+" when fh: "f \ h" + using fh st u by fastforce + ultimately show ?case using st(1) u(1) by blast + qed +qed + +lemma timpl_closure'_inv'': + assumes "(Fun f S, Fun g T) \ timpl_closure' TI" + shows "length S = length T" + and "\i. i < length T \ (S ! i, T ! i) \ timpl_closure' TI" + and "f \ g \ is_Abs f \ is_Abs g \ (the_Abs f, the_Abs g) \ TI\<^sup>+" +using assms timpl_closure'_inv' by auto + +lemma timpl_closure_Fun_inv: + assumes "s \ timpl_closure (Fun f T) TI" + shows "\g S. s = Fun g S" +using assms timpl_closure_is_timpl_closure' timpl_closure'_inv +by fastforce + +lemma timpl_closure_Fun_inv': + assumes "Fun g S \ timpl_closure (Fun f T) TI" + shows "length S = length T" + and "\i. i < length S \ S ! i \ timpl_closure (T ! i) TI" + and "f \ g \ is_Abs f \ is_Abs g \ (the_Abs f, the_Abs g) \ TI\<^sup>+" +using assms timpl_closure_is_timpl_closure' +by (metis timpl_closure'_inv''(1), metis timpl_closure'_inv''(2), metis timpl_closure'_inv''(3)) + +lemma timpl_closure_Fun_not_Var[simp]: + "Fun f T \ timpl_closure (Var x) TI" +using timpl_closure_Var_inv by fast + +lemma timpl_closure_Var_not_Fun[simp]: + "Var x \ timpl_closure (Fun f T) TI" +using timpl_closure_Fun_inv by fast + +lemma (in stateful_protocol_model) timpl_closure_wf_trms: + assumes m: "wf\<^sub>t\<^sub>r\<^sub>m m" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (timpl_closure m TI)" +proof + fix t assume "t \ timpl_closure m TI" + thus "wf\<^sub>t\<^sub>r\<^sub>m t" + proof (induction t rule: timpl_closure.induct) + case TI thus ?case using term_variants_pred_wf_trms by force + qed (rule m) +qed + +lemma (in stateful_protocol_model) timpl_closure_set_wf_trms: + assumes M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (timpl_closure_set M TI)" +proof + fix t assume "t \ timpl_closure_set M TI" + then obtain m where "t \ timpl_closure m TI" "m \ M" "wf\<^sub>t\<^sub>r\<^sub>m m" + using M timpl_closure_set_is_timpl_closure_union by blast + thus "wf\<^sub>t\<^sub>r\<^sub>m t" using timpl_closure_wf_trms by blast +qed + +lemma timpl_closure_Fu_inv: + assumes "t \ timpl_closure (Fun (Fu f) T) TI" + shows "\S. length S = length T \ t = Fun (Fu f) S" +using assms +proof (induction t rule: timpl_closure.induct) + case (TI u a b s) + then obtain U where U: "length U = length T" "u = Fun (Fu f) U" + by moura + hence *: "term_variants_pred ((\_. [])(Abs a := [Abs b])) (Fun (Fu f) U) s" + using TI.hyps(3) by meson + + show ?case + using term_variants_pred_inv'(1,2,4)[OF *] U + by force +qed simp + +lemma timpl_closure_Fu_inv': + assumes "Fun (Fu f) T \ timpl_closure t TI" + shows "\S. length S = length T \ t = Fun (Fu f) S" +using assms +proof (induction "Fun (Fu f) T" arbitrary: T rule: timpl_closure.induct) + case (TI u a b) + obtain g U where U: + "u = Fun g U" "length U = length T" + "Fu f \ g \ Abs a = g \ Fu f = Abs b" + using term_variants_pred_inv''[OF TI.hyps(4)] by fastforce + + have g: "g = Fu f" using U(3) by blast + + show ?case using TI.hyps(2)[OF U(1)[unfolded g]] U(2) by auto +qed simp + +lemma timpl_closure_no_Abs_eq: + assumes "t \ timpl_closure s TI" + and "\f \ funs_term t. \is_Abs f" + shows "t = s" +using assms +proof (induction t rule: timpl_closure.induct) + case (TI t a b s) thus ?case + using term_variants_pred_eq_case_Abs[of a b t s] + unfolding timpl_apply_term_def term_variants_pred_iff_in_term_variants[symmetric] + by metis +qed simp + +lemma timpl_closure_set_no_Abs_in_set: + assumes "t \ timpl_closure_set FP TI" + and "\f \ funs_term t. \is_Abs f" + shows "t \ FP" +using assms timpl_closure_no_Abs_eq unfolding timpl_closure_set_def by blast + +lemma timpl_closure_funs_term_subset: + "\(funs_term ` (timpl_closure t TI)) \ funs_term t \ Abs ` snd ` TI" + (is "?A \ ?B \ ?C") +proof + fix f assume "f \ ?A" + then obtain s where "s \ timpl_closure t TI" "f \ funs_term s" by moura + thus "f \ ?B \ ?C" + proof (induction s rule: timpl_closure.induct) + case (TI u a b s) + have "Abs b \ Abs ` snd ` TI" using TI.hyps(2) by force + thus ?case using term_variants_pred_funs_term[OF TI.hyps(3) TI.prems] TI.IH by force + qed blast +qed + +lemma timpl_closure_set_funs_term_subset: + "\(funs_term ` (timpl_closure_set FP TI)) \ \(funs_term ` FP) \ Abs ` snd ` TI" +using timpl_closure_funs_term_subset[of _ TI] + timpl_closure_set_is_timpl_closure_union[of FP TI] +by auto + +lemma funs_term_OCC_TI_subset: + defines "absc \ \a. Fun (Abs a) []" + assumes OCC1: "\t \ FP. \f \ funs_term t. is_Abs f \ f \ Abs ` OCC" + and OCC2: "snd ` TI \ OCC" + shows "\t \ timpl_closure_set FP TI. \f \ funs_term t. is_Abs f \ f \ Abs ` OCC" (is ?A) + and "\t \ absc ` OCC. \(a,b) \ TI. \s \ set \a --\ b\\t\. s \ absc ` OCC" (is ?B) +proof - + let ?F = "\(funs_term ` FP)" + let ?G = "Abs ` snd ` TI" + + show ?A + proof (intro ballI impI) + fix t f assume t: "t \ timpl_closure_set FP TI" and f: "f \ funs_term t" "is_Abs f" + hence "f \ ?F \ f \ ?G" using timpl_closure_set_funs_term_subset[of FP TI] by auto + thus "f \ Abs ` OCC" + proof + assume "f \ ?F" thus ?thesis using OCC1 f(2) by fast + next + assume "f \ ?G" thus ?thesis using OCC2 by auto + qed + qed + + { fix s t a b + assume t: "t \ absc ` OCC" + and ab: "(a, b) \ TI" + and s: "s \ set \a --\ b\\t\" + obtain c where c: "t = absc c" "c \ OCC" using t by moura + hence "s = absc b \ s = absc c" + using ab s timpl_apply_const'[of c a b] unfolding absc_def by auto + moreover have "b \ OCC" using ab OCC2 by auto + ultimately have "s \ absc ` OCC" using c(2) by blast + } thus ?B by blast +qed + +lemma (in stateful_protocol_model) intruder_synth_timpl_closure_set: + fixes M::"('fun,'atom,'sets) prot_terms" and t::"('fun,'atom,'sets) prot_term" + assumes "M \\<^sub>c t" + and "s \ timpl_closure t TI" + shows "timpl_closure_set M TI \\<^sub>c s" +using assms +proof (induction t arbitrary: s rule: intruder_synth_induct) + case (AxiomC t) + hence "s \ timpl_closure_set M TI" + using timpl_closure_set_is_timpl_closure_union[of M TI] + by blast + thus ?case by simp +next + case (ComposeC T f) + obtain g S where s: "s = Fun g S" + using timpl_closure_Fun_inv[OF ComposeC.prems] by moura + hence s': + "f = g" "length S = length T" + "\i. i < length S \ S ! i \ timpl_closure (T ! i) TI" + using timpl_closure_Fun_inv'[of g S f T TI] ComposeC.prems ComposeC.hyps(2) + unfolding is_Abs_def by fastforce+ + + have "timpl_closure_set M TI \\<^sub>c u" when u: "u \ set S" for u + using ComposeC.IH u s'(2,3) in_set_conv_nth[of _ T] in_set_conv_nth[of u S] by auto + thus ?case + using s s'(1,2) ComposeC.hyps(1,2) intruder_synth.ComposeC[of S g "timpl_closure_set M TI"] + by argo +qed + +lemma (in stateful_protocol_model) intruder_synth_timpl_closure': + fixes M::"('fun,'atom,'sets) prot_terms" and t::"('fun,'atom,'sets) prot_term" + assumes "timpl_closure_set M TI \\<^sub>c t" + and "s \ timpl_closure t TI" + shows "timpl_closure_set M TI \\<^sub>c s" +by (metis intruder_synth_timpl_closure_set[OF assms] timpl_closure_set_idem) + +lemma timpl_closure_set_absc_subset_in: + defines "absc \ \a. Fun (Abs a) []" + assumes A: "timpl_closure_set (absc ` A) TI \ absc ` A" + and a: "a \ A" "(a,b) \ TI\<^sup>+" + shows "b \ A" +proof - + have "timpl_closure (absc a) (TI\<^sup>+) \ absc ` A" + using a(1) A timpl_closure_timpls_trancl_eq + unfolding timpl_closure_set_def by fast + thus ?thesis + using timpl_closure.TI[OF timpl_closure.FP[of "absc a"] a(2), of "absc b"] + term_variants_P[of "[]" "[]" "(\_. [])(Abs a := [Abs b])" "Abs b" "Abs a"] + unfolding absc_def by auto +qed + + +subsection \Composition-only Intruder Deduction Modulo Term Implication Closure of the Intruder Knowledge\ +context stateful_protocol_model +begin + +fun in_trancl where + "in_trancl TI a b = ( + if (a,b) \ set TI then True + else list_ex (\(c,d). c = a \ in_trancl (removeAll (c,d) TI) d b) TI)" + +definition in_rtrancl where + "in_rtrancl TI a b \ a = b \ in_trancl TI a b" + +declare in_trancl.simps[simp del] + +fun timpls_transformable_to where + "timpls_transformable_to TI (Var x) (Var y) = (x = y)" +| "timpls_transformable_to TI (Fun f T) (Fun g S) = ( + (f = g \ (is_Abs f \ is_Abs g \ (the_Abs f, the_Abs g) \ set TI)) \ + list_all2 (timpls_transformable_to TI) T S)" +| "timpls_transformable_to _ _ _ = False" + +fun timpls_transformable_to' where + "timpls_transformable_to' TI (Var x) (Var y) = (x = y)" +| "timpls_transformable_to' TI (Fun f T) (Fun g S) = ( + (f = g \ (is_Abs f \ is_Abs g \ in_trancl TI (the_Abs f) (the_Abs g))) \ + list_all2 (timpls_transformable_to' TI) T S)" +| "timpls_transformable_to' _ _ _ = False" + +fun equal_mod_timpls where + "equal_mod_timpls TI (Var x) (Var y) = (x = y)" +| "equal_mod_timpls TI (Fun f T) (Fun g S) = ( + (f = g \ (is_Abs f \ is_Abs g \ + ((the_Abs f, the_Abs g) \ set TI \ + (the_Abs g, the_Abs f) \ set TI \ + (\ti \ set TI. (the_Abs f, snd ti) \ set TI \ (the_Abs g, snd ti) \ set TI)))) \ + list_all2 (equal_mod_timpls TI) T S)" +| "equal_mod_timpls _ _ _ = False" + +fun intruder_synth_mod_timpls where + "intruder_synth_mod_timpls M TI (Var x) = List.member M (Var x)" +| "intruder_synth_mod_timpls M TI (Fun f T) = ( + (list_ex (\t. timpls_transformable_to TI t (Fun f T)) M) \ + (public f \ length T = arity f \ list_all (intruder_synth_mod_timpls M TI) T))" + +fun intruder_synth_mod_timpls' where + "intruder_synth_mod_timpls' M TI (Var x) = List.member M (Var x)" +| "intruder_synth_mod_timpls' M TI (Fun f T) = ( + (list_ex (\t. timpls_transformable_to' TI t (Fun f T)) M) \ + (public f \ length T = arity f \ list_all (intruder_synth_mod_timpls' M TI) T))" + +fun intruder_synth_mod_eq_timpls where + "intruder_synth_mod_eq_timpls M TI (Var x) = (Var x \ M)" +| "intruder_synth_mod_eq_timpls M TI (Fun f T) = ( + (\t \ M. equal_mod_timpls TI t (Fun f T)) \ + (public f \ length T = arity f \ list_all (intruder_synth_mod_eq_timpls M TI) T))" + +definition analyzed_closed_mod_timpls where + "analyzed_closed_mod_timpls M TI \ + let f = list_all (intruder_synth_mod_timpls M TI); + g = \t. if f (fst (Ana t)) then f (snd (Ana t)) + else \s \ comp_timpl_closure {t} (set TI). case Ana s of (K,R) \ f K \ f R + in list_all g M" + +definition analyzed_closed_mod_timpls' where + "analyzed_closed_mod_timpls' M TI \ + let f = list_all (intruder_synth_mod_timpls' M TI); + g = \t. if f (fst (Ana t)) then f (snd (Ana t)) + else \s \ comp_timpl_closure {t} (set TI). case Ana s of (K,R) \ f K \ f R + in list_all g M" +(* Alternative definition (allows for computing the closures beforehand which may be useful) *) +definition analyzed_closed_mod_timpls_alt where + "analyzed_closed_mod_timpls_alt M TI timpl_cl_witness \ + let f = \R. \r \ set R. intruder_synth_mod_timpls M TI r; + N = {t \ set M. f (fst (Ana t))}; + N' = set M - N + in (\t \ N. f (snd (Ana t))) \ + (N' \ {} \ (N' \ (\x\timpl_cl_witness. \(a,b)\set TI. set \a --\ b\\x\) \ timpl_cl_witness)) \ + (\s \ timpl_cl_witness. case Ana s of (K,R) \ f K \ f R)" + +lemma in_trancl_closure_iff_in_trancl_fun: + "(a,b) \ (set TI)\<^sup>+ \ in_trancl TI a b" (is "?A TI a b \ ?B TI a b") +proof + show "?A TI a b \ ?B TI a b" + proof (induction rule: trancl_induct) + case (step c d) + show ?case using step.IH step.hyps(2) + proof (induction TI a c rule: in_trancl.induct) + case (1 TI a b) thus ?case using in_trancl.simps + by (smt Bex_set case_prodE case_prodI member_remove prod.sel(2) remove_code(1)) + qed + qed (metis in_trancl.simps) + + show "?B TI a b \ ?A TI a b" + proof (induction TI a b rule: in_trancl.induct) + case (1 TI a b) + let ?P = "\TI a b c d. in_trancl (List.removeAll (c,d) TI) d b" + have *: "\(c,d) \ set TI. c = a \ ?P TI a b c d" when "(a,b) \ set TI" + using that "1.prems" list_ex_iff[of _ TI] in_trancl.simps[of TI a b] + by auto + show ?case + proof (cases "(a,b) \ set TI") + case False + hence "\(c,d) \ set TI. c = a \ ?P TI a b c d" using * by blast + then obtain d where d: "(a,d) \ set TI" "?P TI a b a d" by blast + have "(d,b) \ (set (removeAll (a,d) TI))\<^sup>+" using "1.IH"[OF False d(1)] d(2) by blast + moreover have "set (removeAll (a,d) TI) \ set TI" by simp + ultimately have "(d,b) \ (set TI)\<^sup>+" using trancl_mono by blast + thus ?thesis using d(1) by fastforce + qed simp + qed +qed + +lemma in_rtrancl_closure_iff_in_rtrancl_fun: + "(a,b) \ (set TI)\<^sup>* \ in_rtrancl TI a b" +by (metis rtrancl_eq_or_trancl in_trancl_closure_iff_in_trancl_fun in_rtrancl_def) + +lemma in_trancl_mono: + assumes "set TI \ set TI'" + and "in_trancl TI a b" + shows "in_trancl TI' a b" +by (metis assms in_trancl_closure_iff_in_trancl_fun trancl_mono) + +lemma equal_mod_timpls_refl: + "equal_mod_timpls TI t t" +proof (induction t) + case (Fun f T) thus ?case + using list_all2_conv_all_nth[of "equal_mod_timpls TI" T T] by force +qed simp + +lemma equal_mod_timpls_inv_Var: + "equal_mod_timpls TI (Var x) t \ t = Var x" (is "?A \ ?C") + "equal_mod_timpls TI t (Var x) \ t = Var x" (is "?B \ ?C") +proof - + show "?A \ ?C" by (cases t) auto + show "?B \ ?C" by (cases t) auto +qed + +lemma equal_mod_timpls_inv: + assumes "equal_mod_timpls TI (Fun f T) (Fun g S)" + shows "length T = length S" + and "\i. i < length T \ equal_mod_timpls TI (T ! i) (S ! i)" + and "f \ g \ (is_Abs f \ is_Abs g \ ( + (the_Abs f, the_Abs g) \ set TI \ (the_Abs g, the_Abs f) \ set TI \ + (\ti \ set TI. (the_Abs f, snd ti) \ set TI \ + (the_Abs g, snd ti) \ set TI)))" +using assms list_all2_conv_all_nth[of "equal_mod_timpls TI" T S] +by (auto elim: equal_mod_timpls.cases) + +lemma equal_mod_timpls_inv': + assumes "equal_mod_timpls TI (Fun f T) t" + shows "is_Fun t" + and "length T = length (args t)" + and "\i. i < length T \ equal_mod_timpls TI (T ! i) (args t ! i)" + and "f \ the_Fun t \ (is_Abs f \ is_Abs (the_Fun t) \ ( + (the_Abs f, the_Abs (the_Fun t)) \ set TI \ + (the_Abs (the_Fun t), the_Abs f) \ set TI \ + (\ti \ set TI. (the_Abs f, snd ti) \ set TI \ + (the_Abs (the_Fun t), snd ti) \ set TI)))" + and "\is_Abs f \ f = the_Fun t" +using assms list_all2_conv_all_nth[of "equal_mod_timpls TI" T] +by (cases t; auto)+ + +lemma equal_mod_timpls_if_term_variants: + fixes s t::"(('a, 'b, 'c) prot_fun, 'd) term" and a b::"'c set" + defines "P \ (\_. [])(Abs a := [Abs b])" + assumes st: "term_variants_pred P s t" + and ab: "(a,b) \ set TI" + shows "equal_mod_timpls TI s t" +using st P_def +proof (induction rule: term_variants_pred.induct) + case (term_variants_P T S f) thus ?case + using ab list_all2_conv_all_nth[of "equal_mod_timpls TI" T S] + in_trancl_closure_iff_in_trancl_fun[of _ _ TI] + by auto +next + case (term_variants_Fun T S f) thus ?case + using ab list_all2_conv_all_nth[of "equal_mod_timpls TI" T S] + in_trancl_closure_iff_in_trancl_fun[of _ _ TI] + by auto +qed simp + +lemma equal_mod_timpls_mono: + assumes "set TI \ set TI'" + and "equal_mod_timpls TI s t" + shows "equal_mod_timpls TI' s t" + using assms +proof (induction TI s t rule: equal_mod_timpls.induct) + case (2 TI f T g S) + have *: "f = g \ (is_Abs f \ is_Abs g \ ((the_Abs f, the_Abs g) \ set TI \ + (the_Abs g, the_Abs f) \ set TI \ + (\ti \ set TI. (the_Abs f, snd ti) \ set TI \ + (the_Abs g, snd ti) \ set TI)))" + "list_all2 (equal_mod_timpls TI) T S" + using "2.prems" by simp_all + + show ?case + using "2.IH" "2.prems"(1) list.rel_mono_strong[OF *(2)] *(1) in_trancl_mono[of TI TI'] + by (metis (no_types, lifting) equal_mod_timpls.simps(2) set_rev_mp) +qed auto + +lemma equal_mod_timpls_refl_minus_eq: + "equal_mod_timpls TI s t \ equal_mod_timpls (filter (\(a,b). a \ b) TI) s t" + (is "?A \ ?B") +proof + show ?A when ?B using that equal_mod_timpls_mono[of "filter (\(a,b). a \ b) TI" TI] by auto + + show ?B when ?A using that + proof (induction TI s t rule: equal_mod_timpls.induct) + case (2 TI f T g S) + define TI' where "TI' \ filter (\(a,b). a \ b) TI" + + let ?P = "\X Y. f = g \ (is_Abs f \ is_Abs g \ ((the_Abs f, the_Abs g) \ set X \ + (the_Abs g, the_Abs f) \ set X \ (\ti \ set Y. + (the_Abs f, snd ti) \ set X \ (the_Abs g, snd ti) \ set X)))" + + have *: "?P TI TI" "list_all2 (equal_mod_timpls TI) T S" + using "2.prems" by simp_all + + have "?P TI' TI" + using *(1) unfolding TI'_def is_Abs_def by auto + hence "?P TI' TI'" + by (metis (no_types, lifting) snd_conv) + moreover have "list_all2 (equal_mod_timpls TI') T S" + using *(2) "2.IH" list.rel_mono_strong unfolding TI'_def by blast + ultimately show ?case unfolding TI'_def by force + qed auto +qed + +lemma timpls_transformable_to_refl: + "timpls_transformable_to TI t t" (is ?A) + "timpls_transformable_to' TI t t" (is ?B) +by (induct t) (auto simp add: list_all2_conv_all_nth) + +lemma timpls_transformable_to_inv_Var: + "timpls_transformable_to TI (Var x) t \ t = Var x" (is "?A \ ?C") + "timpls_transformable_to TI t (Var x) \ t = Var x" (is "?B \ ?C") + "timpls_transformable_to' TI (Var x) t \ t = Var x" (is "?A' \ ?C") + "timpls_transformable_to' TI t (Var x) \ t = Var x" (is "?B' \ ?C") +by (cases t; auto)+ + +lemma timpls_transformable_to_inv: + assumes "timpls_transformable_to TI (Fun f T) (Fun g S)" + shows "length T = length S" + and "\i. i < length T \ timpls_transformable_to TI (T ! i) (S ! i)" + and "f \ g \ (is_Abs f \ is_Abs g \ (the_Abs f, the_Abs g) \ set TI)" +using assms list_all2_conv_all_nth[of "timpls_transformable_to TI" T S] by auto + +lemma timpls_transformable_to'_inv: + assumes "timpls_transformable_to' TI (Fun f T) (Fun g S)" + shows "length T = length S" + and "\i. i < length T \ timpls_transformable_to' TI (T ! i) (S ! i)" + and "f \ g \ (is_Abs f \ is_Abs g \ in_trancl TI (the_Abs f) (the_Abs g))" +using assms list_all2_conv_all_nth[of "timpls_transformable_to' TI" T S] by auto + +lemma timpls_transformable_to_inv': + assumes "timpls_transformable_to TI (Fun f T) t" + shows "is_Fun t" + and "length T = length (args t)" + and "\i. i < length T \ timpls_transformable_to TI (T ! i) (args t ! i)" + and "f \ the_Fun t \ ( + is_Abs f \ is_Abs (the_Fun t) \ (the_Abs f, the_Abs (the_Fun t)) \ set TI)" + and "\is_Abs f \ f = the_Fun t" +using assms list_all2_conv_all_nth[of "timpls_transformable_to TI" T] +by (cases t; auto)+ + +lemma timpls_transformable_to'_inv': + assumes "timpls_transformable_to' TI (Fun f T) t" + shows "is_Fun t" + and "length T = length (args t)" + and "\i. i < length T \ timpls_transformable_to' TI (T ! i) (args t ! i)" + and "f \ the_Fun t \ ( + is_Abs f \ is_Abs (the_Fun t) \ in_trancl TI (the_Abs f) (the_Abs (the_Fun t)))" + and "\is_Abs f \ f = the_Fun t" +using assms list_all2_conv_all_nth[of "timpls_transformable_to' TI" T] +by (cases t; auto)+ + +lemma timpls_transformable_to_size_eq: + fixes s t::"(('b, 'c, 'a) prot_fun, 'd) term" + shows "timpls_transformable_to TI s t \ size s = size t" (is "?A \ ?C") + and "timpls_transformable_to' TI s t \ size s = size t" (is "?B \ ?C") +proof - + have *: "size_list size T = size_list size S" + when "length T = length S" "\i. i < length T \ size (T ! i) = size (S ! i)" + for S T::"(('b, 'c, 'a) prot_fun, 'd) term list" + using that + proof (induction T arbitrary: S) + case (Cons x T') + then obtain y S' where y: "S = y#S'" by (cases S) auto + hence "size_list size T' = size_list size S'" "size x = size y" + using Cons.prems Cons.IH[of S'] by force+ + thus ?case using y by simp + qed simp + + show ?C when ?A using that + proof (induction rule: timpls_transformable_to.induct) + case (2 TI f T g S) + hence "length T = length S" "\i. i < length T \ size (T ! i) = size (S ! i)" + using timpls_transformable_to_inv(1,2)[of TI f T g S] by auto + thus ?case using *[of S T] by simp + qed simp_all + + show ?C when ?B using that + proof (induction rule: timpls_transformable_to.induct) + case (2 TI f T g S) + hence "length T = length S" "\i. i < length T \ size (T ! i) = size (S ! i)" + using timpls_transformable_to'_inv(1,2)[of TI f T g S] by auto + thus ?case using *[of S T] by simp + qed simp_all +qed + +lemma timpls_transformable_to_if_term_variants: + fixes s t::"(('a, 'b, 'c) prot_fun, 'd) term" and a b::"'c set" + defines "P \ (\_. [])(Abs a := [Abs b])" + assumes st: "term_variants_pred P s t" + and ab: "(a,b) \ set TI" + shows "timpls_transformable_to TI s t" +using st P_def +proof (induction rule: term_variants_pred.induct) + case (term_variants_P T S f) thus ?case + using ab list_all2_conv_all_nth[of "timpls_transformable_to TI" T S] + by auto +next + case (term_variants_Fun T S f) thus ?case + using ab list_all2_conv_all_nth[of "timpls_transformable_to TI" T S] + by auto +qed simp + +lemma timpls_transformable_to'_if_term_variants: + fixes s t::"(('a, 'b, 'c) prot_fun, 'd) term" and a b::"'c set" + defines "P \ (\_. [])(Abs a := [Abs b])" + assumes st: "term_variants_pred P s t" + and ab: "(a,b) \ (set TI)\<^sup>+" + shows "timpls_transformable_to' TI s t" +using st P_def +proof (induction rule: term_variants_pred.induct) + case (term_variants_P T S f) thus ?case + using ab list_all2_conv_all_nth[of "timpls_transformable_to' TI" T S] + in_trancl_closure_iff_in_trancl_fun[of _ _ TI] + by auto +next + case (term_variants_Fun T S f) thus ?case + using ab list_all2_conv_all_nth[of "timpls_transformable_to' TI" T S] + in_trancl_closure_iff_in_trancl_fun[of _ _ TI] + by auto +qed simp + +lemma timpls_transformable_to_trans: + assumes TI_trancl: "\(a,b) \ (set TI)\<^sup>+. a \ b \ (a,b) \ set TI" + and st: "timpls_transformable_to TI s t" + and tu: "timpls_transformable_to TI t u" + shows "timpls_transformable_to TI s u" +using st tu +proof (induction s arbitrary: t u) + case (Var x) thus ?case using tu timpls_transformable_to_inv_Var(1) by fast +next + case (Fun f T) + obtain g S where t: + "t = Fun g S" "length T = length S" + "\i. i < length T \ timpls_transformable_to TI (T ! i) (S ! i)" + "f \ g \ is_Abs f \ is_Abs g \ (the_Abs f, the_Abs g) \ set TI" + using timpls_transformable_to_inv'[OF Fun.prems(1)] TI_trancl by moura + + obtain h U where u: + "u = Fun h U" "length S = length U" + "\i. i < length S \ timpls_transformable_to TI (S ! i) (U ! i)" + "g \ h \ is_Abs g \ is_Abs h \ (the_Abs g, the_Abs h) \ set TI" + using timpls_transformable_to_inv'[OF Fun.prems(2)[unfolded t(1)]] TI_trancl by moura + + have "list_all2 (timpls_transformable_to TI) T U" + using t(1,2,3) u(1,2,3) Fun.IH + list_all2_conv_all_nth[of "timpls_transformable_to TI" T S] + list_all2_conv_all_nth[of "timpls_transformable_to TI" S U] + list_all2_conv_all_nth[of "timpls_transformable_to TI" T U] + by force + moreover have "(the_Abs f, the_Abs h) \ set TI" + when "(the_Abs f, the_Abs g) \ set TI" "(the_Abs g, the_Abs h) \ set TI" + "f \ h" "is_Abs f" "is_Abs h" + using that(3,4,5) TI_trancl trancl_into_trancl[OF r_into_trancl[OF that(1)] that(2)] + unfolding is_Abs_def the_Abs_def + by force + hence "is_Abs f \ is_Abs h \ (the_Abs f, the_Abs h) \ set TI" + when "f \ h" + using that TI_trancl t(4) u(4) by fast + ultimately show ?case using t(1) u(1) by force +qed + +lemma timpls_transformable_to'_trans: + assumes st: "timpls_transformable_to' TI s t" + and tu: "timpls_transformable_to' TI t u" + shows "timpls_transformable_to' TI s u" +using st tu +proof (induction s arbitrary: t u) + case (Var x) thus ?case using tu timpls_transformable_to_inv_Var(3) by fast +next + case (Fun f T) + note 0 = in_trancl_closure_iff_in_trancl_fun[of _ _ TI] + + obtain g S where t: + "t = Fun g S" "length T = length S" + "\i. i < length T \ timpls_transformable_to' TI (T ! i) (S ! i)" + "f \ g \ is_Abs f \ is_Abs g \ (the_Abs f, the_Abs g) \ (set TI)\<^sup>+" + using timpls_transformable_to'_inv'[OF Fun.prems(1)] 0 by moura + + obtain h U where u: + "u = Fun h U" "length S = length U" + "\i. i < length S \ timpls_transformable_to' TI (S ! i) (U ! i)" + "g \ h \ is_Abs g \ is_Abs h \ (the_Abs g, the_Abs h) \ (set TI)\<^sup>+" + using timpls_transformable_to'_inv'[OF Fun.prems(2)[unfolded t(1)]] 0 by moura + + have "list_all2 (timpls_transformable_to' TI) T U" + using t(1,2,3) u(1,2,3) Fun.IH + list_all2_conv_all_nth[of "timpls_transformable_to' TI" T S] + list_all2_conv_all_nth[of "timpls_transformable_to' TI" S U] + list_all2_conv_all_nth[of "timpls_transformable_to' TI" T U] + by force + moreover have "(the_Abs f, the_Abs h) \ (set TI)\<^sup>+" + when "(the_Abs f, the_Abs g) \ (set TI)\<^sup>+" "(the_Abs g, the_Abs h) \ (set TI)\<^sup>+" + using that by simp + hence "is_Abs f \ is_Abs h \ (the_Abs f, the_Abs h) \ (set TI)\<^sup>+" + when "f \ h" + by (metis that t(4) u(4)) + ultimately show ?case using t(1) u(1) 0 by force +qed + +lemma timpls_transformable_to_mono: + assumes "set TI \ set TI'" + and "timpls_transformable_to TI s t" + shows "timpls_transformable_to TI' s t" + using assms +proof (induction TI s t rule: timpls_transformable_to.induct) + case (2 TI f T g S) + have *: "f = g \ (is_Abs f \ is_Abs g \ (the_Abs f, the_Abs g) \ set TI)" + "list_all2 (timpls_transformable_to TI) T S" + using "2.prems" by simp_all + + show ?case + using "2.IH" "2.prems"(1) list.rel_mono_strong[OF *(2)] *(1) in_trancl_mono[of TI TI'] + by (metis (no_types, lifting) timpls_transformable_to.simps(2) set_rev_mp) +qed auto + +lemma timpls_transformable_to'_mono: + assumes "set TI \ set TI'" + and "timpls_transformable_to' TI s t" + shows "timpls_transformable_to' TI' s t" + using assms +proof (induction TI s t rule: timpls_transformable_to'.induct) + case (2 TI f T g S) + have *: "f = g \ (is_Abs f \ is_Abs g \ in_trancl TI (the_Abs f) (the_Abs g))" + "list_all2 (timpls_transformable_to' TI) T S" + using "2.prems" by simp_all + + show ?case + using "2.IH" "2.prems"(1) list.rel_mono_strong[OF *(2)] *(1) in_trancl_mono[of TI TI'] + by (metis (no_types, lifting) timpls_transformable_to'.simps(2)) +qed auto + +lemma timpls_transformable_to_refl_minus_eq: + "timpls_transformable_to TI s t \ timpls_transformable_to (filter (\(a,b). a \ b) TI) s t" + (is "?A \ ?B") +proof + let ?TI' = "\TI. filter (\(a,b). a \ b) TI" + + show ?A when ?B using that timpls_transformable_to_mono[of "?TI' TI" TI] by auto + + show ?B when ?A using that + proof (induction TI s t rule: timpls_transformable_to.induct) + case (2 TI f T g S) + have *: "f = g \ (is_Abs f \ is_Abs g \ (the_Abs f, the_Abs g) \ set TI)" + "list_all2 (timpls_transformable_to TI) T S" + using "2.prems" by simp_all + + have "f = g \ (is_Abs f \ is_Abs g \ (the_Abs f, the_Abs g) \ set (?TI' TI))" + using *(1) unfolding is_Abs_def by auto + moreover have "list_all2 (timpls_transformable_to (?TI' TI)) T S" + using *(2) "2.IH" list.rel_mono_strong by blast + ultimately show ?case by force + qed auto +qed + +lemma timpls_transformable_to_iff_in_timpl_closure: + assumes "set TI' = {(a,b) \ (set TI)\<^sup>+. a \ b}" + shows "timpls_transformable_to TI' s t \ t \ timpl_closure s (set TI)" (is "?A s t \ ?B s t") +proof + show "?A s t \ ?B s t" using assms + proof (induction s t rule: timpls_transformable_to.induct) + case (2 TI f T g S) + note prems = "2.prems" + note IH = "2.IH" + + have 1: "length T = length S" "\i timpl_closure' (set TI')" when i: "i < length S" for i + proof - + have "timpls_transformable_to TI' (T ! i) (S ! i)" using i 1 by presburger + hence "S ! i \ timpl_closure (T ! i) (set TI)" + using IH[of "T ! i" "S ! i"] i 1(1) prems(2) by force + thus ?thesis using 2[of "S ! i" "T ! i" "set TI"] 4 by blast + qed + + have 5: "f = g \ (\a b. (a, b) \ (set TI')\<^sup>+ \ f = Abs a \ g = Abs b)" + using prems(1) the_Abs_def[of f] the_Abs_def[of g] is_Abs_def[of f] is_Abs_def[of g] + by fastforce + + show ?case using 2 4 timpl_closure_FunI[OF IH' 1(1) 5] 1(1) by auto + qed (simp_all add: timpl_closure.FP) + + show "?B s t \ ?A s t" + proof (induction t rule: timpl_closure.induct) + case (TI u a b v) show ?case + proof (cases "a = b") + case True thus ?thesis using TI.hyps(3) TI.IH term_variants_pred_refl_inv by fastforce + next + case False + hence 1: "timpls_transformable_to TI' u v" + using TI.hyps(2) assms timpls_transformable_to_if_term_variants[OF TI.hyps(3), of TI'] + by blast + have 2: "(c,d) \ set TI'" when cd: "(c,d) \ (set TI')\<^sup>+" "c \ d" for c d + proof - + let ?cl = "\X. {(a,b) \ X\<^sup>+. a \ b}" + have "?cl (set TI') = ?cl (?cl (set TI))" using assms by presburger + hence "set TI' = ?cl (set TI')" using assms trancl_minus_refl_idem[of "set TI"] by argo + thus ?thesis using cd by blast + qed + show ?thesis using timpls_transformable_to_trans[OF _ TI.IH 1] 2 by blast + qed + qed (use timpls_transformable_to_refl in fast) +qed + +lemma timpls_transformable_to'_iff_in_timpl_closure: + "timpls_transformable_to' TI s t \ t \ timpl_closure s (set TI)" (is "?A s t \ ?B s t") +proof + show "?A s t \ ?B s t" + proof (induction s t rule: timpls_transformable_to'.induct) + case (2 TI f T g S) + note prems = "2.prems" + note IH = "2.IH" + + have 1: "length T = length S" "\i timpl_closure' (set TI)" when i: "i < length S" for i + proof - + have "timpls_transformable_to' TI (T ! i) (S ! i)" using i 1 by presburger + hence "S ! i \ timpl_closure (T ! i) (set TI)" using IH[of "T ! i" "S ! i"] i 1(1) by force + thus ?thesis using 2[of "S ! i" "T ! i" "set TI"] by blast + qed + + have 4: "f = g \ (\a b. (a, b) \ (set TI)\<^sup>+ \ f = Abs a \ g = Abs b)" + using prems the_Abs_def[of f] the_Abs_def[of g] is_Abs_def[of f] is_Abs_def[of g] + in_trancl_closure_iff_in_trancl_fun[of _ _ TI] + by auto + + show ?case using 2 timpl_closure_FunI[OF IH' 1(1) 4] 1(1) by auto + qed (simp_all add: timpl_closure.FP) + + show "?B s t \ ?A s t" + proof (induction t rule: timpl_closure.induct) + case (TI u a b v) thus ?case + using timpls_transformable_to'_trans + timpls_transformable_to'_if_term_variants + by blast + qed (use timpls_transformable_to_refl(2) in fast) +qed + +lemma equal_mod_timpls_iff_ex_in_timpl_closure: + assumes "set TI' = {(a,b) \ TI\<^sup>+. a \ b}" + shows "equal_mod_timpls TI' s t \ (\u. u \ timpl_closure s TI \ u \ timpl_closure t TI)" + (is "?A s t \ ?B s t") +proof + show "?A s t \ ?B s t" using assms + proof (induction s t rule: equal_mod_timpls.induct) + case (2 TI' f T g S) + note prems = "2.prems" + note IH = "2.IH" + + have 1: "length T = length S" "\iu. (T ! i, u) \ timpl_closure' TI \ (S ! i, u) \ timpl_closure' TI" + when i: "i < length S" for i + proof - + have "equal_mod_timpls TI' (T ! i) (S ! i)" using i 1 by presburger + hence "\u. u \ timpl_closure (T ! i) TI \ u \ timpl_closure (S ! i) TI" + using IH[of "T ! i" "S ! i"] i 1(1) prems by force + thus ?thesis using 4 unfolding 2 by blast + qed + + let ?P = "\G. f = g \ (\a b. (a, b) \ G \ f = Abs a \ g = Abs b) \ + (\a b. (a, b) \ G \ f = Abs b \ g = Abs a) \ + (\a b c. (a, c) \ G \ (b, c) \ G \ f = Abs a \ g = Abs b)" + + have "?P (set TI')" + using prems the_Abs_def[of f] the_Abs_def[of g] is_Abs_def[of f] is_Abs_def[of g] + by fastforce + hence "?P (TI\<^sup>+)" unfolding prems by blast + hence "?P (rtrancl TI)" by (metis (no_types, lifting) trancl_into_rtrancl) + hence 5: "f = g \ (\a b c. (a, c) \ TI\<^sup>* \ (b, c) \ TI\<^sup>* \ f = Abs a \ g = Abs b)" by blast + + show ?case + using timpl_closure_FunI3[OF _ 1(1) 5] IH 1(1) + unfolding timpl_closure'_timpls_rtrancl_eq 2 + by auto + qed (use timpl_closure.FP in auto) + + show "?A s t" when B: "?B s t" + proof - + obtain u where u: "u \ timpl_closure s TI" "u \ timpl_closure t TI" + using B by moura + thus ?thesis using assms + proof (induction u arbitrary: s t rule: term.induct) + case (Var x s t) thus ?case + using timpl_closure_Var_in_iff[of x s TI] + timpl_closure_Var_in_iff[of x t TI] + equal_mod_timpls.simps(1)[of TI' x x] + by blast + next + case (Fun f U s t) + obtain g S where s: + "s = Fun g S" "length U = length S" + "\i. i < length U \ U ! i \ timpl_closure (S ! i) TI" + "g \ f \ is_Abs g \ is_Abs f \ (the_Abs g, the_Abs f) \ TI\<^sup>+" + using Fun.prems(1) timpl_closure_Fun_inv'[of f U _ _ TI] + by (cases s) auto + + obtain h T where t: + "t = Fun h T" "length U = length T" + "\i. i < length U \ U ! i \ timpl_closure (T ! i) TI" + "h \ f \ is_Abs h \ is_Abs f \ (the_Abs h, the_Abs f) \ TI\<^sup>+" + using Fun.prems(2) timpl_closure_Fun_inv'[of f U _ _ TI] + by (cases t) auto + + have g: "(the_Abs g, the_Abs f) \ set TI'" "is_Abs f" "is_Abs g" when neq_f: "g \ f" + proof - + obtain ga fa where a: "g = Abs ga" "f = Abs fa" + using s(4)[OF neq_f] unfolding is_Abs_def by presburger + hence "the_Abs g \ the_Abs f" using neq_f by simp + thus "(the_Abs g, the_Abs f) \ set TI'" "is_Abs f" "is_Abs g" + using s(4)[OF neq_f] Fun.prems by blast+ + qed + + have h: "(the_Abs h, the_Abs f) \ set TI'" "is_Abs f" "is_Abs h" when neq_f: "h \ f" + proof - + obtain ha fa where a: "h = Abs ha" "f = Abs fa" + using t(4)[OF neq_f] unfolding is_Abs_def by presburger + hence "the_Abs h \ the_Abs f" using neq_f by simp + thus "(the_Abs h, the_Abs f) \ set TI'" "is_Abs f" "is_Abs h" + using t(4)[OF neq_f] Fun.prems by blast+ + qed + + have "equal_mod_timpls TI' (S ! i) (T ! i)" + when i: "i < length U" for i + using i Fun.IH s(1,2,3) t(1,2,3) nth_mem[OF i] Fun.prems by meson + hence "list_all2 (equal_mod_timpls TI') S T" + using list_all2_conv_all_nth[of "equal_mod_timpls TI'" S T] s(2) t(2) by presburger + thus ?case using s(1) t(1) g h by fastforce + qed + qed +qed + +(* lemma equal_mod_timpls_iff_ex_in_timpl_closure': + "equal_mod_timpls (TI\<^sup>+) s t \ (\u. u \ timpl_closure s TI \ u \ timpl_closure t TI)" +using equal_mod_timpls_iff_ex_in_timpl_closure equal_mod_timpls_refl_minus_eq +by blast *) + +context +begin +private inductive timpls_transformable_to_pred where + Var: "timpls_transformable_to_pred A (Var x) (Var x)" +| Fun: "\\is_Abs f; length T = length S; + \i. i < length T \ timpls_transformable_to_pred A (T ! i) (S ! i)\ + \ timpls_transformable_to_pred A (Fun f T) (Fun f S)" +| Abs: "b \ A \ timpls_transformable_to_pred A (Fun (Abs a) []) (Fun (Abs b) [])" + +private lemma timpls_transformable_to_pred_inv_Var: + assumes "timpls_transformable_to_pred A (Var x) t" + shows "t = Var x" +using assms by (auto elim: timpls_transformable_to_pred.cases) + +private lemma timpls_transformable_to_pred_inv: + assumes "timpls_transformable_to_pred A (Fun f T) t" + shows "is_Fun t" + and "length T = length (args t)" + and "\i. i < length T \ timpls_transformable_to_pred A (T ! i) (args t ! i)" + and "\is_Abs f \ f = the_Fun t" + and "is_Abs f \ (is_Abs (the_Fun t) \ the_Abs (the_Fun t) \ A)" +using assms by (auto elim!: timpls_transformable_to_pred.cases[of A]) + +private lemma timpls_transformable_to_pred_finite_aux1: + assumes f: "\is_Abs f" + shows "{s. timpls_transformable_to_pred A (Fun f T) s} \ + (\S. Fun f S) ` {S. length T = length S \ + (\s \ set S. \t \ set T. timpls_transformable_to_pred A t s)}" + (is "?B \ ?C") +proof + fix s assume s: "s \ ?B" + hence *: "timpls_transformable_to_pred A (Fun f T) s" by blast + + obtain S where S: + "s = Fun f S" "length T = length S" "\i. i < length T \ timpls_transformable_to_pred A (T ! i) (S ! i)" + using f timpls_transformable_to_pred_inv[OF *] unfolding the_Abs_def is_Abs_def by auto + + have "\s\set S. \t\set T. timpls_transformable_to_pred A t s" using S(2,3) in_set_conv_nth by metis + thus "s \ ?C" using S(1,2) by blast +qed + +private lemma timpls_transformable_to_pred_finite_aux2: + "{s. timpls_transformable_to_pred A (Fun (Abs a) []) s} \ (\b. Fun (Abs b) []) ` A" (is "?B \ ?C") +proof + fix s assume s: "s \ ?B" + hence *: "timpls_transformable_to_pred A (Fun (Abs a) []) s" by blast + + obtain b where b: "s = Fun (Abs b) []" "b \ A" + using timpls_transformable_to_pred_inv[OF *] unfolding the_Abs_def is_Abs_def by auto + thus "s \ ?C" by blast +qed + +private lemma timpls_transformable_to_pred_finite: + fixes t::"(('fun,'atom,'sets) prot_fun, 'a) term" + assumes A: "finite A" + and t: "wf\<^sub>t\<^sub>r\<^sub>m t" + shows "finite {s. timpls_transformable_to_pred A t s}" +using t +proof (induction t) + case (Var x) + have "{s::(('fun,'atom,'sets) prot_fun, 'a) term. timpls_transformable_to_pred A (Var x) s} = {Var x}" + by (auto intro: timpls_transformable_to_pred.Var elim: timpls_transformable_to_pred_inv_Var) + thus ?case by simp +next + case (Fun f T) + have IH: "finite {s. timpls_transformable_to_pred A t s}" when t: "t \ set T" for t + using Fun.IH[OF t] wf_trm_param[OF Fun.prems t] by blast + + show ?case + proof (cases "is_Abs f") + case True + then obtain a where a: "f = Abs a" unfolding is_Abs_def by presburger + hence "T = []" using wf_trm_arity[OF Fun.prems] by simp_all + hence "{a. timpls_transformable_to_pred A (Fun f T) a} \ (\b. Fun (Abs b) []) ` A" + using timpls_transformable_to_pred_finite_aux2[of A a] a by auto + thus ?thesis using A finite_subset by fast + next + case False thus ?thesis + using IH finite_lists_length_eq' timpls_transformable_to_pred_finite_aux1[of f A T] finite_subset + by blast + qed +qed + +private lemma timpls_transformable_to_pred_if_timpls_transformable_to: + assumes s: "timpls_transformable_to TI t s" + and t: "wf\<^sub>t\<^sub>r\<^sub>m t" "\f \ funs_term t. is_Abs f \ the_Abs f \ A" + shows "timpls_transformable_to_pred (A \ fst ` (set TI)\<^sup>+ \ snd ` (set TI)\<^sup>+) t s" +using s t +proof (induction rule: timpls_transformable_to.induct) + case (2 TI f T g S) + let ?A = "A \ fst ` (set TI)\<^sup>+ \ snd ` (set TI)\<^sup>+" + + note prems = "2.prems" + note IH = "2.IH" + + note 0 = timpls_transformable_to_inv[OF prems(1)] + + have 1: "T = []" "S = []" when f: "f = Abs a" for a + using f wf_trm_arity[OF prems(2)] 0(1) by simp_all + + have "\f \ funs_term t. is_Abs f \ the_Abs f \ A" when t: "t \ set T" for t + using t prems(3) funs_term_subterms_eq(1)[of "Fun f T"] by blast + hence 2: "timpls_transformable_to_pred ?A (T ! i) (S ! i)" + when i: "i < length T" for i + using i IH 0(1,2) wf_trm_param[OF prems(2)] + by (metis (no_types) in_set_conv_nth) + + have 3: "the_Abs f \ ?A" when f: "is_Abs f" using prems(3) f by force + + show ?case + proof (cases "f = g") + case True + note fg = True + show ?thesis + proof (cases "is_Abs f") + case True + then obtain a where a: "f = Abs a" unfolding is_Abs_def by moura + thus ?thesis using fg 1[OF a] timpls_transformable_to_pred.Abs[of a ?A a] 3 by simp + qed (use fg timpls_transformable_to_pred.Fun[OF _ 0(1) 2, of f] in blast) + next + case False + then obtain a b where ab: "f = Abs a" "g = Abs b" "(a, b) \ (set TI)\<^sup>+" + using 0(3) in_trancl_closure_iff_in_trancl_fun[of _ _ TI] + unfolding is_Abs_def the_Abs_def by fastforce + hence "a \ ?A" "b \ ?A" by force+ + thus ?thesis using timpls_transformable_to_pred.Abs ab(1,2) 1[OF ab(1)] by metis + qed +qed (simp_all add: timpls_transformable_to_pred.Var) + +private lemma timpls_transformable_to_pred_if_timpls_transformable_to': + assumes s: "timpls_transformable_to' TI t s" + and t: "wf\<^sub>t\<^sub>r\<^sub>m t" "\f \ funs_term t. is_Abs f \ the_Abs f \ A" + shows "timpls_transformable_to_pred (A \ fst ` (set TI)\<^sup>+ \ snd ` (set TI)\<^sup>+) t s" +using s t +proof (induction rule: timpls_transformable_to.induct) + case (2 TI f T g S) + let ?A = "A \ fst ` (set TI)\<^sup>+ \ snd ` (set TI)\<^sup>+" + + note prems = "2.prems" + note IH = "2.IH" + + note 0 = timpls_transformable_to'_inv[OF prems(1)] + + have 1: "T = []" "S = []" when f: "f = Abs a" for a + using f wf_trm_arity[OF prems(2)] 0(1) by simp_all + + have "\f \ funs_term t. is_Abs f \ the_Abs f \ A" when t: "t \ set T" for t + using t prems(3) funs_term_subterms_eq(1)[of "Fun f T"] by blast + hence 2: "timpls_transformable_to_pred ?A (T ! i) (S ! i)" + when i: "i < length T" for i + using i IH 0(1,2) wf_trm_param[OF prems(2)] + by (metis (no_types) in_set_conv_nth) + + have 3: "the_Abs f \ ?A" when f: "is_Abs f" using prems(3) f by force + + show ?case + proof (cases "f = g") + case True + note fg = True + show ?thesis + proof (cases "is_Abs f") + case True + then obtain a where a: "f = Abs a" unfolding is_Abs_def by moura + thus ?thesis using fg 1[OF a] timpls_transformable_to_pred.Abs[of a ?A a] 3 by simp + qed (use fg timpls_transformable_to_pred.Fun[OF _ 0(1) 2, of f] in blast) + next + case False + then obtain a b where ab: "f = Abs a" "g = Abs b" "(a, b) \ (set TI)\<^sup>+" + using 0(3) in_trancl_closure_iff_in_trancl_fun[of _ _ TI] + unfolding is_Abs_def the_Abs_def by fastforce + hence "a \ ?A" "b \ ?A" by force+ + thus ?thesis using timpls_transformable_to_pred.Abs ab(1,2) 1[OF ab(1)] by metis + qed +qed (simp_all add: timpls_transformable_to_pred.Var) + +private lemma timpls_transformable_to_pred_if_equal_mod_timpls: + assumes s: "equal_mod_timpls TI t s" + and t: "wf\<^sub>t\<^sub>r\<^sub>m t" "\f \ funs_term t. is_Abs f \ the_Abs f \ A" + shows "timpls_transformable_to_pred (A \ fst ` (set TI)\<^sup>+ \ snd ` (set TI)\<^sup>+) t s" +using s t +proof (induction rule: equal_mod_timpls.induct) + case (2 TI f T g S) + let ?A = "A \ fst ` (set TI)\<^sup>+ \ snd ` (set TI)\<^sup>+" + + note prems = "2.prems" + note IH = "2.IH" + + note 0 = equal_mod_timpls_inv[OF prems(1)] + + have 1: "T = []" "S = []" when f: "f = Abs a" for a + using f wf_trm_arity[OF prems(2)] 0(1) by simp_all + + have "\f \ funs_term t. is_Abs f \ the_Abs f \ A" when t: "t \ set T" for t + using t prems(3) funs_term_subterms_eq(1)[of "Fun f T"] by blast + hence 2: "timpls_transformable_to_pred ?A (T ! i) (S ! i)" + when i: "i < length T" for i + using i IH 0(1,2) wf_trm_param[OF prems(2)] + by (metis (no_types) in_set_conv_nth) + + have 3: "the_Abs f \ ?A" when f: "is_Abs f" using prems(3) f by force + + show ?case + proof (cases "f = g") + case True + note fg = True + show ?thesis + proof (cases "is_Abs f") + case True + then obtain a where a: "f = Abs a" unfolding is_Abs_def by moura + thus ?thesis using fg 1[OF a] timpls_transformable_to_pred.Abs[of a ?A a] 3 by simp + qed (use fg timpls_transformable_to_pred.Fun[OF _ 0(1) 2, of f] in blast) + next + case False + then obtain a b where ab: "f = Abs a" "g = Abs b" + "(a, b) \ (set TI)\<^sup>+ \ (b, a) \ (set TI)\<^sup>+ \ + (\ti \ set TI. (a, snd ti) \ (set TI)\<^sup>+ \ (b, snd ti) \ (set TI)\<^sup>+)" + using 0(3) in_trancl_closure_iff_in_trancl_fun[of _ _ TI] + unfolding is_Abs_def the_Abs_def by fastforce + hence "a \ ?A" "b \ ?A" by force+ + thus ?thesis using timpls_transformable_to_pred.Abs ab(1,2) 1[OF ab(1)] by metis + qed +qed (simp_all add: timpls_transformable_to_pred.Var) + +lemma timpls_transformable_to_finite: + assumes t: "wf\<^sub>t\<^sub>r\<^sub>m t" + shows "finite {s. timpls_transformable_to TI t s}" (is ?P) + and "finite {s. timpls_transformable_to' TI t s}" (is ?Q) +proof - + let ?A = "the_Abs ` {f \ funs_term t. is_Abs f} \ fst ` (set TI)\<^sup>+ \ snd ` (set TI)\<^sup>+" + + have 0: "finite ?A" by auto + + have 1: "{s. timpls_transformable_to TI t s} \ {s. timpls_transformable_to_pred ?A t s}" + using timpls_transformable_to_pred_if_timpls_transformable_to[OF _ t] by auto + + have 2: "{s. timpls_transformable_to' TI t s} \ {s. timpls_transformable_to_pred ?A t s}" + using timpls_transformable_to_pred_if_timpls_transformable_to'[OF _ t] by auto + + show ?P using timpls_transformable_to_pred_finite[OF 0 t] finite_subset[OF 1] by blast + show ?Q using timpls_transformable_to_pred_finite[OF 0 t] finite_subset[OF 2] by blast +qed + +lemma equal_mod_timpls_finite: + assumes t: "wf\<^sub>t\<^sub>r\<^sub>m t" + shows "finite {s. equal_mod_timpls TI t s}" +proof - + let ?A = "the_Abs ` {f \ funs_term t. is_Abs f} \ fst ` (set TI)\<^sup>+ \ snd ` (set TI)\<^sup>+" + + have 0: "finite ?A" by auto + + have 1: "{s. equal_mod_timpls TI t s} \ {s. timpls_transformable_to_pred ?A t s}" + using timpls_transformable_to_pred_if_equal_mod_timpls[OF _ t] by auto + + show ?thesis using timpls_transformable_to_pred_finite[OF 0 t] finite_subset[OF 1] by blast +qed + +end + +lemma intruder_synth_mod_timpls_is_synth_timpl_closure_set: + fixes t::"(('fun, 'atom, 'sets) prot_fun, 'a) term" and TI TI' + assumes "set TI' = {(a,b) \ (set TI)\<^sup>+. a \ b}" + shows "intruder_synth_mod_timpls M TI' t \ timpl_closure_set (set M) (set TI) \\<^sub>c t" + (is "?C t \ ?D t") +proof - + have *: "(\m \ M. timpls_transformable_to TI' m t) \ t \ timpl_closure_set M (set TI)" + when "set TI' = {(a,b) \ (set TI)\<^sup>+. a \ b}" + for M TI TI' and t::"(('fun, 'atom, 'sets) prot_fun, 'a) term" + using timpls_transformable_to_iff_in_timpl_closure[OF that] + timpl_closure_set_is_timpl_closure_union[of M "set TI"] + timpl_closure_set_timpls_trancl_eq[of M "set TI"] + timpl_closure_set_timpls_trancl_eq'[of M "set TI"] + by auto + + show "?C t \ ?D t" + proof + show "?C t \ ?D t" using assms + proof (induction t arbitrary: M TI TI' rule: intruder_synth_mod_timpls.induct) + case (1 M TI' x) + hence "Var x \ timpl_closure_set (set M) (set TI)" + using timpl_closure.FP member_def unfolding timpl_closure_set_def by force + thus ?case by simp + next + case (2 M TI f T) + show ?case + proof (cases "\m \ set M. timpls_transformable_to TI' m (Fun f T)") + case True thus ?thesis + using "2.prems" *[of TI' TI "set M" "Fun f T"] + intruder_synth.AxiomC[of "Fun f T" "timpl_closure_set (set M) (set TI)"] + by blast + next + case False + hence "\(list_ex (\t. timpls_transformable_to TI' t (Fun f T)) M)" + unfolding list_ex_iff by blast + hence "public f" "length T = arity f" "list_all (intruder_synth_mod_timpls M TI') T" + using "2.prems"(1) by force+ + thus ?thesis using "2.IH"[OF _ _ "2.prems"(2)] unfolding list_all_iff by force + qed + qed + + show "?D t \ ?C t" + proof (induction t rule: intruder_synth_induct) + case (AxiomC t) thus ?case + using timpl_closure_set_Var_in_iff[of _ "set M" "set TI"] *[OF assms, of "set M" t] + by (cases t rule: term.exhaust) (force simp add: member_def list_ex_iff)+ + next + case (ComposeC T f) thus ?case + using list_all_iff[of "intruder_synth_mod_timpls M TI'" T] + intruder_synth_mod_timpls.simps(2)[of M TI' f T] + by blast + qed + qed +qed + +lemma intruder_synth_mod_timpls'_is_synth_timpl_closure_set: + fixes t::"(('fun, 'atom, 'sets) prot_fun, 'a) term" and TI + shows "intruder_synth_mod_timpls' M TI t \ timpl_closure_set (set M) (set TI) \\<^sub>c t" + (is "?A t \ ?B t") +proof - + have *: "(\m \ M. timpls_transformable_to' TI m t) \ t \ timpl_closure_set M (set TI)" + for M TI and t::"(('fun, 'atom, 'sets) prot_fun, 'a) term" + using timpls_transformable_to'_iff_in_timpl_closure[of TI _ t] + timpl_closure_set_is_timpl_closure_union[of M "set TI"] + by blast+ + + show "?A t \ ?B t" + proof + show "?A t \ ?B t" + proof (induction t arbitrary: M TI rule: intruder_synth_mod_timpls'.induct) + case (1 M TI x) + hence "Var x \ timpl_closure_set (set M) (set TI)" + using timpl_closure.FP List.member_def[of M] unfolding timpl_closure_set_def by auto + thus ?case by simp + next + case (2 M TI f T) + show ?case + proof (cases "\m \ set M. timpls_transformable_to' TI m (Fun f T)") + case True thus ?thesis + using "2.prems" *[of "set M" TI "Fun f T"] + intruder_synth.AxiomC[of "Fun f T" "timpl_closure_set (set M) (set TI)"] + by blast + next + case False + hence "public f" "length T = arity f" "list_all (intruder_synth_mod_timpls' M TI) T" + using "2.prems" list_ex_iff[of _ M] by force+ + thus ?thesis + using "2.IH"[of _ M TI] list_all_iff[of "intruder_synth_mod_timpls' M TI" T] + by force + qed + qed + + show "?B t \ ?A t" + proof (induction t rule: intruder_synth_induct) + case (AxiomC t) thus ?case + using AxiomC timpl_closure_set_Var_in_iff[of _ "set M" "set TI"] *[of "set M" TI t] + list_ex_iff[of _ M] List.member_def[of M] + by (cases t rule: term.exhaust) force+ + next + case (ComposeC T f) thus ?case + using list_all_iff[of "intruder_synth_mod_timpls' M TI" T] + intruder_synth_mod_timpls'.simps(2)[of M TI f T] + by blast + qed + qed +qed + +lemma intruder_synth_mod_eq_timpls_is_synth_timpl_closure_set: + fixes t::"(('fun, 'atom, 'sets) prot_fun, 'a) term" and TI + defines "cl \ \TI. {(a,b) \ TI\<^sup>+. a \ b}" + shows (* "set TI' = (set TI)\<^sup>+ \ + intruder_synth_mod_eq_timpls M TI' t \ + (\s \ timpl_closure t (set TI). timpl_closure_set M (set TI) \\<^sub>c s)" + (is "?P TI TI' \ ?A t \ ?B t") + and *) "set TI' = {(a,b) \ (set TI)\<^sup>+. a \ b} \ + intruder_synth_mod_eq_timpls M TI' t \ + (\s \ timpl_closure t (set TI). timpl_closure_set M (set TI) \\<^sub>c s)" + (is "?Q TI TI' \ ?C t \ ?D t") +proof - + (* have *: "(\m \ M. equal_mod_timpls TI' m t) \ + (\s \ timpl_closure t (set TI). s \ timpl_closure_set M (set TI))" + when P: "?P TI TI'" + for M TI TI' and t::"(('fun, 'atom, 'sets) prot_fun, 'a) term" + using equal_mod_timpls_iff_ex_in_timpl_closure'[OF P] + timpl_closure_set_is_timpl_closure_union[of M "set TI"] + timpl_closure_set_timpls_trancl_eq[of M "set TI"] + by blast *) + + have **: "(\m \ M. equal_mod_timpls TI' m t) \ + (\s \ timpl_closure t (set TI). s \ timpl_closure_set M (set TI))" + when Q: "?Q TI TI'" + for M TI TI' and t::"(('fun, 'atom, 'sets) prot_fun, 'a) term" + using equal_mod_timpls_iff_ex_in_timpl_closure[OF Q] + timpl_closure_set_is_timpl_closure_union[of M "set TI"] + timpl_closure_set_timpls_trancl_eq'[of M "set TI"] + by fastforce + +(* show "?A t \ ?B t" when P: "?P TI TI'" + proof + show "?A t \ ?B t" + proof (induction t arbitrary: M TI rule: intruder_synth_mod_eq_timpls.induct) + case (1 M TI x) + hence "Var x \ timpl_closure_set M TI" "Var x \ timpl_closure (Var x) TI" + using timpl_closure.FP unfolding timpl_closure_set_def by auto + thus ?case by force + next + case (2 M TI f T) + show ?case + proof (cases "\m \ M. equal_mod_timpls (TI\<^sup>+) m (Fun f T)") + case True thus ?thesis + using "2.prems" *[of M TI "Fun f T"] intruder_synth.AxiomC[of _ "timpl_closure_set M TI"] + by blast + next + case False + hence f: "public f" "length T = arity f" "list_all (intruder_synth_mod_eq_timpls M (TI\<^sup>+)) T" + using "2.prems" by force+ + + let ?sy = "intruder_synth (timpl_closure_set M TI)" + + have IH: "\u \ timpl_closure (T ! i) TI. ?sy u" + when i: "i < length T" for i + using "2.IH"[of _ M TI] f(3) nth_mem[OF i] + unfolding list_all_iff by blast + + define S where "S \ map (\u. SOME v. v \ timpl_closure u TI \ ?sy v) T" + + have S1: "length T = length S" + unfolding S_def by simp + + have S2: "S ! i \ timpl_closure (T ! i) TI" + "timpl_closure_set M TI \\<^sub>c S ! i" + when i: "i < length S" for i + using i IH someI_ex[of "\v. v \ timpl_closure (T ! i) TI \ ?sy v"] + unfolding S_def by auto + + have "Fun f S \ timpl_closure (Fun f T) TI" + using timpl_closure_FunI[of T S TI f f] S1 S2(1) + unfolding timpl_closure_is_timpl_closure' by presburger + thus ?thesis + by (metis intruder_synth.ComposeC[of S f] f(1,2) S1 S2(2) in_set_conv_nth[of _ S]) + qed + qed + + show "?A t" when B: "?B t" + proof - + obtain s where "timpl_closure_set M TI \\<^sub>c s" "s \ timpl_closure t TI" + using B by moura + thus ?thesis + proof (induction s arbitrary: t rule: intruder_synth_induct) + case (AxiomC s t) + note 1 = timpl_closure_set_Var_in_iff[of _ M TI] timpl_closure_Var_inv[of s _ TI] + note 2 = *[of M TI] + show ?case + proof (cases t) + case Var thus ?thesis using 1 AxiomC by auto + next + case Fun thus ?thesis using 2 AxiomC by auto + qed + next + case (ComposeC T f t) + obtain g S where gS: + "t = Fun g S" "length S = length T" + "\i < length T. T ! i \ timpl_closure (S ! i) TI" + "g \ f \ is_Abs g \ is_Abs f \ (the_Abs g, the_Abs f) \ TI\<^sup>+" + using ComposeC.prems(1) timpl_closure'_inv'[of t "Fun f T" TI] + timpl_closure_is_timpl_closure'[of _ _ TI] + by fastforce + + have IH: "intruder_synth_mod_eq_timpls M (TI\<^sup>+) u" when u: "u \ set S" for u + by (metis u gS(2,3) ComposeC.IH in_set_conv_nth) + + note 0 = list_all_iff[of "intruder_synth_mod_eq_timpls M (TI\<^sup>+)" S] + intruder_synth_mod_eq_timpls.simps(2)[of M "TI\<^sup>+" g S] + + have "f = g" using ComposeC.hyps gS(4) unfolding is_Abs_def by fastforce + thus ?case by (metis ComposeC.hyps(1,2) gS(1,2) IH 0) + qed + qed + qed *) + + show "?C t \ ?D t" when Q: "?Q TI TI'" + proof + show "?C t \ ?D t" using Q + proof (induction t arbitrary: M TI rule: intruder_synth_mod_eq_timpls.induct) + case (1 M TI' x M TI) + hence "Var x \ timpl_closure_set M (set TI)" "Var x \ timpl_closure (Var x) (set TI)" + using timpl_closure.FP unfolding timpl_closure_set_def by auto + thus ?case by force + next + case (2 M TI' f T M TI) + show ?case + proof (cases "\m \ M. equal_mod_timpls TI' m (Fun f T)") + case True thus ?thesis + using **[OF "2.prems"(2), of M "Fun f T"] + intruder_synth.AxiomC[of _ "timpl_closure_set M (set TI)"] + by blast + next + case False + hence f: "public f" "length T = arity f" "list_all (intruder_synth_mod_eq_timpls M TI') T" + using "2.prems" by force+ + + let ?sy = "intruder_synth (timpl_closure_set M (set TI))" + + have IH: "\u \ timpl_closure (T ! i) (set TI). ?sy u" + when i: "i < length T" for i + using "2.IH"[of _ M TI] f(3) nth_mem[OF i] "2.prems"(2) + unfolding list_all_iff by blast + + define S where "S \ map (\u. SOME v. v \ timpl_closure u (set TI) \ ?sy v) T" + + have S1: "length T = length S" + unfolding S_def by simp + + have S2: "S ! i \ timpl_closure (T ! i) (set TI)" + "timpl_closure_set M (set TI) \\<^sub>c S ! i" + when i: "i < length S" for i + using i IH someI_ex[of "\v. v \ timpl_closure (T ! i) (set TI) \ ?sy v"] + unfolding S_def by auto + + have "Fun f S \ timpl_closure (Fun f T) (set TI)" + using timpl_closure_FunI[of T S "set TI" f f] S1 S2(1) + unfolding timpl_closure_is_timpl_closure' by presburger + thus ?thesis + by (metis intruder_synth.ComposeC[of S f] f(1,2) S1 S2(2) in_set_conv_nth[of _ S]) + qed + qed + + show "?C t" when D: "?D t" + proof - + obtain s where "timpl_closure_set M (set TI) \\<^sub>c s" "s \ timpl_closure t (set TI)" + using D by moura + thus ?thesis + proof (induction s arbitrary: t rule: intruder_synth_induct) + case (AxiomC s t) + note 1 = timpl_closure_set_Var_in_iff[of _ M "set TI"] timpl_closure_Var_inv[of s _ "set TI"] + note 2 = **[OF Q, of M] + show ?case + proof (cases t) + case Var thus ?thesis using 1 AxiomC by auto + next + case Fun thus ?thesis using 2 AxiomC by auto + qed + next + case (ComposeC T f t) + obtain g S where gS: + "t = Fun g S" "length S = length T" + "\i < length T. T ! i \ timpl_closure (S ! i) (set TI)" + "g \ f \ is_Abs g \ is_Abs f \ (the_Abs g, the_Abs f) \ (set TI)\<^sup>+" + using ComposeC.prems(1) timpl_closure'_inv'[of t "Fun f T" "set TI"] + timpl_closure_is_timpl_closure'[of _ _ "set TI"] + by fastforce + + have IH: "intruder_synth_mod_eq_timpls M TI' u" when u: "u \ set S" for u + by (metis u gS(2,3) ComposeC.IH in_set_conv_nth) + + note 0 = list_all_iff[of "intruder_synth_mod_eq_timpls M TI'" S] + intruder_synth_mod_eq_timpls.simps(2)[of M TI' g S] + + have "f = g" using ComposeC.hyps gS(4) unfolding is_Abs_def by fastforce + thus ?case by (metis ComposeC.hyps(1,2) gS(1,2) IH 0) + qed + qed + qed +qed + +lemma timpl_closure_finite: + assumes t: "wf\<^sub>t\<^sub>r\<^sub>m t" + shows "finite (timpl_closure t (set TI))" +using timpls_transformable_to'_iff_in_timpl_closure[of TI t] + timpls_transformable_to_finite[OF t, of TI] +by auto + +lemma timpl_closure_set_finite: + fixes TI::"('sets set \ 'sets set) list" + assumes M_finite: "finite M" + and M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" + shows "finite (timpl_closure_set M (set TI))" +using timpl_closure_set_is_timpl_closure_union[of M "set TI"] + timpl_closure_finite[of _ TI] M_finite M_wf finite +by auto + +lemma comp_timpl_closure_is_timpl_closure_set: + fixes M and TI::"('sets set \ 'sets set) list" + assumes M_finite: "finite M" + and M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" + shows "comp_timpl_closure M (set TI) = timpl_closure_set M (set TI)" +using lfp_while''[OF timpls_Un_mono[of M "set TI"]] + timpl_closure_set_finite[OF M_finite M_wf] + timpl_closure_set_lfp[of M "set TI"] +unfolding comp_timpl_closure_def Let_def by presburger + +context +begin + +private lemma analyzed_closed_mod_timpls_is_analyzed_closed_timpl_closure_set_aux1: + fixes M::"('fun,'atom,'sets) prot_terms" + assumes f: "arity\<^sub>f f = length T" "arity\<^sub>f f > 0" "Ana\<^sub>f f = (K, R)" + and i: "i < length R" + and M: "timpl_closure_set M TI \\<^sub>c T ! (R ! i)" + and m: "Fun (Fu f) T \ M" + and t: "Fun (Fu f) S \ timpl_closure (Fun (Fu f) T) TI" + shows "timpl_closure_set M TI \\<^sub>c S ! (R ! i)" +proof - + have "R ! i < length T" using i Ana\<^sub>f_assm2_alt[OF f(3)] f(1) by simp + thus ?thesis + using timpl_closure_Fun_inv'(1,2)[OF t] intruder_synth_timpl_closure'[OF M] + by presburger +qed + +private lemma analyzed_closed_mod_timpls_is_analyzed_closed_timpl_closure_set_aux2: + fixes M::"('fun,'atom,'sets) prot_terms" + assumes M: "\s \ set (snd (Ana m)). timpl_closure_set M TI \\<^sub>c s" + and m: "m \ M" + and t: "t \ timpl_closure m TI" + and s: "s \ set (snd (Ana t))" + shows "timpl_closure_set M TI \\<^sub>c s" +proof - + obtain f S K N where fS: "t = Fun (Fu f) S" "arity\<^sub>f f = length S" "0 < arity\<^sub>f f" + and Ana_f: "Ana\<^sub>f f = (K, N)" + and Ana_t: "Ana t = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) S, map ((!) S) N)" + using Ana_nonempty_inv[of t] s by fastforce + then obtain T where T: "m = Fun (Fu f) T" "length T = length S" + using t timpl_closure_Fu_inv'[of f S m TI] + by moura + hence Ana_m: "Ana m = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T, map ((!) T) N)" + using fS(2,3) Ana_f by auto + + obtain i where i: "i < length N" "s = S ! (N ! i)" + using s[unfolded fS(1)] Ana_t[unfolded fS(1)] T(2) + in_set_conv_nth[of s "map (\i. S ! i) N"] + by auto + hence "timpl_closure_set M TI \\<^sub>c T ! (N ! i)" + using M[unfolded T(1)] Ana_m[unfolded T(1)] T(2) + by simp + thus ?thesis + using analyzed_closed_mod_timpls_is_analyzed_closed_timpl_closure_set_aux1[ + OF fS(2)[unfolded T(2)[symmetric]] fS(3) Ana_f + i(1) _ m[unfolded T(1)] t[unfolded fS(1) T(1)]] + i(2) + by argo +qed + +lemma analyzed_closed_mod_timpls_is_analyzed_timpl_closure_set: + fixes M::"('fun,'atom,'sets) prot_term list" + assumes TI': "set TI' = {(a,b) \ (set TI)\<^sup>+. a \ b}" + and M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + shows "analyzed_closed_mod_timpls M TI' \ analyzed (timpl_closure_set (set M) (set TI))" + (is "?A \ ?B") +proof + let ?C = "\t \ timpl_closure_set (set M) (set TI). + analyzed_in t (timpl_closure_set (set M) (set TI))" + + let ?P = "\T. \t \ set T. timpl_closure_set (set M) (set TI) \\<^sub>c t" + let ?Q = "\t. \s \ comp_timpl_closure {t} (set TI'). case Ana s of (K, R) \ ?P K \ ?P R" + + note defs = analyzed_closed_mod_timpls_def analyzed_in_code + note 0 = intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI', of M] + note 1 = timpl_closure_set_is_timpl_closure_union[of _ "set TI"] + + have 2: "comp_timpl_closure {t} (set TI') = timpl_closure_set {t} (set TI)" + when t: "t \ set M" "wf\<^sub>t\<^sub>r\<^sub>m t" for t + using t timpl_closure_set_timpls_trancl_eq'[of "{t}" "set TI"] + comp_timpl_closure_is_timpl_closure_set[of "{t}" TI'] + unfolding TI'[symmetric] + by blast + hence 3: "comp_timpl_closure {t} (set TI') \ timpl_closure_set (set M) (set TI)" + when t: "t \ set M" "wf\<^sub>t\<^sub>r\<^sub>m t" for t + using t timpl_closure_set_mono[of "{t}" "set M"] + by fast + + have ?A when C: ?C + unfolding analyzed_closed_mod_timpls_def + intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI'] + list_all_iff Let_def + proof (intro ballI) + fix t assume t: "t \ set M" + show "if ?P (fst (Ana t)) then ?P (snd (Ana t)) else ?Q t" (is ?R) + proof (cases "?P (fst (Ana t))") + case True + hence "?P (snd (Ana t))" + using C timpl_closure_setI[OF t, of "set TI"] prod.exhaust_sel + unfolding analyzed_in_def by blast + thus ?thesis using True by simp + next + case False + have "?Q t" using 3[OF t] C M_wf t unfolding analyzed_in_def by auto + thus ?thesis using False by argo + qed + qed + thus ?A when B: ?B using B analyzed_is_all_analyzed_in by metis + + have ?C when A: ?A unfolding analyzed_in_def Let_def + proof (intro ballI allI impI; elim conjE) + fix t K T s + assume t: "t \ timpl_closure_set (set M) (set TI)" + and s: "s \ set T" + and Ana_t: "Ana t = (K, T)" + and K: "\k \ set K. timpl_closure_set (set M) (set TI) \\<^sub>c k" + + obtain m where m: "m \ set M" "t \ timpl_closure m (set TI)" + using timpl_closure_set_is_timpl_closure_union t by moura + + show "timpl_closure_set (set M) (set TI) \\<^sub>c s" + proof (cases "\k \ set (fst (Ana m)). timpl_closure_set (set M) (set TI) \\<^sub>c k") + case True + hence *: "\r \ set (snd (Ana m)). timpl_closure_set (set M) (set TI) \\<^sub>c r" + using m(1) A + unfolding analyzed_closed_mod_timpls_def + intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI'] + list_all_iff + by simp + + show ?thesis + using K s Ana_t A + analyzed_closed_mod_timpls_is_analyzed_closed_timpl_closure_set_aux2[OF * m] + by simp + next + case False + hence "?Q m" + using m(1) A + unfolding analyzed_closed_mod_timpls_def + intruder_synth_mod_timpls_is_synth_timpl_closure_set[OF TI'] + list_all_iff Let_def + by auto + moreover have "comp_timpl_closure {m} (set TI') = timpl_closure m (set TI)" + using 2[OF m(1)] timpl_closureton_is_timpl_closure M_wf m(1) + by blast + ultimately show ?thesis + using m(2) K s Ana_t + unfolding Let_def by auto + qed + qed + thus ?B when A: ?A using A analyzed_is_all_analyzed_in by metis +qed + +lemma analyzed_closed_mod_timpls'_is_analyzed_timpl_closure_set: + fixes M::"('fun,'atom,'sets) prot_term list" + assumes M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + shows "analyzed_closed_mod_timpls' M TI \ analyzed (timpl_closure_set (set M) (set TI))" + (is "?A \ ?B") +proof + let ?C = "\t \ timpl_closure_set (set M) (set TI). analyzed_in t (timpl_closure_set (set M) (set TI))" + + let ?P = "\T. \t \ set T. timpl_closure_set (set M) (set TI) \\<^sub>c t" + let ?Q = "\t. \s \ comp_timpl_closure {t} (set TI). case Ana s of (K, R) \ ?P K \ ?P R" + + note defs = analyzed_closed_mod_timpls'_def analyzed_in_code + note 0 = intruder_synth_mod_timpls'_is_synth_timpl_closure_set[of M TI] + note 1 = timpl_closure_set_is_timpl_closure_union[of _ "set TI"] + + have 2: "comp_timpl_closure {t} (set TI) = timpl_closure_set {t} (set TI)" + when t: "t \ set M" "wf\<^sub>t\<^sub>r\<^sub>m t" for t + using t timpl_closure_set_timpls_trancl_eq[of "{t}" "set TI"] + comp_timpl_closure_is_timpl_closure_set[of "{t}"] + by blast + hence 3: "comp_timpl_closure {t} (set TI) \ timpl_closure_set (set M) (set TI)" + when t: "t \ set M" "wf\<^sub>t\<^sub>r\<^sub>m t" for t + using t timpl_closure_set_mono[of "{t}" "set M"] + by fast + + have ?A when C: ?C + unfolding analyzed_closed_mod_timpls'_def + intruder_synth_mod_timpls'_is_synth_timpl_closure_set + list_all_iff Let_def + proof (intro ballI) + fix t assume t: "t \ set M" + show "if ?P (fst (Ana t)) then ?P (snd (Ana t)) else ?Q t" (is ?R) + proof (cases "?P (fst (Ana t))") + case True + hence "?P (snd (Ana t))" + using C timpl_closure_setI[OF t, of "set TI"] prod.exhaust_sel + unfolding analyzed_in_def by blast + thus ?thesis using True by simp + next + case False + have "?Q t" using 3[OF t] C M_wf t unfolding analyzed_in_def by auto + thus ?thesis using False by argo + qed + qed + thus ?A when B: ?B using B analyzed_is_all_analyzed_in by metis + + have ?C when A: ?A unfolding analyzed_in_def Let_def + proof (intro ballI allI impI; elim conjE) + fix t K T s + assume t: "t \ timpl_closure_set (set M) (set TI)" + and s: "s \ set T" + and Ana_t: "Ana t = (K, T)" + and K: "\k \ set K. timpl_closure_set (set M) (set TI) \\<^sub>c k" + + obtain m where m: "m \ set M" "t \ timpl_closure m (set TI)" + using timpl_closure_set_is_timpl_closure_union t by moura + + show "timpl_closure_set (set M) (set TI) \\<^sub>c s" + proof (cases "\k \ set (fst (Ana m)). timpl_closure_set (set M) (set TI) \\<^sub>c k") + case True + hence *: "\r \ set (snd (Ana m)). timpl_closure_set (set M) (set TI) \\<^sub>c r" + using m(1) A + unfolding analyzed_closed_mod_timpls'_def + intruder_synth_mod_timpls'_is_synth_timpl_closure_set + list_all_iff + by simp + + show ?thesis + using K s Ana_t A + analyzed_closed_mod_timpls_is_analyzed_closed_timpl_closure_set_aux2[OF * m] + by simp + next + case False + hence "?Q m" + using m(1) A + unfolding analyzed_closed_mod_timpls'_def + intruder_synth_mod_timpls'_is_synth_timpl_closure_set + list_all_iff Let_def + by auto + moreover have "comp_timpl_closure {m} (set TI) = timpl_closure m (set TI)" + using 2[OF m(1)] timpl_closureton_is_timpl_closure M_wf m(1) + by blast + ultimately show ?thesis + using m(2) K s Ana_t + unfolding Let_def by auto + qed + qed + thus ?B when A: ?A using A analyzed_is_all_analyzed_in by metis +qed + +end + +end + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/Term_Variants.thy b/thys/Automated_Stateful_Protocol_Verification/Term_Variants.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/Term_Variants.thy @@ -0,0 +1,451 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Term_Variants.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\Term Variants\ +theory Term_Variants + imports Stateful_Protocol_Composition_and_Typing.Intruder_Deduction +begin + +fun term_variants where + "term_variants P (Var x) = [Var x]" +| "term_variants P (Fun f T) = ( + let S = product_lists (map (term_variants P) T) + in map (Fun f) S@concat (map (\g. map (Fun g) S) (P f)))" + +inductive term_variants_pred where + term_variants_Var: + "term_variants_pred P (Var x) (Var x)" +| term_variants_P: + "\length T = length S; \i. i < length T \ term_variants_pred P (T ! i) (S ! i); g \ set (P f)\ + \ term_variants_pred P (Fun f T) (Fun g S)" +| term_variants_Fun: + "\length T = length S; \i. i < length T \ term_variants_pred P (T ! i) (S ! i)\ + \ term_variants_pred P (Fun f T) (Fun f S)" + +lemma term_variants_pred_inv: + assumes "term_variants_pred P (Fun f T) (Fun h S)" + shows "length T = length S" + and "\i. i < length T \ term_variants_pred P (T ! i) (S ! i)" + and "f \ h \ h \ set (P f)" +using assms by (auto elim: term_variants_pred.cases) + +lemma term_variants_pred_inv': + assumes "term_variants_pred P (Fun f T) t" + shows "is_Fun t" + and "length T = length (args t)" + and "\i. i < length T \ term_variants_pred P (T ! i) (args t ! i)" + and "f \ the_Fun t \ the_Fun t \ set (P f)" + and "P \ (\_. [])(g := [h]) \ f \ the_Fun t \ f = g \ the_Fun t = h" +using assms by (auto elim: term_variants_pred.cases) + +lemma term_variants_pred_inv'': + assumes "term_variants_pred P t (Fun f T)" + shows "is_Fun t" + and "length T = length (args t)" + and "\i. i < length T \ term_variants_pred P (args t ! i) (T ! i)" + and "f \ the_Fun t \ f \ set (P (the_Fun t))" + and "P \ (\_. [])(g := [h]) \ f \ the_Fun t \ f = h \ the_Fun t = g" +using assms by (auto elim: term_variants_pred.cases) + +lemma term_variants_pred_inv_Var: + "term_variants_pred P (Var x) t \ t = Var x" + "term_variants_pred P t (Var x) \ t = Var x" +by (auto intro: term_variants_Var elim: term_variants_pred.cases) + +lemma term_variants_pred_inv_const: + "term_variants_pred P (Fun c []) t \ ((\g \ set (P c). t = Fun g []) \ (t = Fun c []))" +by (auto intro: term_variants_P term_variants_Fun elim: term_variants_pred.cases) + +lemma term_variants_pred_refl: "term_variants_pred P t t" +by (induct t) (auto intro: term_variants_pred.intros) + +lemma term_variants_pred_refl_inv: + assumes st: "term_variants_pred P s t" + and P: "\f. \g \ set (P f). f = g" + shows "s = t" + using st P +proof (induction s t rule: term_variants_pred.induct) +case (term_variants_Var P x) thus ?case by blast +next + case (term_variants_P T S P g f) + hence "T ! i = S ! i" when i: "i < length T" for i using i by blast + hence "T = S" using term_variants_P.hyps(1) by (simp add: nth_equalityI) + thus ?case using term_variants_P.prems term_variants_P.hyps(3) by fast +next + case (term_variants_Fun T S P f) + hence "T ! i = S ! i" when i: "i < length T" for i using i by blast + hence "T = S" using term_variants_Fun.hyps(1) by (simp add: nth_equalityI) + thus ?case by fast +qed + +lemma term_variants_pred_const: + assumes "b \ set (P a)" + shows "term_variants_pred P (Fun a []) (Fun b [])" +using term_variants_P[of "[]" "[]"] assms by simp + +lemma term_variants_pred_const_cases: + "P a \ [] \ term_variants_pred P (Fun a []) t \ + (t = Fun a [] \ (\b \ set (P a). t = Fun b []))" + "P a = [] \ term_variants_pred P (Fun a []) t \ t = Fun a []" +using term_variants_pred_inv_const[of P] by auto + +lemma term_variants_pred_param: + assumes "term_variants_pred P t s" + and fg: "f = g \ g \ set (P f)" + shows "term_variants_pred P (Fun f (S@t#T)) (Fun g (S@s#T))" +proof - + have 1: "length (S@t#T) = length (S@s#T)" by simp + + have "term_variants_pred P (T ! i) (T ! i)" "term_variants_pred P (S ! i) (S ! i)" for i + by (metis term_variants_pred_refl)+ + hence 2: "term_variants_pred P ((S@t#T) ! i) ((S@s#T) ! i)" for i + by (simp add: assms nth_Cons' nth_append) + + show ?thesis by (metis term_variants_Fun[OF 1 2] term_variants_P[OF 1 2] fg) +qed + +lemma term_variants_pred_Cons: + assumes t: "term_variants_pred P t s" + and T: "term_variants_pred P (Fun f T) (Fun f S)" + and fg: "f = g \ g \ set (P f)" + shows "term_variants_pred P (Fun f (t#T)) (Fun g (s#S))" +proof - + have 1: "length (t#T) = length (s#S)" + and "\i. i < length T \ term_variants_pred P (T ! i) (S ! i)" + using term_variants_pred_inv[OF T] by simp_all + hence 2: "\i. i < length (t#T) \ term_variants_pred P ((t#T) ! i) ((s#S) ! i)" + by (metis t One_nat_def diff_less length_Cons less_Suc_eq less_imp_diff_less nth_Cons' + zero_less_Suc) + + show ?thesis using 1 2 fg by (auto intro: term_variants_pred.intros) +qed + +lemma term_variants_pred_dense: + fixes P Q::"'a set" and fs gs::"'a list" + defines "P_fs x \ if x \ P then fs else []" + and "P_gs x \ if x \ P then gs else []" + and "Q_fs x \ if x \ Q then fs else []" + assumes ut: "term_variants_pred P_fs u t" + and g: "g \ Q" "g \ set gs" + shows "\s. term_variants_pred P_gs u s \ term_variants_pred Q_fs s t" +proof - + define F where "F \ \(P::'a set) (fs::'a list) x. if x \ P then fs else []" + + show ?thesis using ut g P_fs_def unfolding P_gs_def Q_fs_def + proof (induction P_fs u t arbitrary: g gs rule: term_variants_pred.induct) + case (term_variants_Var P h x) thus ?case + by (auto intro: term_variants_pred.term_variants_Var) + next + case (term_variants_P T S P' h' h g gs) + note hyps = term_variants_P.hyps(1,2,4,5,6,7) + note IH = term_variants_P.hyps(3) + + have "\s. term_variants_pred (F P gs) (T ! i) s \ term_variants_pred (F Q fs) s (S ! i)" + when i: "i < length T" for i + using IH[OF i hyps(4,5,6)] unfolding F_def by presburger + then obtain U where U: + "length T = length U" "\i. i < length T \ term_variants_pred (F P gs) (T ! i) (U ! i)" + "length U = length S" "\i. i < length U \ term_variants_pred (F Q fs) (U ! i) (S ! i)" + using hyps(1) Skolem_list_nth[of _ "\i s. term_variants_pred (F P gs) (T ! i) s \ + term_variants_pred (F Q fs) s (S ! i)"] + by moura + + show ?case + using term_variants_pred.term_variants_P[OF U(1,2), of g h] + term_variants_pred.term_variants_P[OF U(3,4), of h' g] + hyps(3)[unfolded hyps(6)] hyps(4,5) + unfolding F_def by force + next + case (term_variants_Fun T S P' h' g gs) + note hyps = term_variants_Fun.hyps(1,2,4,5,6) + note IH = term_variants_Fun.hyps(3) + + have "\s. term_variants_pred (F P gs) (T ! i) s \ term_variants_pred (F Q fs) s (S ! i)" + when i: "i < length T" for i + using IH[OF i hyps(3,4,5)] unfolding F_def by presburger + then obtain U where U: + "length T = length U" "\i. i < length T \ term_variants_pred (F P gs) (T ! i) (U ! i)" + "length U = length S" "\i. i < length U \ term_variants_pred (F Q fs) (U ! i) (S ! i)" + using hyps(1) Skolem_list_nth[of _ "\i s. term_variants_pred (F P gs) (T ! i) s \ + term_variants_pred (F Q fs) s (S ! i)"] + by moura + + thus ?case + using term_variants_pred.term_variants_Fun[OF U(1,2)] + term_variants_pred.term_variants_Fun[OF U(3,4)] + unfolding F_def by meson + qed +qed + +lemma term_variants_pred_dense': + assumes ut: "term_variants_pred ((\_. [])(a := [b])) u t" + shows "\s. term_variants_pred ((\_. [])(a := [c])) u s \ + term_variants_pred ((\_. [])(c := [b])) s t" +using ut term_variants_pred_dense[of "{a}" "[b]" u t c "{c}" "[c]"] +unfolding fun_upd_def by simp + +lemma term_variants_pred_eq_case: + fixes t s::"('a,'b) term" + assumes "term_variants_pred P t s" "\f \ funs_term t. P f = []" + shows "t = s" +using assms +proof (induction P t s rule: term_variants_pred.induct) + case (term_variants_Fun T S P f) thus ?case + using subtermeq_imp_funs_term_subset[OF Fun_param_in_subterms[OF nth_mem], of _ T f] + nth_equalityI[of T S] + by blast +qed (simp_all add: term_variants_pred_refl) + +lemma term_variants_pred_subst: + assumes "term_variants_pred P t s" + shows "term_variants_pred P (t \ \) (s \ \)" +using assms +proof (induction P t s rule: term_variants_pred.induct) + case (term_variants_P T S P f g) + have 1: "length (map (\t. t \ \) T) = length (map (\t. t \ \) S)" + using term_variants_P.hyps + by simp + + have 2: "term_variants_pred P ((map (\t. t \ \) T) ! i) ((map (\t. t \ \) S) ! i)" + when "i < length (map (\t. t \ \) T)" for i + using term_variants_P that + by fastforce + + show ?case + using term_variants_pred.term_variants_P[OF 1 2 term_variants_P.hyps(3)] + by fastforce +next + case (term_variants_Fun T S P f) + have 1: "length (map (\t. t \ \) T) = length (map (\t. t \ \) S)" + using term_variants_Fun.hyps + by simp + + have 2: "term_variants_pred P ((map (\t. t \ \) T) ! i) ((map (\t. t \ \) S) ! i)" + when "i < length (map (\t. t \ \) T)" for i + using term_variants_Fun that + by fastforce + + show ?case + using term_variants_pred.term_variants_Fun[OF 1 2] + by fastforce +qed (simp add: term_variants_pred_refl) + +lemma term_variants_pred_subst': + fixes t s::"('a,'b) term" and \::"('a,'b) subst" + assumes "term_variants_pred P (t \ \) s" + and "\x \ fv t \ fv s. (\y. \ x = Var y) \ (\f. \ x = Fun f [] \ P f = [])" + shows "\u. term_variants_pred P t u \ s = u \ \" +using assms +proof (induction P "t \ \" s arbitrary: t rule: term_variants_pred.induct) + case (term_variants_Var P x g) thus ?case using term_variants_pred_refl by fast +next + case (term_variants_P T S P g f) show ?case + proof (cases t) + case (Var x) thus ?thesis + using term_variants_P.hyps(4,5) term_variants_P.prems + by fastforce + next + case (Fun h U) + hence 1: "h = f" "T = map (\s. s \ \) U" "length U = length T" + using term_variants_P.hyps(5) by simp_all + hence 2: "T ! i = U ! i \ \" when "i < length T" for i + using that by simp + + have "\x \ fv (U ! i) \ fv (S ! i). (\y. \ x = Var y) \ (\f. \ x = Fun f [] \ P f = [])" + when "i < length U" for i + using that Fun term_variants_P.prems term_variants_P.hyps(1) 1(3) + by force + hence IH: "\i < length U. \u. term_variants_pred P (U ! i) u \ S ! i = u \ \" + by (metis 1(3) term_variants_P.hyps(3)[OF _ 2]) + + have "\V. length U = length V \ S = map (\v. v \ \) V \ + (\i < length U. term_variants_pred P (U ! i) (V ! i))" + using term_variants_P.hyps(1) 1(3) subst_term_list_obtain[OF IH] by metis + then obtain V where V: "length U = length V" "S = map (\v. v \ \) V" + "\i. i < length U \ term_variants_pred P (U ! i) (V ! i)" + by moura + + have "term_variants_pred P (Fun f U) (Fun g V)" + by (metis term_variants_pred.term_variants_P[OF V(1,3) term_variants_P.hyps(4)]) + moreover have "Fun g S = Fun g V \ \" using V(2) by simp + ultimately show ?thesis using term_variants_P.hyps(1,4) Fun 1 by blast + qed +next + case (term_variants_Fun T S P f t) show ?case + proof (cases t) + case (Var x) + hence "T = []" "P f = []" using term_variants_Fun.hyps(4) term_variants_Fun.prems by fastforce+ + thus ?thesis using term_variants_pred_refl Var term_variants_Fun.hyps(1,4) by fastforce + next + case (Fun h U) + hence 1: "h = f" "T = map (\s. s \ \) U" "length U = length T" + using term_variants_Fun.hyps(4) by simp_all + hence 2: "T ! i = U ! i \ \" when "i < length T" for i + using that by simp + + have "\x \ fv (U ! i) \ fv (S ! i). (\y. \ x = Var y) \ (\f. \ x = Fun f [] \ P f = [])" + when "i < length U" for i + using that Fun term_variants_Fun.prems term_variants_Fun.hyps(1) 1(3) + by force + hence IH: "\i < length U. \u. term_variants_pred P (U ! i) u \ S ! i = u \ \" + by (metis 1(3) term_variants_Fun.hyps(3)[OF _ 2 ]) + + have "\V. length U = length V \ S = map (\v. v \ \) V \ + (\i < length U. term_variants_pred P (U ! i) (V ! i))" + using term_variants_Fun.hyps(1) 1(3) subst_term_list_obtain[OF IH] by metis + then obtain V where V: "length U = length V" "S = map (\v. v \ \) V" + "\i. i < length U \ term_variants_pred P (U ! i) (V ! i)" + by moura + + have "term_variants_pred P (Fun f U) (Fun f V)" + by (metis term_variants_pred.term_variants_Fun[OF V(1,3)]) + moreover have "Fun f S = Fun f V \ \" using V(2) by simp + ultimately show ?thesis using term_variants_Fun.hyps(1) Fun 1 by blast + qed +qed + +lemma term_variants_pred_iff_in_term_variants: + fixes t::"('a,'b) term" + shows "term_variants_pred P t s \ s \ set (term_variants P t)" + (is "?A t s \ ?B t s") +proof + define U where "U \ \P (T::('a,'b) term list). product_lists (map (term_variants P) T)" + + have a: + "g \ set (P f) \ set (map (Fun g) (U P T)) \ set (term_variants P (Fun f T))" + "set (map (Fun f) (U P T)) \ set (term_variants P (Fun f T))" + for f P g and T::"('a,'b) term list" + using term_variants.simps(2)[of P f T] + unfolding U_def Let_def by auto + + have b: "\S \ set (U P T). s = Fun f S \ (\g \ set (P f). s = Fun g S)" + when "s \ set (term_variants P (Fun f T))" for P T f s + using that by (cases "P f") (auto simp add: U_def Let_def) + + have c: "length T = length S" when "S \ set (U P T)" for S P T + using that unfolding U_def + by (simp add: in_set_product_lists_length) + + show "?A t s \ ?B t s" + proof (induction P t s rule: term_variants_pred.induct) + case (term_variants_P T S P g f) + note hyps = term_variants_P.hyps + note IH = term_variants_P.IH + + have "S \ set (U P T)" + using IH hyps(1) product_lists_in_set_nth'[of _ S] + unfolding U_def by simp + thus ?case using a(1)[of _ P, OF hyps(3)] by auto + next + case (term_variants_Fun T S P f) + note hyps = term_variants_Fun.hyps + note IH = term_variants_Fun.IH + + have "S \ set (U P T)" + using IH hyps(1) product_lists_in_set_nth'[of _ S] + unfolding U_def by simp + thus ?case using a(2)[of f P T] by (cases "P f") auto + qed (simp add: term_variants_Var) + + show "?B t s \ ?A t s" + proof (induction P t arbitrary: s rule: term_variants.induct) + case (2 P f T) + obtain S where S: + "s = Fun f S \ (\g \ set (P f). s = Fun g S)" + "S \ set (U P T)" "length T = length S" + using c b[OF "2.prems"] by moura + + have "\i < length T. term_variants_pred P (T ! i) (S ! i)" + using "2.IH" S product_lists_in_set_nth by (fastforce simp add: U_def) + thus ?case using S by (auto intro: term_variants_pred.intros) + qed (simp add: term_variants_Var) +qed + +lemma term_variants_pred_finite: + "finite {s. term_variants_pred P t s}" +using term_variants_pred_iff_in_term_variants[of P t] +by simp + +lemma term_variants_pred_fv_eq: + assumes "term_variants_pred P s t" + shows "fv s = fv t" +using assms +by (induct rule: term_variants_pred.induct) + (metis, metis fv_eq_FunI, metis fv_eq_FunI) + +lemma (in intruder_model) term_variants_pred_wf_trms: + assumes "term_variants_pred P s t" + and "\f g. g \ set (P f) \ arity f = arity g" + and "wf\<^sub>t\<^sub>r\<^sub>m s" + shows "wf\<^sub>t\<^sub>r\<^sub>m t" +using assms +apply (induction rule: term_variants_pred.induct, simp) +by (metis (no_types) wf_trmI wf_trm_arity in_set_conv_nth wf_trm_param_idx)+ + +lemma term_variants_pred_funs_term: + assumes "term_variants_pred P s t" + and "f \ funs_term t" + shows "f \ funs_term s \ (\g \ funs_term s. f \ set (P g))" + using assms +proof (induction rule: term_variants_pred.induct) + case (term_variants_P T S P g h) thus ?case + proof (cases "f = g") + case False + then obtain s where "s \ set S" "f \ funs_term s" + using funs_term_subterms_eq(1)[of "Fun g S"] term_variants_P.prems by auto + thus ?thesis + using term_variants_P.IH term_variants_P.hyps(1) in_set_conv_nth[of s S] by force + qed simp +next + case (term_variants_Fun T S P h) thus ?case + proof (cases "f = h") + case False + then obtain s where "s \ set S" "f \ funs_term s" + using funs_term_subterms_eq(1)[of "Fun h S"] term_variants_Fun.prems by auto + thus ?thesis + using term_variants_Fun.IH term_variants_Fun.hyps(1) in_set_conv_nth[of s S] by force + qed simp +qed fast + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/Transactions.thy b/thys/Automated_Stateful_Protocol_Verification/Transactions.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/Transactions.thy @@ -0,0 +1,966 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Transactions.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\Protocol Transactions\ +theory Transactions + imports + Stateful_Protocol_Composition_and_Typing.Typed_Model + Stateful_Protocol_Composition_and_Typing.Labeled_Stateful_Strands +begin + +subsection \Definitions\ +datatype 'b prot_atom = + is_Atom: Atom 'b +| Value +| SetType +| AttackType +| Bottom +| OccursSecType + +datatype ('a,'b,'c) prot_fun = + Fu (the_Fu: 'a) +| Set (the_Set: 'c) +| Val (the_Val: "nat \ bool") +| Abs (the_Abs: "'c set") +| Pair +| Attack nat +| PubConstAtom 'b nat +| PubConstSetType nat +| PubConstAttackType nat +| PubConstBottom nat +| PubConstOccursSecType nat +| OccursFact +| OccursSec + +definition "is_Fun_Set t \ is_Fun t \ args t = [] \ is_Set (the_Fun t)" + +abbreviation occurs where + "occurs t \ Fun OccursFact [Fun OccursSec [], t]" + +type_synonym ('a,'b,'c) prot_term_type = "(('a,'b,'c) prot_fun,'b prot_atom) term_type" + +type_synonym ('a,'b,'c) prot_var = "('a,'b,'c) prot_term_type \ nat" + +type_synonym ('a,'b,'c) prot_term = "(('a,'b,'c) prot_fun,('a,'b,'c) prot_var) term" +type_synonym ('a,'b,'c) prot_terms = "('a,'b,'c) prot_term set" + +type_synonym ('a,'b,'c) prot_subst = "(('a,'b,'c) prot_fun, ('a,'b,'c) prot_var) subst" + +type_synonym ('a,'b,'c,'d) prot_strand_step = + "(('a,'b,'c) prot_fun, ('a,'b,'c) prot_var, 'd) labeled_stateful_strand_step" +type_synonym ('a,'b,'c,'d) prot_strand = "('a,'b,'c,'d) prot_strand_step list" +type_synonym ('a,'b,'c,'d) prot_constr = "('a,'b,'c,'d) prot_strand_step list" + +datatype ('a,'b,'c,'d) prot_transaction = + Transaction + (transaction_fresh: "('a,'b,'c) prot_var list") + (transaction_receive: "('a,'b,'c,'d) prot_strand") + (transaction_selects: "('a,'b,'c,'d) prot_strand") + (transaction_checks: "('a,'b,'c,'d) prot_strand") + (transaction_updates: "('a,'b,'c,'d) prot_strand") + (transaction_send: "('a,'b,'c,'d) prot_strand") + +definition transaction_strand where + "transaction_strand T \ + transaction_receive T@transaction_selects T@transaction_checks T@ + transaction_updates T@transaction_send T" + +fun transaction_proj where + "transaction_proj l (Transaction A B C D E F) = ( + let f = proj l + in Transaction A (f B) (f C) (f D) (f E) (f F))" + +fun transaction_star_proj where + "transaction_star_proj (Transaction A B C D E F) = ( + let f = filter is_LabelS + in Transaction A (f B) (f C) (f D) (f E) (f F))" + +abbreviation fv_transaction where + "fv_transaction T \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" + +abbreviation bvars_transaction where + "bvars_transaction T \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" + +abbreviation vars_transaction where + "vars_transaction T \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" + +abbreviation trms_transaction where + "trms_transaction T \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" + +abbreviation setops_transaction where + "setops_transaction T \ setops\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))" + +definition wellformed_transaction where + "wellformed_transaction T \ + list_all is_Receive (unlabel (transaction_receive T)) \ + list_all is_Assignment (unlabel (transaction_selects T)) \ + list_all is_Check (unlabel (transaction_checks T)) \ + list_all is_Update (unlabel (transaction_updates T)) \ + list_all is_Send (unlabel (transaction_send T)) \ + set (transaction_fresh T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \ + set (transaction_fresh T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {} \ + set (transaction_fresh T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {} \ + fv_transaction T \ bvars_transaction T = {} \ + fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \ + fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) - set (transaction_fresh T) + \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \ + (\x \ set (unlabel (transaction_selects T)). + is_Equality x \ fv (the_rhs x) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T))" + +type_synonym ('a,'b,'c,'d) prot = "('a,'b,'c,'d) prot_transaction list" + +abbreviation Var_Value_term ("\_\\<^sub>v") where + "\n\\<^sub>v \ Var (Var Value, n)::('a,'b,'c) prot_term" + +abbreviation Fun_Fu_term ("\_ _\\<^sub>t") where + "\f T\\<^sub>t \ Fun (Fu f) T::('a,'b,'c) prot_term" + +abbreviation Fun_Fu_const_term ("\_\\<^sub>c") where + "\c\\<^sub>c \ Fun (Fu c) []::('a,'b,'c) prot_term" + +abbreviation Fun_Set_const_term ("\_\\<^sub>s") where + "\f\\<^sub>s \ Fun (Set f) []::('a,'b,'c) prot_term" + +abbreviation Fun_Abs_const_term ("\_\\<^sub>a") where + "\a\\<^sub>a \ Fun (Abs a) []::('a,'b,'c) prot_term" + +abbreviation Fun_Attack_const_term ("attack\_\") where + "attack\n\ \ Fun (Attack n) []::('a,'b,'c) prot_term" + +abbreviation prot_transaction1 ("transaction\<^sub>1 _ _ new _ _ _") where + "transaction\<^sub>1 (S1::('a,'b,'c,'d) prot_strand) S2 new (B::('a,'b,'c) prot_term list) S3 S4 + \ Transaction (map the_Var B) S1 [] S2 S3 S4" + +abbreviation prot_transaction2 ("transaction\<^sub>2 _ _ _ _") where + "transaction\<^sub>2 (S1::('a,'b,'c,'d) prot_strand) S2 S3 S4 + \ Transaction [] S1 [] S2 S3 S4" + + +subsection \Lemmata\ + +lemma prot_atom_UNIV: + "(UNIV::'b prot_atom set) = range Atom \ {Value, SetType, AttackType, Bottom, OccursSecType}" +proof - + have "a \ range Atom \ a = Value \ a = SetType \ a = AttackType \ a = Bottom \ a = OccursSecType" + for a::"'b prot_atom" + by (cases a) auto + thus ?thesis by auto +qed + +instance prot_atom::(finite) finite +by intro_classes (simp add: prot_atom_UNIV) + +instantiation prot_atom::(enum) enum +begin +definition "enum_prot_atom == map Atom enum_class.enum@[Value, SetType, AttackType, Bottom, OccursSecType]" +definition "enum_all_prot_atom P == list_all P (map Atom enum_class.enum@[Value, SetType, AttackType, Bottom, OccursSecType])" +definition "enum_ex_prot_atom P == list_ex P (map Atom enum_class.enum@[Value, SetType, AttackType, Bottom, OccursSecType])" + +instance +proof intro_classes + have *: "set (map Atom (enum_class.enum::'a list)) = range Atom" + "distinct (enum_class.enum::'a list)" + using UNIV_enum enum_distinct by auto + + show "(UNIV::'a prot_atom set) = set enum_class.enum" + using *(1) by (simp add: prot_atom_UNIV enum_prot_atom_def) + + have "set (map Atom enum_class.enum) \ set [Value, SetType, AttackType, Bottom, OccursSecType] = {}" by auto + moreover have "inj_on Atom (set (enum_class.enum::'a list))" unfolding inj_on_def by auto + hence "distinct (map Atom (enum_class.enum::'a list))" by (metis *(2) distinct_map) + ultimately show "distinct (enum_class.enum::'a prot_atom list)" by (simp add: enum_prot_atom_def) + + have "Ball UNIV P \ Ball (range Atom) P \ Ball {Value, SetType, AttackType, Bottom, OccursSecType} P" + for P::"'a prot_atom \ bool" + by (metis prot_atom_UNIV UNIV_I UnE) + thus "enum_class.enum_all P = Ball (UNIV::'a prot_atom set) P" for P + using *(1) Ball_set[of "map Atom enum_class.enum" P] + by (auto simp add: enum_all_prot_atom_def) + + have "Bex UNIV P \ Bex (range Atom) P \ Bex {Value, SetType, AttackType, Bottom, OccursSecType} P" + for P::"'a prot_atom \ bool" + by (metis prot_atom_UNIV UNIV_I UnE) + thus "enum_class.enum_ex P = Bex (UNIV::'a prot_atom set) P" for P + using *(1) Bex_set[of "map Atom enum_class.enum" P] + by (auto simp add: enum_ex_prot_atom_def) +qed +end + +lemma wellformed_transaction_cases: + assumes "wellformed_transaction T" + shows + "(l,x) \ set (transaction_receive T) \ \t. x = receive\t\" (is "?A \ ?A'") + "(l,x) \ set (transaction_selects T) \ + (\t s. x = \t := s\) \ (\t s. x = select\t,s\)" (is "?B \ ?B'") + "(l,x) \ set (transaction_checks T) \ + (\t s. x = \t == s\) \ (\t s. x = \t in s\) \ (\X F G. x = \X\\\: F \\: G\)" (is "?C \ ?C'") + "(l,x) \ set (transaction_updates T) \ + (\t s. x = insert\t,s\) \ (\t s. x = delete\t,s\)" (is "?D \ ?D'") + "(l,x) \ set (transaction_send T) \ \t. x = send\t\" (is "?E \ ?E'") +proof - + have a: + "list_all is_Receive (unlabel (transaction_receive T))" + "list_all is_Assignment (unlabel (transaction_selects T))" + "list_all is_Check (unlabel (transaction_checks T))" + "list_all is_Update (unlabel (transaction_updates T))" + "list_all is_Send (unlabel (transaction_send T))" + using assms unfolding wellformed_transaction_def by metis+ + + note b = Ball_set unlabel_in + note c = stateful_strand_step.collapse + + show "?A \ ?A'" by (metis (mono_tags, lifting) a(1) b c(2)) + show "?B \ ?B'" by (metis (mono_tags, lifting) a(2) b c(3,6)) + show "?C \ ?C'" by (metis (mono_tags, lifting) a(3) b c(3,6,7)) + show "?D \ ?D'" by (metis (mono_tags, lifting) a(4) b c(4,5)) + show "?E \ ?E'" by (metis (mono_tags, lifting) a(5) b c(1)) +qed + +lemma wellformed_transaction_unlabel_cases: + assumes "wellformed_transaction T" + shows + "x \ set (unlabel (transaction_receive T)) \ \t. x = receive\t\" (is "?A \ ?A'") + "x \ set (unlabel (transaction_selects T)) \ + (\t s. x = \t := s\) \ (\t s. x = select\t,s\)" (is "?B \ ?B'") + "x \ set (unlabel (transaction_checks T)) \ + (\t s. x = \t == s\) \ (\t s. x = \t in s\) \ (\X F G. x = \X\\\: F \\: G\)" + (is "?C \ ?C'") + "x \ set (unlabel (transaction_updates T)) \ + (\t s. x = insert\t,s\) \ (\t s. x = delete\t,s\)" (is "?D \ ?D'") + "x \ set (unlabel (transaction_send T)) \ \t. x = send\t\" (is "?E \ ?E'") +proof - + have a: + "list_all is_Receive (unlabel (transaction_receive T))" + "list_all is_Assignment (unlabel (transaction_selects T))" + "list_all is_Check (unlabel (transaction_checks T))" + "list_all is_Update (unlabel (transaction_updates T))" + "list_all is_Send (unlabel (transaction_send T))" + using assms unfolding wellformed_transaction_def by metis+ + + note b = Ball_set + note c = stateful_strand_step.collapse + + show "?A \ ?A'" by (metis (mono_tags, lifting) a(1) b c(2)) + show "?B \ ?B'" by (metis (mono_tags, lifting) a(2) b c(3,6)) + show "?C \ ?C'" by (metis (mono_tags, lifting) a(3) b c(3,6,7)) + show "?D \ ?D'" by (metis (mono_tags, lifting) a(4) b c(4,5)) + show "?E \ ?E'" by (metis (mono_tags, lifting) a(5) b c(1)) +qed + +lemma transaction_strand_subsets[simp]: + "set (transaction_receive T) \ set (transaction_strand T)" + "set (transaction_selects T) \ set (transaction_strand T)" + "set (transaction_checks T) \ set (transaction_strand T)" + "set (transaction_updates T) \ set (transaction_strand T)" + "set (transaction_send T) \ set (transaction_strand T)" + "set (unlabel (transaction_receive T)) \ set (unlabel (transaction_strand T))" + "set (unlabel (transaction_selects T)) \ set (unlabel (transaction_strand T))" + "set (unlabel (transaction_checks T)) \ set (unlabel (transaction_strand T))" + "set (unlabel (transaction_updates T)) \ set (unlabel (transaction_strand T))" + "set (unlabel (transaction_send T)) \ set (unlabel (transaction_strand T))" +unfolding transaction_strand_def unlabel_def by force+ + +lemma transaction_strand_subst_subsets[simp]: + "set (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ set (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + "set (transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ set (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + "set (transaction_checks T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ set (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + "set (transaction_updates T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ set (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + "set (transaction_send T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ set (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + "set (unlabel (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ set (unlabel (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + "set (unlabel (transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ set (unlabel (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + "set (unlabel (transaction_checks T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ set (unlabel (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + "set (unlabel (transaction_updates T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ set (unlabel (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + "set (unlabel (transaction_send T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ set (unlabel (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" +unfolding transaction_strand_def unlabel_def subst_apply_labeled_stateful_strand_def by force+ + +lemma transaction_dual_subst_unfold: + "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) = + unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))@ + unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))@ + unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))@ + unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))@ + unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" +by (simp add: transaction_strand_def unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append) + +lemma trms_transaction_unfold: + "trms_transaction T = + trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \ + trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \ + trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" +by (metis trms\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def) + +lemma trms_transaction_subst_unfold: + "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = + trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ + trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ + trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" +by (metis trms\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def subst_lsst_append) + +lemma vars_transaction_unfold: + "vars_transaction T = + vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \ + vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \ + vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" +by (metis vars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def) + +lemma vars_transaction_subst_unfold: + "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = + vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ + vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ + vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" +by (metis vars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def subst_lsst_append) + +lemma fv_transaction_unfold: + "fv_transaction T = + fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \ + fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \ + fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" +by (metis fv\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def) + +lemma fv_transaction_subst_unfold: + "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = + fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ + fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ + fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" +by (metis fv\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def subst_lsst_append) + +lemma fv_wellformed_transaction_unfold: + assumes "wellformed_transaction T" + shows "fv_transaction T = + fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \ set (transaction_fresh T)" +proof - + let ?A = "set (transaction_fresh T)" + let ?B = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T)" + let ?C = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" + let ?D = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" + let ?E = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" + let ?F = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" + + have "?A \ ?B \ ?C" "?A \ ?D = {}" "?A \ ?E = {}" "?F \ ?D \ ?E" "?B \ ?C - ?A \ ?D \ ?E" + using assms unfolding wellformed_transaction_def by fast+ + thus ?thesis using fv_transaction_unfold by blast +qed + +lemma bvars_transaction_unfold: + "bvars_transaction T = + bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \ + bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \ + bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" +by (metis bvars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def) + +lemma bvars_transaction_subst_unfold: + "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = + bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ + bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ + bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" +by (metis bvars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def subst_lsst_append) + +lemma bvars_wellformed_transaction_unfold: + assumes "wellformed_transaction T" + shows "bvars_transaction T = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?A) + and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}" (is ?B) + and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {}" (is ?C) + and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) = {}" (is ?D) + and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) = {}" (is ?E) +proof - + have 0: "list_all is_Receive (unlabel (transaction_receive T))" + "list_all is_Assignment (unlabel (transaction_selects T))" + "list_all is_Update (unlabel (transaction_updates T))" + "list_all is_Send (unlabel (transaction_send T))" + using assms unfolding wellformed_transaction_def by metis+ + + have "filter is_NegChecks (unlabel (transaction_receive T)) = []" + "filter is_NegChecks (unlabel (transaction_selects T)) = []" + "filter is_NegChecks (unlabel (transaction_updates T)) = []" + "filter is_NegChecks (unlabel (transaction_send T)) = []" + using list_all_filter_nil[OF 0(1), of is_NegChecks] + list_all_filter_nil[OF 0(2), of is_NegChecks] + list_all_filter_nil[OF 0(3), of is_NegChecks] + list_all_filter_nil[OF 0(4), of is_NegChecks] + stateful_strand_step.distinct_disc(11,21,29,35,39,41) + by blast+ + thus ?A ?B ?C ?D ?E + using bvars_transaction_unfold[of T] + bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks[of "unlabel (transaction_receive T)"] + bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks[of "unlabel (transaction_selects T)"] + bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks[of "unlabel (transaction_updates T)"] + bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks[of "unlabel (transaction_send T)"] + by (metis bvars\<^sub>s\<^sub>s\<^sub>t_def UnionE emptyE list.set(1) list.simps(8) subsetI subset_Un_eq sup_commute)+ +qed + +lemma transaction_strand_memberD[dest]: + assumes "x \ set (transaction_strand T)" + shows "x \ set (transaction_receive T) \ x \ set (transaction_selects T) \ + x \ set (transaction_checks T) \ x \ set (transaction_updates T) \ + x \ set (transaction_send T)" +using assms by (simp add: transaction_strand_def) + +lemma transaction_strand_unlabel_memberD[dest]: + assumes "x \ set (unlabel (transaction_strand T))" + shows "x \ set (unlabel (transaction_receive T)) \ x \ set (unlabel (transaction_selects T)) \ + x \ set (unlabel (transaction_checks T)) \ x \ set (unlabel (transaction_updates T)) \ + x \ set (unlabel (transaction_send T))" +using assms by (simp add: unlabel_def transaction_strand_def) + +lemma wellformed_transaction_strand_memberD[dest]: + assumes "wellformed_transaction T" and "(l,x) \ set (transaction_strand T)" + shows + "x = receive\t\ \ (l,x) \ set (transaction_receive T)" (is "?A \ ?A'") + "x = select\t,s\ \ (l,x) \ set (transaction_selects T)" (is "?B \ ?B'") + "x = \t == s\ \ (l,x) \ set (transaction_checks T)" (is "?C \ ?C'") + "x = \t in s\ \ (l,x) \ set (transaction_checks T)" (is "?D \ ?D'") + "x = \X\\\: F \\: G\ \ (l,x) \ set (transaction_checks T)" (is "?E \ ?E'") + "x = insert\t,s\ \ (l,x) \ set (transaction_updates T)" (is "?F \ ?F'") + "x = delete\t,s\ \ (l,x) \ set (transaction_updates T)" (is "?G \ ?G'") + "x = send\t\ \ (l,x) \ set (transaction_send T)" (is "?H \ ?H'") +proof - + have "(l,x) \ set (transaction_receive T) \ (l,x) \ set (transaction_selects T) \ + (l,x) \ set (transaction_checks T) \ (l,x) \ set (transaction_updates T) \ + (l,x) \ set (transaction_send T)" + using assms(2) by auto + thus "?A \ ?A'" "?B \ ?B'" "?C \ ?C'" "?D \ ?D'" + "?E \ ?E'" "?F \ ?F'" "?G \ ?G'" "?H \ ?H'" + using wellformed_transaction_cases[OF assms(1)] by fast+ +qed + +lemma wellformed_transaction_strand_unlabel_memberD[dest]: + assumes "wellformed_transaction T" and "x \ set (unlabel (transaction_strand T))" + shows + "x = receive\t\ \ x \ set (unlabel (transaction_receive T))" (is "?A \ ?A'") + "x = select\t,s\ \ x \ set (unlabel (transaction_selects T))" (is "?B \ ?B'") + "x = \t == s\ \ x \ set (unlabel (transaction_checks T))" (is "?C \ ?C'") + "x = \t in s\ \ x \ set (unlabel (transaction_checks T))" (is "?D \ ?D'") + "x = \X\\\: F \\: G\ \ x \ set (unlabel (transaction_checks T))" (is "?E \ ?E'") + "x = insert\t,s\ \ x \ set (unlabel (transaction_updates T))" (is "?F \ ?F'") + "x = delete\t,s\ \ x \ set (unlabel (transaction_updates T))" (is "?G \ ?G'") + "x = send\t\ \ x \ set (unlabel (transaction_send T))" (is "?H \ ?H'") +proof - + have "x \ set (unlabel (transaction_receive T)) \ x \ set (unlabel (transaction_selects T)) \ + x \ set (unlabel (transaction_checks T)) \ x \ set (unlabel (transaction_updates T)) \ + x \ set (unlabel (transaction_send T))" + using assms(2) by auto + thus "?A \ ?A'" "?B \ ?B'" "?C \ ?C'" "?D \ ?D'" + "?E \ ?E'" "?F \ ?F'" "?G \ ?G'" "?H \ ?H'" + using wellformed_transaction_unlabel_cases[OF assms(1)] by fast+ +qed + +lemma wellformed_transaction_send_receive_trm_cases: + assumes T: "wellformed_transaction T" + shows "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ receive\t\ \ set (unlabel (transaction_receive T))" + and "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \ send\t\ \ set (unlabel (transaction_send T))" +using wellformed_transaction_unlabel_cases(1,5)[OF T] + trms\<^sub>s\<^sub>s\<^sub>t_in[of t "unlabel (transaction_receive T)"] + trms\<^sub>s\<^sub>s\<^sub>t_in[of t "unlabel (transaction_send T)"] +by fastforce+ + +lemma wellformed_transaction_send_receive_subst_trm_cases: + assumes T: "wellformed_transaction T" + shows "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \\<^sub>s\<^sub>e\<^sub>t \ \ receive\t\ \ set (unlabel (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + and "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \ \ send\t\ \ set (unlabel (transaction_send T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" +proof - + assume "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \\<^sub>s\<^sub>e\<^sub>t \" + then obtain s where s: "s \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" "t = s \ \" + by blast + hence "receive\s\ \ set (unlabel (transaction_receive T))" + using wellformed_transaction_send_receive_trm_cases(1)[OF T] by simp + thus "receive\t\ \ set (unlabel (transaction_receive T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + by (metis s(2) unlabel_subst[of _ \] stateful_strand_step_subst_inI(2)) +next + assume "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \\<^sub>s\<^sub>e\<^sub>t \" + then obtain s where s: "s \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "t = s \ \" + by blast + hence "send\s\ \ set (unlabel (transaction_send T))" + using wellformed_transaction_send_receive_trm_cases(2)[OF T] by simp + thus "send\t\ \ set (unlabel (transaction_send T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" + by (metis s(2) unlabel_subst[of _ \] stateful_strand_step_subst_inI(1)) +qed + +lemma wellformed_transaction_send_receive_fv_subset: + assumes T: "wellformed_transaction T" + shows "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ fv t \ fv_transaction T" (is "?A \ ?A'") + and "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \ fv t \ fv_transaction T" (is "?B \ ?B'") +proof - + have "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ receive\t\ \ set (unlabel (transaction_strand T))" + "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \ send\t\ \ set (unlabel (transaction_strand T))" + using wellformed_transaction_send_receive_trm_cases[OF T, of t] + unfolding transaction_strand_def by force+ + thus "?A \ ?A'" "?B \ ?B'" by (induct "transaction_strand T") auto +qed + +lemma dual_wellformed_transaction_ident_cases[dest]: + "list_all is_Assignment (unlabel S) \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S = S" + "list_all is_Check (unlabel S) \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S = S" + "list_all is_Update (unlabel S) \ dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S = S" +proof (induction S) + case (Cons s S) + obtain l x where s: "s = (l,x)" by moura + { case 1 thus ?case using Cons s unfolding unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by (cases x) auto } + { case 2 thus ?case using Cons s unfolding unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by (cases x) auto } + { case 3 thus ?case using Cons s unfolding unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by (cases x) auto } +qed simp_all + +lemma wellformed_transaction_wf\<^sub>s\<^sub>s\<^sub>t: + fixes T::"('a, 'b, 'c, 'd) prot_transaction" + assumes T: "wellformed_transaction T" + shows "wf'\<^sub>s\<^sub>s\<^sub>t (set (transaction_fresh T)) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))" (is ?A) + and "fv_transaction T \ bvars_transaction T = {}" (is ?B) + and "set (transaction_fresh T) \ bvars_transaction T = {}" (is ?C) +proof - + define T1 where "T1 \ unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T))" + define T2 where "T2 \ unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T))" + define T3 where "T3 \ unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T))" + define T4 where "T4 \ unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T))" + define T5 where "T5 \ unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))" + + define X where "X \ set (transaction_fresh T)" + define Y where "Y \ X \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1" + define Z where "Z \ Y \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2" + + define f where "f \ \S::(('a,'b,'c) prot_fun, ('a,'b,'c) prot_var) stateful_strand. + \((\x. case x of + Receive t \ fv t + | Equality Assign _ t' \ fv t' + | Insert t t' \ fv t \ fv t' + | _ \ {}) ` set S)" + + note defs1 = T1_def T2_def T3_def T4_def T5_def + note defs2 = X_def Y_def Z_def + note defs3 = f_def + + have 0: "wf'\<^sub>s\<^sub>s\<^sub>t V (S @ S')" + when "wf'\<^sub>s\<^sub>s\<^sub>t V S" "f S' \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S \ V" for V S S' + by (metis that wf\<^sub>s\<^sub>s\<^sub>t_append_suffix' f_def) + + have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) = T1@T2@T3@T4@T5" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append unlabel_append unfolding transaction_strand_def defs1 by simp + + have 2: + "\x \ set T1. is_Send x" "\x \ set T2. is_Assignment x" "\x \ set T3. is_Check x" + "\x \ set T4. is_Update x" "\x \ set T5. is_Receive x" + "fv\<^sub>s\<^sub>s\<^sub>t T3 \ fv\<^sub>s\<^sub>s\<^sub>t T1 \ fv\<^sub>s\<^sub>s\<^sub>t T2" "fv\<^sub>s\<^sub>s\<^sub>t T4 \ fv\<^sub>s\<^sub>s\<^sub>t T5 \ X \ fv\<^sub>s\<^sub>s\<^sub>t T1 \ fv\<^sub>s\<^sub>s\<^sub>t T2" + "X \ fv\<^sub>s\<^sub>s\<^sub>t T1 = {}" "X \ fv\<^sub>s\<^sub>s\<^sub>t T2 = {}" + "\x \ set T2. is_Equality x \ fv (the_rhs x) \ fv\<^sub>s\<^sub>s\<^sub>t T1" + using T unfolding defs1 defs2 wellformed_transaction_def + by (auto simp add: Ball_set dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq simp del: fv\<^sub>s\<^sub>s\<^sub>t_def) + + have 3: "wf'\<^sub>s\<^sub>s\<^sub>t X T1" using 2(1) + proof (induction T1 arbitrary: X) + case (Cons s T) + obtain t where "s = send\t\" using Cons.prems by (cases s) moura+ + thus ?case using Cons by auto + qed simp + + have 4: "f T1 = {}" "fv\<^sub>s\<^sub>s\<^sub>t T1 = wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1" using 2(1) + proof (induction T1) + case (Cons s T) + { case 1 thus ?case using Cons unfolding defs3 by (cases s) auto } + { case 2 thus ?case using Cons unfolding defs3 wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def by (cases s) auto } + qed (simp_all add: defs3 wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def) + + have 5: "f T2 \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1" "fv\<^sub>s\<^sub>s\<^sub>t T2 = f T2 \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2" using 2(2,10) + proof (induction T2) + case (Cons s T) + { case 1 thus ?case using Cons + proof (cases s) + case (Equality ac t t') thus ?thesis using 1 Cons 4(2) unfolding defs3 by (cases ac) auto + qed (simp_all add: defs3) + } + { case 2 thus ?case using Cons + proof (cases s) + case (Equality ac t t') + hence "ac = Assign" "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s = fv t' \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" "f (s#T) = fv t' \ f T" + using 2 unfolding defs3 by auto + moreover have "fv\<^sub>s\<^sub>s\<^sub>t T = f T \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T" using Cons.IH(2) 2 by auto + ultimately show ?thesis unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def by auto + next + case (InSet ac t t') + hence "ac = Assign" "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s = wfvarsoccs\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" "f (s#T) = f T" + using 2 unfolding defs3 by auto + moreover have "fv\<^sub>s\<^sub>s\<^sub>t T = f T \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T" using Cons.IH(2) 2 by auto + ultimately show ?thesis unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def by auto + qed (simp_all add: defs3) + } + qed (simp_all add: defs3 wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def) + + have "f T \ fv\<^sub>s\<^sub>s\<^sub>t T" for T + proof + fix x show "x \ f T \ x \ fv\<^sub>s\<^sub>s\<^sub>t T" + proof (induction T) + case (Cons s T) thus ?case + proof (cases "x \ f T") + case False thus ?thesis + using Cons.prems unfolding defs3 fv\<^sub>s\<^sub>s\<^sub>t_def + by (auto split: stateful_strand_step.splits poscheckvariant.splits) + qed auto + qed (simp add: defs3 fv\<^sub>s\<^sub>s\<^sub>t_def) + qed + hence 6: + "f T3 \ X \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1 \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2" + "f T4 \ X \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1 \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2" + "f T5 \ X \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1 \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2" + using 2(6,7) 4 5 by blast+ + + have 7: + "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T3 = {}" + "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T4 = {}" + "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T5 = {}" + using 2(3,4,5) unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def + by (auto split: stateful_strand_step.splits) + + have 8: + "f T2 \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1 \ X" + "f T3 \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (T1@T2) \ X" + "f T4 \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t ((T1@T2)@T3) \ X" + "f T5 \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (((T1@T2)@T3)@T4) \ X" + using 4(1) 5(1) 6 7 wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_append[of T1 T2] + wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_append[of "T1@T2" T3] + wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_append[of "(T1@T2)@T3" T4] + by blast+ + + have "wf'\<^sub>s\<^sub>s\<^sub>t X (T1@T2@T3@T4@T5)" + using 0[OF 0[OF 0[OF 0[OF 3 8(1)] 8(2)] 8(3)] 8(4)] + unfolding Y_def Z_def by simp + thus ?A using 1 unfolding defs1 defs2 by simp + + have "set (transaction_fresh T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" + "fv_transaction T \ bvars_transaction T = {}" + using T unfolding wellformed_transaction_def by fast+ + thus ?B ?C using fv_transaction_unfold[of T] bvars_transaction_unfold[of T] by blast+ +qed + +lemma dual_wellformed_transaction_ident_cases'[dest]: + assumes "wellformed_transaction T" + shows "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = transaction_selects T" + "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) = transaction_checks T" + "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) = transaction_updates T" +using assms unfolding wellformed_transaction_def by auto + +lemma dual_transaction_strand: + assumes "wellformed_transaction T" + shows "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) = + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)@transaction_selects T@transaction_checks T@ + transaction_updates T@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" +using dual_wellformed_transaction_ident_cases'[OF assms] dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append +unfolding transaction_strand_def by metis + +lemma dual_unlabel_transaction_strand: + assumes "wellformed_transaction T" + shows "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) = + (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)))@(unlabel (transaction_selects T))@ + (unlabel (transaction_checks T))@(unlabel (transaction_updates T))@ + (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)))" +using dual_transaction_strand[OF assms] by (simp add: unlabel_def) + +lemma dual_transaction_strand_subst: + assumes "wellformed_transaction T" + shows "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = + (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)@transaction_selects T@transaction_checks T@ + transaction_updates T@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" +proof - + have "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst by metis + thus ?thesis using dual_transaction_strand[OF assms] by argo +qed + +lemma dual_transaction_ik_is_transaction_send: + assumes "wellformed_transaction T" + shows "ik\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))) = trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_send T))" + (is "?A = ?B") +proof - + { fix t assume "t \ ?A" + hence "receive\t\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))" by (simp add: ik\<^sub>s\<^sub>s\<^sub>t_def) + hence "send\t\ \ set (unlabel (transaction_strand T))" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(1) by metis + hence "t \ ?B" using wellformed_transaction_strand_unlabel_memberD(8)[OF assms] by force + } moreover { + fix t assume "t \ ?B" + hence "send\t\ \ set (unlabel (transaction_send T))" + using wellformed_transaction_unlabel_cases(5)[OF assms] by fastforce + hence "receive\t\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)))" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(1) by metis + hence "receive\t\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))" + using dual_unlabel_transaction_strand[OF assms] by simp + hence "t \ ?A" by (simp add: ik\<^sub>s\<^sub>s\<^sub>t_def) + } ultimately show "?A = ?B" by auto +qed + +lemma dual_transaction_ik_is_transaction_send': + fixes \::"('a,'b,'c) prot_subst" + assumes "wellformed_transaction T" + shows "ik\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) = + trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_send T)) \\<^sub>s\<^sub>e\<^sub>t \" (is "?A = ?B") +using dual_transaction_ik_is_transaction_send[OF assms] + subst_lsst_unlabel[of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" \] + ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))" \] + dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" \] +by auto + +lemma db\<^sub>s\<^sub>s\<^sub>t_transaction_prefix_eq: + assumes T: "wellformed_transaction T" + and S: "prefix S (transaction_receive T@transaction_selects T@transaction_checks T)" + shows "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" +proof - + let ?T1 = "transaction_receive T" + let ?T2 = "transaction_selects T" + let ?T3 = "transaction_checks T" + + have *: "prefix (unlabel S) (unlabel (?T1@?T2@?T3))" using S prefix_proj(1) by blast + + have "list_all is_Receive (unlabel ?T1)" + "list_all is_Assignment (unlabel ?T2)" + "list_all is_Check (unlabel ?T3)" + using T by (simp_all add: wellformed_transaction_def) + hence "\b \ set (unlabel ?T1). \is_Insert b \ \is_Delete b" + "\b \ set (unlabel ?T2). \is_Insert b \ \is_Delete b" + "\b \ set (unlabel ?T3). \is_Insert b \ \is_Delete b" + by (metis (mono_tags, lifting) Ball_set stateful_strand_step.distinct_disc(16,18), + metis (mono_tags, lifting) Ball_set stateful_strand_step.distinct_disc(24,26,33,37), + metis (mono_tags, lifting) Ball_set stateful_strand_step.distinct_disc(24,26,33,35,37,39)) + hence "\b \ set (unlabel (?T1@?T2@?T3)). \is_Insert b \ \is_Delete b" + by (auto simp add: unlabel_def) + hence "\b \ set (unlabel S). \is_Insert b \ \is_Delete b" + using * unfolding prefix_def by fastforce + hence "\b \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \\<^sub>s\<^sub>s\<^sub>t \). \is_Insert b \ \is_Delete b" + proof (induction S) + case (Cons a S) + then obtain l b where "a = (l,b)" by (metis surj_pair) + thus ?case + using Cons unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def unlabel_def subst_apply_stateful_strand_def + by (cases b) auto + qed simp + hence **: "\b \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))). \is_Insert b \ \is_Delete b" + by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_unlabel) + + show ?thesis + using db\<^sub>s\<^sub>s\<^sub>t_no_upd_append[OF **] unlabel_append + unfolding db\<^sub>s\<^sub>s\<^sub>t_def by metis +qed + +lemma db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_ex: + assumes "d \ set (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ D)" + "\t u. insert\t,u\ \ set (unlabel A) \ (\s. u = Fun (Set s) [])" + "\t u. delete\t,u\ \ set (unlabel A) \ (\s. u = Fun (Set s) [])" + "\d \ set D. \s. snd d = Fun (Set s) []" + shows "\s. snd d = Fun (Set s) []" + using assms +proof (induction A arbitrary: D) + case (Cons a A) + obtain l b where a: "a = (l,b)" by (metis surj_pair) + + have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = receive\t \ \\#unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + when "b = send\t\" for t + by (simp add: a that subst_lsst_unlabel_cons) + + have 2: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = send\t \ \\#unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + when "b = receive\t\" for t + by (simp add: a that subst_lsst_unlabel_cons) + + have 3: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)#unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + when "\t. b = send\t\ \ b = receive\t\" + using a that dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_Cons subst_lsst_unlabel_cons[of l b] + by (cases b) auto + + show ?case using 1 2 3 a Cons by (cases b) fastforce+ +qed simp + +lemma is_Fun_SetE[elim]: + assumes t: "is_Fun_Set t" + obtains s where "t = Fun (Set s) []" +proof (cases t) + case (Fun f T) + then obtain s where "f = Set s" using t unfolding is_Fun_Set_def by (cases f) moura+ + moreover have "T = []" using Fun t unfolding is_Fun_Set_def by (cases T) auto + ultimately show ?thesis using Fun that by fast +qed (use t is_Fun_Set_def in fast) + +lemma Fun_Set_InSet_iff: + "(u = \a: Var x \ Fun (Set s) []\) \ + (is_InSet u \ is_Var (the_elem_term u) \ is_Fun_Set (the_set_term u) \ + the_Set (the_Fun (the_set_term u)) = s \ the_Var (the_elem_term u) = x \ the_check u = a)" + (is "?A \ ?B") +proof + show "?A \ ?B" unfolding is_Fun_Set_def by auto + + assume B: ?B + thus ?A + proof (cases u) + case (InSet b t t') + hence "b = a" "t = Var x" "t' = Fun (Set s) []" + using B by (simp, fastforce, fastforce) + thus ?thesis using InSet by fast + qed auto +qed + +lemma Fun_Set_NotInSet_iff: + "(u = \Var x not in Fun (Set s) []\) \ + (is_NegChecks u \ bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p u = [] \ the_eqs u = [] \ length (the_ins u) = 1 \ + is_Var (fst (hd (the_ins u))) \ is_Fun_Set (snd (hd (the_ins u)))) \ + the_Set (the_Fun (snd (hd (the_ins u)))) = s \ the_Var (fst (hd (the_ins u))) = x" + (is "?A \ ?B") +proof + show "?A \ ?B" unfolding is_Fun_Set_def by auto + + assume B: ?B + show ?A + proof (cases u) + case (NegChecks X F F') + hence "X = []" "F = []" + using B by auto + moreover have "fst (hd (the_ins u)) = Var x" "snd (hd (the_ins u)) = Fun (Set s) []" + using B is_Fun_SetE[of "snd (hd (the_ins u))"] + by (force, fastforce) + hence "F' = [(Var x, Fun (Set s) [])]" + using NegChecks B by (cases "the_ins u") auto + ultimately show ?thesis using NegChecks by fast + qed (use B in auto) +qed + +lemma is_Fun_Set_exi: "is_Fun_Set x \ (\s. x = Fun (Set s) [])" +by (metis prot_fun.collapse(2) term.collapse(2) prot_fun.disc(15) term.disc(2) + term.sel(2,4) is_Fun_Set_def un_Fun1_def) + +lemma is_Fun_Set_subst: + assumes "is_Fun_Set S'" + shows "is_Fun_Set (S' \ \)" +using assms by (fastforce simp add: is_Fun_Set_def) + +lemma is_Update_in_transaction_updates: + assumes tu: "is_Update t" + assumes t: "t \ set (unlabel (transaction_strand TT))" + assumes vt: "wellformed_transaction TT" + shows "t \ set (unlabel (transaction_updates TT))" +using t tu vt unfolding transaction_strand_def wellformed_transaction_def list_all_iff +by (auto simp add: unlabel_append) + +lemma transaction_fresh_vars_subset: + assumes "wellformed_transaction T" + shows "set (transaction_fresh T) \ fv_transaction T" +using assms fv_transaction_unfold[of T] +unfolding wellformed_transaction_def +by auto + +lemma transaction_fresh_vars_notin: + assumes T: "wellformed_transaction T" + and x: "x \ set (transaction_fresh T)" + shows "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" (is ?A) + and "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" (is ?B) + and "x \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?C) + and "x \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" (is ?D) + and "x \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" (is ?E) + and "x \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?F) + and "x \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" (is ?G) + and "x \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" (is ?H) + and "x \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?I) +proof - + have 0: + "set (transaction_fresh T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" + "set (transaction_fresh T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}" + "set (transaction_fresh T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {}" + "fv_transaction T \ bvars_transaction T = {}" + "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" + using T unfolding wellformed_transaction_def + by fast+ + + have 1: "set (transaction_fresh T) \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) = {}" + using 0(1,4) fv_transaction_unfold[of T] bvars_transaction_unfold[of T] by blast + + have 2: + "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" + "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" + "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}" + "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {}" + using bvars_wellformed_transaction_unfold[OF T] bvars_transaction_unfold[of T] + vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_receive T)"] + vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_selects T)"] + by blast+ + + show ?A ?B ?C ?D ?E ?G ?H ?I using 0 1 2 x by fast+ + + show ?F using 0(2,3,5) 1 x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_checks T)"] by fast +qed + + +lemma transaction_proj_member: + assumes "T \ set P" + shows "transaction_proj n T \ set (map (transaction_proj n) P)" +using assms by simp + +lemma transaction_strand_proj: + "transaction_strand (transaction_proj n T) = proj n (transaction_strand T)" +proof - + obtain A B C D E F where "T = Transaction A B C D E F" by (cases T) simp + thus ?thesis + using transaction_proj.simps[of n A B C D E F] + unfolding transaction_strand_def proj_def Let_def by auto +qed + +lemma transaction_proj_fresh_eq: + "transaction_fresh (transaction_proj n T) = transaction_fresh T" +proof - + obtain A B C D E F where "T = Transaction A B C D E F" by (cases T) simp + thus ?thesis + using transaction_proj.simps[of n A B C D E F] + unfolding transaction_fresh_def proj_def Let_def by auto +qed + +lemma transaction_proj_trms_subset: + "trms_transaction (transaction_proj n T) \ trms_transaction T" +proof - + obtain A B C D E F where "T = Transaction A B C D E F" by (cases T) simp + thus ?thesis + using transaction_proj.simps[of n A B C D E F] trms\<^sub>s\<^sub>s\<^sub>t_proj_subset(1)[of n] + unfolding transaction_fresh_def Let_def transaction_strand_def by auto +qed + +lemma transaction_proj_vars_subset: + "vars_transaction (transaction_proj n T) \ vars_transaction T" +proof - + obtain A B C D E F where "T = Transaction A B C D E F" by (cases T) simp + thus ?thesis + using transaction_proj.simps[of n A B C D E F] + sst_vars_proj_subset(3)[of n "transaction_strand T"] + unfolding transaction_fresh_def Let_def transaction_strand_def by simp +qed + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/document/root.bib b/thys/Automated_Stateful_Protocol_Verification/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/document/root.bib @@ -0,0 +1,72 @@ + +@InProceedings{ brucker.ea:integrating:2009, + author = {Achim D. Brucker and Sebastian M{\"{o}}dersheim}, + editor = {Pierpaolo Degano and Joshua D. Guttman}, + title = {{Integrating Automated and Interactive Protocol Verification}}, + booktitle = {Formal Aspects in Security and Trust, 6th International Workshop, {FAST} 2009, Eindhoven, The + Netherlands, November 5-6, 2009, Revised Selected Papers}, + series = {Lecture Notes in Computer Science}, + volume = 5983, + pages = {248--262}, + publisher = {Springer}, + year = 2009, + doi = {10.1007/978-3-642-12459-4_18} +} + + +@InProceedings{ hess.ea:formalizing:2017, + author = {Andreas V. Hess and Sebastian M{\"{o}}dersheim}, + title = {{Formalizing and Proving a Typing Result for Security Protocols in Isabelle/HOL}}, + booktitle = {30th {IEEE} Computer Security Foundations Symposium, {CSF} 2017, Santa Barbara, CA, USA, August + 21-25, 2017}, + pages = {451--463}, + publisher = {{IEEE} Computer Society}, + year = 2017, + doi = {10.1109/CSF.2017.27} +} + +@InProceedings{ hess.ea:typing:2018, + author = {Andreas V. Hess and Sebastian M{\"{o}}dersheim}, + title = {{A Typing Result for Stateful Protocols}}, + booktitle = {31st {IEEE} Computer Security Foundations Symposium, {CSF} 2018, Oxford, United Kingdom, July 9-12, + 2018}, + pages = {374--388}, + publisher = {{IEEE} Computer Society}, + year = 2018, + doi = {10.1109/CSF.2018.00034} +} + +@InProceedings{ hess.ea:stateful:2018, + author = {Andreas V. Hess and Sebastian M{\"{o}}dersheim and Achim D. Brucker}, + editor = {Javier L{\'{o}}pez and Jianying Zhou and Miguel Soriano}, + title = {{Stateful Protocol Composition}}, + booktitle = {Computer Security - 23rd European Symposium on Research in Computer Security, {ESORICS} 2018, + Barcelona, Spain, September 3-7, 2018, Proceedings, Part {I}}, + series = {Lecture Notes in Computer Science}, + volume = 11098, + pages = {427--446}, + publisher = {Springer}, + year = 2018, + doi = {10.1007/978-3-319-99073-6_21} +} + +@PhDThesis{ hess:typing:2018, + author = {Andreas Viktor Hess}, + title = {Typing and Compositionality for Stateful Security Protocols}, + year = {2019}, + url = {https://orbit.dtu.dk/en/publications/typing-and-compositionality-for-stateful-security-protocols}, + language = {English}, + series = {TU Compute PHD-2018}, + publisher = {DTU Compute} +} + +@Article{ hess.ea:stateful:2020, + author = {Andreas V. Hess and Sebastian~M{\"o}dersheim and Achim~D.~Brucker}, + title = {{Stateful Protocol Composition and Typing}}, + journal = {Archive of Formal Proofs}, + month = apr, + year = 2020, + note = {\url{http://isa-afp.org/entries/Stateful_Protocol_Composition_and_Typing.html}, Formal proof + development}, + issn = {2150-914x} +} diff --git a/thys/Automated_Stateful_Protocol_Verification/document/root.tex b/thys/Automated_Stateful_Protocol_Verification/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/document/root.tex @@ -0,0 +1,166 @@ +\documentclass[10pt,DIV16,a4paper,abstract=true,twoside=semi,openright] +{scrreprt} +\usepackage[USenglish]{babel} +\usepackage[numbers, sort&compress]{natbib} +\usepackage{isabelle,isabellesym} +\usepackage{booktabs} +\usepackage{paralist} +\usepackage{graphicx} +\usepackage{amssymb} +\usepackage{xspace} +\usepackage{xcolor} +\usepackage{hyperref} + + +\pagestyle{headings} +\isabellestyle{default} +\setcounter{tocdepth}{1} +\newcommand{\ie}{i.\,e.\xspace} +\newcommand{\eg}{e.\,g.\xspace} +\newcommand{\thy}{\isabellecontext} +\renewcommand{\isamarkupsection}[1]{% + \begingroup% + \def\isacharunderscore{\textunderscore}% + \section{#1 (\thy)}% + \def\isacharunderscore{-}% + \expandafter\label{sec:\isabellecontext}% + \endgroup% +} + +\title{Automated Stateful Protocol Verification} +\author{% +\begin{minipage}{.8\textwidth} + \centering + \href{https://www.dtu.dk/english/service/phonebook/person?id=64207}{Andreas~V.~Hess}\footnotemark[1] + \qquad\qquad + \href{https://people.compute.dtu.dk/samo/}{Sebastian~M{\"o}dersheim}\footnotemark[1] + \\ + \href{http://www.brucker.ch/}{Achim~D.~Brucker}\footnotemark[2] + \qquad\qquad + \href{https://people.compute.dtu.dk/andschl}{Anders~Schlichtkrull} + \end{minipage} +} + +\publishers{% + \footnotemark[1]~DTU Compute, Technical University of Denmark, Lyngby, Denmark\texorpdfstring{\\}{, } + \texttt{\{avhe, samo, andschl\}@dtu.dk}\\[2em] + % + \footnotemark[2]~ + Department of Computer Science, University of Exeter, Exeter, UK\texorpdfstring{\\}{, } + \texttt{a.brucker@exeter.ac.uk} + % +} + +\begin{document} + \maketitle + \begin{abstract} + \begin{quote} + In protocol verification we observe a wide spectrum from fully + automated methods to interactive theorem proving with proof + assistants like Isabelle/HOL. + In this AFP entry, we present a fully-automated approach for + verifying stateful security protocols, i.e., protocols with mutable + state that may span several sessions. + The approach supports reachability goals like secrecy and + authentication. + We also include a simple user-friendly transaction-based + protocol specification language that is embedded into Isabelle. + + \bigskip + \noindent{\textbf{Keywords:}} + Fully automated verification, stateful security protocols + \end{quote} + \end{abstract} + + +\tableofcontents +\cleardoublepage + +\chapter{Introduction} + In protocol verification we observe a wide spectrum from fully + automated methods to interactive theorem proving with proof + assistants like Isabelle/HOL. The latter provide overwhelmingly high + assurance of the correctness, which automated methods often cannot: + due to their complexity, bugs in such automated verification tools + are likely and thus the risk of erroneously verifying a flawed + protocol is non-negligible. There are a few works that try to + combine advantages from both ends of the spectrum: a high degree of + automation and assurance. + + Inspired by~\cite{brucker.ea:integrating:2009}, we present here a + first step towards achieving this for a more challenging class of + protocols, namely those that work with a mutable long-term state. To + our knowledge this is the first approach that achieves fully + automated verification of stateful protocols in an LCF-style theorem + prover. The approach also includes a simple user-friendly + transaction-based protocol specification language embedded into + Isabelle, and can also leverage a number of existing results such as + soundness of a typed model (see, + e.g.,~\cite{hess:typing:2018,hess.ea:formalizing:2017,hess.ea:typing:2018}) + and compositionality (see, + e.g.,~\cite{hess:typing:2018,hess.ea:stateful:2018}). The Isabelle + formalization extends the AFP entry on stateful protocol composition and + typing~\cite{hess.ea:stateful:2020}. + + \begin{figure} + \centering + \includegraphics[height=\textheight]{session_graph} + \caption{The Dependency Graph of the Isabelle Theories.\label{fig:session-graph}} + \end{figure} + The rest of this document is automatically generated from the + formalization in Isabelle/HOL, i.e., all content is checked by + Isabelle. Overall, the structure of this document follows the + theory dependencies (see \autoref{fig:session-graph}): We start with + the formal framework for verifying stateful security protocols + (\autoref{cha:verification}). We continue with the setup for + supporting the high-level protocol specifications language for + security protocols (the Trac format) and the implementation of the + fully automated proof tactics (\autoref{cha:trac}). Finally, we + present examples (\autoref{cha:examples}). + +\paragraph{Acknowledgments} +This work was supported by the Sapere-Aude project ``Composec: Secure Composition of Distributed Systems'', grant 4184-00334B of the Danish Council for Independent Research. + +\clearpage + +\chapter{Stateful Protocol Verification} +\label{cha:verification} +\input{Transactions.tex} +\input{Term_Abstraction.tex} +\input{Stateful_Protocol_Model.tex} +\input{Term_Variants.tex} +\input{Term_Implication.tex} +\input{Stateful_Protocol_Verification.tex} + +\chapter{Trac Support and Automation} +\label{cha:trac} +\input{Eisbach_Protocol_Verification.tex} +\input{ml_yacc_lib.tex} +\input{trac_term.tex} +\input{trac_fp_parser.tex} +\input{trac_protocol_parser.tex} +\input{trac.tex} + +\chapter{Examples} +\label{cha:examples} +\input{Keyserver.tex} +\input{Keyserver2.tex} +\input{Keyserver_Composition.tex} +\input{PKCS_Model03.tex} +\input{PKCS_Model07.tex} +\input{PKCS_Model09.tex} + +% \input{session} + + +{\small + \bibliographystyle{abbrvnat} + \bibliography{root} +} +\end{document} +\endinput +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: + diff --git a/thys/Automated_Stateful_Protocol_Verification/examples/Keyserver.thy b/thys/Automated_Stateful_Protocol_Verification/examples/Keyserver.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/examples/Keyserver.thy @@ -0,0 +1,133 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Keyserver.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\The Keyserver Protocol\ +theory Keyserver + imports "../PSPSP" +begin + +declare [[code_timing]] + +trac\ +Protocol: keyserver + +Types: +honest = {a,b,c} +server = {s} +agents = honest ++ server + +Sets: +ring/1 valid/2 revoked/2 + +Functions: +Public sign/2 crypt/2 pair/2 +Private inv/1 + +Analysis: +sign(X,Y) -> Y +crypt(X,Y) ? inv(X) -> Y +pair(X,Y) -> X,Y + +Transactions: +# Out-of-band registration +outOfBand(A:honest,S:server) + new NPK + insert NPK ring(A) + insert NPK valid(A,S) + send NPK. + +# User update key +keyUpdateUser(A:honest,PK:value) + PK in ring(A) + new NPK + delete PK ring(A) + insert NPK ring(A) + send sign(inv(PK),pair(A,NPK)). + +# Server update key +keyUpdateServer(A:honest,S:server,PK:value,NPK:value) + receive sign(inv(PK),pair(A,NPK)) + PK in valid(A,S) + NPK notin valid(_) + NPK notin revoked(_) + delete PK valid(A,S) + insert PK revoked(A,S) + insert NPK valid(A,S) + send inv(PK). + +# Attack definition +authAttack(A:honest,S:server,PK:value) + receive inv(PK) + PK in valid(A,S) + attack. +\\ +val(ring(A)) where A:honest +sign(inv(val(0)),pair(A,val(ring(A)))) where A:honest +inv(val(revoked(A,S))) where A:honest S:server +pair(A,val(ring(A))) where A:honest + +occurs(val(ring(A))) where A:honest + +timplies(val(ring(A)),val(ring(A),valid(A,S))) where A:honest S:server +timplies(val(ring(A)),val(0)) where A:honest +timplies(val(ring(A),valid(A,S)),val(valid(A,S))) where A:honest S:server +timplies(val(0),val(valid(A,S))) where A:honest S:server +timplies(val(valid(A,S)),val(revoked(A,S))) where A:honest S:server +\ + + +subsection \Proof of security\ +protocol_model_setup spm: keyserver +compute_SMP [optimized] keyserver_protocol keyserver_SMP +manual_protocol_security_proof ssp: keyserver + for keyserver_protocol keyserver_fixpoint keyserver_SMP + apply check_protocol_intro + subgoal by code_simp + subgoal by code_simp + subgoal by code_simp + subgoal by code_simp + subgoal by code_simp + done + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/examples/Keyserver2.thy b/thys/Automated_Stateful_Protocol_Verification/examples/Keyserver2.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/examples/Keyserver2.thy @@ -0,0 +1,132 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Keyserver2.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\A Variant of the Keyserver Protocol\ +theory Keyserver2 + imports "../PSPSP" +begin + +declare [[code_timing]] + +trac\ +Protocol: keyserver2 + +Types: +honest = {a,b,c} +dishonest = {i} +agent = honest ++ dishonest + +Sets: +ring'/1 seen/1 pubkeys/0 valid/1 + +Functions: +Public h/1 sign/2 crypt/2 scrypt/2 pair/2 update/3 +Private inv/1 pw/1 + +Analysis: +sign(X,Y) -> Y +crypt(X,Y) ? inv(X) -> Y +scrypt(X,Y) ? X -> Y +pair(X,Y) -> X,Y +update(X,Y,Z) -> X,Y,Z + +Transactions: +passwordGenD(A:dishonest) + send pw(A). + +pubkeysGen() + new PK + insert PK pubkeys + send PK. + +updateKeyPw(A:honest,PK:value) + PK in pubkeys + new NPK + insert NPK ring'(A) + send NPK + send crypt(PK,update(A,NPK,pw(A))). + +updateKeyServerPw(A:agent,PK:value,NPK:value) + receive crypt(PK,update(A,NPK,pw(A))) + PK in pubkeys + NPK notin pubkeys + NPK notin seen(_) + insert NPK valid(A) + insert NPK seen(A). + +authAttack2(A:honest,PK:value) + receive inv(PK) + PK in valid(A) + attack. +\ + + +subsection \Proof of security \ +protocol_model_setup spm: keyserver2 +compute_fixpoint keyserver2_protocol keyserver2_fixpoint +protocol_security_proof ssp: keyserver2 + + +subsection \The generated theorems and definitions\ +thm ssp.protocol_secure + +thm keyserver2_enum_consts.nchotomy +thm keyserver2_sets.nchotomy +thm keyserver2_fun.nchotomy +thm keyserver2_atom.nchotomy +thm keyserver2_arity.simps +thm keyserver2_public.simps +thm keyserver2_\.simps +thm keyserver2_Ana.simps + +thm keyserver2_transaction_passwordGenD_def +thm keyserver2_transaction_pubkeysGen_def +thm keyserver2_transaction_updateKeyPw_def +thm keyserver2_transaction_updateKeyServerPw_def +thm keyserver2_transaction_authAttack2_def +thm keyserver2_protocol_def + +thm keyserver2_fixpoint_def + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/examples/Keyserver_Composition.thy b/thys/Automated_Stateful_Protocol_Verification/examples/Keyserver_Composition.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/examples/Keyserver_Composition.thy @@ -0,0 +1,295 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Keyserver_Composition.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\The Composition of the Two Keyserver Protocols\ +theory Keyserver_Composition + imports "../PSPSP" +begin + +declare [[code_timing]] + +trac\ +Protocol: kscomp + +Types: +honest = {a,b,c} +dishonest = {i} +agent = honest ++ dishonest + +Sets: +ring/1 valid/1 revoked/1 deleted/1 +ring'/1 seen/1 pubkeys/0 + +Functions: +Public h/1 sign/2 crypt/2 scrypt/2 pair/2 update/3 +Private inv/1 pw/1 + +Analysis: +sign(X,Y) -> Y +crypt(X,Y) ? inv(X) -> Y +scrypt(X,Y) ? X -> Y +pair(X,Y) -> X,Y +update(X,Y,Z) -> X,Y,Z + +Transactions: +### The signature-based keyserver protocol +p1_outOfBand(A:honest) + new PK + insert PK ring(A) +* insert PK valid(A) + send PK. + +p1_oufOfBandD(A:dishonest) + new PK +* insert PK valid(A) + send PK + send inv(PK). + +p1_updateKey(A:honest,PK:value) + PK in ring(A) + new NPK + delete PK ring(A) + insert PK deleted(A) + insert NPK ring(A) + send sign(inv(PK),pair(A,NPK)). + +p1_updateKeyServer(A:agent,PK:value,NPK:value) + receive sign(inv(PK),pair(A,NPK)) +* PK in valid(A) +* NPK notin valid(_) + NPK notin revoked(_) +* delete PK valid(A) + insert PK revoked(A) +* insert NPK valid(A) + send inv(PK). + +p1_authAttack(A:honest,PK:value) + receive inv(PK) +* PK in valid(A) + attack. + +### The password-based keyserver protocol +p2_passwordGenD(A:dishonest) + send pw(A). + +p2_pubkeysGen() + new PK + insert PK pubkeys + send PK. + +p2_updateKeyPw(A:honest,PK:value) + PK in pubkeys + new NPK +# NOTE: The ring' sets are not used elsewhere, but we have to avoid that the fresh keys generated +# by this rule are abstracted to the empty abstraction, and so we insert them into a ring' +# set. Otherwise the two protocols would have too many abstractions in common (in particular, +# the empty abstraction) which leads to false attacks in the composed protocol (probably +# because the term implication graphs of the two protocols then become 'linked' through the +# empty abstraction) + insert NPK ring'(A) + send NPK + send crypt(PK,update(A,NPK,pw(A))). + +#Transactions of p2: +p2_updateKeyServerPw(A:agent,PK:value,NPK:value) +receive crypt(PK,update(A,NPK,pw(A))) + PK in pubkeys + NPK notin pubkeys + NPK notin seen(_) +* insert NPK valid(A) + insert NPK seen(A). + +p2_authAttack2(A:honest,PK:value) + receive inv(PK) +* PK in valid(A) + attack. +\ \ +sign(inv(val(deleted(A))),pair(A,val(ring(A)))) where A:honest +sign(inv(val(deleted(A),valid(B))),pair(A,val(ring(A)))) where A:honest B:dishonest +sign(inv(val(deleted(A),seen(B),valid(B))),pair(A,val(ring(A)))) where A:honest B:dishonest +sign(inv(val(deleted(A),valid(A))),pair(A,val(ring(A)))) where A:honest B:dishonest +sign(inv(val(deleted(A),seen(B),valid(B),valid(A))),pair(A,val(ring(A)))) where A:honest B:dishonest +pair(A,val(ring(A))) where A:honest +inv(val(deleted(A),revoked(A))) where A:honest +inv(val(valid(A))) where A:dishonest +inv(val(revoked(A))) where A:dishonest +inv(val(revoked(A),seen(A))) where A:dishonest +inv(val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest +inv(val(revoked(A),deleted(A),seen(B),valid(B))) where A:honest B:dishonest +occurs(val(ring(A))) where A:honest +occurs(val(valid(A))) where A:dishonest +occurs(val(ring'(A))) where A:honest +occurs(val(pubkeys)) +occurs(val(valid(A),ring(A))) where A:honest +pw(A) where A:dishonest +crypt(val(pubkeys),update(A,val(ring'(A)),pw(A))) where A:honest +val(ring(A)) where A:honest +val(valid(A)) where A:dishonest +val(ring'(A)) where A:honest +val(pubkeys) +val(valid(A),ring(A)) where A:honest + +timplies(val(pubkeys),val(valid(A),pubkeys)) where A:dishonest + +timplies(val(ring'(A)),val(ring'(A),valid(B))) where A:honest B:dishonest +timplies(val(ring'(A)),val(ring'(A),valid(A),seen(A))) where A:honest +timplies(val(ring'(A)),val(ring'(A),valid(A),seen(A),valid(B))) where A:honest B:dishonest +timplies(val(ring'(A)),val(seen(B),valid(B),ring'(A))) where A:honest B:dishonest + +timplies(val(ring'(A),valid(B)),val(ring'(A),valid(A),seen(A),valid(B))) where A:honest B:dishonest +timplies(val(ring'(A),valid(B)),val(seen(B),valid(B),ring'(A))) where A:honest B:dishonest + +timplies(val(ring(A)),val(ring(A),valid(A))) where A:honest +timplies(val(ring(A)),val(ring(A),valid(B))) where A:honest B:dishonest +timplies(val(ring(A)),val(deleted(A))) where A:honest +timplies(val(ring(A)),val(revoked(A),deleted(A),seen(B),valid(B))) where A:honest B:dishonest +timplies(val(ring(A)),val(revoked(A),deleted(A),seen(B),revoked(B))) where A:honest B:dishonest +timplies(val(ring(A)),val(deleted(A),seen(B),valid(B))) where A:honest B:dishonest +timplies(val(ring(A)),val(ring(A),seen(B),valid(B))) where A:honest B:dishonest +timplies(val(ring(A)),val(valid(A),deleted(A),seen(B),valid(B))) where A:honest B:dishonest +timplies(val(ring(A)),val(valid(A),ring(A),seen(B),valid(B))) where A:honest B:dishonest + +timplies(val(ring(A),valid(A)),val(deleted(A),valid(A))) where A:honest +timplies(val(ring(A),valid(B)),val(deleted(A),valid(B))) where A:honest B:dishonest +timplies(val(ring(A),valid(A)),val(deleted(A),revoked(A))) where A:honest + +timplies(val(deleted(A)),val(deleted(A),valid(A))) where A:honest +timplies(val(deleted(A)),val(deleted(A),valid(B))) where A:honest B:dishonest +timplies(val(deleted(A)),val(revoked(A),seen(B),valid(B),deleted(A))) where A:honest B:dishonest +timplies(val(deleted(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest +timplies(val(deleted(A)),val(seen(B),valid(B),deleted(A))) where A:honest B:dishonest +timplies(val(deleted(A)),val(seen(B),valid(B),valid(A),deleted(A))) where A:honest B:dishonest + +timplies(val(revoked(A)),val(seen(A),revoked(A))) where A:dishonest +timplies(val(revoked(A)),val(seen(A),revoked(A),valid(A))) where A:dishonest + +timplies(val(revoked(A),deleted(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest +timplies(val(revoked(A),deleted(A)),val(seen(B),valid(B),revoked(A),deleted(A))) where A:honest B:dishonest + +timplies(val(seen(B),valid(B),deleted(A),valid(A)),val(revoked(A),seen(B),valid(B),deleted(A))) where A:honest B:dishonest +timplies(val(seen(B),valid(B),deleted(A),valid(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest +timplies(val(seen(B),valid(B),revoked(A),deleted(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest +timplies(val(seen(A),valid(A)),val(revoked(A),seen(A))) where A:dishonest +timplies(val(seen(A),valid(A),revoked(A)),val(seen(A),revoked(A))) where A:dishonest +timplies(val(seen(B),valid(B),ring(A)),val(deleted(A),seen(B),valid(B))) where A:honest B:dishonest +timplies(val(seen(B),valid(B),valid(A),ring(A)),val(deleted(A),seen(B),valid(B),valid(A))) where A:honest B:dishonest +timplies(val(seen(B),valid(B),valid(A),ring(A)),val(revoked(A),seen(B),valid(B),deleted(A))) where A:honest B:dishonest +timplies(val(seen(B),valid(B),valid(A),ring(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest + +timplies(val(valid(A)),val(revoked(A))) where A:dishonest + +timplies(val(valid(A),deleted(A)),val(deleted(A),revoked(A))) where A:honest +timplies(val(valid(A),deleted(A)),val(revoked(A),seen(B),valid(B),deleted(A))) where A:honest B:dishonest +timplies(val(valid(A),deleted(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest +timplies(val(valid(A),deleted(A)),val(seen(B),valid(B),valid(A),deleted(A))) where A:honest B:dishonest + +timplies(val(ring(A),valid(A)),val(deleted(A),seen(B),valid(B),valid(A))) where A:honest B:dishonest +timplies(val(ring(A),valid(A)),val(revoked(B),seen(B),revoked(A),deleted(A))) where A:honest B:dishonest +timplies(val(ring(A),valid(A)),val(seen(B),valid(B),valid(A),ring(A))) where A:honest B:dishonest +timplies(val(valid(B),deleted(A)),val(seen(B),valid(B),deleted(A))) where A:honest B:dishonest +timplies(val(ring(A),valid(B)),val(deleted(A),seen(B),valid(B))) where A:honest B:dishonest +timplies(val(ring(A),valid(B)),val(seen(B),valid(B),ring(A))) where A:honest B:dishonest + +timplies(val(valid(A)),val(seen(A),valid(A))) where A:dishonest +\ + +subsection \Proof: The composition of the two keyserver protocols is secure\ +protocol_model_setup spm: kscomp +setup_protocol_checks spm kscomp_protocol +manual_protocol_security_proof ssp: kscomp + apply check_protocol_intro + subgoal by code_simp + subgoal + apply coverage_check_intro + subgoal by code_simp + subgoal by code_simp + subgoal by eval + subgoal by eval + subgoal by eval + subgoal by code_simp + subgoal by code_simp + subgoal by eval + subgoal by eval + subgoal by eval + done + subgoal by eval + subgoal by eval + subgoal + apply (unfold spm.wellformed_fixpoint_def Let_def case_prod_unfold; intro conjI) + subgoal by code_simp + subgoal by code_simp + subgoal by eval + subgoal by code_simp + subgoal by code_simp + done + done + + +subsection \The generated theorems and definitions\ +thm ssp.protocol_secure + +thm kscomp_enum_consts.nchotomy +thm kscomp_sets.nchotomy +thm kscomp_fun.nchotomy +thm kscomp_atom.nchotomy +thm kscomp_arity.simps +thm kscomp_public.simps +thm kscomp_\.simps +thm kscomp_Ana.simps + +thm kscomp_transaction_p1_outOfBand_def +thm kscomp_transaction_p1_oufOfBandD_def +thm kscomp_transaction_p1_updateKey_def +thm kscomp_transaction_p1_updateKeyServer_def +thm kscomp_transaction_p1_authAttack_def +thm kscomp_transaction_p2_passwordGenD_def +thm kscomp_transaction_p2_pubkeysGen_def +thm kscomp_transaction_p2_updateKeyPw_def +thm kscomp_transaction_p2_updateKeyServerPw_def +thm kscomp_transaction_p2_authAttack2_def +thm kscomp_protocol_def + +thm kscomp_fixpoint_def + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model03.thy b/thys/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model03.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model03.thy @@ -0,0 +1,161 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: PKCS_Model03.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\The PKCS Model, Scenario 3\ +theory PKCS_Model03 + imports "../../PSPSP" + +begin + +declare [[code_timing]] + +trac\ +Protocol: ATTACK_UNSET + +Types: +token = {token1} + +Sets: +extract/1 wrap/1 decrypt/1 sensitive/1 + +Functions: +Public senc/2 h/1 +Private inv/1 + +Analysis: +senc(M,K2) ? K2 -> M #This analysis rule corresponds to the decrypt2 rule in the AIF-omega specification. + #M was type untyped + +Transactions: + +iik1() +new K1 +insert K1 sensitive(token1) +insert K1 extract(token1) +send h(K1). + +iik2() +new K2 +insert K2 wrap(token1) +send h(K2). + +# ======================wrap================ +wrap(K1:value,K2:value) +receive h(K1) +receive h(K2) +K1 in extract(token1) +K2 in wrap(token1) +send senc(K1,K2). + +# ======================set wrap================ +setwrap(K2:value) +receive h(K2) +K2 notin decrypt(token1) +insert K2 wrap(token1). + +# ======================set decrypt================ +setdecrypt(K2:value) +receive h(K2) +K2 notin wrap(token1) +insert K2 decrypt(token1). + +# ======================decrypt================ +decrypt1(K2:value,M:value) #M was untyped in the AIF-omega specification. +receive h(K2) +receive senc(M,K2) +K2 in decrypt(token1) +send M. + +# ======================attacks================ +attack1(K1:value) +receive K1 +K1 in sensitive(token1) +attack. +\ + +subsection \Protocol model setup\ +protocol_model_setup spm: ATTACK_UNSET + +subsection \Fixpoint computation\ +compute_fixpoint ATTACK_UNSET_protocol ATTACK_UNSET_fixpoint +compute_SMP [optimized] ATTACK_UNSET_protocol ATTACK_UNSET_SMP + +subsection \Proof of security\ +manual_protocol_security_proof ssp: ATTACK_UNSET + for ATTACK_UNSET_protocol ATTACK_UNSET_fixpoint ATTACK_UNSET_SMP + apply check_protocol_intro + subgoal by code_simp + subgoal by code_simp + subgoal by code_simp + subgoal by code_simp + subgoal by code_simp + done + + +subsection \The generated theorems and definitions\ +thm ssp.protocol_secure + +thm ATTACK_UNSET_enum_consts.nchotomy +thm ATTACK_UNSET_sets.nchotomy +thm ATTACK_UNSET_fun.nchotomy +thm ATTACK_UNSET_atom.nchotomy +thm ATTACK_UNSET_arity.simps +thm ATTACK_UNSET_public.simps +thm ATTACK_UNSET_\.simps +thm ATTACK_UNSET_Ana.simps + +thm ATTACK_UNSET_transaction_iik1_def +thm ATTACK_UNSET_transaction_iik2_def +thm ATTACK_UNSET_transaction_wrap_def +thm ATTACK_UNSET_transaction_setwrap_def +thm ATTACK_UNSET_transaction_setdecrypt_def +thm ATTACK_UNSET_transaction_decrypt1_def +thm ATTACK_UNSET_transaction_attack1_def + +thm ATTACK_UNSET_protocol_def + +thm ATTACK_UNSET_fixpoint_def +thm ATTACK_UNSET_SMP_def + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model07.thy b/thys/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model07.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model07.thy @@ -0,0 +1,221 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: PKCS_Model07.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\The PKCS Protocol, Scenario 7\ +theory PKCS_Model07 + imports "../../PSPSP" + +begin + +declare [[code_timing]] + +trac\ +Protocol: RE_IMPORT_ATT + +Types: +token = {token1} + +Sets: +extract/1 wrap/1 unwrap/1 decrypt/1 sensitive/1 + +Functions: +Public senc/2 h/2 bind/2 +Private inv/1 + +Analysis: +senc(M1,K2) ? K2 -> M1 #This analysis rule corresponds to the decrypt2 rule in the AIF-omega specification. + #M1 was type untyped + +Transactions: + +iik1() +new K1 +new N1 +insert N1 sensitive(token1) +insert N1 extract(token1) +insert K1 sensitive(token1) +send h(N1,K1). + +iik2() +new K2 +new N2 +insert N2 wrap(token1) +insert N2 extract(token1) +send h(N2,K2). + +# =====set wrap===== +setwrap(N2:value,K2:value) +receive h(N2,K2) +N2 notin sensitive(token1) +N2 notin decrypt(token1) +insert N2 wrap(token1). + +# =====set unwrap=== +setunwrap(N2:value,K2:value) +receive h(N2,K2) +N2 notin sensitive(token1) +insert N2 unwrap(token1). + +# =====unwrap, generate new handler====== +#-----------the senstive attr copy------------- +unwrapsensitive(M2:value, K2:value, N1:value, N2:value) #M2 was untyped in the AIF-omega specification. +receive senc(M2,K2) +receive bind(N1,M2) +receive h(N2,K2) +N1 in sensitive(token1) +N2 in unwrap(token1) +new Nnew +insert Nnew sensitive(token1) +send h(Nnew,M2). + +#-----------the wrap attr copy------------- +wrapattr(M2:value, K2:value, N1:value, N2:value) #M2 was untyped in the AIF-omega specification. +receive senc(M2,K2) +receive bind(N1,M2) +receive h(N2,K2) +N1 in wrap(token1) +N2 in unwrap(token1) +new Nnew +insert Nnew wrap(token1) +send h(Nnew,M2). + +#-----------the decrypt attr copy------------- +decrypt1attr(M2:value,K2:value,N1:value,N2:value) #M2 was untyped in the AIF-omega specification. +receive senc(M2,K2) +receive bind(N1,M2) +receive h(N2,K2) +N1 in decrypt(token1) +N2 in unwrap(token1) +new Nnew +insert Nnew decrypt(token1) +send h(Nnew,M2). + +decrypt2attr(M2:value,K2:value,N1:value,N2:value) #M2 was untyped in the AIF-omega specification. +receive senc(M2,K2) +receive bind(N1,M2) +receive h(N2,K2) +N1 notin sensitive(token1) +N1 notin wrap(token1) +N1 notin decrypt(token1) +N2 in unwrap(token1) +new Nnew +send h(Nnew,M2). + +# ======================wrap================ +wrap(N1:value,K1:value,N2:value,K2:value) +receive h(N1,K1) +receive h(N2,K2) +N1 in extract(token1) +N2 in wrap(token1) +send senc(K1,K2) +send bind(N1,K1). + +# =====set decrypt=== +setdecrypt(Nnew:value, K2:value) +receive h(Nnew,K2) +Nnew notin wrap(token1) +insert Nnew decrypt(token1). + +# ======================decrypt================ +decrypt1(Nnew:value, K2:value,M1:value) #M1 was untyped in the AIF-omega specification. +receive h(Nnew,K2) +receive senc(M1,K2) +Nnew in decrypt(token1) +delete Nnew decrypt(token1) +send M1. + +# ======================attacks================ +attack1(K1:value) +receive K1 +K1 in sensitive(token1) +attack. +\ + + + +subsection \Protocol model setup\ +protocol_model_setup spm: RE_IMPORT_ATT + + +subsection \Fixpoint computation\ +compute_fixpoint RE_IMPORT_ATT_protocol RE_IMPORT_ATT_fixpoint +compute_SMP [optimized] RE_IMPORT_ATT_protocol RE_IMPORT_ATT_SMP + + +subsection \Proof of security\ +protocol_security_proof [unsafe] ssp: RE_IMPORT_ATT + for RE_IMPORT_ATT_protocol RE_IMPORT_ATT_fixpoint RE_IMPORT_ATT_SMP + + +subsection \The generated theorems and definitions\ +thm ssp.protocol_secure + +thm RE_IMPORT_ATT_enum_consts.nchotomy +thm RE_IMPORT_ATT_sets.nchotomy +thm RE_IMPORT_ATT_fun.nchotomy +thm RE_IMPORT_ATT_atom.nchotomy +thm RE_IMPORT_ATT_arity.simps +thm RE_IMPORT_ATT_public.simps +thm RE_IMPORT_ATT_\.simps +thm RE_IMPORT_ATT_Ana.simps + +thm RE_IMPORT_ATT_transaction_iik1_def +thm RE_IMPORT_ATT_transaction_iik2_def +thm RE_IMPORT_ATT_transaction_setwrap_def +thm RE_IMPORT_ATT_transaction_setunwrap_def +thm RE_IMPORT_ATT_transaction_unwrapsensitive_def +thm RE_IMPORT_ATT_transaction_wrapattr_def +thm RE_IMPORT_ATT_transaction_decrypt1attr_def +thm RE_IMPORT_ATT_transaction_decrypt2attr_def +thm RE_IMPORT_ATT_transaction_wrap_def +thm RE_IMPORT_ATT_transaction_setdecrypt_def +thm RE_IMPORT_ATT_transaction_decrypt1_def +thm RE_IMPORT_ATT_transaction_attack1_def + +thm RE_IMPORT_ATT_protocol_def + +thm RE_IMPORT_ATT_fixpoint_def +thm RE_IMPORT_ATT_SMP_def + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model09.thy b/thys/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model09.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model09.thy @@ -0,0 +1,237 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: PKCS_Model09.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\The PKCS Protocol, Scenario 9\ +theory PKCS_Model09 + imports "../../PSPSP" + +begin + +declare [[code_timing]] + +trac\ +Protocol: LOSS_KEY_ATT + +Types: +token = {token1} + +Sets: +extract/1 wrap/1 unwrap/1 decrypt/1 sensitive/1 + +Functions: +Public senc/2 h/2 bind/3 +Private inv/1 + +Analysis: +senc(M1,K2) ? K2 -> M1 #This analysis rule corresponds to the decrypt2 rule in the AIF-omega specification. + #M1 was type untyped + +Transactions: +iik1() +new K1 +new N1 +insert N1 sensitive(token1) +insert N1 extract(token1) +insert K1 sensitive(token1) +send h(N1,K1). + +iik2() +new K2 +new N2 +insert N2 wrap(token1) +insert N2 extract(token1) +send h(N2,K2). + +iik3() +new K3 +new N3 +insert N3 extract(token1) +insert N3 decrypt(token1) +insert K3 decrypt(token1) +send h(N3,K3) +send K3. + +# =====set wrap===== +setwrap(N2:value,K2:value) where N2 != K2 +receive h(N2,K2) +N2 notin sensitive(token1) +N2 notin decrypt(token1) +insert N2 wrap(token1). + +# =====set unwrap=== +setunwrap(N2:value,K2:value) where N2 != K2 +receive h(N2,K2) +N2 notin sensitive(token1) +insert N2 unwrap(token1). + +# =====unwrap, generate new handler====== +#-----------add the wrap attr copy------------- +unwrapWrap(M2:value,K2:value,N1:value,N2:value) where M2 != K2, M2 != N1, M2 != N2, K2 != N1, K2 != N2, N1 != N2 #M2 was untyped in the AIF-omega specification. +receive senc(M2,K2) +receive bind(N1,M2,K2) +receive h(N2,K2) +N1 in wrap(token1) +N2 in unwrap(token1) +new Nnew +insert Nnew wrap(token1) +send h(Nnew,M2). + +#-----------add the senstive attr copy------------- +unwrapSens(M2:value,K2:value,N1:value,N2:value) where M2 != K2, M2 != N1, M2 != N2, K2 != N1, K2 != N2, N1 != N2 #M2 was untyped in the AIF-omega specification. +receive senc(M2,K2) +receive bind(N1,M2,K2) +receive h(N2,K2) +N1 in sensitive(token1) +N2 in unwrap(token1) +new Nnew +insert Nnew sensitive(token1) +send h(Nnew,M2). + +#-----------add the decrypt attr copy------------- +decrypt1Attr(M2:value, K2:value,N1:value,N2:value) where M2 != K2, M2 != N1, M2 != N2, K2 != N1, K2 != N2, N1 != N2 #M2 was untyped in the AIF-omega specification. +receive senc(M2,K2) +receive bind(N1,M2,K2) +receive h(N2,K2) +N1 in decrypt(token1) +N2 in unwrap(token1) +new Nnew +insert Nnew decrypt(token1) +send h(Nnew,M2). + +decrypt2Attr(M2:value, K2:value,N1:value,N2:value) where M2 != K2, M2 != N1, M2 != N2, K2 != N1, K2 != N2, N1 != N2 #M2 was untyped in the AIF-omega specification. +receive senc(M2,K2) +receive bind(N1,M2,K2) +receive h(N2,K2) +N1 notin wrap(token1) +N1 notin sensitive(token1) +N1 notin decrypt(token1) +N2 in unwrap(token1) +new Nnew +send h(Nnew,M2). + +# ======================wrap================ +wrap(N1:value,K1:value, N2:value, K2:value) where N1 != N2, N1 != K2, N1 != K1, N2 != K2, N2 != K1, K2 != K1 +receive h(N1,K1) +receive h(N2,K2) +N1 in extract(token1) +N2 in wrap(token1) +send senc(K1,K2) +send bind(N1,K1,K2). + +# ======================bind generation================ +bind1(K3:value,N2:value,K2:value, K1:value) where K3 != N2, K3 != K2, K3 != K1, N2 != K2, N2 != K1, K2 != K1 +receive K3 +receive h(N2,K2) +send bind(N2,K3,K3). + +bind2(K3:value,N2:value,K2:value, K1:value) where K3 != N2, K3 != K2, K3 != K1, N2 != K2, N2 != K1, K2 != K1 +receive K3 +receive K1 +receive h(N2,K2) +send bind(N2,K1,K3) +send bind(N2,K3,K1). + +# =====set decrypt=== +setdecrypt(Nnew:value,K2:value) where Nnew != K2 +receive h(Nnew,K2) +Nnew notin wrap(token1) +insert Nnew decrypt(token1). + +# ======================decrypt================ +decrypt1(Nnew:value,K2:value,M1:value) where Nnew != K2, Nnew != M1, K2 != M1 #M1 was untyped in the AIF-omega specification. +receive h(Nnew,K2) +receive senc(M1,K2) +Nnew in decrypt(token1) +send M1. + +# ======================attacks================ +attack1(K1:value) +receive K1 +K1 in sensitive(token1) +attack. + +\ + + +subsection \Protocol model setup\ +protocol_model_setup spm: LOSS_KEY_ATT + + +subsection \Fixpoint computation\ +compute_fixpoint LOSS_KEY_ATT_protocol LOSS_KEY_ATT_fixpoint + +text \The fixpoint contains an attack signal\ +value "attack_notin_fixpoint LOSS_KEY_ATT_fixpoint" + + +subsection \The generated theorems and definitions\ +thm LOSS_KEY_ATT_enum_consts.nchotomy +thm LOSS_KEY_ATT_sets.nchotomy +thm LOSS_KEY_ATT_fun.nchotomy +thm LOSS_KEY_ATT_atom.nchotomy +thm LOSS_KEY_ATT_arity.simps +thm LOSS_KEY_ATT_public.simps +thm LOSS_KEY_ATT_\.simps +thm LOSS_KEY_ATT_Ana.simps + +thm LOSS_KEY_ATT_transaction_iik1_def +thm LOSS_KEY_ATT_transaction_iik2_def +thm LOSS_KEY_ATT_transaction_iik3_def +thm LOSS_KEY_ATT_transaction_setwrap_def +thm LOSS_KEY_ATT_transaction_setunwrap_def +thm LOSS_KEY_ATT_transaction_unwrapWrap_def +thm LOSS_KEY_ATT_transaction_unwrapSens_def +thm LOSS_KEY_ATT_transaction_decrypt1Attr_def +thm LOSS_KEY_ATT_transaction_decrypt2Attr_def +thm LOSS_KEY_ATT_transaction_wrap_def +thm LOSS_KEY_ATT_transaction_bind1_def +thm LOSS_KEY_ATT_transaction_bind2_def +thm LOSS_KEY_ATT_transaction_setdecrypt_def +thm LOSS_KEY_ATT_transaction_decrypt1_def +thm LOSS_KEY_ATT_transaction_attack1_def + +thm LOSS_KEY_ATT_protocol_def +thm LOSS_KEY_ATT_fixpoint_def + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/Makefile b/thys/Automated_Stateful_Protocol_Verification/trac/Makefile new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/Makefile @@ -0,0 +1,51 @@ +#!/bin/sh +# (C) Copyright Andreas Viktor Hess, DTU, 2020 +# (C) Copyright Sebastian A. Mödersheim, DTU, 2020 +# (C) Copyright Achim D. Brucker, University of Exeter, 2020 +# (C) Copyright Anders Schlichtkrull, DTU, 2020 +# +# All Rights Reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are +# met: +# +# - Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# +# - Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# - Neither the name of the copyright holder nor the names of its +# contributors may be used to endorse or promote products +# derived from this software without specific prior written +# permission. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +ISABELLE=isabelle + +all: trac_parser/trac_fp.lex.sml trac_parser/trac_fp.grm.sig trac_parser/trac_protocol.lex.sml trac_parser/trac_protocol.grm.sig + +test: + isabelle build -c -D . + +clean: + rm -f trac_parser/*.lex.sml trac_parser/*.grm.sml trac_parser/*.grm.sig + +%.lex.sml: %.lex + bin/ml-lex-isa $< +%.grm.sig: %.grm + bin/ml-yacc-isa $< + diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/README.md b/thys/Automated_Stateful_Protocol_Verification/trac/README.md new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/README.md @@ -0,0 +1,13 @@ +# Interface between Isabelle and trac specifications + +## Prerequisites + +* For re-generating the parser, ml-lex and ml-yacc are required + + +## License + +This project is licensed under a 2-clause BSD-style license. + +SPDX-License-Identifier: BSD-2-Clause + diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/bin/ml-lex-isa b/thys/Automated_Stateful_Protocol_Verification/trac/bin/ml-lex-isa new file mode 100755 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/bin/ml-lex-isa @@ -0,0 +1,42 @@ +#!/bin/bash +# (C) Copyright Andreas Viktor Hess, DTU, 2020 +# (C) Copyright Sebastian A. Mödersheim, DTU, 2020 +# (C) Copyright Achim D. Brucker, University of Exeter, 2020 +# (C) Copyright Anders Schlichtkrull, DTU, 2020 +# +# All Rights Reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are +# met: +# +# - Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# +# - Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# - Neither the name of the copyright holder nor the names of its +# contributors may be used to endorse or promote products +# derived from this software without specific prior written +# permission. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +ml-lex "$1" +sed -i -e '1s/^/ (***** GENERATED FILE -- DO NOT EDIT ****)\n/'\ + -e "s/\\bref\\b/Unsynchronized.ref/g" \ + -e "s/\\bUnsafe.\\b//g" \ + -e "s/structure YYPosInt : INTEGER = Int/structure YYPosInt = Int/" \ + "$1.sml" diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/bin/ml-yacc-isa b/thys/Automated_Stateful_Protocol_Verification/trac/bin/ml-yacc-isa new file mode 100755 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/bin/ml-yacc-isa @@ -0,0 +1,39 @@ +#!/bin/bash +# (C) Copyright Andreas Viktor Hess, DTU, 2020 +# (C) Copyright Sebastian A. Mödersheim, DTU, 2020 +# (C) Copyright Achim D. Brucker, University of Exeter, 2020 +# (C) Copyright Anders Schlichtkrull, DTU, 2020 +# +# All Rights Reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are +# met: +# +# - Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# +# - Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# - Neither the name of the copyright holder nor the names of its +# contributors may be used to endorse or promote products +# derived from this software without specific prior written +# permission. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +ml-yacc "$1" +sed -i -e '1s/^/ (***** GENERATED FILE -- DO NOT EDIT ****)\n/'\ + -e "s/\\bref\\b/Unsynchronized.ref/g" "$1.sml" diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/base.sig b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/base.sig new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/base.sig @@ -0,0 +1,323 @@ +(****************************************************************************** + * STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. + * + * Copyright (c) 1989-2002 by Lucent Technologies + * + * Permission to use, copy, modify, and distribute this software and its + * documentation for any purpose and without fee is hereby granted, + * provided that the above copyright notice appear in all copies and that + * both the copyright notice and this permission notice and warranty + * disclaimer appear in supporting documentation, and that the name of + * Lucent Technologies, Bell Labs or any Lucent entity not be used in + * advertising or publicity pertaining to distribution of the software + * without specific, written prior permission. + * + * Lucent disclaims all warranties with regard to this software, + * including all implied warranties of merchantability and fitness. In no + * event shall Lucent be liable for any special, indirect or + * consequential damages or any damages whatsoever resulting from loss of + * use, data or profits, whether in an action of contract, negligence or + * other tortious action, arising out of or in connection with the use + * or performance of this software. + ******************************************************************************) +(* $Id$ *) + +(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *) + +(* base.sig: Base signature file for SML-Yacc. This file contains signatures + that must be loaded before any of the files produced by ML-Yacc are loaded +*) + +(* STREAM: signature for a lazy stream.*) + +signature STREAM = + sig type 'xa stream + val streamify : (unit -> '_a) -> '_a stream + val cons : '_a * '_a stream -> '_a stream + val get : '_a stream -> '_a * '_a stream + end + +(* LR_TABLE: signature for an LR Table. + + The list of actions and gotos passed to mkLrTable must be ordered by state + number. The values for state 0 are the first in the list, the values for + state 1 are next, etc. +*) + +signature LR_TABLE = + sig + datatype ('a,'b) pairlist = EMPTY | PAIR of 'a * 'b * ('a,'b) pairlist + datatype state = STATE of int + datatype term = T of int + datatype nonterm = NT of int + datatype action = SHIFT of state + | REDUCE of int + | ACCEPT + | ERROR + type table + + val numStates : table -> int + val numRules : table -> int + val describeActions : table -> state -> + (term,action) pairlist * action + val describeGoto : table -> state -> (nonterm,state) pairlist + val action : table -> state * term -> action + val goto : table -> state * nonterm -> state + val initialState : table -> state + exception Goto of state * nonterm + + val mkLrTable : {actions : ((term,action) pairlist * action) array, + gotos : (nonterm,state) pairlist array, + numStates : int, numRules : int, + initialState : state} -> table + end + +(* TOKEN: signature revealing the internal structure of a token. This signature + TOKEN distinct from the signature {parser name}_TOKENS produced by ML-Yacc. + The {parser name}_TOKENS structures contain some types and functions to + construct tokens from values and positions. + + The representation of token was very carefully chosen here to allow the + polymorphic parser to work without knowing the types of semantic values + or line numbers. + + This has had an impact on the TOKENS structure produced by SML-Yacc, which + is a structure parameter to lexer functors. We would like to have some + type 'a token which functions to construct tokens would create. A + constructor function for a integer token might be + + INT: int * 'a * 'a -> 'a token. + + This is not possible because we need to have tokens with the representation + given below for the polymorphic parser. + + Thus our constructur functions for tokens have the form: + + INT: int * 'a * 'a -> (svalue,'a) token + + This in turn has had an impact on the signature that lexers for SML-Yacc + must match and the types that a user must declare in the user declarations + section of lexers. +*) + +signature TOKEN = + sig + structure LrTable : LR_TABLE + datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b) + val sameToken : ('a,'b) token * ('a,'b) token -> bool + end + +(* LR_PARSER: signature for a polymorphic LR parser *) + +signature LR_PARSER = + sig + structure Stream: STREAM + structure LrTable : LR_TABLE + structure Token : TOKEN + + sharing LrTable = Token.LrTable + + exception ParseError + + val parse : {table : LrTable.table, + lexer : ('_b,'_c) Token.token Stream.stream, + arg: 'arg, + saction : int * + '_c * + (LrTable.state * ('_b * '_c * '_c)) list * + 'arg -> + LrTable.nonterm * + ('_b * '_c * '_c) * + ((LrTable.state *('_b * '_c * '_c)) list), + void : '_b, + ec : { is_keyword : LrTable.term -> bool, + noShift : LrTable.term -> bool, + preferred_change : (LrTable.term list * LrTable.term list) list, + errtermvalue : LrTable.term -> '_b, + showTerminal : LrTable.term -> string, + terms: LrTable.term list, + error : string * '_c * '_c -> unit + }, + lookahead : int (* max amount of lookahead used in *) + (* error correction *) + } -> '_b * + (('_b,'_c) Token.token Stream.stream) + end + +(* LEXER: a signature that most lexers produced for use with SML-Yacc's + output will match. The user is responsible for declaring type token, + type pos, and type svalue in the UserDeclarations section of a lexer. + + Note that type token is abstract in the lexer. This allows SML-Yacc to + create a TOKENS signature for use with lexers produced by ML-Lex that + treats the type token abstractly. Lexers that are functors parametrized by + a Tokens structure matching a TOKENS signature cannot examine the structure + of tokens. +*) + +signature LEXER = + sig + structure UserDeclarations : + sig + type ('a,'b) token + type pos + type svalue + end + val makeLexer : (int -> string) -> unit -> + (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token + end + +(* ARG_LEXER: the %arg option of ML-Lex allows users to produce lexers which + also take an argument before yielding a function from unit to a token +*) + +signature ARG_LEXER = + sig + structure UserDeclarations : + sig + type ('a,'b) token + type pos + type svalue + type arg + end + val makeLexer : (int -> string) -> UserDeclarations.arg -> unit -> + (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token + end + +(* PARSER_DATA: the signature of ParserData structures in {parser name}LrValsFun + produced by SML-Yacc. All such structures match this signature. + + The {parser name}LrValsFun produces a structure which contains all the values + except for the lexer needed to call the polymorphic parser mentioned + before. + +*) + +signature PARSER_DATA = + sig + (* the type of line numbers *) + + type pos + + (* the type of semantic values *) + + type svalue + + (* the type of the user-supplied argument to the parser *) + type arg + + (* the intended type of the result of the parser. This value is + produced by applying extract from the structure Actions to the + final semantic value resultiing from a parse. + *) + + type result + + structure LrTable : LR_TABLE + structure Token : TOKEN + sharing Token.LrTable = LrTable + + (* structure Actions contains the functions which mantain the + semantic values stack in the parser. Void is used to provide + a default value for the semantic stack. + *) + + structure Actions : + sig + val actions : int * pos * + (LrTable.state * (svalue * pos * pos)) list * arg-> + LrTable.nonterm * (svalue * pos * pos) * + ((LrTable.state *(svalue * pos * pos)) list) + val void : svalue + val extract : svalue -> result + end + + (* structure EC contains information used to improve error + recovery in an error-correcting parser *) + + structure EC : + sig + val is_keyword : LrTable.term -> bool + val noShift : LrTable.term -> bool + val preferred_change : (LrTable.term list * LrTable.term list) list + val errtermvalue : LrTable.term -> svalue + val showTerminal : LrTable.term -> string + val terms: LrTable.term list + end + + (* table is the LR table for the parser *) + + val table : LrTable.table + end + +(* signature PARSER is the signature that most user parsers created by + SML-Yacc will match. +*) + +signature PARSER = + sig + structure Token : TOKEN + structure Stream : STREAM + exception ParseError + + (* type pos is the type of line numbers *) + + type pos + + (* type result is the type of the result from the parser *) + + type result + + (* the type of the user-supplied argument to the parser *) + type arg + + (* type svalue is the type of semantic values for the semantic value + stack + *) + + type svalue + + (* val makeLexer is used to create a stream of tokens for the parser *) + + val makeLexer : (int -> string) -> + (svalue,pos) Token.token Stream.stream + + (* val parse takes a stream of tokens and a function to print + errors and returns a value of type result and a stream containing + the unused tokens + *) + + val parse : int * ((svalue,pos) Token.token Stream.stream) * + (string * pos * pos -> unit) * arg -> + result * (svalue,pos) Token.token Stream.stream + + val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token -> + bool + end + +(* signature ARG_PARSER is the signature that will be matched by parsers whose + lexer takes an additional argument. +*) + +signature ARG_PARSER = + sig + structure Token : TOKEN + structure Stream : STREAM + exception ParseError + + type arg + type lexarg + type pos + type result + type svalue + + val makeLexer : (int -> string) -> lexarg -> + (svalue,pos) Token.token Stream.stream + val parse : int * ((svalue,pos) Token.token Stream.stream) * + (string * pos * pos -> unit) * arg -> + result * (svalue,pos) Token.token Stream.stream + + val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token -> + bool + end + diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/copyright b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/copyright new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/copyright @@ -0,0 +1,40 @@ +This package was debianized by Aaron Matthew Read on +Fri, 25 Oct 2002 16:54:10 -0800. + +It was downloaded from http://smlnj.cs.uchicago.edu/dist/working + +Upstream Authors: The SML/NJ Team + +Copyright: 2003-2008 The SML/NJ Fellowship + 1989-2002 Lucent Technologies + 1991-2003 John Reppy + 1996-1998,2000 YALE FLINT PROJECT + 1992 Vrije Universiteit, The Netherlands + 1989-1992 Andrew W. Appel, James S. Mattson, David R. Tarditi + 1988 Evans & Sutherland Computer Corporation, Salt Lake City, Utah + +STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. + +Copyright (c) 1989-2002 by Lucent Technologies + +Permission to use, copy, modify, and distribute this software and its +documentation for any purpose and without fee is hereby granted, +provided that the above copyright notice appear in all copies and that +both the copyright notice and this permission notice and warranty +disclaimer appear in supporting documentation, and that the name of +Lucent Technologies, Bell Labs or any Lucent entity not be used in +advertising or publicity pertaining to distribution of the software +without specific, written prior permission. + +Lucent disclaims all warranties with regard to this software, +including all implied warranties of merchantability and fitness. In no +event shall Lucent be liable for any special, indirect or +consequential damages or any damages whatsoever resulting from loss of +use, data or profits, whether in an action of contract, negligence or +other tortious action, arising out of or in connection with the use +or performance of this software. + + +The SML/NJ distribution also includes code licensed under the same +terms as above, but with "David R. Tarditi Jr. and Andrew W. Appel", +"Vrije Universiteit" or "Evans & Sutherland" instead of "Lucent". diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/join.sml b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/join.sml new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/join.sml @@ -0,0 +1,118 @@ +(****************************************************************************** + * STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. + * + * Copyright (c) 1989-2002 by Lucent Technologies + * + * Permission to use, copy, modify, and distribute this software and its + * documentation for any purpose and without fee is hereby granted, + * provided that the above copyright notice appear in all copies and that + * both the copyright notice and this permission notice and warranty + * disclaimer appear in supporting documentation, and that the name of + * Lucent Technologies, Bell Labs or any Lucent entity not be used in + * advertising or publicity pertaining to distribution of the software + * without specific, written prior permission. + * + * Lucent disclaims all warranties with regard to this software, + * including all implied warranties of merchantability and fitness. In no + * event shall Lucent be liable for any special, indirect or + * consequential damages or any damages whatsoever resulting from loss of + * use, data or profits, whether in an action of contract, negligence or + * other tortious action, arising out of or in connection with the use + * or performance of this software. + ******************************************************************************) +(* $Id$ *) + +(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *) + +(* functor Join creates a user parser by putting together a Lexer structure, + an LrValues structure, and a polymorphic parser structure. Note that + the Lexer and LrValues structure must share the type pos (i.e. the type + of line numbers), the type svalues for semantic values, and the type + of tokens. +*) + +functor Join(structure Lex : LEXER + structure ParserData: PARSER_DATA + structure LrParser : LR_PARSER + sharing ParserData.LrTable = LrParser.LrTable + sharing ParserData.Token = LrParser.Token + sharing type Lex.UserDeclarations.svalue = ParserData.svalue + sharing type Lex.UserDeclarations.pos = ParserData.pos + sharing type Lex.UserDeclarations.token = ParserData.Token.token) + : PARSER = +struct + structure Token = ParserData.Token + structure Stream = LrParser.Stream + + exception ParseError = LrParser.ParseError + + type arg = ParserData.arg + type pos = ParserData.pos + type result = ParserData.result + type svalue = ParserData.svalue + val makeLexer = LrParser.Stream.streamify o Lex.makeLexer + val parse = fn (lookahead,lexer,error,arg) => + (fn (a,b) => (ParserData.Actions.extract a,b)) + (LrParser.parse {table = ParserData.table, + lexer=lexer, + lookahead=lookahead, + saction = ParserData.Actions.actions, + arg=arg, + void= ParserData.Actions.void, + ec = {is_keyword = ParserData.EC.is_keyword, + noShift = ParserData.EC.noShift, + preferred_change = ParserData.EC.preferred_change, + errtermvalue = ParserData.EC.errtermvalue, + error=error, + showTerminal = ParserData.EC.showTerminal, + terms = ParserData.EC.terms}} + ) + val sameToken = Token.sameToken +end + +(* functor JoinWithArg creates a variant of the parser structure produced + above. In this case, the makeLexer take an additional argument before + yielding a value of type unit -> (svalue,pos) token + *) + +functor JoinWithArg(structure Lex : ARG_LEXER + structure ParserData: PARSER_DATA + structure LrParser : LR_PARSER + sharing ParserData.LrTable = LrParser.LrTable + sharing ParserData.Token = LrParser.Token + sharing type Lex.UserDeclarations.svalue = ParserData.svalue + sharing type Lex.UserDeclarations.pos = ParserData.pos + sharing type Lex.UserDeclarations.token = ParserData.Token.token) + : ARG_PARSER = +struct + structure Token = ParserData.Token + structure Stream = LrParser.Stream + + exception ParseError = LrParser.ParseError + + type arg = ParserData.arg + type lexarg = Lex.UserDeclarations.arg + type pos = ParserData.pos + type result = ParserData.result + type svalue = ParserData.svalue + + val makeLexer = fn s => fn arg => + LrParser.Stream.streamify (Lex.makeLexer s arg) + val parse = fn (lookahead,lexer,error,arg) => + (fn (a,b) => (ParserData.Actions.extract a,b)) + (LrParser.parse {table = ParserData.table, + lexer=lexer, + lookahead=lookahead, + saction = ParserData.Actions.actions, + arg=arg, + void= ParserData.Actions.void, + ec = {is_keyword = ParserData.EC.is_keyword, + noShift = ParserData.EC.noShift, + preferred_change = ParserData.EC.preferred_change, + errtermvalue = ParserData.EC.errtermvalue, + error=error, + showTerminal = ParserData.EC.showTerminal, + terms = ParserData.EC.terms}} + ) + val sameToken = Token.sameToken +end; diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/lrtable.sml b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/lrtable.sml new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/lrtable.sml @@ -0,0 +1,83 @@ +(****************************************************************************** + * STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. + * + * Copyright (c) 1989-2002 by Lucent Technologies + * + * Permission to use, copy, modify, and distribute this software and its + * documentation for any purpose and without fee is hereby granted, + * provided that the above copyright notice appear in all copies and that + * both the copyright notice and this permission notice and warranty + * disclaimer appear in supporting documentation, and that the name of + * Lucent Technologies, Bell Labs or any Lucent entity not be used in + * advertising or publicity pertaining to distribution of the software + * without specific, written prior permission. + * + * Lucent disclaims all warranties with regard to this software, + * including all implied warranties of merchantability and fitness. In no + * event shall Lucent be liable for any special, indirect or + * consequential damages or any damages whatsoever resulting from loss of + * use, data or profits, whether in an action of contract, negligence or + * other tortious action, arising out of or in connection with the use + * or performance of this software. + ******************************************************************************) +(* $Id$ *) + +(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *) +structure LrTable : LR_TABLE = + struct + open Array List + infix 9 sub + datatype ('a,'b) pairlist = EMPTY + | PAIR of 'a * 'b * ('a,'b) pairlist + datatype term = T of int + datatype nonterm = NT of int + datatype state = STATE of int + datatype action = SHIFT of state + | REDUCE of int (* rulenum from grammar *) + | ACCEPT + | ERROR + exception Goto of state * nonterm + type table = {states: int, rules : int,initialState: state, + action: ((term,action) pairlist * action) array, + goto : (nonterm,state) pairlist array} + val numStates = fn ({states,...} : table) => states + val numRules = fn ({rules,...} : table) => rules + val describeActions = + fn ({action,...} : table) => + fn (STATE s) => action sub s + val describeGoto = + fn ({goto,...} : table) => + fn (STATE s) => goto sub s + fun findTerm (T term,row,default) = + let fun find (PAIR (T key,data,r)) = + if key < term then find r + else if key=term then data + else default + | find EMPTY = default + in find row + end + fun findNonterm (NT nt,row) = + let fun find (PAIR (NT key,data,r)) = + if key < nt then find r + else if key=nt then SOME data + else NONE + | find EMPTY = NONE + in find row + end + val action = fn ({action,...} : table) => + fn (STATE state,term) => + let val (row,default) = action sub state + in findTerm(term,row,default) + end + val goto = fn ({goto,...} : table) => + fn (a as (STATE state,nonterm)) => + case findNonterm(nonterm,goto sub state) + of SOME state => state + | NONE => raise (Goto a) + val initialState = fn ({initialState,...} : table) => initialState + val mkLrTable = fn {actions,gotos,initialState,numStates,numRules} => + ({action=actions,goto=gotos, + states=numStates, + rules=numRules, + initialState=initialState} : table) +end; diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/parser2.sml b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/parser2.sml new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/parser2.sml @@ -0,0 +1,567 @@ +(****************************************************************************** + * STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. + * + * Copyright (c) 1989-2002 by Lucent Technologies + * + * Permission to use, copy, modify, and distribute this software and its + * documentation for any purpose and without fee is hereby granted, + * provided that the above copyright notice appear in all copies and that + * both the copyright notice and this permission notice and warranty + * disclaimer appear in supporting documentation, and that the name of + * Lucent Technologies, Bell Labs or any Lucent entity not be used in + * advertising or publicity pertaining to distribution of the software + * without specific, written prior permission. + * + * Lucent disclaims all warranties with regard to this software, + * including all implied warranties of merchantability and fitness. In no + * event shall Lucent be liable for any special, indirect or + * consequential damages or any damages whatsoever resulting from loss of + * use, data or profits, whether in an action of contract, negligence or + * other tortious action, arising out of or in connection with the use + * or performance of this software. + ******************************************************************************) +(* $Id$ *) + +(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *) + +(* parser.sml: This is a parser driver for LR tables with an error-recovery + routine added to it. The routine used is described in detail in this + article: + + 'A Practical Method for LR and LL Syntactic Error Diagnosis and + Recovery', by M. Burke and G. Fisher, ACM Transactions on + Programming Langauges and Systems, Vol. 9, No. 2, April 1987, + pp. 164-197. + + This program is an implementation is the partial, deferred method discussed + in the article. The algorithm and data structures used in the program + are described below. + + This program assumes that all semantic actions are delayed. A semantic + action should produce a function from unit -> value instead of producing the + normal value. The parser returns the semantic value on the top of the + stack when accept is encountered. The user can deconstruct this value + and apply the unit -> value function in it to get the answer. + + It also assumes that the lexer is a lazy stream. + + Data Structures: + ---------------- + + * The parser: + + The state stack has the type + + (state * (semantic value * line # * line #)) list + + The parser keeps a queue of (state stack * lexer pair). A lexer pair + consists of a terminal * value pair and a lexer. This allows the + parser to reconstruct the states for terminals to the left of a + syntax error, and attempt to make error corrections there. + + The queue consists of a pair of lists (x,y). New additions to + the queue are cons'ed onto y. The first element of x is the top + of the queue. If x is nil, then y is reversed and used + in place of x. + + Algorithm: + ---------- + + * The steady-state parser: + + This parser keeps the length of the queue of state stacks at + a steady state by always removing an element from the front when + another element is placed on the end. + + It has these arguments: + + stack: current stack + queue: value of the queue + lexPair ((terminal,value),lex stream) + + When SHIFT is encountered, the state to shift to and the value are + are pushed onto the state stack. The state stack and lexPair are + placed on the queue. The front element of the queue is removed. + + When REDUCTION is encountered, the rule is applied to the current + stack to yield a triple (nonterm,value,new stack). A new + stack is formed by adding (goto(top state of stack,nonterm),value) + to the stack. + + When ACCEPT is encountered, the top value from the stack and the + lexer are returned. + + When an ERROR is encountered, fixError is called. FixError + takes the arguments to the parser, fixes the error if possible and + returns a new set of arguments. + + * The distance-parser: + + This parser includes an additional argument distance. It pushes + elements on the queue until it has parsed distance tokens, or an + ACCEPT or ERROR occurs. It returns a stack, lexer, the number of + tokens left unparsed, a queue, and an action option. +*) + +signature FIFO = + sig type 'a queue + val empty : 'a queue + exception Empty + val get : 'a queue -> 'a * 'a queue + val put : 'a * 'a queue -> 'a queue + end + +(* drt (12/15/89) -- the functor should be used in development work, but + it wastes space in the release version. + +functor ParserGen(structure LrTable : LR_TABLE + structure Stream : STREAM) : LR_PARSER = +*) + +structure LrParser :> LR_PARSER = + struct + structure LrTable = LrTable + structure Stream = Stream + + val print = warning (* fn s => TextIO.output(TextIO.stdOut,s) *) + fun eqT (LrTable.T i, LrTable.T i') = i = i' + + structure Token : TOKEN = + struct + structure LrTable = LrTable + datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b) + val sameToken = fn (TOKEN(t,_),TOKEN(t',_)) => eqT (t,t') + end + + open LrTable + open Token + + val DEBUG1 = false + val DEBUG2 = false + exception ParseError + exception ParseImpossible of int + + structure Fifo :> FIFO = + struct + type 'a queue = ('a list * 'a list) + val empty = (nil,nil) + exception Empty + fun get(a::x, y) = (a, (x,y)) + | get(nil, nil) = raise Empty + | get(nil, y) = get(rev y, nil) + fun put(a,(x,y)) = (x,a::y) + end + + type ('a,'b) elem = (state * ('a * 'b * 'b)) + type ('a,'b) stack = ('a,'b) elem list + type ('a,'b) lexv = ('a,'b) token + type ('a,'b) lexpair = ('a,'b) lexv * (('a,'b) lexv Stream.stream) + type ('a,'b) distanceParse = + ('a,'b) lexpair * + ('a,'b) stack * + (('a,'b) stack * ('a,'b) lexpair) Fifo.queue * + int -> + ('a,'b) lexpair * + ('a,'b) stack * + (('a,'b) stack * ('a,'b) lexpair) Fifo.queue * + int * + action option + + type ('a,'b) ecRecord = + {is_keyword : term -> bool, + preferred_change : (term list * term list) list, + error : string * 'b * 'b -> unit, + errtermvalue : term -> 'a, + terms : term list, + showTerminal : term -> string, + noShift : term -> bool} + + local + val print = warning (* fn s => TextIO.output(TextIO.stdOut,s) *) + val println = fn s => (print s; print "\n") + val showState = fn (STATE s) => "STATE " ^ (Int.toString s) + in + fun printStack(stack: ('a,'b) stack, n: int) = + case stack + of (state,_) :: rest => + (print("\t" ^ Int.toString n ^ ": "); + println(showState state); + printStack(rest, n+1)) + | nil => () + + fun prAction showTerminal + (stack as (state,_) :: _, next as (TOKEN (term,_),_), action) = + (println "Parse: state stack:"; + printStack(stack, 0); + print(" state=" + ^ showState state + ^ " next=" + ^ showTerminal term + ^ " action=" + ); + case action + of SHIFT state => println ("SHIFT " ^ (showState state)) + | REDUCE i => println ("REDUCE " ^ (Int.toString i)) + | ERROR => println "ERROR" + | ACCEPT => println "ACCEPT") + | prAction _ (_,_,action) = () + end + + (* ssParse: parser which maintains the queue of (state * lexvalues) in a + steady-state. It takes a table, showTerminal function, saction + function, and fixError function. It parses until an ACCEPT is + encountered, or an exception is raised. When an error is encountered, + fixError is called with the arguments of parseStep (lexv,stack,and + queue). It returns the lexv, and a new stack and queue adjusted so + that the lexv can be parsed *) + + val ssParse = + fn (table,showTerminal,saction,fixError,arg) => + let val prAction = prAction showTerminal + val action = LrTable.action table + val goto = LrTable.goto table + fun parseStep(args as + (lexPair as (TOKEN (terminal, value as (_,leftPos,_)), + lexer + ), + stack as (state,_) :: _, + queue)) = + let val nextAction = action (state,terminal) + val _ = if DEBUG1 then prAction(stack,lexPair,nextAction) + else () + in case nextAction + of SHIFT s => + let val newStack = (s,value) :: stack + val newLexPair = Stream.get lexer + val (_,newQueue) =Fifo.get(Fifo.put((newStack,newLexPair), + queue)) + in parseStep(newLexPair,(s,value)::stack,newQueue) + end + | REDUCE i => + (case saction(i,leftPos,stack,arg) + of (nonterm,value,stack as (state,_) :: _) => + parseStep(lexPair,(goto(state,nonterm),value)::stack, + queue) + | _ => raise (ParseImpossible 197)) + | ERROR => parseStep(fixError args) + | ACCEPT => + (case stack + of (_,(topvalue,_,_)) :: _ => + let val (token,restLexer) = lexPair + in (topvalue,Stream.cons(token,restLexer)) + end + | _ => raise (ParseImpossible 202)) + end + | parseStep _ = raise (ParseImpossible 204) + in parseStep + end + + (* distanceParse: parse until n tokens are shifted, or accept or + error are encountered. Takes a table, showTerminal function, and + semantic action function. Returns a parser which takes a lexPair + (lex result * lexer), a state stack, a queue, and a distance + (must be > 0) to parse. The parser returns a new lex-value, a stack + with the nth token shifted on top, a queue, a distance, and action + option. *) + + val distanceParse = + fn (table,showTerminal,saction,arg) => + let val prAction = prAction showTerminal + val action = LrTable.action table + val goto = LrTable.goto table + fun parseStep(lexPair,stack,queue,0) = (lexPair,stack,queue,0,NONE) + | parseStep(lexPair as (TOKEN (terminal, value as (_,leftPos,_)), + lexer + ), + stack as (state,_) :: _, + queue,distance) = + let val nextAction = action(state,terminal) + val _ = if DEBUG1 then prAction(stack,lexPair,nextAction) + else () + in case nextAction + of SHIFT s => + let val newStack = (s,value) :: stack + val newLexPair = Stream.get lexer + in parseStep(newLexPair,(s,value)::stack, + Fifo.put((newStack,newLexPair),queue),distance-1) + end + | REDUCE i => + (case saction(i,leftPos,stack,arg) + of (nonterm,value,stack as (state,_) :: _) => + parseStep(lexPair,(goto(state,nonterm),value)::stack, + queue,distance) + | _ => raise (ParseImpossible 240)) + | ERROR => (lexPair,stack,queue,distance,SOME nextAction) + | ACCEPT => (lexPair,stack,queue,distance,SOME nextAction) + end + | parseStep _ = raise (ParseImpossible 242) + in parseStep : ('_a,'_b) distanceParse + end + +(* mkFixError: function to create fixError function which adjusts parser state + so that parse may continue in the presence of an error *) + +fun mkFixError({is_keyword,terms,errtermvalue, + preferred_change,noShift, + showTerminal,error,...} : ('_a,'_b) ecRecord, + distanceParse : ('_a,'_b) distanceParse, + minAdvance,maxAdvance) + + (lexv as (TOKEN (term,value as (_,leftPos,_)),_),stack,queue) = + let val _ = if DEBUG2 then + error("syntax error found at " ^ (showTerminal term), + leftPos,leftPos) + else () + + fun tokAt(t,p) = TOKEN(t,(errtermvalue t,p,p)) + + val minDelta = 3 + + (* pull all the state * lexv elements from the queue *) + + val stateList = + let fun f q = let val (elem,newQueue) = Fifo.get q + in elem :: (f newQueue) + end handle Fifo.Empty => nil + in f queue + end + + (* now number elements of stateList, giving distance from + error token *) + + val (_, numStateList) = + List.foldr (fn (a,(num,r)) => (num+1,(a,num)::r)) (0, []) stateList + + (* Represent the set of potential changes as a linked list. + + Values of datatype Change hold information about a potential change. + + oper = oper to be applied + pos = the # of the element in stateList that would be altered. + distance = the number of tokens beyond the error token which the + change allows us to parse. + new = new terminal * value pair at that point + orig = original terminal * value pair at the point being changed. + *) + + datatype ('a,'b) change = CHANGE of + {pos : int, distance : int, leftPos: 'b, rightPos: 'b, + new : ('a,'b) lexv list, orig : ('a,'b) lexv list} + + + val showTerms = String.concat o map (fn TOKEN(t,_) => " " ^ showTerminal t) + + val printChange = fn c => + let val CHANGE {distance,new,orig,pos,...} = c + in (print ("{distance= " ^ (Int.toString distance)); + print (",orig ="); print(showTerms orig); + print (",new ="); print(showTerms new); + print (",pos= " ^ (Int.toString pos)); + print "}\n") + end + + val printChangeList = app printChange + +(* parse: given a lexPair, a stack, and the distance from the error + token, return the distance past the error token that we are able to parse.*) + + fun parse (lexPair,stack,queuePos : int) = + case distanceParse(lexPair,stack,Fifo.empty,queuePos+maxAdvance+1) + of (_,_,_,distance,SOME ACCEPT) => + if maxAdvance-distance-1 >= 0 + then maxAdvance + else maxAdvance-distance-1 + | (_,_,_,distance,_) => maxAdvance - distance - 1 + +(* catList: String.concatenate results of scanning list *) + + fun catList l f = List.foldr (fn(a,r)=> f a @ r) [] l + + fun keywordsDelta new = if List.exists (fn(TOKEN(t,_))=>is_keyword t) new + then minDelta else 0 + + fun tryChange{lex,stack,pos,leftPos,rightPos,orig,new} = + let val lex' = List.foldr (fn (t',p)=>(t',Stream.cons p)) lex new + val distance = parse(lex',stack,pos+length new-length orig) + in if distance >= minAdvance + keywordsDelta new + then [CHANGE{pos=pos,leftPos=leftPos,rightPos=rightPos, + distance=distance,orig=orig,new=new}] + else [] + end + + +(* tryDelete: Try to delete n terminals. + Return single-element [success] or nil. + Do not delete unshiftable terminals. *) + + + fun tryDelete n ((stack,lexPair as (TOKEN(term,(_,l,r)),_)),qPos) = + let fun del(0,accum,left,right,lexPair) = + tryChange{lex=lexPair,stack=stack, + pos=qPos,leftPos=left,rightPos=right, + orig=rev accum, new=[]} + | del(n,accum,left,right,(tok as TOKEN(term,(_,_,r)),lexer)) = + if noShift term then [] + else del(n-1,tok::accum,left,r,Stream.get lexer) + in del(n,[],l,r,lexPair) + end + +(* tryInsert: try to insert tokens before the current terminal; + return a list of the successes *) + + fun tryInsert((stack,lexPair as (TOKEN(_,(_,l,_)),_)),queuePos) = + catList terms (fn t => + tryChange{lex=lexPair,stack=stack, + pos=queuePos,orig=[],new=[tokAt(t,l)], + leftPos=l,rightPos=l}) + +(* trySubst: try to substitute tokens for the current terminal; + return a list of the successes *) + + fun trySubst ((stack,lexPair as (orig as TOKEN (term,(_,l,r)),lexer)), + queuePos) = + if noShift term then [] + else + catList terms (fn t => + tryChange{lex=Stream.get lexer,stack=stack, + pos=queuePos, + leftPos=l,rightPos=r,orig=[orig], + new=[tokAt(t,r)]}) + + (* do_delete(toks,lexPair) tries to delete tokens "toks" from "lexPair". + If it succeeds, returns SOME(toks',l,r,lp), where + toks' is the actual tokens (with positions and values) deleted, + (l,r) are the (leftmost,rightmost) position of toks', + lp is what remains of the stream after deletion + *) + fun do_delete(nil,lp as (TOKEN(_,(_,l,_)),_)) = SOME(nil,l,l,lp) + | do_delete([t],(tok as TOKEN(t',(_,l,r)),lp')) = + if eqT (t, t') + then SOME([tok],l,r,Stream.get lp') + else NONE + | do_delete(t::rest,(tok as TOKEN(t',(_,l,r)),lp')) = + if eqT (t,t') + then case do_delete(rest,Stream.get lp') + of SOME(deleted,l',r',lp'') => + SOME(tok::deleted,l,r',lp'') + | NONE => NONE + else NONE + + fun tryPreferred((stack,lexPair),queuePos) = + catList preferred_change (fn (delete,insert) => + if List.exists noShift delete then [] (* should give warning at + parser-generation time *) + else case do_delete(delete,lexPair) + of SOME(deleted,l,r,lp) => + tryChange{lex=lp,stack=stack,pos=queuePos, + leftPos=l,rightPos=r,orig=deleted, + new=map (fn t=>(tokAt(t,r))) insert} + | NONE => []) + + val changes = catList numStateList tryPreferred @ + catList numStateList tryInsert @ + catList numStateList trySubst @ + catList numStateList (tryDelete 1) @ + catList numStateList (tryDelete 2) @ + catList numStateList (tryDelete 3) + + val findMaxDist = fn l => + List.foldr (fn (CHANGE {distance,...},high) => Int.max(distance,high)) 0 l + +(* maxDist: max distance past error taken that we could parse *) + + val maxDist = findMaxDist changes + +(* remove changes which did not parse maxDist tokens past the error token *) + + val changes = catList changes + (fn(c as CHANGE{distance,...}) => + if distance=maxDist then [c] else []) + + in case changes + of (l as change :: _) => + let fun print_msg (CHANGE {new,orig,leftPos,rightPos,...}) = + let val s = + case (orig,new) + of (_::_,[]) => "deleting " ^ (showTerms orig) + | ([],_::_) => "inserting " ^ (showTerms new) + | _ => "replacing " ^ (showTerms orig) ^ + " with " ^ (showTerms new) + in error ("syntax error: " ^ s,leftPos,rightPos) + end + + val _ = + (if length l > 1 andalso DEBUG2 then + (print "multiple fixes possible; could fix it by:\n"; + app print_msg l; + print "chosen correction:\n") + else (); + print_msg change) + + (* findNth: find nth queue entry from the error + entry. Returns the Nth queue entry and the portion of + the queue from the beginning to the nth-1 entry. The + error entry is at the end of the queue. + + Examples: + + queue = a b c d e + findNth 0 = (e,a b c d) + findNth 1 = (d,a b c) + *) + + val findNth = fn n => + let fun f (h::t,0) = (h,rev t) + | f (h::t,n) = f(t,n-1) + | f (nil,_) = let exception FindNth + in raise FindNth + end + in f (rev stateList,n) + end + + val CHANGE {pos,orig,new,...} = change + val (last,queueFront) = findNth pos + val (stack,lexPair) = last + + val lp1 = List.foldl(fn (_,(_,r)) => Stream.get r) lexPair orig + val lp2 = List.foldr(fn(t,r)=>(t,Stream.cons r)) lp1 new + + val restQueue = + Fifo.put((stack,lp2), + List.foldl Fifo.put Fifo.empty queueFront) + + val (lexPair,stack,queue,_,_) = + distanceParse(lp2,stack,restQueue,pos) + + in (lexPair,stack,queue) + end + | nil => (error("syntax error found at " ^ (showTerminal term), + leftPos,leftPos); raise ParseError) + end + + val parse = fn {arg,table,lexer,saction,void,lookahead, + ec=ec as {showTerminal,...} : ('_a,'_b) ecRecord} => + let val distance = 15 (* defer distance tokens *) + val minAdvance = 1 (* must parse at least 1 token past error *) + val maxAdvance = Int.max(lookahead,0)(* max distance for parse check *) + val lexPair = Stream.get lexer + val (TOKEN (_,(_,leftPos,_)),_) = lexPair + val startStack = [(initialState table,(void,leftPos,leftPos))] + val startQueue = Fifo.put((startStack,lexPair),Fifo.empty) + val distanceParse = distanceParse(table,showTerminal,saction,arg) + val fixError = mkFixError(ec,distanceParse,minAdvance,maxAdvance) + val ssParse = ssParse(table,showTerminal,saction,fixError,arg) + fun loop (lexPair,stack,queue,_,SOME ACCEPT) = + ssParse(lexPair,stack,queue) + | loop (lexPair,stack,queue,0,_) = ssParse(lexPair,stack,queue) + | loop (lexPair,stack,queue,distance,SOME ERROR) = + let val (lexPair,stack,queue) = fixError(lexPair,stack,queue) + in loop (distanceParse(lexPair,stack,queue,distance)) + end + | loop _ = let exception ParseInternal + in raise ParseInternal + end + in loop (distanceParse(lexPair,startStack,startQueue,distance)) + end + end; + diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/root.sml b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/root.sml new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/root.sml @@ -0,0 +1,29 @@ +(****************************************************************************** + * STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. + * + * Copyright (c) 1989-2002 by Lucent Technologies + * + * Permission to use, copy, modify, and distribute this software and its + * documentation for any purpose and without fee is hereby granted, + * provided that the above copyright notice appear in all copies and that + * both the copyright notice and this permission notice and warranty + * disclaimer appear in supporting documentation, and that the name of + * Lucent Technologies, Bell Labs or any Lucent entity not be used in + * advertising or publicity pertaining to distribution of the software + * without specific, written prior permission. + * + * Lucent disclaims all warranties with regard to this software, + * including all implied warranties of merchantability and fitness. In no + * event shall Lucent be liable for any special, indirect or + * consequential damages or any damages whatsoever resulting from loss of + * use, data or profits, whether in an action of contract, negligence or + * other tortious action, arising out of or in connection with the use + * or performance of this software. + ******************************************************************************) +(* $Id$ *) + +use "base.sig"; +use "join.sml"; +use "lrtable.sml"; +use "stream.sml"; +use "parser2.sml"; diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/stream.sml b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/stream.sml new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/stream.sml @@ -0,0 +1,43 @@ +(****************************************************************************** + * STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. + * + * Copyright (c) 1989-2002 by Lucent Technologies + * + * Permission to use, copy, modify, and distribute this software and its + * documentation for any purpose and without fee is hereby granted, + * provided that the above copyright notice appear in all copies and that + * both the copyright notice and this permission notice and warranty + * disclaimer appear in supporting documentation, and that the name of + * Lucent Technologies, Bell Labs or any Lucent entity not be used in + * advertising or publicity pertaining to distribution of the software + * without specific, written prior permission. + * + * Lucent disclaims all warranties with regard to this software, + * including all implied warranties of merchantability and fitness. In no + * event shall Lucent be liable for any special, indirect or + * consequential damages or any damages whatsoever resulting from loss of + * use, data or profits, whether in an action of contract, negligence or + * other tortious action, arising out of or in connection with the use + * or performance of this software. + ******************************************************************************) +(* $Id$ *) + +(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *) + +(* Stream: a structure implementing a lazy stream. The signature STREAM + is found in base.sig *) + +structure Stream :> STREAM = +struct + datatype 'a str = EVAL of 'a * 'a str Unsynchronized.ref | UNEVAL of (unit->'a) + + type 'a stream = 'a str Unsynchronized.ref + + fun get(Unsynchronized.ref(EVAL t)) = t + | get(s as Unsynchronized.ref(UNEVAL f)) = + let val t = (f(), Unsynchronized.ref(UNEVAL f)) in s := EVAL t; t end + + fun streamify f = Unsynchronized.ref(UNEVAL f) + fun cons(a,s) = Unsynchronized.ref(EVAL(a,s)) + +end; diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/ml_yacc_lib.thy b/thys/Automated_Stateful_Protocol_Verification/trac/ml_yacc_lib.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/ml_yacc_lib.thy @@ -0,0 +1,101 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: ml_yacc_lib.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\ML Yacc Library\ +theory + "ml_yacc_lib" + imports + Main +begin +ML_file "ml-yacc-lib/base.sig" +ML_file "ml-yacc-lib/join.sml" +ML_file "ml-yacc-lib/lrtable.sml" +ML_file "ml-yacc-lib/stream.sml" +ML_file "ml-yacc-lib/parser2.sml" + +(* + +The files in the directory "ml-yacc-lib" are part of the sml/NJ language +processing tools. It was modified to work with Isabelle/ML by Achim D. Brucker. + +It was downloaded from http://smlnj.cs.uchicago.edu/dist/working + +Upstream Authors: The SML/NJ Team + +Copyright: 2003-2008 The SML/NJ Fellowship + 1989-2002 Lucent Technologies + 1991-2003 John Reppy + 1996-1998,2000 YALE FLINT PROJECT + 1992 Vrije Universiteit, The Netherlands + 1989-1992 Andrew W. Appel, James S. Mattson, David R. Tarditi + 1988 Evans & Sutherland Computer Corporation, Salt Lake City, Utah + +STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. + +Copyright (c) 1989-2002 by Lucent Technologies + +Permission to use, copy, modify, and distribute this software and its +documentation for any purpose and without fee is hereby granted, +provided that the above copyright notice appear in all copies and that +both the copyright notice and this permission notice and warranty +disclaimer appear in supporting documentation, and that the name of +Lucent Technologies, Bell Labs or any Lucent entity not be used in +advertising or publicity pertaining to distribution of the software +without specific, written prior permission. + +Lucent disclaims all warranties with regard to this software, +including all implied warranties of merchantability and fitness. In no +event shall Lucent be liable for any special, indirect or +consequential damages or any damages whatsoever resulting from loss of +use, data or profits, whether in an action of contract, negligence or +other tortious action, arising out of or in connection with the use +or performance of this software. + + +The SML/NJ distribution also includes code licensed under the same +terms as above, but with "David R. Tarditi Jr. and Andrew W. Appel", +"Vrije Universiteit" or "Evans & Sutherland" instead of "Lucent". + +*) +end diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac.thy b/thys/Automated_Stateful_Protocol_Verification/trac/trac.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac.thy @@ -0,0 +1,1947 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: trac.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\Support for the Trac Format\ +theory + "trac" + imports + trac_fp_parser + trac_protocol_parser +keywords + "trac" :: thy_decl + and "trac_import" :: thy_decl + and "trac_trac" :: thy_decl + and "trac_import_trac" :: thy_decl + and "protocol_model_setup" :: thy_decl + and "protocol_security_proof" :: thy_decl + and "manual_protocol_model_setup" :: thy_decl + and "manual_protocol_security_proof" :: thy_decl + and "compute_fixpoint" :: thy_decl + and "compute_SMP" :: thy_decl + and "setup_protocol_model'" :: thy_decl + and "protocol_security_proof'" :: thy_decl + and "setup_protocol_checks" :: thy_decl +begin + +ML \ +(* Some of this is based on code from the following files distributed with Isabelle 2018: + * HOL/Tools/value_command.ML + * HOL/Code_Evaluation.thy + * Pure.thy +*) + +fun protocol_model_interpretation_defs name = + let + fun f s = + (Binding.empty_atts:Attrib.binding, ((Binding.name s, NoSyn), name ^ "." ^ s)) + in + (map f [ + "public", "arity", "Ana", "\", "\\<^sub>v", "timpls_transformable_to", "intruder_synth_mod_timpls", + "analyzed_closed_mod_timpls", "timpls_transformable_to'", "intruder_synth_mod_timpls'", + "analyzed_closed_mod_timpls'", "admissible_transaction_terms", "admissible_transaction", + "abs_substs_set", "abs_substs_fun", "in_trancl", "transaction_poschecks_comp", + "transaction_negchecks_comp", "transaction_check_comp", "transaction_check", + "transaction_check_pre", "transaction_check_post", "compute_fixpoint_fun'", + "compute_fixpoint_fun", "attack_notin_fixpoint", "protocol_covered_by_fixpoint", + "analyzed_fixpoint", "wellformed_protocol'", "wellformed_protocol", "wellformed_fixpoint", + "wellformed_composable_protocols", "composable_protocols" + ]):string Interpretation.defines + end + +fun protocol_model_interpretation_params name = + let + fun f s = name ^ "_" ^ s + in + map SOME [f "arity", "\_. 0", f "public", f "Ana", f "\", "0::nat", "1::nat"] + end + +fun declare_thm_attr attribute name print lthy = + let + val arg = [(Facts.named name, [[Token.make_string (attribute, Position.none)]])] + val (_, lthy') = Specification.theorems_cmd "" [(Binding.empty_atts, arg)] [] print lthy + in + lthy' + end + +fun declare_def_attr attribute name = declare_thm_attr attribute (name ^ "_def") + +val declare_code_eqn = declare_def_attr "code" + +val declare_protocol_check = declare_def_attr "protocol_checks" + +fun declare_protocol_checks print = + declare_protocol_check "attack_notin_fixpoint" print #> + declare_protocol_check "protocol_covered_by_fixpoint" print #> + declare_protocol_check "analyzed_fixpoint" print #> + declare_protocol_check "wellformed_protocol'" print #> + declare_protocol_check "wellformed_protocol" print #> + declare_protocol_check "wellformed_fixpoint" print #> + declare_protocol_check "compute_fixpoint_fun" print + +fun eval_define (name, raw_t) lthy = + let + val t = Code_Evaluation.dynamic_value_strict lthy (Syntax.read_term lthy raw_t) + val arg = ((Binding.name name, NoSyn), ((Binding.name (name ^ "_def"),[]), t)) + val (_, lthy') = Local_Theory.define arg lthy + in + (t, lthy') + end + +fun eval_define_declare (name, raw_t) print = + eval_define (name, raw_t) ##> declare_code_eqn name print + +val _ = Outer_Syntax.local_theory' @{command_keyword "compute_fixpoint"} + "evaluate and define protocol fixpoint" + (Parse.name -- Parse.name >> (fn (protocol, fixpoint) => fn print => + snd o eval_define_declare (fixpoint, "compute_fixpoint_fun " ^ protocol) print)); + +val _ = Outer_Syntax.local_theory' @{command_keyword "compute_SMP"} + "evaluate and define a finite representation of the sub-message patterns of a protocol" + ((Scan.optional (\<^keyword>\[\ |-- Parse.name --| \<^keyword>\]\) "no_optimizations") -- + Parse.name -- Parse.name >> (fn ((opt,protocol), smp) => fn print => + let + val rmd = "List.remdups" + val f = "Stateful_Strands.trms_list\<^sub>s\<^sub>s\<^sub>t" + val g = + "(\T. " ^ f ^ " T@map (pair' prot_fun.Pair) (Stateful_Strands.setops_list\<^sub>s\<^sub>s\<^sub>t T))" + fun s trms = + "(" ^ rmd ^ " (List.concat (List.map (" ^ trms ^ + " \ Labeled_Strands.unlabel \ transaction_strand) " ^ protocol ^ ")))" + val opt1 = "remove_superfluous_terms \" + val opt2 = "generalize_terms \ is_Var" + val gsmp_opt = + "generalize_terms \ (\t. is_Var t \ t \ TAtom AttackType \ " ^ + "t \ TAtom SetType \ t \ TAtom OccursSecType \ \is_Atom (the_Var t))" + val smp_fun = "SMP0 Ana \" + fun smp_fun' opts = + "(\T. let T' = (" ^ rmd ^ " \ " ^ opts ^ " \ " ^ smp_fun ^ + ") T in List.map (\t. t \ Typed_Model.var_rename (Typed_Model.max_var_set " ^ + "(Messages.fv\<^sub>s\<^sub>e\<^sub>t (set (T@T'))))) T')" + val cmd = + if opt = "no_optimizations" then smp_fun ^ " " ^ s f + else if opt = "optimized" + then smp_fun' (opt1 ^ " \ " ^ opt2) ^ " " ^ s f + else if opt = "GSMP" + then smp_fun' (opt1 ^ " \ " ^ gsmp_opt) ^ " " ^ s g + else error ("Invalid option: " ^ opt) + in + snd o eval_define_declare (smp, cmd) print + end)); + +val _ = Outer_Syntax.local_theory' @{command_keyword "setup_protocol_checks"} + "setup protocol checks" + (Parse.name -- Parse.name >> (fn (protocol_model, protocol_name) => fn print => + let + val a1 = "coverage_check_intro_lemmata" + val a2 = "coverage_check_unfold_lemmata" + val a3 = "coverage_check_unfold_protocol_lemma" + in + declare_protocol_checks print #> + declare_thm_attr a1 (protocol_model ^ ".protocol_covered_by_fixpoint_intros") print #> + declare_def_attr a2 (protocol_model ^ ".protocol_covered_by_fixpoint") print #> + declare_def_attr a3 protocol_name print + end + )); + +val _ = + Outer_Syntax.local_theory_to_proof \<^command_keyword>\setup_protocol_model'\ + "prove interpretation of protocol model locale into global theory" + (Parse.!!! (Parse.name -- Parse_Spec.locale_expression) >> (fn (prefix,expr) => fn lthy => + let + fun f x y z = ([(x,(y,(Expression.Positional z,[])))],[]) + val (a,(b,c)) = nth (fst expr) 0 + val name = fst b + val _ = case c of (Expression.Named [],[]) => () | _ => error "Invalid arguments" + val pexpr = f a b (protocol_model_interpretation_params prefix) + val pdefs = protocol_model_interpretation_defs name + in + if name = "" + then error "No name given" + else Interpretation.global_interpretation_cmd pexpr pdefs lthy + end)); + +val _ = + Outer_Syntax.local_theory_to_proof' \<^command_keyword>\protocol_security_proof'\ + "prove interpretation of secure protocol locale into global theory" + (Parse.!!! (Parse.name -- Parse_Spec.locale_expression) >> (fn (prefix,expr) => fn print => + let + fun f x y z = ([(x,(y,(Expression.Positional z,[])))],[]) + val (a,(b,c)) = nth (fst expr) 0 + val d = case c of (Expression.Positional ps,[]) => ps | _ => error "Invalid arguments" + val pexpr = f a b (protocol_model_interpretation_params prefix@d) + in + declare_protocol_checks print #> Interpretation.global_interpretation_cmd pexpr [] + end + )); +\ + +ML\ +structure ml_isar_wrapper = struct + fun define_constant_definition (constname, trm) lthy = + let + val arg = ((Binding.name constname, NoSyn), ((Binding.name (constname^"_def"),[]), trm)) + val ((_, (_ , thm)), lthy') = Local_Theory.define arg lthy + in + (thm, lthy') + end + + fun define_constant_definition' (constname, trm) print lthy = + let + val arg = ((Binding.name constname, NoSyn), ((Binding.name (constname^"_def"),[]), trm)) + val ((_, (_ , thm)), lthy') = Local_Theory.define arg lthy + val lthy'' = declare_code_eqn constname print lthy' + in + (thm, lthy'') + end + + fun define_simple_abbrev (constname, trm) lthy = + let + val arg = ((Binding.name constname, NoSyn), trm) + val ((_, _), lthy') = Local_Theory.abbrev Syntax.mode_default arg lthy + in + lthy' + end + + fun define_simple_type_synonym (name, typedecl) lthy = + let + val (_, lthy') = Typedecl.abbrev_global (Binding.name name, [], NoSyn) typedecl lthy + in + lthy' + end + + fun define_simple_datatype (dt_tyargs, dt_name) constructors = + let + val options = Plugin_Name.default_filter + fun lift_c (tyargs, name) = (((Binding.empty, Binding.name name), map (fn t => (Binding.empty, t)) tyargs), NoSyn) + val c_spec = map lift_c constructors + val datatyp = ((map (fn ty => (NONE, ty)) dt_tyargs, Binding.name dt_name), NoSyn) + val dtspec = + ((options,false), + [(((datatyp, c_spec), (Binding.empty, Binding.empty, Binding.empty)), [])]) + in + BNF_FP_Def_Sugar.co_datatypes BNF_Util.Least_FP BNF_LFP.construct_lfp dtspec + end + + fun define_simple_primrec pname precs lthy = + let + val rec_eqs = map (fn (lhs,rhs) => (((Binding.empty,[]), HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs,rhs))),[],[])) precs + in + snd (BNF_LFP_Rec_Sugar.primrec false [] [(Binding.name pname, NONE, NoSyn)] rec_eqs lthy) + end + + fun define_simple_fun pname precs lthy = + let + val rec_eqs = map (fn (lhs,rhs) => (((Binding.empty,[]), HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs,rhs))),[],[])) precs + in + Function_Fun.add_fun [(Binding.name pname, NONE, NoSyn)] rec_eqs Function_Common.default_config lthy + end + + fun prove_simple name stmt tactic lthy = + let + val thm = Goal.prove lthy [] [] stmt (fn {context, ...} => tactic context) + |> Goal.norm_result lthy + |> Goal.check_finished lthy + in + lthy |> + snd o Local_Theory.note ((Binding.name name, []), [thm]) + end + + fun prove_state_simple method proof_state = + Seq.the_result "error in proof state" ( (Proof.refine method proof_state)) + |> Proof.global_done_proof + +end +\ + +ML\ + +structure trac_definitorial_package = struct + (* constant names *) + open Trac_Utils + val enum_constsN="enum_consts" + val setsN="sets" + val funN="fun" + val atomN="atom" + val arityN="arity" + val publicN = "public" + val gammaN = "\" + val anaN = "Ana" + val valN = "val" + val timpliesN = "timplies" + val occursN = "occurs" + val enumN = "enum" + val priv_fun_secN = "PrivFunSec" + val secret_typeN = "SecretType" + val enum_typeN = "EnumType" + val other_pubconsts_typeN = "PubConstType" + + val types = [enum_typeN, secret_typeN] + val special_funs = ["occurs", "zero", valN, priv_fun_secN] + + fun mk_listT T = Type ("List.list", [T]) + val mk_setT = HOLogic.mk_setT + val boolT = HOLogic.boolT + val natT = HOLogic.natT + val mk_tupleT = HOLogic.mk_tupleT + val mk_prodT = HOLogic.mk_prodT + + val mk_set = HOLogic.mk_set + val mk_list = HOLogic.mk_list + val mk_nat = HOLogic.mk_nat + val mk_eq = HOLogic.mk_eq + val mk_Trueprop = HOLogic.mk_Trueprop + val mk_tuple = HOLogic.mk_tuple + val mk_prod = HOLogic.mk_prod + + fun mkN (a,b) = a^"_"^b + + val info = Output.information + + fun rm_special_funs sel l = list_minus (list_rm_pair sel) l special_funs + + fun is_priv_fun (trac:TracProtocol.protocol) f = let + val funs = #private (Option.valOf (#function_spec trac)) + in + (* not (List.find (fn g => fst g = f) funs = NONE) *) + List.exists (fn (g,n) => f = g andalso n <> "0") funs + end + + fun full_name name lthy = + Local_Theory.full_name lthy (Binding.name name) + + fun full_name' n (trac:TracProtocol.protocol) lthy = full_name (mkN (#name trac, n)) lthy + + fun mk_prot_type name targs (trac:TracProtocol.protocol) lthy = + Term.Type (full_name' name trac lthy, targs) + + val enum_constsT = mk_prot_type enum_constsN [] + + fun mk_enum_const a trac lthy = + Term.Const (full_name' enum_constsN trac lthy ^ "." ^ a, enum_constsT trac lthy) + + val databaseT = mk_prot_type setsN [] + + val funT = mk_prot_type funN [] + + val atomT = mk_prot_type atomN [] + + fun messageT (trac:TracProtocol.protocol) lthy = + Term.Type ("Transactions.prot_term", [funT trac lthy, atomT trac lthy, databaseT trac lthy]) + + fun message_funT (trac:TracProtocol.protocol) lthy = + Term.Type ("Transactions.prot_fun", [funT trac lthy, atomT trac lthy, databaseT trac lthy]) + + fun message_varT (trac:TracProtocol.protocol) lthy = + Term.Type ("Transactions.prot_var", [funT trac lthy, atomT trac lthy, databaseT trac lthy]) + + fun message_term_typeT (trc:TracProtocol.protocol) lthy = + Term.Type ("Transactions.prot_term_type", [funT trc lthy, atomT trc lthy, databaseT trc lthy]) + + fun message_atomT (trac:TracProtocol.protocol) lthy = + Term.Type ("Transactions.prot_atom", [atomT trac lthy]) + + fun messageT' varT (trac:TracProtocol.protocol) lthy = + Term.Type ("Term.term", [message_funT trac lthy, varT]) + + fun message_listT (trac:TracProtocol.protocol) lthy = + mk_listT (messageT trac lthy) + + fun message_listT' varT (trac:TracProtocol.protocol) lthy = + mk_listT (messageT' varT trac lthy) + + fun absT (trac:TracProtocol.protocol) lthy = + mk_setT (databaseT trac lthy) + + fun abssT (trac:TracProtocol.protocol) lthy = + mk_setT (absT trac lthy) + + val poscheckvariantT = + Term.Type ("Strands_and_Constraints.poscheckvariant", []) + + val strand_labelT = + Term.Type ("Labeled_Strands.strand_label", [natT]) + + fun strand_stepT (trac:TracProtocol.protocol) lthy = + Term.Type ("Stateful_Strands.stateful_strand_step", + [message_funT trac lthy, message_varT trac lthy]) + + fun labeled_strand_stepT (trac:TracProtocol.protocol) lthy = + mk_prodT (strand_labelT, strand_stepT trac lthy) + + fun prot_strandT (trac:TracProtocol.protocol) lthy = + mk_listT (labeled_strand_stepT trac lthy) + + fun prot_transactionT (trac:TracProtocol.protocol) lthy = + Term.Type ("Transactions.prot_transaction", + [funT trac lthy, atomT trac lthy, databaseT trac lthy, natT]) + + val mk_star_label = + Term.Const ("Labeled_Strands.strand_label.LabelS", strand_labelT) + + fun mk_prot_label (lbl:int) = + Term.Const ("Labeled_Strands.strand_label.LabelN", natT --> strand_labelT) $ + mk_nat lbl + + fun mk_labeled_step (label:term) (step:term) = + mk_prod (label, step) + + fun mk_Send_step (trac:TracProtocol.protocol) lthy (label:term) (msg:term) = + mk_labeled_step label + (Term.Const ("Stateful_Strands.stateful_strand_step.Send", + messageT trac lthy --> strand_stepT trac lthy) $ msg) + + fun mk_Receive_step (trac:TracProtocol.protocol) lthy (label:term) (msg:term) = + mk_labeled_step label + (Term.Const ("Stateful_Strands.stateful_strand_step.Receive", + messageT trac lthy --> strand_stepT trac lthy) $ msg) + + fun mk_InSet_step (trac:TracProtocol.protocol) lthy (label:term) (elem:term) (set:term) = + let + val psT = [poscheckvariantT, messageT trac lthy, messageT trac lthy] + in + mk_labeled_step label + (Term.Const ("Stateful_Strands.stateful_strand_step.InSet", + psT ---> strand_stepT trac lthy) $ + Term.Const ("Strands_and_Constraints.poscheckvariant.Check", poscheckvariantT) $ + elem $ set) + end + + fun mk_NotInSet_step (trac:TracProtocol.protocol) lthy (label:term) (elem:term) (set:term) = + let + val varT = message_varT trac lthy + val trm_prodT = mk_prodT (messageT trac lthy, messageT trac lthy) + val psT = [mk_listT varT, mk_listT trm_prodT, mk_listT trm_prodT] + in + mk_labeled_step label + (Term.Const ("Stateful_Strands.stateful_strand_step.NegChecks", + psT ---> strand_stepT trac lthy) $ + mk_list varT [] $ + mk_list trm_prodT [] $ + mk_list trm_prodT [mk_prod (elem,set)]) + end + + fun mk_Inequality_step (trac:TracProtocol.protocol) lthy (label:term) (t1:term) (t2:term) = + let + val varT = message_varT trac lthy + val trm_prodT = mk_prodT (messageT trac lthy, messageT trac lthy) + val psT = [mk_listT varT, mk_listT trm_prodT, mk_listT trm_prodT] + in + mk_labeled_step label + (Term.Const ("Stateful_Strands.stateful_strand_step.NegChecks", + psT ---> strand_stepT trac lthy) $ + mk_list varT [] $ + mk_list trm_prodT [mk_prod (t1,t2)] $ + mk_list trm_prodT []) + end + + fun mk_Insert_step (trac:TracProtocol.protocol) lthy (label:term) (elem:term) (set:term) = + mk_labeled_step label + (Term.Const ("Stateful_Strands.stateful_strand_step.Insert", + [messageT trac lthy, messageT trac lthy] ---> strand_stepT trac lthy) $ + elem $ set) + + fun mk_Delete_step (trac:TracProtocol.protocol) lthy (label:term) (elem:term) (set:term) = + mk_labeled_step label + (Term.Const ("Stateful_Strands.stateful_strand_step.Delete", + [messageT trac lthy, messageT trac lthy] ---> strand_stepT trac lthy) $ + elem $ set) + + fun mk_Transaction (trac:TracProtocol.protocol) lthy S1 S2 S3 S4 S5 S6 = + let + val varT = message_varT trac lthy + val msgT = messageT trac lthy + val var_listT = mk_listT varT + val msg_listT = mk_listT msgT + val trT = prot_transactionT trac lthy + (* val decl_elemT = mk_prodT (varT, mk_listT msgT) + val declT = mk_listT decl_elemT *) + val stepT = labeled_strand_stepT trac lthy + val strandT = prot_strandT trac lthy + val strandsT = mk_listT strandT + val paramsT = [(* declT, *)var_listT, strandT, strandT, strandT, strandT, strandT] + in + Term.Const ("Transactions.prot_transaction.Transaction", paramsT ---> trT) $ + (* mk_list decl_elemT [] $ *) + (if null S4 then mk_list varT [] + else (Term.Const (@{const_name "map"}, [msgT --> varT, msg_listT] ---> var_listT) $ + Term.Const (@{const_name "the_Var"}, msgT --> varT) $ + mk_list msgT S4)) $ + mk_list stepT S1 $ + mk_list stepT [] $ + (if null S3 then mk_list stepT S2 + else (Term.Const (@{const_name "append"}, [strandT,strandT] ---> strandT) $ + mk_list stepT S2 $ + (Term.Const (@{const_name "concat"}, strandsT --> strandT) $ mk_list strandT S3))) $ + mk_list stepT S5 $ + mk_list stepT S6 + end + + fun get_funs (trac:TracProtocol.protocol) = + let + fun append_sec fs = fs@[(priv_fun_secN, "0")] + val filter_funs = filter (fn (_,n) => n <> "0") + val filter_consts = filter (fn (_,n) => n = "0") + fun inc_ar (s,n) = (s, Int.toString (1+Option.valOf (Int.fromString n))) + in + case (#function_spec trac) of + NONE => ([],[],[]) + | SOME ({public=pub, private=priv}) => + let + val pub_symbols = rm_special_funs fst (pub@map inc_ar (filter_funs priv)) + val pub_funs = filter_funs pub_symbols + val pub_consts = filter_consts pub_symbols + val priv_consts = append_sec (rm_special_funs fst (filter_consts priv)) + in + (pub_funs, pub_consts, priv_consts) + end + end + + fun get_set_spec (trac:TracProtocol.protocol) = + mk_unique (map (fn (s,n) => (s,Option.valOf (Int.fromString n))) (#set_spec trac)) + + fun set_arity (trac:TracProtocol.protocol) s = + case List.find (fn x => fst x = s) (get_set_spec trac) of + SOME (_,n) => SOME n + | NONE => NONE + + fun get_enums (trac:TracProtocol.protocol) = + mk_unique (TracProtocol.extract_Consts (#type_spec trac)) + + fun flatten_type_spec (trac:TracProtocol.protocol) = + let + fun find_type taus tau = + case List.find (fn x => fst x = tau) taus of + SOME x => snd x + | NONE => error ("Type " ^ tau ^ " has not been declared") + fun step taus (s,e) = + case e of + TracProtocol.Union ts => + let + val es = map (find_type taus) ts + fun f es' = mk_unique (List.concat (map TracProtocol.the_Consts es')) + in + if List.all TracProtocol.is_Consts es + then (s,TracProtocol.Consts (f es)) + else (s,TracProtocol.Union ts) + end + | c => (s,c) + fun loop taus = + let + val taus' = map (step taus) taus + in + if taus = taus' + then taus + else loop taus' + end + val flat_type_spec = + let + val x = loop (#type_spec trac) + val errpre = "Couldn't flatten the enumeration types: " + in + if List.all (fn (_,e) => TracProtocol.is_Consts e) x + then + let + val y = map (fn (s,e) => (s,TracProtocol.the_Consts e)) x + in + if List.all (not o List.null o snd) y + then y + else error (errpre ^ "does every type have at least one value?") + end + else error (errpre ^ "have all types been declared?") + end + in + flat_type_spec + end + + fun is_attack_transaction (tr:TracProtocol.cTransaction) = + not (null (#attack_actions tr)) + + fun get_transaction_name (tr:TracProtocol.cTransaction) = + #1 (#transaction tr) + + fun get_fresh_value_variables (tr:TracProtocol.cTransaction) = + map_filter (TracProtocol.maybe_the_Fresh o snd) (#fresh_actions tr) + + fun get_nonfresh_value_variables (tr:TracProtocol.cTransaction) = + map fst (filter (fn x => snd x = "value") (#2 (#transaction tr))) + + fun get_value_variables (tr:TracProtocol.cTransaction) = + get_nonfresh_value_variables tr@get_fresh_value_variables tr + + fun get_enum_variables (tr:TracProtocol.cTransaction) = + mk_unique (filter (fn x => snd x <> "value") (#2 (#transaction tr))) + + fun get_variable_restrictions (tr:TracProtocol.cTransaction) = + let + val enum_vars = get_enum_variables tr + val value_vars = get_value_variables tr + fun enum_member x = List.exists (fn y => x = fst y) + fun value_member x = List.exists (fn y => x = y) + fun aux [] = ([],[]) + | aux ((a,b)::rs) = + if enum_member a enum_vars andalso enum_member b enum_vars + then let val (es,vs) = aux rs in ((a,b)::es,vs) end + else if value_member a value_vars andalso value_member b value_vars + then let val (es,vs) = aux rs in (es,(a,b)::vs) end + else error ("Ill-formed or ill-typed variable restriction: " ^ a ^ " != " ^ b) + in + aux (#3 (#transaction tr)) + end + + fun conv_enum_consts trac (t:Trac_Term.cMsg) = + let + open Trac_Term + val enums = get_enums trac + fun aux (cFun (f,ts)) = + if List.exists (fn x => x = f) enums + then if null ts + then cEnum f + else error ("Enum constant " ^ f ^ " should not have a parameter list") + else + cFun (f,map aux ts) + | aux (cConst c) = + if List.exists (fn x => x = c) enums + then cEnum c + else cConst c + | aux (cSet (s,ts)) = cSet (s,map aux ts) + | aux (cOccursFact bs) = cOccursFact (aux bs) + | aux t = t + in + aux t + end + + fun val_to_abs_list vs = + let + open Trac_Term + fun aux t = case t of cEnum b => b | _ => error "Invalid val parameter list" + in + case vs of + [] => [] + | (cConst "0"::ts) => val_to_abs_list ts + | (cFun (s,ps)::ts) => (s, map aux ps)::val_to_abs_list ts + | (cSet (s,ps)::ts) => (s, map aux ps)::val_to_abs_list ts + | _ => error "Invalid val parameter list" + end + + fun val_to_abs (t:Trac_Term.cMsg) = + let + open Trac_Term + fun aux t = case t of cEnum b => b | _ => error "Invalid val parameter list" + + fun val_to_abs_list [] = [] + | val_to_abs_list (cConst "0"::ts) = val_to_abs_list ts + | val_to_abs_list (cFun (s,ps)::ts) = (s, map aux ps)::val_to_abs_list ts + | val_to_abs_list (cSet (s,ps)::ts) = (s, map aux ps)::val_to_abs_list ts + | val_to_abs_list _ = error "Invalid val parameter list" + in + case t of + cFun (f,ts) => + if f = valN + then cAbs (val_to_abs_list ts) + else cFun (f,map val_to_abs ts) + | cSet (s,ts) => + cSet (s,map val_to_abs ts) + | cOccursFact bs => + cOccursFact (val_to_abs bs) + | t => t + end + + fun occurs_enc t = + let + open Trac_Term + fun aux [cVar x] = cVar x + | aux [cAbs bs] = cAbs bs + | aux _ = error "Invalid occurs parameter list" + fun enc (cFun (f,ts)) = ( + if f = occursN + then cOccursFact (aux ts) + else cFun (f,map enc ts)) + | enc (cSet (s,ts)) = + cSet (s,map enc ts) + | enc (cOccursFact bs) = + cOccursFact (enc bs) + | enc t = t + in + enc t + end + + fun priv_fun_enc trac (Trac_Term.cFun (f,ts)) = ( + if is_priv_fun trac f andalso + (case ts of Trac_Term.cPrivFunSec::_ => false | _ => true) + then Trac_Term.cFun (f,Trac_Term.cPrivFunSec::map (priv_fun_enc trac) ts) + else Trac_Term.cFun (f,map (priv_fun_enc trac) ts)) + | priv_fun_enc _ t = t + + fun transform_cMsg trac = + priv_fun_enc trac o occurs_enc o val_to_abs o conv_enum_consts trac + + fun check_no_vars_and_consts (fp:Trac_Term.cMsg list) = + let + open Trac_Term + fun aux (cVar _) = false + | aux (cConst _) = false + | aux (cFun (_,ts)) = List.all aux ts + | aux (cSet (_,ts)) = List.all aux ts + | aux (cOccursFact bs) = aux bs + | aux _ = true + in + if List.all aux fp + then fp + else error "There shouldn't be any cVars and cConsts at this point in the fixpoint translation" + end + + fun split_fp (fp:Trac_Term.cMsg list) = + let + open Trac_Term + fun fa t = case t of cFun (s,_) => s <> timpliesN | _ => true + fun fb (t,ts) = case t of cOccursFact (cAbs bs) => bs::ts | _ => ts + fun fc (cFun (s, [cAbs bs, cAbs cs]),ts) = + if s = timpliesN + then (bs,cs)::ts + else ts + | fc (_,ts) = ts + + val eq = eq_set (fn ((s,xs),(t,ys)) => s = t andalso eq_set (op =) (xs,ys)) + fun eq_pairs ((a,b),(c,d)) = eq (a,c) andalso eq (b,d) + + val timplies_trancl = + let + fun trans_step ts = + let + fun aux (s,t) = map (fn (_,u) => (s,u)) (filter (fn (v,_) => eq (t,v)) ts) + in + distinct eq_pairs (filter (not o eq) (ts@List.concat (map aux ts))) + end + fun loop ts = + let + val ts' = trans_step ts + in + if eq_set eq_pairs (ts,ts') + then ts + else loop ts' + end + in + loop + end + + val ti = List.foldl fc [] fp + in + (filter fa fp, distinct eq (List.foldl fb [] fp@map snd ti), timplies_trancl ti) + end + + fun mk_enum_substs trac (vars:(string * Trac_Term.VarType) list) = + let + open Trac_Term + val flat_type_spec = flatten_type_spec trac + val deltas = + let + fun f (s,EnumType tau) = ( + case List.find (fn x => fst x = tau) flat_type_spec of + SOME x => map (fn c => (s,c)) (snd x) + | NONE => error ("Type " ^ tau ^ " was not found in the type specification")) + | f (s,_) = error ("Variable " ^ s ^ " is not of enum type") + in + list_product (map f vars) + end + in + map (fn d => map (fn (x,t) => (x,cEnum t)) d) deltas + end + + fun ground_enum_variables trac (fp:Trac_Term.cMsg list) = + let + open Trac_Term + fun do_grounding t = map (fn d => subst_apply d t) (mk_enum_substs trac (fv_cMsg t)) + in + List.concat (map do_grounding fp) + end + + fun transform_fp trac (fp:Trac_Term.cMsg list) = + fp |> ground_enum_variables trac + |> map (transform_cMsg trac) + |> check_no_vars_and_consts + |> split_fp + + fun database_to_hol (db:string * Trac_Term.cMsg list) (trac:TracProtocol.protocol) lthy = + let + open Trac_Term + val errmsg = "Invalid database parameter" + fun mkN' n = mkN (#name trac, n) + val s_prefix = full_name (mkN' setsN) lthy ^ "." + val e_prefix = full_name (mkN' enum_constsN) lthy ^ "." + val (s,es) = db + val tau = enum_constsT trac lthy + val databaseT = databaseT trac lthy + val a = Term.Const (s_prefix ^ s, map (fn _ => tau) es ---> databaseT) + fun param_to_hol (cVar (x,EnumType _)) = Term.Free (x, tau) + | param_to_hol (cVar (x,Untyped)) = Term.Free (x, tau) + | param_to_hol (cEnum e) = Term.Const (e_prefix ^ e, tau) + | param_to_hol (cConst c) = error (errmsg ^ ": cConst " ^ c) + | param_to_hol (cVar (x,ValueType)) = error (errmsg ^ ": cVar (" ^ x ^ ",ValueType)") + | param_to_hol _ = error errmsg + in + fold (fn e => fn b => b $ param_to_hol e) es a + end + + fun abs_to_hol (bs:(string * string list) list) (trac:TracProtocol.protocol) lthy = + let + val databaseT = databaseT trac lthy + fun db_params_to_cEnum (a,cs) = (a, map Trac_Term.cEnum cs) + in + mk_set databaseT (map (fn db => database_to_hol (db_params_to_cEnum db) trac lthy) bs) + end + + fun cMsg_to_hol (t:Trac_Term.cMsg) lbl varT var_map free_enum_var trac lthy = + let + open Trac_Term + val tT = messageT' varT trac lthy + val fT = message_funT trac lthy + val enum_constsT = enum_constsT trac lthy + val tsT = message_listT' varT trac lthy + val VarT = varT --> tT + val FunT = [fT, tsT] ---> tT + val absT = absT trac lthy + val databaseT = databaseT trac lthy + val AbsT = absT --> fT + val funT = funT trac lthy + val FuT = funT --> fT + val SetT = databaseT --> fT + val enumT = enum_constsT --> funT + val VarC = Term.Const (@{const_name "Var"}, VarT) + val FunC = Term.Const (@{const_name "Fun"}, FunT) + val NilC = Term.Const (@{const_name "Nil"}, tsT) + val prot_label = mk_nat lbl + fun full_name'' n = full_name' n trac lthy + fun mk_enum_const' a = mk_enum_const a trac lthy + fun mk_prot_fun_trm f tau = Term.Const ("Transactions.prot_fun." ^ f, tau) + fun mk_enum_trm etrm = + mk_prot_fun_trm "Fu" FuT $ (Term.Const (full_name'' funN ^ "." ^ enumN, enumT) $ etrm) + fun mk_Fu_trm f = + mk_prot_fun_trm "Fu" FuT $ Term.Const (full_name'' funN ^ "." ^ f, funT) + fun c_to_h s = cMsg_to_hol s lbl varT var_map free_enum_var trac lthy + fun c_list_to_h ts = mk_list tT (map c_to_h ts) + in + case t of + cVar x => + if free_enum_var x + then FunC $ mk_enum_trm (Term.Free (fst x, enum_constsT)) $ NilC + else VarC $ var_map x + | cConst f => + FunC $ + mk_Fu_trm f $ + NilC + | cFun (f,ts) => + FunC $ + mk_Fu_trm f $ + c_list_to_h ts + | cSet (s,ts) => + FunC $ + (mk_prot_fun_trm "Set" SetT $ database_to_hol (s,ts) trac lthy) $ + NilC + | cAttack => + FunC $ + (mk_prot_fun_trm "Attack" (natT --> fT) $ prot_label) $ + NilC + | cAbs bs => + FunC $ + (mk_prot_fun_trm "Abs" AbsT $ abs_to_hol bs trac lthy) $ + NilC + | cOccursFact bs => + FunC $ + mk_prot_fun_trm "OccursFact" fT $ + mk_list tT [ + FunC $ mk_prot_fun_trm "OccursSec" fT $ NilC, + c_to_h bs] + | cPrivFunSec => + FunC $ + mk_Fu_trm priv_fun_secN $ + NilC + | cEnum a => + FunC $ + mk_enum_trm (mk_enum_const' a) $ + NilC + end + + fun ground_cMsg_to_hol t lbl trac lthy = + cMsg_to_hol t lbl (message_varT trac lthy) (fn _ => error "Term not ground") + (fn _ => false) trac lthy + + fun ana_cMsg_to_hol inc_vars t (ana_var_map:string list) = + let + open Trac_Term + fun var_map (x,Untyped) = ( + case list_find (fn y => x = y) ana_var_map of + SOME (_,n) => if inc_vars then mk_nat (1+n) else mk_nat n + | NONE => error ("Analysis variable " ^ x ^ " not found")) + | var_map _ = error "Analysis variables must be untyped" + val lbl = 0 (* There's no constants in analysis messages requiring labels anyway *) + in + cMsg_to_hol t lbl natT var_map (fn _ => false) + end + + fun transaction_cMsg_to_hol t lbl (transaction_var_map:string list) trac lthy = + let + open Trac_Term + val varT = message_varT trac lthy + val atomT = message_atomT trac lthy + val term_typeT = message_term_typeT trac lthy + fun TAtom_Value_var n = + let + val a = Term.Const (@{const_name "Var"}, atomT --> term_typeT) $ + Term.Const ("Transactions.prot_atom.Value", atomT) + in + HOLogic.mk_prod (a, mk_nat n) + end + + fun var_map_err_prefix x = + "Transaction variable " ^ x ^ " should be value typed but is actually " + + fun var_map (x,ValueType) = ( + case list_find (fn y => x = y) transaction_var_map of + SOME (_,n) => TAtom_Value_var n + | NONE => error ("Transaction variable " ^ x ^ " not found")) + | var_map (x,EnumType e) = error (var_map_err_prefix x ^ "of enum type " ^ e) + | var_map (x,Untyped) = error (var_map_err_prefix x ^ "untyped") + in + cMsg_to_hol t lbl varT var_map (fn (_,t) => case t of EnumType _ => true | _ => false) + trac lthy + end + + fun fp_triple_to_hol (fp,occ,ti) trac lthy = + let + val prot_label = 0 + val tau_abs = absT trac lthy + val tau_fp_elem = messageT trac lthy + val tau_occ_elem = tau_abs + val tau_ti_elem = mk_prodT (tau_abs, tau_abs) + fun a_to_h bs = abs_to_hol bs trac lthy + fun c_to_h t = ground_cMsg_to_hol t prot_label trac lthy + val fp' = mk_list tau_fp_elem (map c_to_h fp) + val occ' = mk_list tau_occ_elem (map a_to_h occ) + val ti' = mk_list tau_ti_elem (map (mk_prod o map_prod a_to_h) ti) + in + mk_tuple [fp', occ', ti'] + end + + fun abstract_over_enum_vars enum_vars enum_ineqs trm flat_type_spec trac lthy = + let + val enum_constsT = enum_constsT trac lthy + fun enumlistelemT n = mk_tupleT (replicate n enum_constsT) + fun enumlistT n = mk_listT (enumlistelemT n) + fun mk_enum_const' a = mk_enum_const a trac lthy + + fun absfreeprod xs trm = + let + val tau = enum_constsT + val tau_out = Term.fastype_of trm + fun absfree' x = absfree (x,enum_constsT) + fun aux _ [] = trm + | aux _ [x] = absfree' x trm + | aux len (x::y::xs) = + Term.Const (@{const_name "case_prod"}, + [[tau,mk_tupleT (replicate (len-1) tau)] ---> tau_out, + mk_tupleT (replicate len tau)] ---> tau_out) $ + absfree' x (aux (len-1) (y::xs)) + in + aux (length xs) xs + end + + fun mk_enum_neq (a,b) = (HOLogic.mk_not o HOLogic.mk_eq) + (Term.Free (a, enum_constsT), Term.Free (b, enum_constsT)) + + fun mk_enum_neqs_list [] = Term.Const (@{const_name "True"}, HOLogic.boolT) + | mk_enum_neqs_list [x] = mk_enum_neq x + | mk_enum_neqs_list (x::y::xs) = HOLogic.mk_conj (mk_enum_neq x, mk_enum_neqs_list (y::xs)) + + val enum_types = + let + fun aux t = + if t = "" + then get_enums trac + else case List.find (fn (s,_) => t = s) flat_type_spec of + SOME (_,cs) => cs + | NONE => error ("Not an enum type: " ^ t ^ "?") + in + map (aux o snd) enum_vars + end + + val enumlist_product = + let + fun mk_enumlist ns = mk_list enum_constsT (map mk_enum_const' ns) + + fun aux _ [] = mk_enumlist [] + | aux _ [ns] = mk_enumlist ns + | aux len (ns::ms::elists) = + Term.Const ("List.product", [enumlistT 1, enumlistT (len-1)] ---> enumlistT len) $ + mk_enumlist ns $ aux (len-1) (ms::elists) + in + aux (length enum_types) enum_types + end + + val absfp = absfreeprod (map fst enum_vars) trm + val eptrm = enumlist_product + val typof = Term.fastype_of + val evseT = enumlistelemT (length enum_vars) + val evslT = enumlistT (length enum_vars) + val eneqs = absfreeprod (map fst enum_vars) (mk_enum_neqs_list enum_ineqs) + in + if null enum_vars + then mk_list (typof trm) [trm] + else if null enum_ineqs + then Term.Const(@{const_name "map"}, + [typof absfp, typof eptrm] ---> mk_listT (typof trm)) $ + absfp $ eptrm + else Term.Const(@{const_name "map"}, + [typof absfp, typof eptrm] ---> mk_listT (typof trm)) $ + absfp $ (Term.Const(@{const_name "filter"}, + [evseT --> HOLogic.boolT, evslT] ---> evslT) $ + eneqs $ eptrm) + end + + fun mk_type_of_name lthy pname name ty_args + = Type(Local_Theory.full_name lthy (Binding.name (mkN(pname, name))), ty_args) + + fun mk_mt_list t = Term.Const (@{const_name "Nil"}, mk_listT t) + + fun name_of_typ (Type (s, _)) = s + | name_of_typ (TFree _) = error "name_of_type: unexpected TFree" + | name_of_typ (TVar _ ) = error "name_of_type: unexpected TVAR" + + fun prove_UNIV name typ elems thmsN lthy = + let + val rhs = mk_set typ elems + val lhs = Const("Set.UNIV",mk_setT typ) + val stmt = mk_Trueprop (mk_eq (lhs,rhs)) + val fq_tname = name_of_typ typ + + fun inst_and_prove_enum thy = + let + val _ = writeln("Inst enum: "^name) + val lthy = Class.instantiation ([fq_tname], [], @{sort enum}) thy + val enum_eq = Const("Pure.eq",mk_listT typ --> mk_listT typ --> propT) + $Const(@{const_name "enum_class.enum"},mk_listT typ) + $(mk_list typ elems) + + val ((_, (_, enum_def')), lthy) = Specification.definition NONE [] [] + ((Binding.name ("enum_"^name),[]), enum_eq) lthy + val ctxt_thy = Proof_Context.init_global (Proof_Context.theory_of lthy) + val enum_def = singleton (Proof_Context.export lthy ctxt_thy) enum_def' + + val enum_all_eq = Const("Pure.eq", boolT --> boolT --> propT) + $(Const(@{const_name "enum_class.enum_all"},(typ --> boolT) --> boolT) + $Free("P",typ --> boolT)) + $(Const(@{const_name "list_all"},(typ --> boolT) --> (mk_listT typ) --> boolT) + $Free("P",typ --> boolT)$(mk_list typ elems)) + val ((_, (_, enum_all_def')), lthy) = Specification.definition NONE [] [] + ((Binding.name ("enum_all_"^name),[]), enum_all_eq) lthy + val ctxt_thy = Proof_Context.init_global (Proof_Context.theory_of lthy) + val enum_all_def = singleton (Proof_Context.export lthy ctxt_thy) enum_all_def' + + val enum_ex_eq = Const("Pure.eq", boolT --> boolT --> propT) + $(Const(@{const_name "enum_class.enum_ex"},(typ --> boolT) --> boolT) + $Free("P",typ --> boolT)) + $(Const(@{const_name "list_ex"},(typ --> boolT) --> (mk_listT typ) --> boolT) + $Free("P",typ --> boolT)$(mk_list typ elems)) + val ((_, (_, enum_ex_def')), lthy) = Specification.definition NONE [] [] + ((Binding.name ("enum_ex_"^name),[]), enum_ex_eq) lthy + val ctxt_thy = Proof_Context.init_global (Proof_Context.theory_of lthy) + val enum_ex_def = singleton (Proof_Context.export lthy ctxt_thy) enum_ex_def' + in + Class.prove_instantiation_exit (fn ctxt => + (Class.intro_classes_tac ctxt []) THEN + ALLGOALS (simp_tac (ctxt addsimps [Proof_Context.get_thm ctxt (name^"_UNIV"), + enum_def, enum_all_def, enum_ex_def]) ) + )lthy + end + fun inst_and_prove_finite thy = + let + val lthy = Class.instantiation ([fq_tname], [], @{sort finite}) thy + in + Class.prove_instantiation_exit (fn ctxt => + (Class.intro_classes_tac ctxt []) THEN + (simp_tac (ctxt addsimps[Proof_Context.get_thm ctxt (name^"_UNIV")])) 1) lthy + end + in + lthy + |> ml_isar_wrapper.prove_simple (name^"_UNIV") stmt + (fn c => (safe_tac c) + THEN (ALLGOALS(simp_tac c)) + THEN (ALLGOALS(Metis_Tactic.metis_tac ["full_types"] + "combs" c + (map (Proof_Context.get_thm c) thmsN))) + ) + |> Local_Theory.raw_theory inst_and_prove_finite + |> Local_Theory.raw_theory inst_and_prove_enum + end + + fun def_types (trac:TracProtocol.protocol) lthy = + let + val pname = #name trac + val defname = mkN(pname, enum_constsN) + val _ = info(" Defining "^defname) + val tnames = get_enums trac + val types = map (fn x => ([],x)) tnames + in + ([defname], ml_isar_wrapper.define_simple_datatype ([], defname) types lthy) + end + + fun def_sets (trac:TracProtocol.protocol) lthy = + let + val pname = #name trac + val defname = mkN(pname, setsN) + val _ = info (" Defining "^defname) + + val sspec = get_set_spec trac + val tfqn = Local_Theory.full_name lthy (Binding.name (mkN(pname, enum_constsN))) + val ttyp = Type(tfqn, []) + val types = map (fn (x,n) => (replicate n ttyp,x)) sspec + in + lthy + |> ml_isar_wrapper.define_simple_datatype ([], defname) types + end + + fun def_funs (trac:TracProtocol.protocol) lthy = + let + val pname = #name trac + val (pub_f, pub_c, priv) = get_funs trac + val pub = pub_f@pub_c + + fun def_atom lthy = + let + val def_atomname = mkN(pname, atomN) + val types = + if null pub_c + then types + else types@[other_pubconsts_typeN] + fun define_atom_dt lthy = + let + val _ = info(" Defining "^def_atomname) + in + lthy + |> ml_isar_wrapper.define_simple_datatype ([], def_atomname) (map (fn x => ([],x)) types) + end + fun prove_UNIV_atom lthy = + let + val _ = info (" Proving "^def_atomname^"_UNIV") + val thmsN = [def_atomname^".exhaust"] + val fqn = Local_Theory.full_name lthy (Binding.name (mkN(pname, atomN))) + val typ = Type(fqn, []) + in + lthy + |> prove_UNIV (def_atomname) typ (map (fn c => Const(fqn^"."^c,typ)) types) thmsN + end + in + lthy + |> define_atom_dt + |> prove_UNIV_atom + end + + fun def_fun_dt lthy = + let + val def_funname = mkN(pname, funN) + val _ = info(" Defining "^def_funname) + val types = map (fn x => ([],x)) (map fst (pub@priv)) + val ctyp = Type(Local_Theory.full_name lthy (Binding.name (mkN(pname, enum_constsN))), []) + in + ml_isar_wrapper.define_simple_datatype ([], def_funname) (types@[([ctyp],enumN)]) lthy + end + + fun def_fun_arity lthy = + let + val fqn_name = Local_Theory.full_name lthy (Binding.name (mkN(pname, funN))) + val ctyp = Type(fqn_name, []) + + fun mk_rec_eq name (fname,arity) = (Free(name,ctyp --> natT) + $Const(fqn_name^"."^fname,ctyp), + mk_nat((Option.valOf o Int.fromString) arity)) + val name = mkN(pname, arityN) + val _ = info(" Defining "^name) + val ctyp' = Type(Local_Theory.full_name lthy (Binding.name (mkN(pname, enum_constsN))), []) + in + ml_isar_wrapper.define_simple_fun name + ((map (mk_rec_eq name) (pub@priv))@[ + (Free(name, ctyp --> natT) + $(Const(fqn_name^"."^enumN, ctyp' --> ctyp)$(Term.dummy_pattern ctyp')), + mk_nat(0))]) lthy + end + + fun def_public lthy = + let + val fqn_name = Local_Theory.full_name lthy (Binding.name (mkN(pname, funN))) + val ctyp = Type(fqn_name, []) + + fun mk_rec_eq name t fname = (Free(name, ctyp --> boolT) + $Const(fqn_name^"."^fname,ctyp), t) + val name = mkN(pname, publicN) + val _ = info(" Defining "^name) + val ctyp' = Type(Local_Theory.full_name lthy (Binding.name (mkN(pname, enum_constsN))), []) + in + ml_isar_wrapper.define_simple_fun name + ((map (mk_rec_eq name (@{term "False"})) (map fst priv)) + @(map (mk_rec_eq name (@{term "True"})) (map fst pub)) + @[(Free(name, ctyp --> boolT) + $(Const(fqn_name^"."^enumN, ctyp' --> ctyp)$(Term.dummy_pattern ctyp')), + @{term "True"})]) lthy + end + + fun def_gamma lthy = + let + fun optionT t = Type (@{type_name "option"}, [t]) + fun mk_Some t = Const (@{const_name "Some"}, t --> optionT t) + fun mk_None t = Const (@{const_name "None"}, optionT t) + + val fqn_name = Local_Theory.full_name lthy (Binding.name (mkN(pname, funN))) + val ctyp = Type(fqn_name, []) + val atomFQN = Local_Theory.full_name lthy (Binding.name (mkN(pname, atomN))) + val atomT = Type(atomFQN, []) + + fun mk_rec_eq name t fname = (Free(name, ctyp --> optionT atomT) + $Const(fqn_name^"."^fname,ctyp), t) + val name = mkN(pname, gammaN) + val _ = info(" Defining "^name) + val ctyp' = Type(Local_Theory.full_name lthy (Binding.name (mkN(pname, enum_constsN))), []) + in + ml_isar_wrapper.define_simple_fun name + ((map (mk_rec_eq name ((mk_Some atomT)$(Const(atomFQN^"."^secret_typeN, atomT)))) (map fst priv)) + @(map (mk_rec_eq name ((mk_Some atomT)$(Const(atomFQN^"."^other_pubconsts_typeN, atomT)))) (map fst pub_c)) + @[(Free(name, ctyp --> optionT atomT) + $(Const(fqn_name^"."^enumN, ctyp' --> ctyp)$(Term.dummy_pattern ctyp')), + (mk_Some atomT)$(Const(atomFQN^"."^enum_typeN,atomT)))] + @(map (mk_rec_eq name (mk_None atomT)) (map fst pub_f)) ) lthy + end + + fun def_ana lthy = let + val pname = #name trac + val (pub_f, pub_c, priv) = get_funs trac + val pub = pub_f@pub_c + + val keyT = messageT' natT trac lthy + + val fqn_name = Local_Theory.full_name lthy (Binding.name (mkN(pname, funN))) + val ctyp = Type(fqn_name, []) + + val ana_outputT = mk_prodT (mk_listT keyT, mk_listT natT) + + val default_output = mk_prod (mk_list keyT [], mk_list natT []) + + fun mk_ana_output ks rs = mk_prod (mk_list keyT ks, mk_list natT rs) + + fun mk_rec_eq name t fname = (Free(name, ctyp --> ana_outputT) + $Term.Const(fqn_name^"."^fname,ctyp), t) + val name = mkN(pname, anaN) + val _ = info(" Defining "^name) + val ctyp' = Type(Local_Theory.full_name lthy (Binding.name (mkN(pname, enum_constsN))), []) + + val ana_spec = + let + val toInt = Option.valOf o Int.fromString + fun ana_arity (f,n) = (if is_priv_fun trac f then (toInt n)-1 else toInt n) + fun check_valid_arity ((f,ps),ks,rs) = + case List.find (fn g => f = fst g) pub_f of + SOME (f',n) => + if length ps <> ana_arity (f',n) + then error ("Invalid number of parameters in the analysis rule for " ^ f ^ + " (expected " ^ Int.toString (ana_arity (f',n)) ^ + " but got " ^ Int.toString (length ps) ^ ")") + else ((f,ps),ks,rs) + | NONE => error (f ^ " is not a declared function symbol of arity greater than zero") + val transform_cMsg = transform_cMsg trac + val rm_special_funs = rm_special_funs (fn ((f,_),_,_) => f) + fun var_to_nat f xs x = + let + val n = snd (Option.valOf ((list_find (fn y => y = x) xs))) + in + if is_priv_fun trac f then mk_nat (1+n) else mk_nat n + end + fun c_to_h f xs t = ana_cMsg_to_hol (is_priv_fun trac f) t xs trac lthy + fun keys f ps ks = map (c_to_h f ps o transform_cMsg o Trac_Term.certifyMsg [] []) ks + fun results f ps rs = map (var_to_nat f ps) rs + fun aux ((f,ps),ks,rs) = (f, mk_ana_output (keys f ps ks) (results f ps rs)) + in + map (aux o check_valid_arity) (rm_special_funs (#analysis_spec trac)) + end + + val other_funs = + filter (fn f => not (List.exists (fn g => f = g) (map fst ana_spec))) (map fst (pub@priv)) + in + ml_isar_wrapper.define_simple_fun name + ((map (fn (f,out) => mk_rec_eq name out f) ana_spec) + @(map (mk_rec_eq name default_output) other_funs) + @[(Free(name, ctyp --> ana_outputT) + $(Term.Const(fqn_name^"."^enumN, ctyp' --> ctyp)$(Term.dummy_pattern ctyp')), + default_output)]) lthy + end + + in + lthy |> def_atom + |> def_fun_dt + |> def_fun_arity + |> def_public + |> def_gamma + |> def_ana + end + + fun define_term_model (trac:TracProtocol.protocol) lthy = + let + val _ = info("Defining term model") + in + lthy |> snd o def_types trac + |> def_sets trac + |> def_funs trac + end + + fun define_fixpoint fp trac print lthy = + let + val fp_name = mkN (#name trac, "fixpoint") + val _ = info("Defining fixpoint") + val _ = info(" Defining "^fp_name) + val fp_triple = transform_fp trac fp + val fp_triple_trm = fp_triple_to_hol fp_triple trac lthy + val trac = TracProtocol.update_fixed_point trac (SOME fp_triple) + in + (trac, #2 (ml_isar_wrapper.define_constant_definition' (fp_name, fp_triple_trm) print lthy)) + end + + fun define_protocol print ((trac:TracProtocol.protocol), lthy) = let + val _ = + if length (#transaction_spec trac) > 1 + then info("Defining protocols") + else info("Defining protocol") + val pname = #name trac + + val flat_type_spec = flatten_type_spec trac + + val mk_Transaction = mk_Transaction trac lthy + + val mk_Send = mk_Send_step trac lthy + val mk_Receive = mk_Receive_step trac lthy + val mk_InSet = mk_InSet_step trac lthy + val mk_NotInSet = mk_NotInSet_step trac lthy + val mk_Inequality = mk_Inequality_step trac lthy + val mk_Insert = mk_Insert_step trac lthy + val mk_Delete = mk_Delete_step trac lthy + + val star_label = mk_star_label + val prot_label = mk_prot_label + + val certify_transation = TracProtocol.certifyTransaction + + fun mk_tname i (tr:TracProtocol.transaction_name) = + let + val x = #1 tr + val y = case i of NONE => x | SOME n => mkN(n, x) + val z = mkN("transaction", y) + in mkN(pname, z) + end + + fun def_transaction name_prefix prot_num (transaction:TracProtocol.cTransaction) lthy = let + val defname = mk_tname name_prefix (#transaction transaction) + val _ = info(" Defining "^defname) + + val receives = #receive_actions transaction + val checkssingle = #checksingle_actions transaction + val checksall = #checkall_actions transaction + val updates = #update_actions transaction + val sends = #send_actions transaction + val fresh = get_fresh_value_variables transaction + val attack_signals = #attack_actions transaction + + val nonfresh_value_vars = get_nonfresh_value_variables transaction + val value_vars = get_value_variables transaction + val enum_vars = get_enum_variables transaction + + val (enum_ineqs, value_ineqs) = get_variable_restrictions transaction + + val transform_cMsg = transform_cMsg trac + + fun c_to_h trm = transaction_cMsg_to_hol (transform_cMsg trm) prot_num value_vars trac lthy + + val abstract_over_enum_vars = fn x => fn y => fn z => + abstract_over_enum_vars x y z flat_type_spec trac lthy + + fun mk_transaction_term (rcvs, chcksingle, chckall, upds, snds, frsh, atcks) = + let + open Trac_Term + fun action_filter f (lbl,a) = case f a of SOME x => SOME (lbl,x) | NONE => NONE + + fun lbl_to_h (TracProtocol.LabelS) = star_label + | lbl_to_h (TracProtocol.LabelN) = prot_label prot_num + + fun lbl_trm_to_h f (lbl,t) = f (lbl_to_h lbl) (c_to_h t) + + val S1 = map (lbl_trm_to_h mk_Receive) + (map_filter (action_filter TracProtocol.maybe_the_Receive) rcvs) + + val S2 = + let + fun aux (lbl,TracProtocol.cInequality (x,y)) = + SOME (mk_Inequality (lbl_to_h lbl) (c_to_h x) (c_to_h y)) + | aux (lbl,TracProtocol.cInSet (e,s)) = + SOME (mk_InSet (lbl_to_h lbl) (c_to_h e) (c_to_h s)) + | aux (lbl,TracProtocol.cNotInSet (e,s)) = + SOME (mk_NotInSet (lbl_to_h lbl) (c_to_h e) (c_to_h s)) + | aux _ = NONE + in + map_filter aux chcksingle + end + + val S3 = + let + fun arity s = case set_arity trac s of + SOME n => n + | NONE => error ("Not a set family: " ^ s) + + fun mk_evs s = map (fn n => ("X" ^ Int.toString n, "")) (0 upto ((arity s) -1)) + + fun mk_trm (lbl,e,s) = + let + val ps = map (fn x => cVar (x,Untyped)) (map fst (mk_evs s)) + in + mk_NotInSet (lbl_to_h lbl) (c_to_h e) (c_to_h (cSet (s,ps))) + end + + fun mk_trms (lbl,(e,s)) = + abstract_over_enum_vars (mk_evs s) [] (mk_trm (lbl,e,s)) + in + map mk_trms (map_filter (action_filter TracProtocol.maybe_the_NotInAny) chckall) + end + + val S4 = map (c_to_h o mk_Value_cVar) frsh + + val S5 = + let + fun aux (lbl,TracProtocol.cInsert (e,s)) = + SOME (mk_Insert (lbl_to_h lbl) (c_to_h e) (c_to_h s)) + | aux (lbl,TracProtocol.cDelete (e,s)) = + SOME (mk_Delete (lbl_to_h lbl) (c_to_h e) (c_to_h s)) + | aux _ = NONE + in + map_filter aux upds + end + + val S6 = + let val snds' = map_filter (action_filter TracProtocol.maybe_the_Send) snds + in map (lbl_trm_to_h mk_Send) (snds'@map (fn (lbl,_) => (lbl,cAttack)) atcks) end + in + abstract_over_enum_vars enum_vars enum_ineqs (mk_Transaction S1 S2 S3 S4 S5 S6) + end + + fun def_trm trm print lthy = + #2 (ml_isar_wrapper.define_constant_definition' (defname, trm) print lthy) + + val additional_value_ineqs = + let + open Trac_Term + open TracProtocol + val poschecks = map_filter (maybe_the_InSet o snd) checkssingle + val negchecks_single = map_filter (maybe_the_NotInSet o snd) checkssingle + val negchecks_all = map_filter (maybe_the_NotInAny o snd) checksall + + fun aux' (cVar (x,ValueType),s) (cVar (y,ValueType),t) = + if s = t then SOME (x,y) else NONE + | aux' _ _ = NONE + + fun aux (x,cSet (s,ps)) = SOME ( + map_filter (aux' (x,cSet (s,ps))) negchecks_single@ + map_filter (aux' (x,s)) negchecks_all + ) + | aux _ = NONE + in + List.concat (map_filter aux poschecks) + end + + val all_value_ineqs = mk_unique (value_ineqs@additional_value_ineqs) + + val valvarsprod = + filter (fn p => not (List.exists (fn q => p = q orelse swap p = q) all_value_ineqs)) + (list_triangle_product (fn x => fn y => (x,y)) nonfresh_value_vars) + + val transaction_trm0 = mk_transaction_term + (receives, checkssingle, checksall, updates, sends, fresh, attack_signals) + in + if null valvarsprod + then def_trm transaction_trm0 print lthy + else let + val partitions = list_partitions nonfresh_value_vars all_value_ineqs + val ps = filter (not o null) (map (filter (fn x => length x > 1)) partitions) + + fun mk_subst ps = + let + open Trac_Term + fun aux [] = NONE + | aux (x::xs) = SOME (map (fn y => (y,cVar (x,ValueType))) xs) + in + List.concat (map_filter aux ps) + end + + fun apply d = + let + val ap = TracProtocol.subst_apply_actions d + fun f (TracProtocol.cInequality (x,y)) = x <> y + | f _ = true + val checksingle' = filter (f o snd) (ap checkssingle) + in + (ap receives, checksingle', ap checksall, ap updates, ap sends, fresh, attack_signals) + end + + val transaction_trms = transaction_trm0::map (mk_transaction_term o apply o mk_subst) ps + val transaction_typ = Term.fastype_of transaction_trm0 + + fun mk_concat_trm tau trms = + Term.Const (@{const_name "concat"}, mk_listT tau --> tau) $ mk_list tau trms + in + def_trm (mk_concat_trm transaction_typ transaction_trms) print lthy + end + end + + val def_transactions = + let + val prots = map (fn (n,pr) => map (fn tr => (n,tr)) pr) (#transaction_spec trac) + val lbls = list_upto (length prots) + val lbl_prots = List.concat (map (fn i => map (fn tr => (i,tr)) (nth prots i)) lbls) + val f = fold (fn (i,(n,tr)) => def_transaction n i (certify_transation tr)) + in + f lbl_prots + end + + fun def_protocols lthy = let + fun mk_prot_def (name,trm) lthy = + let val _ = info(" Defining "^name) + in #2 (ml_isar_wrapper.define_constant_definition' (name,trm) print lthy) + end + + val prots = #transaction_spec trac + val num_prots = length prots + + val pdefname = mkN(pname, "protocol") + + fun mk_tnames i = + let + val trs = case nth prots i of (j,prot) => map (fn tr => (j,tr)) prot + in map (fn (j,s) => full_name (mk_tname j (#transaction s)) lthy) trs + end + + val tnames = List.concat (map mk_tnames (list_upto num_prots)) + + val pnames = + let + val f = fn i => (Int.toString i,nth prots i) + val g = fn (i,(n,_)) => case n of NONE => i | SOME m => m + val h = fn s => mkN (pdefname,s) + in map (h o g o f) (list_upto num_prots) + end + + val trtyp = prot_transactionT trac lthy + val trstyp = mk_listT trtyp + + fun mk_prot_trm names = + Term.Const (@{const_name "concat"}, mk_listT trstyp --> trstyp) $ + mk_list trstyp (map (fn x => Term.Const (x, trstyp)) names) + + val lthy = + if num_prots > 1 + then fold (fn (i,pname) => mk_prot_def (pname, mk_prot_trm (mk_tnames i))) + (map (fn i => (i, nth pnames i)) (list_upto num_prots)) + lthy + else lthy + + val pnames' = map (fn n => full_name n lthy) pnames + + fun mk_prot_trm_with_star i = + let + fun f j = + if j = i + then Term.Const (nth pnames' j, trstyp) + else (Term.Const (@{const_name "map"}, [trtyp --> trtyp, trstyp] ---> trstyp) $ + Term.Const ("Transactions.transaction_star_proj", trtyp --> trtyp) $ + Term.Const (nth pnames' j, trstyp)) + in + Term.Const (@{const_name "concat"}, mk_listT trstyp --> trstyp) $ + mk_list trstyp (map f (list_upto num_prots)) + end + + val lthy = + if num_prots > 1 + then fold (fn (i,pname) => mk_prot_def (pname, mk_prot_trm_with_star i)) + (map (fn i => (i, nth pnames i ^ "_with_star")) (list_upto num_prots)) + lthy + else lthy + in + mk_prot_def (pdefname, mk_prot_trm (if num_prots > 1 then pnames' else tnames)) lthy + end + in + (trac, lthy |> def_transactions |> def_protocols) + end +end +\ + +ML\ +structure trac = struct + open Trac_Term + + val info = Output.information + (* Define global configuration option "trac" *) + (* val trac_fp_compute_binary_cfg = + let + val (trac_fp_compute_path_config, trac_fp_compute_path_setup) = + Attrib.config_string (Binding.name "trac_fp_compute") (K "trac_fp_compute") + in + Context.>>(Context.map_theory trac_fp_compute_path_setup); + trac_fp_compute_path_config + end + + val trac_eval_cfg = + let + val (trac_fp_compute_eval_config, trac_fp_compute_eval) = + Attrib.config_bool (Binding.name "trac_fp_compute_eval") (K false) + in + Context.>>(Context.map_theory trac_fp_compute_eval); + trac_fp_compute_eval_config + end *) + + type hide_tvar_tab = (TracProtocol.protocol) Symtab.table + fun trac_eq (a, a') = (#name a) = (#name a') + fun merge_trac_tab (tab,tab') = Symtab.merge trac_eq (tab,tab') + structure Data = Generic_Data + ( + type T = hide_tvar_tab + val empty = Symtab.empty:hide_tvar_tab + val extend = I + fun merge(t1,t2) = merge_trac_tab (t1, t2) + ); + + fun update p thy = Context.theory_of + ((Data.map (fn tab => Symtab.update (#name p, p) tab) (Context.Theory thy))) + fun lookup name thy = (Symtab.lookup ((Data.get o Context.Theory) thy) name,thy) + + fun mk_abs_filename thy filename = + let + val filename = Path.explode filename + val master_dir = Resources.master_directory thy + in + Path.implode (if (Path.is_absolute filename) + then filename + else Path.append master_dir filename) + end + + (* fun exec {trac_path, error_detail} filename = let + open OS.FileSys OS.Process + + val tmpname = tmpName() + val err_tmpname = tmpName() + fun plural 1 = "" | plural _ = "s" + val trac = case trac_path of + SOME s => s + | NONE => raise error ("trac_fp_compute_path not specified") + val cmdline = trac ^ " \"" ^ filename ^ "\" > " ^ tmpname ^ " 2> " ^ err_tmpname + in + if isSuccess (system cmdline) then (OS.FileSys.remove err_tmpname; tmpname) + else let val _ = OS.FileSys.remove tmpname + val (msg, rest) = File.read_lines (Path.explode err_tmpname) |> chop error_detail + val _ = OS.FileSys.remove err_tmpname + val _ = warning ("trac failed on " ^ filename ^ "\nCommand: " ^ cmdline ^ + "\n\nOutput:\n" ^ + cat_lines (msg @ (if null rest then [] else + ["(... " ^ string_of_int (length rest) ^ + " more line" ^ plural (length rest) ^ ")"]))) + in raise error ("trac failed on " ^ filename) end + end *) + + fun lookup_trac (pname:string) lthy = + Option.valOf (fst (lookup pname (Proof_Context.theory_of lthy))) + + fun def_fp fp_str print (trac, lthy) = + let + val fp = TracFpParser.parse_str fp_str + val (trac,lthy) = trac_definitorial_package.define_fixpoint fp trac print lthy + val lthy = Local_Theory.raw_theory (update trac) lthy + in + (trac, lthy) + end + + fun def_fp_file filename print (trac, lthy) = let + val thy = Proof_Context.theory_of lthy + val abs_filename = mk_abs_filename thy filename + val fp = TracFpParser.parse_file abs_filename + val (trac,lthy) = trac_definitorial_package.define_fixpoint fp trac print lthy + val lthy = Local_Theory.raw_theory (update trac) lthy + in + (trac, lthy) + end + + fun def_fp_trac fp_filename print (trac, lthy) = let + open OS.FileSys OS.Process + val _ = info("Checking protocol specification with trac.") + val thy = Proof_Context.theory_of lthy + (* val trac = Config.get_global thy trac_binary_cfg *) + val abs_filename = mk_abs_filename thy fp_filename + (* val fp_file = exec {error_detail=10, trac_path = SOME trac} abs_filename *) + (* val fp_raw = File.read (Path.explode fp_file) *) + val fp_raw = File.read (Path.explode abs_filename) + val fp = TracFpParser.parse_str fp_raw + (* val _ = OS.FileSys.remove fp_file *) + val _ = if TracFpParser.attack fp + then + error (" ATTACK found, skipping generating of Isabelle/HOL definitions.\n\n") + else + info(" No attack found, continue with generating Isabelle/HOL definitions.") + val (trac,lthy) = trac_definitorial_package.define_fixpoint fp trac print lthy + val lthy = Local_Theory.raw_theory (update trac) lthy + in + (trac, lthy) + end + + fun def_trac_term_model str lthy = let + val trac = TracProtocolParser.parse_str str + val lthy = Local_Theory.raw_theory (update trac) lthy + val lthy = trac_definitorial_package.define_term_model trac lthy + in + (trac, lthy) + end + + val def_trac_protocol = trac_definitorial_package.define_protocol + + fun def_trac str print = def_trac_protocol print o def_trac_term_model str + + fun def_trac_file filename print lthy = let + val trac_raw = File.read (Path.explode filename) + val (trac,lthy) = def_trac trac_raw print lthy + val lthy = Local_Theory.raw_theory (update trac) lthy + in + (trac, lthy) + end + + fun def_trac_fp_trac trac_str print lthy = let + open OS.FileSys OS.Process + val (trac,lthy) = def_trac trac_str print lthy + val tmpname = tmpName() + val _ = File.write (Path.explode tmpname) trac_str + val (trac,lthy) = def_fp_trac tmpname print (trac, lthy) + val _ = OS.FileSys.remove tmpname + val lthy = Local_Theory.raw_theory (update trac) lthy + in + lthy + end + +end +\ + +ML\ + val fileNameP = Parse.name -- Parse.name + + val _ = Outer_Syntax.local_theory' @{command_keyword "trac_import"} + "Import protocol and fixpoint from trac files." + (fileNameP >> (fn (trac_filename, fp_filename) => fn print => + trac.def_trac_file trac_filename print #> + trac.def_fp_file fp_filename print #> snd)); + + val _ = Outer_Syntax.local_theory' @{command_keyword "trac_import_trac"} + "Import protocol from trac file and compute fixpoint with trac." + (fileNameP >> (fn (trac_filename, fp_filename) => fn print => + trac.def_trac trac_filename print #> trac.def_fp_trac fp_filename print #> snd)); + + val _ = Outer_Syntax.local_theory' @{command_keyword "trac_trac"} + "Define protocol using trac format and compute fixpoint with trac." + (Parse.cartouche >> (fn trac => fn print => trac.def_trac_fp_trac trac print)); + + val _ = Outer_Syntax.local_theory' @{command_keyword "trac"} + "Define protocol and (optionally) fixpoint using trac format." + (Parse.cartouche -- Scan.optional Parse.cartouche "" >> (fn (trac,fp) => fn print => + if fp = "" + then trac.def_trac trac print #> snd + else trac.def_trac trac print #> trac.def_fp fp print #> snd)); +\ + +ML\ +val name_prefix_parser = Parse.!!! (Parse.name --| Parse.$$$ ":" -- Parse.name) + +(* Original definition (opt_evaluator) copied from value_command.ml *) +val opt_proof_method_choice = + Scan.optional (\<^keyword>\[\ |-- Parse.name --| \<^keyword>\]\) "safe"; + +(* Original definition (locale_expression) copied from parse_spec.ML *) +val opt_defs_list = Scan.optional + (\<^keyword>\for\ |-- Scan.repeat1 Parse.name >> + (fn xs => if length xs > 3 then error "Too many optional arguments" else xs)) + []; + +val security_proof_locale_parser = + name_prefix_parser -- opt_defs_list + +val security_proof_locale_parser_with_method_choice = + opt_proof_method_choice -- name_prefix_parser -- opt_defs_list + + +fun protocol_model_setup_proof_state name prefix lthy = + let + fun f x y z = ([((x,Position.none),((y,true),(Expression.Positional z,[])))],[]) + val _ = if name = "" then error "No name given" else () + val pexpr = f "stateful_protocol_model" name (protocol_model_interpretation_params prefix) + val pdefs = protocol_model_interpretation_defs name + val proof_state = Interpretation.global_interpretation_cmd pexpr pdefs lthy + in + proof_state + end + +fun protocol_security_proof_proof_state manual_proof name prefix opt_defs print lthy = + let + fun f x y z = ([((x,Position.none),((y,true),(Expression.Positional z,[])))],[]) + val _ = if name = "" then error "No name given" else () + val num_defs = length opt_defs + val pparams = protocol_model_interpretation_params prefix + val default_defs = [prefix ^ "_" ^ "protocol", prefix ^ "_" ^ "fixpoint"] + fun g locale_name extra_params = f locale_name name (pparams@map SOME extra_params) + val (prot_fp_smp_names, pexpr) = if manual_proof + then (case num_defs of + 0 => (default_defs, g "secure_stateful_protocol'" default_defs) + | 1 => (opt_defs, g "secure_stateful_protocol''" opt_defs) + | 2 => (opt_defs, g "secure_stateful_protocol'" opt_defs) + | _ => (opt_defs, g "secure_stateful_protocol" opt_defs)) + else (case num_defs of + 0 => (default_defs, g "secure_stateful_protocol''''" default_defs) + | 1 => (opt_defs, g "secure_stateful_protocol''" opt_defs) + | 2 => (opt_defs, g "secure_stateful_protocol''''" opt_defs) + | _ => (opt_defs, g "secure_stateful_protocol'''" opt_defs)) + val proof_state = lthy |> declare_protocol_checks print + |> Interpretation.global_interpretation_cmd pexpr [] + in + (prot_fp_smp_names, proof_state) + end + +val _ = + Outer_Syntax.local_theory \<^command_keyword>\protocol_model_setup\ + "prove interpretation of protocol model locale into global theory" + (name_prefix_parser >> (fn (name,prefix) => fn lthy => + let + val proof_state = protocol_model_setup_proof_state name prefix lthy + val meth = + let + val m = "protocol_model_interpretation" + val _ = Output.information ( + "Proving protocol model locale instance with proof method " ^ m) + in + Method.Source (Token.make_src (m, Position.none) []) + end + in + ml_isar_wrapper.prove_state_simple meth proof_state + end)); + +val _ = + Outer_Syntax.local_theory_to_proof \<^command_keyword>\manual_protocol_model_setup\ + "prove interpretation of protocol model locale into global theory" + (name_prefix_parser >> (fn (name,prefix) => fn lthy => + let + val proof_state = protocol_model_setup_proof_state name prefix lthy + val subgoal_proof = " subgoal by protocol_model_subgoal\n" + val _ = Output.information ("Example proof:\n" ^ + Active.sendback_markup_command (" apply unfold_locales\n"^ + subgoal_proof^ + subgoal_proof^ + subgoal_proof^ + subgoal_proof^ + subgoal_proof^ + " done\n")) + in + proof_state + end)); + +val _ = + Outer_Syntax.local_theory' \<^command_keyword>\protocol_security_proof\ + "prove interpretation of secure protocol locale into global theory" + (security_proof_locale_parser_with_method_choice >> (fn params => fn print => fn lthy => + let + val ((opt_meth_level,(name,prefix)),opt_defs) = params + val (defs, proof_state) = + protocol_security_proof_proof_state false name prefix opt_defs print lthy + val num_defs = length defs + val meth = + let + val m = case opt_meth_level of + "safe" => "check_protocol" ^ "'" (* (if num_defs = 1 then "'" else "") *) + | "unsafe" => "check_protocol_unsafe" ^ "'" (* (if num_defs = 1 then "'" else "") *) + | _ => error ("Invalid option: " ^ opt_meth_level) + val _ = Output.information ( + "Proving security of protocol " ^ nth defs 0 ^ " with proof method " ^ m) + val _ = if num_defs > 1 then Output.information ("Using fixpoint " ^ nth defs 1) else () + val _ = if num_defs > 2 then Output.information ("Using SMP set " ^ nth defs 2) else () + in + Method.Source (Token.make_src (m, Position.none) []) + end + in + ml_isar_wrapper.prove_state_simple meth proof_state + end + )); + +val _ = + Outer_Syntax.local_theory_to_proof' \<^command_keyword>\manual_protocol_security_proof\ + "prove interpretation of secure protocol locale into global theory" + (security_proof_locale_parser >> (fn params => fn print => fn lthy => + let + val ((name,prefix),opt_defs) = params + val (defs, proof_state) = + protocol_security_proof_proof_state true name prefix opt_defs print lthy + val subgoal_proof = + let + val m = "code_simp" (* case opt_meth_level of + "safe" => "code_simp" + | "unsafe" => "eval" + | _ => error ("Invalid option: " ^ opt_meth_level) *) + in + " subgoal by " ^ m ^ "\n" + end + val _ = Output.information ("Example proof:\n" ^ + Active.sendback_markup_command (" apply check_protocol_intro\n"^ + subgoal_proof^ + (if length defs = 1 then "" + else subgoal_proof^ + subgoal_proof^ + subgoal_proof^ + subgoal_proof)^ + " done\n")) + in + proof_state + end + )); +\ + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_fp_parser.thy b/thys/Automated_Stateful_Protocol_Verification/trac/trac_fp_parser.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_fp_parser.thy @@ -0,0 +1,127 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: trac_fp_parser.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section\Parser for Trac FP definitions\ +theory + trac_fp_parser + imports + "trac_term" +begin + +ML_file "trac_parser/trac_fp.grm.sig" +ML_file "trac_parser/trac_fp.lex.sml" +ML_file "trac_parser/trac_fp.grm.sml" + +ML\ +structure TracFpParser : sig + val parse_file: string -> (Trac_Term.cMsg) list + val parse_str: string -> (Trac_Term.cMsg) list + (* val term_of_trac: Trac_Term.cMsg -> term *) + val attack: Trac_Term.cMsg list -> bool +end = +struct + + open Trac_Term + + structure TracLrVals = + TracLrValsFun(structure Token = LrParser.Token) + + structure TracLex = + TracLexFun(structure Tokens = TracLrVals.Tokens) + + structure TracParser = + Join(structure LrParser = LrParser + structure ParserData = TracLrVals.ParserData + structure Lex = TracLex) + + fun invoke lexstream = + let fun print_error (s,i:(int * int * int),_) = + TextIO.output(TextIO.stdOut, + "Error, line .... " ^ (Int.toString (#1 i)) ^"."^(Int.toString (#2 i ))^ ", " ^ s ^ "\n") + in TracParser.parse(0,lexstream,print_error,()) + end + + fun parse_fp lexer = let + val dummyEOF = TracLrVals.Tokens.EOF((0,0,0),(0,0,0)) + fun certify (m,t) = Trac_Term.certifyMsg t [] m + fun loop lexer = + let + val _ = (TracLex.UserDeclarations.pos := (0,0,0);()) + val (res,lexer) = invoke lexer + val (nextToken,lexer) = TracParser.Stream.get lexer + in if TracParser.sameToken(nextToken,dummyEOF) then ((),res) + else loop lexer + end + in map certify (#2(loop lexer)) + end + + fun parse_file tracFile = let + val infile = TextIO.openIn tracFile + val lexer = TracParser.makeLexer (fn _ => case ((TextIO.inputLine) infile) of + SOME s => s + | NONE => "") + in + parse_fp lexer + end + + fun parse_str trac_fp_str = let + val parsed = Unsynchronized.ref false + fun input_string _ = if !parsed then "" else (parsed := true ;trac_fp_str) + val lexer = TracParser.makeLexer input_string + in + parse_fp lexer + end + fun attack fp = List.exists (fn e => e = cAttack) fp + +(* fun term_of_trac (Trac_Term.cVar (n,t)) = @{const "cVar"}$(HOLogic.mk_tuple[HOLogic.mk_string n, + HOLogic.mk_string t]) + | term_of_trac (Trac_Term.cConst n) = @{const "cConst"}$HOLogic.mk_string n + | term_of_trac (Trac_Term.cFun (n,l)) = @{const "cFun"} + $(HOLogic.mk_tuple[HOLogic.mk_string n, HOLogic.mk_list @{typ "cMsg"} + (map term_of_trac l)]) *) +end +\ + + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm @@ -0,0 +1,126 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +open Trac_Term + +exception NotYetSupported of string + + +%% + +%eop EOF + +%left + +%name Trac + +%term EOF + | COMMA of string + | FIXEDPOINT of string + | WHERE of string + | COLON of string + | PAREN_OPEN of string + | PAREN_CLOSE of string + | ASTERISK of string + | DOUBLE_ASTERISK of string + | DOUBLE_RARROW of string + | STRING_LITERAL of string + | UPPER_STRING_LITERAL of string + | LOWER_STRING_LITERAL of string + | INTEGER_LITERAL of string + | ONE of string + | ZERO of string + | ATTACK of string + +%nonterm START of (Msg * TypeDecl list) list + | trac_file of (Msg * TypeDecl list) list + | symfact_list_exp of (Msg * TypeDecl list) list + | symfact_exp of Msg * TypeDecl list + | rule_exp of Msg + | arg_list_exp of Msg list + | arg_exp of Msg + | type_list_exp of TypeDecl list + | type_exp of TypeDecl + | string_literal of string + | upper_literal of string + | lower_literal of string + | int_literal of string + +%pos (int * int * int) + +%noshift EOF + +%% + +START: trac_file (trac_file) +trac_file: FIXEDPOINT symfact_list_exp (symfact_list_exp) + | symfact_list_exp (symfact_list_exp) +symfact_list_exp: symfact_exp ([symfact_exp]) + | symfact_exp symfact_list_exp ([symfact_exp]@symfact_list_exp) + +symfact_exp: DOUBLE_RARROW ATTACK ((Attack,[])) + | rule_exp WHERE type_list_exp ((rule_exp,type_list_exp)) + | DOUBLE_RARROW rule_exp WHERE type_list_exp ((rule_exp,type_list_exp)) + | DOUBLE_ASTERISK DOUBLE_RARROW rule_exp WHERE type_list_exp ((rule_exp,type_list_exp)) + | rule_exp ((rule_exp,[])) + | DOUBLE_RARROW rule_exp ((rule_exp,[])) + | DOUBLE_ASTERISK DOUBLE_RARROW rule_exp ((rule_exp,[])) + +rule_exp: upper_literal (Var (upper_literal)) + | lower_literal (Fun (lower_literal,[])) + | lower_literal PAREN_OPEN arg_list_exp PAREN_CLOSE (Fun (lower_literal,arg_list_exp)) +arg_list_exp: arg_exp ([arg_exp]) + | arg_exp COMMA arg_list_exp ([arg_exp]@arg_list_exp) +arg_exp: rule_exp (rule_exp) + | ASTERISK int_literal (Var (int_literal)) + | int_literal (Const (int_literal)) + +type_list_exp: type_exp ([type_exp]) + | type_exp type_list_exp ([type_exp]@type_list_exp) +type_exp: ASTERISK int_literal COLON string_literal ((int_literal,string_literal)) + | upper_literal COLON string_literal ((upper_literal,string_literal)) + +upper_literal: UPPER_STRING_LITERAL (UPPER_STRING_LITERAL) +lower_literal: LOWER_STRING_LITERAL (LOWER_STRING_LITERAL) +string_literal: upper_literal (upper_literal) + | lower_literal (lower_literal) +int_literal: INTEGER_LITERAL (INTEGER_LITERAL) + | ZERO ("0") + | ONE ("1") + + + diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sig b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sig new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sig @@ -0,0 +1,29 @@ +signature Trac_TOKENS = +sig +type ('a,'b) token +type svalue +val ATTACK: (string) * 'a * 'a -> (svalue,'a) token +val ZERO: (string) * 'a * 'a -> (svalue,'a) token +val ONE: (string) * 'a * 'a -> (svalue,'a) token +val INTEGER_LITERAL: (string) * 'a * 'a -> (svalue,'a) token +val LOWER_STRING_LITERAL: (string) * 'a * 'a -> (svalue,'a) token +val UPPER_STRING_LITERAL: (string) * 'a * 'a -> (svalue,'a) token +val STRING_LITERAL: (string) * 'a * 'a -> (svalue,'a) token +val DOUBLE_RARROW: (string) * 'a * 'a -> (svalue,'a) token +val DOUBLE_ASTERISK: (string) * 'a * 'a -> (svalue,'a) token +val ASTERISK: (string) * 'a * 'a -> (svalue,'a) token +val PAREN_CLOSE: (string) * 'a * 'a -> (svalue,'a) token +val PAREN_OPEN: (string) * 'a * 'a -> (svalue,'a) token +val COLON: (string) * 'a * 'a -> (svalue,'a) token +val WHERE: (string) * 'a * 'a -> (svalue,'a) token +val FIXEDPOINT: (string) * 'a * 'a -> (svalue,'a) token +val COMMA: (string) * 'a * 'a -> (svalue,'a) token +val EOF: 'a * 'a -> (svalue,'a) token +end +signature Trac_LRVALS= +sig +structure Tokens : Trac_TOKENS +structure ParserData:PARSER_DATA +sharing type ParserData.Token.token = Tokens.token +sharing type ParserData.svalue = Tokens.svalue +end diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sml b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sml new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sml @@ -0,0 +1,678 @@ + (***** GENERATED FILE -- DO NOT EDIT ****) +functor TracLrValsFun(structure Token : TOKEN) + : sig structure ParserData : PARSER_DATA + structure Tokens : Trac_TOKENS + end + = +struct +structure ParserData= +struct +structure Header = +struct +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +open Trac_Term + +exception NotYetSupported of string + + + +end +structure LrTable = Token.LrTable +structure Token = Token +local open LrTable in +val table=let val actionRows = +"\ +\\001\000\001\000\000\000\000\000\ +\\001\000\003\000\013\000\009\000\012\000\010\000\011\000\012\000\010\000\ +\\013\000\009\000\000\000\ +\\001\000\005\000\038\000\000\000\ +\\001\000\005\000\047\000\000\000\ +\\001\000\007\000\036\000\000\000\ +\\001\000\008\000\028\000\012\000\010\000\013\000\009\000\014\000\027\000\ +\\015\000\026\000\016\000\025\000\000\000\ +\\001\000\008\000\032\000\012\000\010\000\000\000\ +\\001\000\009\000\012\000\010\000\011\000\012\000\010\000\013\000\009\000\000\000\ +\\001\000\010\000\019\000\000\000\ +\\001\000\012\000\010\000\013\000\009\000\000\000\ +\\001\000\012\000\010\000\013\000\009\000\017\000\018\000\000\000\ +\\001\000\014\000\027\000\015\000\026\000\016\000\025\000\000\000\ +\\051\000\000\000\ +\\052\000\000\000\ +\\053\000\000\000\ +\\054\000\009\000\012\000\010\000\011\000\012\000\010\000\013\000\009\000\000\000\ +\\055\000\000\000\ +\\056\000\000\000\ +\\057\000\000\000\ +\\058\000\000\000\ +\\059\000\000\000\ +\\060\000\004\000\015\000\000\000\ +\\061\000\004\000\033\000\000\000\ +\\062\000\004\000\042\000\000\000\ +\\063\000\000\000\ +\\064\000\006\000\014\000\000\000\ +\\065\000\000\000\ +\\066\000\002\000\035\000\000\000\ +\\067\000\000\000\ +\\068\000\000\000\ +\\069\000\000\000\ +\\070\000\000\000\ +\\071\000\008\000\032\000\012\000\010\000\000\000\ +\\072\000\000\000\ +\\073\000\000\000\ +\\074\000\000\000\ +\\075\000\000\000\ +\\076\000\000\000\ +\\077\000\000\000\ +\\078\000\000\000\ +\\079\000\000\000\ +\\080\000\000\000\ +\\081\000\000\000\ +\" +val actionRowNumbers = +"\001\000\025\000\024\000\021\000\ +\\015\000\014\000\012\000\037\000\ +\\036\000\010\000\008\000\007\000\ +\\005\000\006\000\016\000\022\000\ +\\017\000\009\000\013\000\031\000\ +\\027\000\004\000\029\000\041\000\ +\\042\000\040\000\011\000\002\000\ +\\032\000\018\000\011\000\006\000\ +\\023\000\005\000\026\000\030\000\ +\\009\000\033\000\003\000\019\000\ +\\006\000\028\000\039\000\038\000\ +\\035\000\009\000\020\000\034\000\ +\\000\000" +val gotoT = +"\ +\\001\000\048\000\002\000\006\000\003\000\005\000\004\000\004\000\ +\\005\000\003\000\011\000\002\000\012\000\001\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\003\000\014\000\004\000\004\000\005\000\003\000\011\000\002\000\ +\\012\000\001\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\005\000\015\000\011\000\002\000\012\000\001\000\000\000\ +\\000\000\ +\\003\000\018\000\004\000\004\000\005\000\003\000\011\000\002\000\ +\\012\000\001\000\000\000\ +\\005\000\022\000\006\000\021\000\007\000\020\000\011\000\002\000\ +\\012\000\001\000\013\000\019\000\000\000\ +\\008\000\029\000\009\000\028\000\011\000\027\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\005\000\032\000\011\000\002\000\012\000\001\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\013\000\035\000\000\000\ +\\000\000\ +\\008\000\037\000\009\000\028\000\011\000\027\000\000\000\ +\\000\000\ +\\013\000\038\000\000\000\ +\\008\000\039\000\009\000\028\000\011\000\027\000\000\000\ +\\000\000\ +\\005\000\022\000\006\000\041\000\007\000\020\000\011\000\002\000\ +\\012\000\001\000\013\000\019\000\000\000\ +\\000\000\ +\\000\000\ +\\010\000\044\000\011\000\043\000\012\000\042\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\008\000\046\000\009\000\028\000\011\000\027\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\010\000\047\000\011\000\043\000\012\000\042\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\" +val numstates = 49 +val numrules = 31 +val s = Unsynchronized.ref "" and index = Unsynchronized.ref 0 +val string_to_int = fn () => +let val i = !index +in index := i+2; Char.ord(String.sub(!s,i)) + Char.ord(String.sub(!s,i+1)) * 256 +end +val string_to_list = fn s' => + let val len = String.size s' + fun f () = + if !index < len then string_to_int() :: f() + else nil + in index := 0; s := s'; f () + end +val string_to_pairlist = fn (conv_key,conv_entry) => + let fun f () = + case string_to_int() + of 0 => EMPTY + | n => PAIR(conv_key (n-1),conv_entry (string_to_int()),f()) + in f + end +val string_to_pairlist_default = fn (conv_key,conv_entry) => + let val conv_row = string_to_pairlist(conv_key,conv_entry) + in fn () => + let val default = conv_entry(string_to_int()) + val row = conv_row() + in (row,default) + end + end +val string_to_table = fn (convert_row,s') => + let val len = String.size s' + fun f ()= + if !index < len then convert_row() :: f() + else nil + in (s := s'; index := 0; f ()) + end +local + val memo = Array.array(numstates+numrules,ERROR) + val _ =let fun g i=(Array.update(memo,i,REDUCE(i-numstates)); g(i+1)) + fun f i = + if i=numstates then g i + else (Array.update(memo,i,SHIFT (STATE i)); f (i+1)) + in f 0 handle General.Subscript => () + end +in +val entry_to_action = fn 0 => ACCEPT | 1 => ERROR | j => Array.sub(memo,(j-2)) +end +val gotoT=Array.fromList(string_to_table(string_to_pairlist(NT,STATE),gotoT)) +val actionRows=string_to_table(string_to_pairlist_default(T,entry_to_action),actionRows) +val actionRowNumbers = string_to_list actionRowNumbers +val actionT = let val actionRowLookUp= +let val a=Array.fromList(actionRows) in fn i=>Array.sub(a,i) end +in Array.fromList(List.map actionRowLookUp actionRowNumbers) +end +in LrTable.mkLrTable {actions=actionT,gotos=gotoT,numRules=numrules, +numStates=numstates,initialState=STATE 0} +end +end +local open Header in +type pos = ( int * int * int ) +type arg = unit +structure MlyValue = +struct +datatype svalue = VOID | ntVOID of unit -> unit + | ATTACK of unit -> (string) | ZERO of unit -> (string) + | ONE of unit -> (string) | INTEGER_LITERAL of unit -> (string) + | LOWER_STRING_LITERAL of unit -> (string) + | UPPER_STRING_LITERAL of unit -> (string) + | STRING_LITERAL of unit -> (string) + | DOUBLE_RARROW of unit -> (string) + | DOUBLE_ASTERISK of unit -> (string) + | ASTERISK of unit -> (string) | PAREN_CLOSE of unit -> (string) + | PAREN_OPEN of unit -> (string) | COLON of unit -> (string) + | WHERE of unit -> (string) | FIXEDPOINT of unit -> (string) + | COMMA of unit -> (string) | int_literal of unit -> (string) + | lower_literal of unit -> (string) + | upper_literal of unit -> (string) + | string_literal of unit -> (string) + | type_exp of unit -> (TypeDecl) + | type_list_exp of unit -> (TypeDecl list) + | arg_exp of unit -> (Msg) | arg_list_exp of unit -> (Msg list) + | rule_exp of unit -> (Msg) + | symfact_exp of unit -> (Msg*TypeDecl list) + | symfact_list_exp of unit -> ( ( Msg * TypeDecl list ) list) + | trac_file of unit -> ( ( Msg * TypeDecl list ) list) + | START of unit -> ( ( Msg * TypeDecl list ) list) +end +type svalue = MlyValue.svalue +type result = ( Msg * TypeDecl list ) list +end +structure EC= +struct +open LrTable +infix 5 $$ +fun x $$ y = y::x +val is_keyword = +fn _ => false +val preferred_change : (term list * term list) list = +nil +val noShift = +fn (T 0) => true | _ => false +val showTerminal = +fn (T 0) => "EOF" + | (T 1) => "COMMA" + | (T 2) => "FIXEDPOINT" + | (T 3) => "WHERE" + | (T 4) => "COLON" + | (T 5) => "PAREN_OPEN" + | (T 6) => "PAREN_CLOSE" + | (T 7) => "ASTERISK" + | (T 8) => "DOUBLE_ASTERISK" + | (T 9) => "DOUBLE_RARROW" + | (T 10) => "STRING_LITERAL" + | (T 11) => "UPPER_STRING_LITERAL" + | (T 12) => "LOWER_STRING_LITERAL" + | (T 13) => "INTEGER_LITERAL" + | (T 14) => "ONE" + | (T 15) => "ZERO" + | (T 16) => "ATTACK" + | _ => "bogus-term" +local open Header in +val errtermvalue= +fn _ => MlyValue.VOID +end +val terms : term list = nil + $$ (T 0)end +structure Actions = +struct +exception mlyAction of int +local open Header in +val actions = +fn (i392,defaultPos,stack, + (()):arg) => +case (i392,stack) +of ( 0, ( ( _, ( MlyValue.trac_file trac_file1, trac_file1left, +trac_file1right)) :: rest671)) => let val result = MlyValue.START (fn + _ => let val (trac_file as trac_file1) = trac_file1 () + in (trac_file) +end) + in ( LrTable.NT 0, ( result, trac_file1left, trac_file1right), +rest671) +end +| ( 1, ( ( _, ( MlyValue.symfact_list_exp symfact_list_exp1, _, +symfact_list_exp1right)) :: ( _, ( MlyValue.FIXEDPOINT FIXEDPOINT1, +FIXEDPOINT1left, _)) :: rest671)) => let val result = +MlyValue.trac_file (fn _ => let val FIXEDPOINT1 = FIXEDPOINT1 () + val (symfact_list_exp as symfact_list_exp1) = symfact_list_exp1 () + in (symfact_list_exp) +end) + in ( LrTable.NT 1, ( result, FIXEDPOINT1left, symfact_list_exp1right) +, rest671) +end +| ( 2, ( ( _, ( MlyValue.symfact_list_exp symfact_list_exp1, +symfact_list_exp1left, symfact_list_exp1right)) :: rest671)) => let + val result = MlyValue.trac_file (fn _ => let val (symfact_list_exp + as symfact_list_exp1) = symfact_list_exp1 () + in (symfact_list_exp) +end) + in ( LrTable.NT 1, ( result, symfact_list_exp1left, +symfact_list_exp1right), rest671) +end +| ( 3, ( ( _, ( MlyValue.symfact_exp symfact_exp1, symfact_exp1left, +symfact_exp1right)) :: rest671)) => let val result = +MlyValue.symfact_list_exp (fn _ => let val (symfact_exp as +symfact_exp1) = symfact_exp1 () + in ([symfact_exp]) +end) + in ( LrTable.NT 2, ( result, symfact_exp1left, symfact_exp1right), +rest671) +end +| ( 4, ( ( _, ( MlyValue.symfact_list_exp symfact_list_exp1, _, +symfact_list_exp1right)) :: ( _, ( MlyValue.symfact_exp symfact_exp1, +symfact_exp1left, _)) :: rest671)) => let val result = +MlyValue.symfact_list_exp (fn _ => let val (symfact_exp as +symfact_exp1) = symfact_exp1 () + val (symfact_list_exp as symfact_list_exp1) = symfact_list_exp1 () + in ([symfact_exp]@symfact_list_exp) +end) + in ( LrTable.NT 2, ( result, symfact_exp1left, symfact_list_exp1right +), rest671) +end +| ( 5, ( ( _, ( MlyValue.ATTACK ATTACK1, _, ATTACK1right)) :: ( _, ( +MlyValue.DOUBLE_RARROW DOUBLE_RARROW1, DOUBLE_RARROW1left, _)) :: +rest671)) => let val result = MlyValue.symfact_exp (fn _ => let val +DOUBLE_RARROW1 = DOUBLE_RARROW1 () + val ATTACK1 = ATTACK1 () + in ((Attack,[])) +end) + in ( LrTable.NT 3, ( result, DOUBLE_RARROW1left, ATTACK1right), +rest671) +end +| ( 6, ( ( _, ( MlyValue.type_list_exp type_list_exp1, _, +type_list_exp1right)) :: ( _, ( MlyValue.WHERE WHERE1, _, _)) :: ( _, +( MlyValue.rule_exp rule_exp1, rule_exp1left, _)) :: rest671)) => let + val result = MlyValue.symfact_exp (fn _ => let val (rule_exp as +rule_exp1) = rule_exp1 () + val WHERE1 = WHERE1 () + val (type_list_exp as type_list_exp1) = type_list_exp1 () + in ((rule_exp,type_list_exp)) +end) + in ( LrTable.NT 3, ( result, rule_exp1left, type_list_exp1right), +rest671) +end +| ( 7, ( ( _, ( MlyValue.type_list_exp type_list_exp1, _, +type_list_exp1right)) :: ( _, ( MlyValue.WHERE WHERE1, _, _)) :: ( _, +( MlyValue.rule_exp rule_exp1, _, _)) :: ( _, ( MlyValue.DOUBLE_RARROW + DOUBLE_RARROW1, DOUBLE_RARROW1left, _)) :: rest671)) => let val +result = MlyValue.symfact_exp (fn _ => let val DOUBLE_RARROW1 = +DOUBLE_RARROW1 () + val (rule_exp as rule_exp1) = rule_exp1 () + val WHERE1 = WHERE1 () + val (type_list_exp as type_list_exp1) = type_list_exp1 () + in ((rule_exp,type_list_exp)) +end) + in ( LrTable.NT 3, ( result, DOUBLE_RARROW1left, type_list_exp1right) +, rest671) +end +| ( 8, ( ( _, ( MlyValue.type_list_exp type_list_exp1, _, +type_list_exp1right)) :: ( _, ( MlyValue.WHERE WHERE1, _, _)) :: ( _, +( MlyValue.rule_exp rule_exp1, _, _)) :: ( _, ( MlyValue.DOUBLE_RARROW + DOUBLE_RARROW1, _, _)) :: ( _, ( MlyValue.DOUBLE_ASTERISK +DOUBLE_ASTERISK1, DOUBLE_ASTERISK1left, _)) :: rest671)) => let val +result = MlyValue.symfact_exp (fn _ => let val DOUBLE_ASTERISK1 = +DOUBLE_ASTERISK1 () + val DOUBLE_RARROW1 = DOUBLE_RARROW1 () + val (rule_exp as rule_exp1) = rule_exp1 () + val WHERE1 = WHERE1 () + val (type_list_exp as type_list_exp1) = type_list_exp1 () + in ((rule_exp,type_list_exp)) +end) + in ( LrTable.NT 3, ( result, DOUBLE_ASTERISK1left, +type_list_exp1right), rest671) +end +| ( 9, ( ( _, ( MlyValue.rule_exp rule_exp1, rule_exp1left, +rule_exp1right)) :: rest671)) => let val result = +MlyValue.symfact_exp (fn _ => let val (rule_exp as rule_exp1) = +rule_exp1 () + in ((rule_exp,[])) +end) + in ( LrTable.NT 3, ( result, rule_exp1left, rule_exp1right), rest671) + +end +| ( 10, ( ( _, ( MlyValue.rule_exp rule_exp1, _, rule_exp1right)) :: +( _, ( MlyValue.DOUBLE_RARROW DOUBLE_RARROW1, DOUBLE_RARROW1left, _)) + :: rest671)) => let val result = MlyValue.symfact_exp (fn _ => let + val DOUBLE_RARROW1 = DOUBLE_RARROW1 () + val (rule_exp as rule_exp1) = rule_exp1 () + in ((rule_exp,[])) +end) + in ( LrTable.NT 3, ( result, DOUBLE_RARROW1left, rule_exp1right), +rest671) +end +| ( 11, ( ( _, ( MlyValue.rule_exp rule_exp1, _, rule_exp1right)) :: +( _, ( MlyValue.DOUBLE_RARROW DOUBLE_RARROW1, _, _)) :: ( _, ( +MlyValue.DOUBLE_ASTERISK DOUBLE_ASTERISK1, DOUBLE_ASTERISK1left, _)) + :: rest671)) => let val result = MlyValue.symfact_exp (fn _ => let + val DOUBLE_ASTERISK1 = DOUBLE_ASTERISK1 () + val DOUBLE_RARROW1 = DOUBLE_RARROW1 () + val (rule_exp as rule_exp1) = rule_exp1 () + in ((rule_exp,[])) +end) + in ( LrTable.NT 3, ( result, DOUBLE_ASTERISK1left, rule_exp1right), +rest671) +end +| ( 12, ( ( _, ( MlyValue.upper_literal upper_literal1, +upper_literal1left, upper_literal1right)) :: rest671)) => let val +result = MlyValue.rule_exp (fn _ => let val (upper_literal as +upper_literal1) = upper_literal1 () + in (Var (upper_literal)) +end) + in ( LrTable.NT 4, ( result, upper_literal1left, upper_literal1right) +, rest671) +end +| ( 13, ( ( _, ( MlyValue.lower_literal lower_literal1, +lower_literal1left, lower_literal1right)) :: rest671)) => let val +result = MlyValue.rule_exp (fn _ => let val (lower_literal as +lower_literal1) = lower_literal1 () + in (Fun (lower_literal,[])) +end) + in ( LrTable.NT 4, ( result, lower_literal1left, lower_literal1right) +, rest671) +end +| ( 14, ( ( _, ( MlyValue.PAREN_CLOSE PAREN_CLOSE1, _, +PAREN_CLOSE1right)) :: ( _, ( MlyValue.arg_list_exp arg_list_exp1, _, + _)) :: ( _, ( MlyValue.PAREN_OPEN PAREN_OPEN1, _, _)) :: ( _, ( +MlyValue.lower_literal lower_literal1, lower_literal1left, _)) :: +rest671)) => let val result = MlyValue.rule_exp (fn _ => let val ( +lower_literal as lower_literal1) = lower_literal1 () + val PAREN_OPEN1 = PAREN_OPEN1 () + val (arg_list_exp as arg_list_exp1) = arg_list_exp1 () + val PAREN_CLOSE1 = PAREN_CLOSE1 () + in (Fun (lower_literal,arg_list_exp)) +end) + in ( LrTable.NT 4, ( result, lower_literal1left, PAREN_CLOSE1right), +rest671) +end +| ( 15, ( ( _, ( MlyValue.arg_exp arg_exp1, arg_exp1left, +arg_exp1right)) :: rest671)) => let val result = +MlyValue.arg_list_exp (fn _ => let val (arg_exp as arg_exp1) = +arg_exp1 () + in ([arg_exp]) +end) + in ( LrTable.NT 5, ( result, arg_exp1left, arg_exp1right), rest671) + +end +| ( 16, ( ( _, ( MlyValue.arg_list_exp arg_list_exp1, _, +arg_list_exp1right)) :: ( _, ( MlyValue.COMMA COMMA1, _, _)) :: ( _, ( + MlyValue.arg_exp arg_exp1, arg_exp1left, _)) :: rest671)) => let val + result = MlyValue.arg_list_exp (fn _ => let val (arg_exp as arg_exp1 +) = arg_exp1 () + val COMMA1 = COMMA1 () + val (arg_list_exp as arg_list_exp1) = arg_list_exp1 () + in ([arg_exp]@arg_list_exp) +end) + in ( LrTable.NT 5, ( result, arg_exp1left, arg_list_exp1right), +rest671) +end +| ( 17, ( ( _, ( MlyValue.rule_exp rule_exp1, rule_exp1left, +rule_exp1right)) :: rest671)) => let val result = MlyValue.arg_exp + (fn _ => let val (rule_exp as rule_exp1) = rule_exp1 () + in (rule_exp) +end) + in ( LrTable.NT 6, ( result, rule_exp1left, rule_exp1right), rest671) + +end +| ( 18, ( ( _, ( MlyValue.int_literal int_literal1, _, +int_literal1right)) :: ( _, ( MlyValue.ASTERISK ASTERISK1, +ASTERISK1left, _)) :: rest671)) => let val result = MlyValue.arg_exp + (fn _ => let val ASTERISK1 = ASTERISK1 () + val (int_literal as int_literal1) = int_literal1 () + in (Var (int_literal)) +end) + in ( LrTable.NT 6, ( result, ASTERISK1left, int_literal1right), +rest671) +end +| ( 19, ( ( _, ( MlyValue.int_literal int_literal1, int_literal1left, + int_literal1right)) :: rest671)) => let val result = +MlyValue.arg_exp (fn _ => let val (int_literal as int_literal1) = +int_literal1 () + in (Const (int_literal)) +end) + in ( LrTable.NT 6, ( result, int_literal1left, int_literal1right), +rest671) +end +| ( 20, ( ( _, ( MlyValue.type_exp type_exp1, type_exp1left, +type_exp1right)) :: rest671)) => let val result = +MlyValue.type_list_exp (fn _ => let val (type_exp as type_exp1) = +type_exp1 () + in ([type_exp]) +end) + in ( LrTable.NT 7, ( result, type_exp1left, type_exp1right), rest671) + +end +| ( 21, ( ( _, ( MlyValue.type_list_exp type_list_exp1, _, +type_list_exp1right)) :: ( _, ( MlyValue.type_exp type_exp1, +type_exp1left, _)) :: rest671)) => let val result = +MlyValue.type_list_exp (fn _ => let val (type_exp as type_exp1) = +type_exp1 () + val (type_list_exp as type_list_exp1) = type_list_exp1 () + in ([type_exp]@type_list_exp) +end) + in ( LrTable.NT 7, ( result, type_exp1left, type_list_exp1right), +rest671) +end +| ( 22, ( ( _, ( MlyValue.string_literal string_literal1, _, +string_literal1right)) :: ( _, ( MlyValue.COLON COLON1, _, _)) :: ( _, + ( MlyValue.int_literal int_literal1, _, _)) :: ( _, ( +MlyValue.ASTERISK ASTERISK1, ASTERISK1left, _)) :: rest671)) => let + val result = MlyValue.type_exp (fn _ => let val ASTERISK1 = +ASTERISK1 () + val (int_literal as int_literal1) = int_literal1 () + val COLON1 = COLON1 () + val (string_literal as string_literal1) = string_literal1 () + in ((int_literal,string_literal)) +end) + in ( LrTable.NT 8, ( result, ASTERISK1left, string_literal1right), +rest671) +end +| ( 23, ( ( _, ( MlyValue.string_literal string_literal1, _, +string_literal1right)) :: ( _, ( MlyValue.COLON COLON1, _, _)) :: ( _, + ( MlyValue.upper_literal upper_literal1, upper_literal1left, _)) :: +rest671)) => let val result = MlyValue.type_exp (fn _ => let val ( +upper_literal as upper_literal1) = upper_literal1 () + val COLON1 = COLON1 () + val (string_literal as string_literal1) = string_literal1 () + in ((upper_literal,string_literal)) +end) + in ( LrTable.NT 8, ( result, upper_literal1left, string_literal1right +), rest671) +end +| ( 24, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1, + UPPER_STRING_LITERAL1left, UPPER_STRING_LITERAL1right)) :: rest671)) + => let val result = MlyValue.upper_literal (fn _ => let val ( +UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1 + () + in (UPPER_STRING_LITERAL) +end) + in ( LrTable.NT 10, ( result, UPPER_STRING_LITERAL1left, +UPPER_STRING_LITERAL1right), rest671) +end +| ( 25, ( ( _, ( MlyValue.LOWER_STRING_LITERAL LOWER_STRING_LITERAL1, + LOWER_STRING_LITERAL1left, LOWER_STRING_LITERAL1right)) :: rest671)) + => let val result = MlyValue.lower_literal (fn _ => let val ( +LOWER_STRING_LITERAL as LOWER_STRING_LITERAL1) = LOWER_STRING_LITERAL1 + () + in (LOWER_STRING_LITERAL) +end) + in ( LrTable.NT 11, ( result, LOWER_STRING_LITERAL1left, +LOWER_STRING_LITERAL1right), rest671) +end +| ( 26, ( ( _, ( MlyValue.upper_literal upper_literal1, +upper_literal1left, upper_literal1right)) :: rest671)) => let val +result = MlyValue.string_literal (fn _ => let val (upper_literal as +upper_literal1) = upper_literal1 () + in (upper_literal) +end) + in ( LrTable.NT 9, ( result, upper_literal1left, upper_literal1right) +, rest671) +end +| ( 27, ( ( _, ( MlyValue.lower_literal lower_literal1, +lower_literal1left, lower_literal1right)) :: rest671)) => let val +result = MlyValue.string_literal (fn _ => let val (lower_literal as +lower_literal1) = lower_literal1 () + in (lower_literal) +end) + in ( LrTable.NT 9, ( result, lower_literal1left, lower_literal1right) +, rest671) +end +| ( 28, ( ( _, ( MlyValue.INTEGER_LITERAL INTEGER_LITERAL1, +INTEGER_LITERAL1left, INTEGER_LITERAL1right)) :: rest671)) => let val + result = MlyValue.int_literal (fn _ => let val (INTEGER_LITERAL as +INTEGER_LITERAL1) = INTEGER_LITERAL1 () + in (INTEGER_LITERAL) +end) + in ( LrTable.NT 12, ( result, INTEGER_LITERAL1left, +INTEGER_LITERAL1right), rest671) +end +| ( 29, ( ( _, ( MlyValue.ZERO ZERO1, ZERO1left, ZERO1right)) :: +rest671)) => let val result = MlyValue.int_literal (fn _ => let val +ZERO1 = ZERO1 () + in ("0") +end) + in ( LrTable.NT 12, ( result, ZERO1left, ZERO1right), rest671) +end +| ( 30, ( ( _, ( MlyValue.ONE ONE1, ONE1left, ONE1right)) :: rest671) +) => let val result = MlyValue.int_literal (fn _ => let val ONE1 = +ONE1 () + in ("1") +end) + in ( LrTable.NT 12, ( result, ONE1left, ONE1right), rest671) +end +| _ => raise (mlyAction i392) +end +val void = MlyValue.VOID +val extract = fn a => (fn MlyValue.START x => x +| _ => let exception ParseInternal + in raise ParseInternal end) a () +end +end +structure Tokens : Trac_TOKENS = +struct +type svalue = ParserData.svalue +type ('a,'b) token = ('a,'b) Token.token +fun EOF (p1,p2) = Token.TOKEN (ParserData.LrTable.T 0,( +ParserData.MlyValue.VOID,p1,p2)) +fun COMMA (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 1,( +ParserData.MlyValue.COMMA (fn () => i),p1,p2)) +fun FIXEDPOINT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 2,( +ParserData.MlyValue.FIXEDPOINT (fn () => i),p1,p2)) +fun WHERE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 3,( +ParserData.MlyValue.WHERE (fn () => i),p1,p2)) +fun COLON (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 4,( +ParserData.MlyValue.COLON (fn () => i),p1,p2)) +fun PAREN_OPEN (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 5,( +ParserData.MlyValue.PAREN_OPEN (fn () => i),p1,p2)) +fun PAREN_CLOSE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 6,( +ParserData.MlyValue.PAREN_CLOSE (fn () => i),p1,p2)) +fun ASTERISK (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 7,( +ParserData.MlyValue.ASTERISK (fn () => i),p1,p2)) +fun DOUBLE_ASTERISK (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 8,( +ParserData.MlyValue.DOUBLE_ASTERISK (fn () => i),p1,p2)) +fun DOUBLE_RARROW (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 9,( +ParserData.MlyValue.DOUBLE_RARROW (fn () => i),p1,p2)) +fun STRING_LITERAL (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 10,( +ParserData.MlyValue.STRING_LITERAL (fn () => i),p1,p2)) +fun UPPER_STRING_LITERAL (i,p1,p2) = Token.TOKEN ( +ParserData.LrTable.T 11,(ParserData.MlyValue.UPPER_STRING_LITERAL + (fn () => i),p1,p2)) +fun LOWER_STRING_LITERAL (i,p1,p2) = Token.TOKEN ( +ParserData.LrTable.T 12,(ParserData.MlyValue.LOWER_STRING_LITERAL + (fn () => i),p1,p2)) +fun INTEGER_LITERAL (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 13,( +ParserData.MlyValue.INTEGER_LITERAL (fn () => i),p1,p2)) +fun ONE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 14,( +ParserData.MlyValue.ONE (fn () => i),p1,p2)) +fun ZERO (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 15,( +ParserData.MlyValue.ZERO (fn () => i),p1,p2)) +fun ATTACK (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 16,( +ParserData.MlyValue.ATTACK (fn () => i),p1,p2)) +end +end diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex @@ -0,0 +1,103 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +structure Tokens = Tokens +open Trac_Term + +type pos = int * int * int +type svalue = Tokens.svalue + +type ('a,'b) token = ('a,'b) Tokens.token +type lexresult= (svalue,pos) token + + +val pos = ref (0,0,0) + + fun eof () = Tokens.EOF((!pos,!pos)) + fun error (e,p : (int * int * int),_) = TextIO.output (TextIO.stdOut, + String.concat[ + "line ", (Int.toString (#1 p)), "/", + (Int.toString (#2 p - #3 p)),": ", e, "\n" + ]) + + fun inputPos yypos = ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))), + (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))) + fun inputPos_half yypos = (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))) + + + +%% +%header (functor TracLexFun(structure Tokens: Trac_TOKENS)); +alpha=[A-Za-z_]; +upper=[A-Z]; +lower=[a-z]; +digit=[0-9]; +ws = [\ \t]; +%% + +\n => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos ); lex()); +{ws}+ => (pos := (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))); lex()); + +(#)[^\n]*\n => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos ); lex()); + +"/*""/"*([^*/]|[^*]"/"|"*"[^/])*"*"*"*/" => (lex()); + + +"," => (Tokens.COMMA(yytext,inputPos_half yypos,inputPos_half yypos)); +"Fixedpoint" => (Tokens.FIXEDPOINT(yytext,inputPos_half yypos,inputPos_half yypos)); +"where" => (Tokens.WHERE(yytext,inputPos_half yypos,inputPos_half yypos)); +":" => (Tokens.COLON(yytext,inputPos_half yypos,inputPos_half yypos)); +"(" => (Tokens.PAREN_OPEN(yytext,inputPos_half yypos,inputPos_half yypos)); +")" => (Tokens.PAREN_CLOSE(yytext,inputPos_half yypos,inputPos_half yypos)); +"**" => (Tokens.DOUBLE_ASTERISK(yytext,inputPos_half yypos,inputPos_half yypos)); +"*" => (Tokens.ASTERISK(yytext,inputPos_half yypos,inputPos_half yypos)); +"=>" => (Tokens.DOUBLE_RARROW(yytext,inputPos_half yypos,inputPos_half yypos)); +"one" => (Tokens.ONE(yytext,inputPos_half yypos,inputPos_half yypos)); +"zero" => (Tokens.ZERO(yytext,inputPos_half yypos,inputPos_half yypos)); +"attack" => (Tokens.ATTACK(yytext,inputPos_half yypos,inputPos_half yypos)); + + +{digit}+ => (Tokens.INTEGER_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos)); +"'"({alpha}|{ws}|{digit})*(("."|"_"|"/"|"-")*({alpha}|{ws}|{digit})*)*"'" => (Tokens.STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos)); +{upper}({alpha}|{digit})*("'")* => (Tokens.UPPER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos)); +{lower}({alpha}|{digit})*("'")* => (Tokens.LOWER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos)); + + +. => (error ("ignoring bad character "^yytext, + ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))), + ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))))); + lex()); diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex.sml b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex.sml new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex.sml @@ -0,0 +1,728 @@ + (***** GENERATED FILE -- DO NOT EDIT ****) +functor TracLexFun(structure Tokens: Trac_TOKENS)= + struct + structure UserDeclarations = + struct +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +structure Tokens = Tokens +open Trac_Term + +type pos = int * int * int +type svalue = Tokens.svalue + +type ('a,'b) token = ('a,'b) Tokens.token +type lexresult= (svalue,pos) token + + +val pos = Unsynchronized.ref (0,0,0) + + fun eof () = Tokens.EOF((!pos,!pos)) + fun error (e,p : (int * int * int),_) = TextIO.output (TextIO.stdOut, + String.concat[ + "line ", (Int.toString (#1 p)), "/", + (Int.toString (#2 p - #3 p)),": ", e, "\n" + ]) + + fun inputPos yypos = ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))), + (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))) + fun inputPos_half yypos = (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))) + + + +end (* end of user routines *) +exception LexError (* raised if illegal leaf action tried *) +structure Internal = + struct + +datatype yyfinstate = N of int +type statedata = {fin : yyfinstate list, trans: string} +(* transition & final state table *) +val tab = let +val s = [ + (0, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (1, +"\003\003\003\003\003\003\003\003\003\065\067\003\003\003\003\003\ +\\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\ +\\065\003\003\062\003\003\003\058\057\056\054\003\053\003\003\043\ +\\041\041\041\041\041\041\041\041\041\041\040\003\003\038\003\003\ +\\003\025\025\025\025\025\028\025\025\025\025\025\025\025\025\025\ +\\025\025\025\025\025\025\025\025\025\025\025\003\003\003\003\003\ +\\003\019\010\010\010\010\010\010\010\010\010\010\010\010\010\016\ +\\010\010\010\010\010\010\010\011\010\010\004\003\003\003\003\003\ +\\003" +), + (4, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\007\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (5, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (6, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (7, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\008\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (8, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\009\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (11, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\005\005\005\012\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (12, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\013\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (13, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\014\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (14, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\015\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (16, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\017\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (17, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\018\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (19, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\020\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (20, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\021\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (21, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\022\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (22, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\023\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (23, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\ +\\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\000\ +\\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\005\ +\\000\005\005\005\005\005\005\005\005\005\005\024\005\005\005\005\ +\\005\005\005\005\005\005\005\005\005\005\005\000\000\000\000\000\ +\\000" +), + (25, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\ +\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\ +\\000" +), + (27, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (28, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\ +\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\ +\\000\026\026\026\026\026\026\026\026\029\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\ +\\000" +), + (29, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\ +\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\030\026\026\000\000\000\000\000\ +\\000" +), + (30, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\ +\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\ +\\000\026\026\026\026\031\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\ +\\000" +), + (31, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\ +\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\ +\\000\026\026\026\032\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\ +\\000" +), + (32, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\ +\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\033\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\ +\\000" +), + (33, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\ +\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\034\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\ +\\000" +), + (34, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\ +\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\ +\\000\026\026\026\026\026\026\026\026\035\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\ +\\000" +), + (35, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\ +\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\036\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\ +\\000" +), + (36, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\027\000\000\000\000\000\000\000\000\ +\\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\ +\\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ +\\026\026\026\026\037\026\026\026\026\026\026\000\000\000\000\000\ +\\000" +), + (38, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\039\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (41, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\042\042\042\042\042\042\042\042\042\042\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (43, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\044\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (44, +"\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\046\045\045\045\045\052\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045" +), + (45, +"\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\046\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045" +), + (46, +"\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\ +\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\ +\\047\047\047\047\047\047\047\047\047\047\050\047\047\047\047\049\ +\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\ +\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\ +\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\ +\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\ +\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\ +\\047" +), + (47, +"\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\046\045\045\045\045\048\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045" +), + (48, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\047\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (50, +"\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\046\045\045\045\045\051\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\045\ +\\045" +), + (54, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\055\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (58, +"\000\000\000\000\000\000\000\000\000\059\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\059\000\000\000\000\000\000\061\000\000\000\000\000\060\060\060\ +\\059\059\059\059\059\059\059\059\059\059\000\000\000\000\000\000\ +\\000\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\ +\\059\059\059\059\059\059\059\059\059\059\059\000\000\000\000\059\ +\\000\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\ +\\059\059\059\059\059\059\059\059\059\059\059\000\000\000\000\000\ +\\000" +), + (60, +"\000\000\000\000\000\000\000\000\000\060\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\060\000\000\000\000\000\000\061\000\000\000\000\000\060\060\060\ +\\060\060\060\060\060\060\060\060\060\060\000\000\000\000\000\000\ +\\000\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\ +\\060\060\060\060\060\060\060\060\060\060\060\000\000\000\000\060\ +\\000\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\ +\\060\060\060\060\060\060\060\060\060\060\060\000\000\000\000\000\ +\\000" +), + (62, +"\063\063\063\063\063\063\063\063\063\063\064\063\063\063\063\063\ +\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\ +\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\ +\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\ +\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\ +\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\ +\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\ +\\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\063\ +\\063" +), + (65, +"\000\000\000\000\000\000\000\000\000\066\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\066\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), +(0, "")] +fun f x = x +val s = List.map f (List.rev (tl (List.rev s))) +exception LexHackingError +fun look ((j,x)::r, i: int) = if i = j then x else look(r, i) + | look ([], i) = raise LexHackingError +fun g {fin=x, trans=i} = {fin=x, trans=look(s,i)} +in Vector.fromList(List.map g +[{fin = [], trans = 0}, +{fin = [], trans = 1}, +{fin = [], trans = 1}, +{fin = [(N 97)], trans = 0}, +{fin = [(N 95),(N 97)], trans = 4}, +{fin = [(N 95)], trans = 5}, +{fin = [(N 95)], trans = 6}, +{fin = [(N 95)], trans = 7}, +{fin = [(N 95)], trans = 8}, +{fin = [(N 62),(N 95)], trans = 5}, +{fin = [(N 95),(N 97)], trans = 5}, +{fin = [(N 95),(N 97)], trans = 11}, +{fin = [(N 95)], trans = 12}, +{fin = [(N 95)], trans = 13}, +{fin = [(N 95)], trans = 14}, +{fin = [(N 39),(N 95)], trans = 5}, +{fin = [(N 95),(N 97)], trans = 16}, +{fin = [(N 95)], trans = 17}, +{fin = [(N 57),(N 95)], trans = 5}, +{fin = [(N 95),(N 97)], trans = 19}, +{fin = [(N 95)], trans = 20}, +{fin = [(N 95)], trans = 21}, +{fin = [(N 95)], trans = 22}, +{fin = [(N 95)], trans = 23}, +{fin = [(N 69),(N 95)], trans = 5}, +{fin = [(N 90),(N 97)], trans = 25}, +{fin = [(N 90)], trans = 25}, +{fin = [(N 90)], trans = 27}, +{fin = [(N 90),(N 97)], trans = 28}, +{fin = [(N 90)], trans = 29}, +{fin = [(N 90)], trans = 30}, +{fin = [(N 90)], trans = 31}, +{fin = [(N 90)], trans = 32}, +{fin = [(N 90)], trans = 33}, +{fin = [(N 90)], trans = 34}, +{fin = [(N 90)], trans = 35}, +{fin = [(N 90)], trans = 36}, +{fin = [(N 33),(N 90)], trans = 25}, +{fin = [(N 97)], trans = 38}, +{fin = [(N 53)], trans = 0}, +{fin = [(N 41),(N 97)], trans = 0}, +{fin = [(N 72),(N 97)], trans = 41}, +{fin = [(N 72)], trans = 41}, +{fin = [(N 97)], trans = 43}, +{fin = [], trans = 44}, +{fin = [], trans = 45}, +{fin = [], trans = 46}, +{fin = [], trans = 47}, +{fin = [], trans = 48}, +{fin = [(N 20)], trans = 0}, +{fin = [], trans = 50}, +{fin = [(N 20)], trans = 48}, +{fin = [], trans = 44}, +{fin = [(N 22),(N 97)], trans = 0}, +{fin = [(N 50),(N 97)], trans = 54}, +{fin = [(N 48)], trans = 0}, +{fin = [(N 45),(N 97)], trans = 0}, +{fin = [(N 43),(N 97)], trans = 0}, +{fin = [(N 97)], trans = 58}, +{fin = [], trans = 58}, +{fin = [], trans = 60}, +{fin = [(N 85)], trans = 0}, +{fin = [(N 97)], trans = 62}, +{fin = [], trans = 62}, +{fin = [(N 8)], trans = 0}, +{fin = [(N 4),(N 97)], trans = 65}, +{fin = [(N 4)], trans = 65}, +{fin = [(N 1)], trans = 0}]) +end +structure StartStates = + struct + datatype yystartstate = STARTSTATE of int + +(* start state definitions *) + +val INITIAL = STARTSTATE 1; + +end +type result = UserDeclarations.lexresult + exception LexerError (* raised if illegal leaf action tried *) +end + +fun makeLexer yyinput = +let val yygone0=1 + val yyb = Unsynchronized.ref "\n" (* buffer *) + val yybl = Unsynchronized.ref 1 (*buffer length *) + val yybufpos = Unsynchronized.ref 1 (* location of next character to use *) + val yygone = Unsynchronized.ref yygone0 (* position in file of beginning of buffer *) + val yydone = Unsynchronized.ref false (* eof found yet? *) + val yybegin = Unsynchronized.ref 1 (*Current 'start state' for lexer *) + + val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) => + yybegin := x + +fun lex () : Internal.result = +let fun continue() = lex() in + let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0) = + let fun action (i,nil) = raise LexError + | action (i,nil::l) = action (i-1,l) + | action (i,(node::acts)::l) = + case node of + Internal.N yyk => + (let fun yymktext() = String.substring(!yyb,i0,i-i0) + val yypos = i0+ !yygone + open UserDeclarations Internal.StartStates + in (yybufpos := i; case yyk of + + (* Application actions *) + + 1 => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos ); lex()) +| 20 => (lex()) +| 22 => let val yytext=yymktext() in Tokens.COMMA(yytext,inputPos_half yypos,inputPos_half yypos) end +| 33 => let val yytext=yymktext() in Tokens.FIXEDPOINT(yytext,inputPos_half yypos,inputPos_half yypos) end +| 39 => let val yytext=yymktext() in Tokens.WHERE(yytext,inputPos_half yypos,inputPos_half yypos) end +| 4 => (pos := (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))); lex()) +| 41 => let val yytext=yymktext() in Tokens.COLON(yytext,inputPos_half yypos,inputPos_half yypos) end +| 43 => let val yytext=yymktext() in Tokens.PAREN_OPEN(yytext,inputPos_half yypos,inputPos_half yypos) end +| 45 => let val yytext=yymktext() in Tokens.PAREN_CLOSE(yytext,inputPos_half yypos,inputPos_half yypos) end +| 48 => let val yytext=yymktext() in Tokens.DOUBLE_ASTERISK(yytext,inputPos_half yypos,inputPos_half yypos) end +| 50 => let val yytext=yymktext() in Tokens.ASTERISK(yytext,inputPos_half yypos,inputPos_half yypos) end +| 53 => let val yytext=yymktext() in Tokens.DOUBLE_RARROW(yytext,inputPos_half yypos,inputPos_half yypos) end +| 57 => let val yytext=yymktext() in Tokens.ONE(yytext,inputPos_half yypos,inputPos_half yypos) end +| 62 => let val yytext=yymktext() in Tokens.ZERO(yytext,inputPos_half yypos,inputPos_half yypos) end +| 69 => let val yytext=yymktext() in Tokens.ATTACK(yytext,inputPos_half yypos,inputPos_half yypos) end +| 72 => let val yytext=yymktext() in Tokens.INTEGER_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end +| 8 => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos ); lex()) +| 85 => let val yytext=yymktext() in Tokens.STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end +| 90 => let val yytext=yymktext() in Tokens.UPPER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end +| 95 => let val yytext=yymktext() in Tokens.LOWER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end +| 97 => let val yytext=yymktext() in error ("ignoring bad character "^yytext, + ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))), + ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))))); + lex() end +| _ => raise Internal.LexerError + + ) end ) + + val {fin,trans} = Vector.sub(Internal.tab, s) + val NewAcceptingLeaves = fin::AcceptingLeaves + in if l = !yybl then + if trans = #trans(Vector.sub(Internal.tab,0)) + then action(l,NewAcceptingLeaves +) else let val newchars= if !yydone then "" else yyinput 1024 + in if (String.size newchars)=0 + then (yydone := true; + if (l=i0) then UserDeclarations.eof () + else action(l,NewAcceptingLeaves)) + else (if i0=l then yyb := newchars + else yyb := String.substring(!yyb,i0,l-i0)^newchars; + yygone := !yygone+i0; + yybl := String.size (!yyb); + scan (s,AcceptingLeaves,l-i0,0)) + end + else let val NewChar = Char.ord(CharVector.sub(!yyb,l)) + val NewChar = if NewChar<128 then NewChar else 128 + val NewState = Char.ord(CharVector.sub(trans,NewChar)) + in if NewState=0 then action(l,NewAcceptingLeaves) + else scan(NewState,NewAcceptingLeaves,l+1,i0) + end + end +(* + val start= if String.substring(!yyb,!yybufpos-1,1)="\n" +then !yybegin+1 else !yybegin +*) + in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos) + end +end + in lex + end +end diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm @@ -0,0 +1,287 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +open Trac_Term + +exception NotYetSupported of string + + +%% + +%verbose + +%eop EOF + +%left + +%name TracTransaction + +%term EOF + | OPENP of string + | CLOSEP of string + | OPENB of string + | CLOSEB of string + | OPENSCRYPT of string + | CLOSESCRYPT of string + | COLON of string + | SEMICOLON of string + | SECCH of string + | AUTHCH of string + | CONFCH of string + | INSECCH of string + | FAUTHCH of string + | FSECCH of string + | PERCENT of string + | UNEQUAL of string + | EXCLAM of string + | DOT of string + | COMMA of string + | OPENSQB of string + | CLOSESQB of string + | UNION of string + | PROTOCOL of string + | KNOWLEDGE of string + | WHERE of string + | ACTIONS of string + | ABSTRACTION of string + | GOALS of string + | AUTHENTICATES of string + | WEAKLY of string + | ON of string + | TSECRET of string + | TBETWEEN of string + | Sets of string + | FUNCTIONS of string + | PUBLIC of string + | PRIVATE of string + | RECEIVE of string + | SEND of string + | IN of string + | NOTIN of string + | INSERT of string + | DELETE of string + | NEW of string + | ATTACK of string + | slash of string + | QUESTION of string + | equal of string + | TYPES of string + | SETS of string + | ARROW of string + | ANALYSIS of string + | TRANSACTIONS of string + | STRING_LITERAL of string + | UPPER_STRING_LITERAL of string + | LOWER_STRING_LITERAL of string + | UNDERSCORE of string + | INTEGER_LITERAL of string + | STAR of string + | OF of string + +%nonterm START of TracProtocol.protocol + | name of string + | arity of string + | uident of string + | lident of string + | ident of string + | trac_protocol of TracProtocol.protocol + | protocol_spec of TracProtocol.protocol + | type_union of (string list) + | type_spec of (string * TracProtocol.type_spec_elem) + | type_specs of (string * TracProtocol.type_spec_elem) list + | idents of string list + | uidents of string list + | lidents of string list + | set_specs of TracProtocol.set_spec list + | set_spec of TracProtocol.set_spec + | priv_or_pub_fun_spec of TracProtocol.fun_spec + | fun_specs of TracProtocol.funT list + | fun_spec of TracProtocol.funT + | priv_fun_spec of TracProtocol.funT list + | pub_fun_spec of TracProtocol.funT list + | analysis_spec of TracProtocol.anaT + | transaction_spec_head of string option + | transaction_spec of TracProtocol.transaction list + | rule of TracProtocol.ruleT + | head of string * string list + | head_params of string list + | keys of Trac_Term.Msg list + | result of string list + | msg of Trac_Term.Msg + | msgs of Trac_Term.Msg list + | setexp of string * Trac_Term.Msg list + | action of TracProtocol.prot_label * TracProtocol.action + | actions of (TracProtocol.prot_label * TracProtocol.action) list + | ineq_aux of string + | ineq of string * string + | ineqs of (string * string) list + | transaction of TracProtocol.transaction_name + | typ of string + | parameter of string * string + | parameters of (string * string) list + +%pos (int * int * int) + +%noshift EOF + +%% + +START: trac_protocol (trac_protocol) +trac_protocol: PROTOCOL COLON name protocol_spec (TracProtocol.update_name protocol_spec name) + +protocol_spec: TYPES COLON type_specs protocol_spec (TracProtocol.update_type_spec protocol_spec type_specs) + | SETS COLON set_specs protocol_spec (TracProtocol.update_sets protocol_spec set_specs) + | FUNCTIONS COLON priv_or_pub_fun_spec protocol_spec (TracProtocol.update_functions protocol_spec (SOME priv_or_pub_fun_spec)) + | ANALYSIS COLON analysis_spec protocol_spec (TracProtocol.update_analysis protocol_spec analysis_spec) + | transaction_spec_head COLON transaction_spec protocol_spec (TracProtocol.update_transactions transaction_spec_head protocol_spec transaction_spec) + | (TracProtocol.empty) + +type_union: ident ([ident]) + | ident UNION type_union (ident::type_union) + +type_specs: type_spec ([type_spec]) + | type_spec type_specs (type_spec::type_specs) +type_spec: ident equal OPENB lidents CLOSEB ((ident, TracProtocol.Consts lidents)) + | ident equal type_union ((ident, TracProtocol.Union type_union)) + + +set_specs: set_spec ([set_spec]) + | set_spec set_specs (set_spec::set_specs) +set_spec: ident slash arity ((ident, arity)) + +priv_or_pub_fun_spec: pub_fun_spec priv_or_pub_fun_spec (TracProtocol.update_fun_public priv_or_pub_fun_spec pub_fun_spec) + | priv_fun_spec priv_or_pub_fun_spec (TracProtocol.update_fun_private priv_or_pub_fun_spec priv_fun_spec) + | (TracProtocol.fun_empty) +pub_fun_spec: PUBLIC fun_specs (fun_specs) +priv_fun_spec: PRIVATE fun_specs (fun_specs) +fun_specs: fun_spec ([fun_spec]) + | fun_spec fun_specs (fun_spec::fun_specs) +fun_spec: ident slash arity ((ident, arity)) + +analysis_spec: rule ([rule]) + | rule analysis_spec (rule::analysis_spec) + +rule: head ARROW result ((head,[],result)) + | head QUESTION keys ARROW result ((head,keys,result)) + +head: LOWER_STRING_LITERAL OPENP head_params CLOSEP ((LOWER_STRING_LITERAL,head_params)) + +head_params: UPPER_STRING_LITERAL ([UPPER_STRING_LITERAL]) + | UPPER_STRING_LITERAL COMMA head_params ([UPPER_STRING_LITERAL]@head_params) + +keys: msgs (msgs) + +result: UPPER_STRING_LITERAL ([UPPER_STRING_LITERAL]) + | UPPER_STRING_LITERAL COMMA result ([UPPER_STRING_LITERAL]@result) + + +transaction_spec_head: TRANSACTIONS (NONE) + | TRANSACTIONS OF LOWER_STRING_LITERAL (SOME LOWER_STRING_LITERAL) + +transaction_spec: transaction actions DOT ([TracProtocol.mkTransaction transaction actions]) + | transaction actions DOT transaction_spec ((TracProtocol.mkTransaction transaction actions)::transaction_spec) + +ineq_aux: UNEQUAL UPPER_STRING_LITERAL (UPPER_STRING_LITERAL) + +ineq: UPPER_STRING_LITERAL ineq_aux ((UPPER_STRING_LITERAL,ineq_aux)) + +ineqs: ineq ([ineq]) + | ineq COMMA ineqs ([ineq]@ineqs) + +transaction: ident OPENP parameters CLOSEP WHERE ineqs ((ident,parameters,ineqs)) + | ident OPENP parameters CLOSEP ((ident,parameters,[])) + | ident OPENP CLOSEP ((ident,[],[])) + +parameters: parameter ([parameter]) + | parameter COMMA parameters (parameter::parameters) + +parameter: ident COLON typ ((ident, typ)) + +typ: UPPER_STRING_LITERAL (UPPER_STRING_LITERAL) + | LOWER_STRING_LITERAL (LOWER_STRING_LITERAL) + +actions: action ([action]) + | action actions (action::actions) + +action: RECEIVE msg ((TracProtocol.LabelN,TracProtocol.RECEIVE(msg))) + | SEND msg ((TracProtocol.LabelN,TracProtocol.SEND(msg))) + | msg IN setexp ((TracProtocol.LabelN,TracProtocol.IN(msg,setexp))) + | msg NOTIN setexp ((TracProtocol.LabelN,TracProtocol.NOTIN(msg,setexp))) + | msg NOTIN lident OPENP UNDERSCORE CLOSEP ((TracProtocol.LabelN,TracProtocol.NOTINANY(msg,lident))) + | INSERT msg setexp ((TracProtocol.LabelN,TracProtocol.INSERT(msg,setexp))) + | DELETE msg setexp ((TracProtocol.LabelN,TracProtocol.DELETE(msg,setexp))) + | NEW uident ((TracProtocol.LabelS,TracProtocol.NEW(uident))) + | ATTACK ((TracProtocol.LabelN,TracProtocol.ATTACK)) + | STAR RECEIVE msg ((TracProtocol.LabelS,TracProtocol.RECEIVE(msg))) + | STAR SEND msg ((TracProtocol.LabelS,TracProtocol.SEND(msg))) + | STAR msg IN setexp ((TracProtocol.LabelS,TracProtocol.IN(msg,setexp))) + | STAR msg NOTIN setexp ((TracProtocol.LabelS,TracProtocol.NOTIN(msg,setexp))) + | STAR msg NOTIN lident OPENP UNDERSCORE CLOSEP ((TracProtocol.LabelS,TracProtocol.NOTINANY(msg,lident))) + | STAR INSERT msg setexp ((TracProtocol.LabelS,TracProtocol.INSERT(msg,setexp))) + | STAR DELETE msg setexp ((TracProtocol.LabelS,TracProtocol.DELETE(msg,setexp))) + +setexp: lident ((lident,[])) + | lident OPENP msgs CLOSEP ((lident,msgs)) + +msg: uident (Var uident) + | lident (Const lident) + | lident OPENP msgs CLOSEP (Fun (lident,msgs)) + +msgs: msg ([msg]) + | msg COMMA msgs (msg::msgs) + +name: UPPER_STRING_LITERAL (UPPER_STRING_LITERAL) + | LOWER_STRING_LITERAL (LOWER_STRING_LITERAL) + +uident: UPPER_STRING_LITERAL (UPPER_STRING_LITERAL) + +uidents: uident ([uident]) + | uident COMMA uidents (uident::uidents) + +lident: LOWER_STRING_LITERAL (LOWER_STRING_LITERAL) + +lidents: lident ([lident]) + | lident COMMA lidents (lident::lidents) + +ident: uident (uident) + | lident (lident) + +idents: ident ([ident]) + | ident COMMA idents (ident::idents) + +arity: INTEGER_LITERAL (INTEGER_LITERAL) + diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sig b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sig new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sig @@ -0,0 +1,73 @@ +signature TracTransaction_TOKENS = +sig +type ('a,'b) token +type svalue +val OF: (string) * 'a * 'a -> (svalue,'a) token +val STAR: (string) * 'a * 'a -> (svalue,'a) token +val INTEGER_LITERAL: (string) * 'a * 'a -> (svalue,'a) token +val UNDERSCORE: (string) * 'a * 'a -> (svalue,'a) token +val LOWER_STRING_LITERAL: (string) * 'a * 'a -> (svalue,'a) token +val UPPER_STRING_LITERAL: (string) * 'a * 'a -> (svalue,'a) token +val STRING_LITERAL: (string) * 'a * 'a -> (svalue,'a) token +val TRANSACTIONS: (string) * 'a * 'a -> (svalue,'a) token +val ANALYSIS: (string) * 'a * 'a -> (svalue,'a) token +val ARROW: (string) * 'a * 'a -> (svalue,'a) token +val SETS: (string) * 'a * 'a -> (svalue,'a) token +val TYPES: (string) * 'a * 'a -> (svalue,'a) token +val equal: (string) * 'a * 'a -> (svalue,'a) token +val QUESTION: (string) * 'a * 'a -> (svalue,'a) token +val slash: (string) * 'a * 'a -> (svalue,'a) token +val ATTACK: (string) * 'a * 'a -> (svalue,'a) token +val NEW: (string) * 'a * 'a -> (svalue,'a) token +val DELETE: (string) * 'a * 'a -> (svalue,'a) token +val INSERT: (string) * 'a * 'a -> (svalue,'a) token +val NOTIN: (string) * 'a * 'a -> (svalue,'a) token +val IN: (string) * 'a * 'a -> (svalue,'a) token +val SEND: (string) * 'a * 'a -> (svalue,'a) token +val RECEIVE: (string) * 'a * 'a -> (svalue,'a) token +val PRIVATE: (string) * 'a * 'a -> (svalue,'a) token +val PUBLIC: (string) * 'a * 'a -> (svalue,'a) token +val FUNCTIONS: (string) * 'a * 'a -> (svalue,'a) token +val Sets: (string) * 'a * 'a -> (svalue,'a) token +val TBETWEEN: (string) * 'a * 'a -> (svalue,'a) token +val TSECRET: (string) * 'a * 'a -> (svalue,'a) token +val ON: (string) * 'a * 'a -> (svalue,'a) token +val WEAKLY: (string) * 'a * 'a -> (svalue,'a) token +val AUTHENTICATES: (string) * 'a * 'a -> (svalue,'a) token +val GOALS: (string) * 'a * 'a -> (svalue,'a) token +val ABSTRACTION: (string) * 'a * 'a -> (svalue,'a) token +val ACTIONS: (string) * 'a * 'a -> (svalue,'a) token +val WHERE: (string) * 'a * 'a -> (svalue,'a) token +val KNOWLEDGE: (string) * 'a * 'a -> (svalue,'a) token +val PROTOCOL: (string) * 'a * 'a -> (svalue,'a) token +val UNION: (string) * 'a * 'a -> (svalue,'a) token +val CLOSESQB: (string) * 'a * 'a -> (svalue,'a) token +val OPENSQB: (string) * 'a * 'a -> (svalue,'a) token +val COMMA: (string) * 'a * 'a -> (svalue,'a) token +val DOT: (string) * 'a * 'a -> (svalue,'a) token +val EXCLAM: (string) * 'a * 'a -> (svalue,'a) token +val UNEQUAL: (string) * 'a * 'a -> (svalue,'a) token +val PERCENT: (string) * 'a * 'a -> (svalue,'a) token +val FSECCH: (string) * 'a * 'a -> (svalue,'a) token +val FAUTHCH: (string) * 'a * 'a -> (svalue,'a) token +val INSECCH: (string) * 'a * 'a -> (svalue,'a) token +val CONFCH: (string) * 'a * 'a -> (svalue,'a) token +val AUTHCH: (string) * 'a * 'a -> (svalue,'a) token +val SECCH: (string) * 'a * 'a -> (svalue,'a) token +val SEMICOLON: (string) * 'a * 'a -> (svalue,'a) token +val COLON: (string) * 'a * 'a -> (svalue,'a) token +val CLOSESCRYPT: (string) * 'a * 'a -> (svalue,'a) token +val OPENSCRYPT: (string) * 'a * 'a -> (svalue,'a) token +val CLOSEB: (string) * 'a * 'a -> (svalue,'a) token +val OPENB: (string) * 'a * 'a -> (svalue,'a) token +val CLOSEP: (string) * 'a * 'a -> (svalue,'a) token +val OPENP: (string) * 'a * 'a -> (svalue,'a) token +val EOF: 'a * 'a -> (svalue,'a) token +end +signature TracTransaction_LRVALS= +sig +structure Tokens : TracTransaction_TOKENS +structure ParserData:PARSER_DATA +sharing type ParserData.Token.token = Tokens.token +sharing type ParserData.svalue = Tokens.svalue +end diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sml b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sml new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sml @@ -0,0 +1,1720 @@ + (***** GENERATED FILE -- DO NOT EDIT ****) +functor TracTransactionLrValsFun(structure Token : TOKEN) + : sig structure ParserData : PARSER_DATA + structure Tokens : TracTransaction_TOKENS + end + = +struct +structure ParserData= +struct +structure Header = +struct +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +open Trac_Term + +exception NotYetSupported of string + + + +end +structure LrTable = Token.LrTable +structure Token = Token +local open LrTable in +val table=let val actionRows = +"\ +\\001\000\001\000\000\000\000\000\ +\\001\000\002\000\058\000\000\000\ +\\001\000\002\000\063\000\000\000\ +\\001\000\003\000\095\000\056\000\028\000\057\000\027\000\000\000\ +\\001\000\003\000\124\000\000\000\ +\\001\000\003\000\130\000\000\000\ +\\001\000\003\000\138\000\000\000\ +\\001\000\003\000\163\000\000\000\ +\\001\000\003\000\164\000\000\000\ +\\001\000\003\000\169\000\000\000\ +\\001\000\004\000\107\000\056\000\028\000\057\000\027\000\000\000\ +\\001\000\005\000\154\000\000\000\ +\\001\000\008\000\005\000\000\000\ +\\001\000\008\000\016\000\000\000\ +\\001\000\008\000\018\000\000\000\ +\\001\000\008\000\019\000\000\000\ +\\001\000\008\000\020\000\000\000\ +\\001\000\008\000\021\000\000\000\ +\\001\000\008\000\126\000\000\000\ +\\001\000\017\000\168\000\000\000\ +\\001\000\019\000\077\000\000\000\ +\\001\000\024\000\004\000\000\000\ +\\001\000\039\000\056\000\040\000\055\000\043\000\054\000\044\000\053\000\ +\\045\000\052\000\046\000\051\000\056\000\028\000\057\000\027\000\ +\\060\000\050\000\000\000\ +\\001\000\039\000\086\000\040\000\085\000\043\000\084\000\044\000\083\000\ +\\056\000\028\000\057\000\027\000\000\000\ +\\001\000\041\000\080\000\042\000\079\000\000\000\ +\\001\000\041\000\117\000\042\000\116\000\000\000\ +\\001\000\047\000\066\000\000\000\ +\\001\000\047\000\109\000\000\000\ +\\001\000\048\000\060\000\052\000\059\000\000\000\ +\\001\000\049\000\069\000\000\000\ +\\001\000\052\000\129\000\000\000\ +\\001\000\056\000\008\000\057\000\007\000\000\000\ +\\001\000\056\000\028\000\000\000\ +\\001\000\056\000\028\000\057\000\027\000\000\000\ +\\001\000\056\000\028\000\057\000\027\000\058\000\157\000\000\000\ +\\001\000\056\000\028\000\057\000\027\000\058\000\165\000\000\000\ +\\001\000\056\000\097\000\000\000\ +\\001\000\056\000\102\000\000\000\ +\\001\000\056\000\148\000\057\000\147\000\000\000\ +\\001\000\056\000\161\000\000\000\ +\\001\000\056\000\171\000\000\000\ +\\001\000\057\000\027\000\000\000\ +\\001\000\057\000\029\000\000\000\ +\\001\000\057\000\033\000\000\000\ +\\001\000\059\000\104\000\000\000\ +\\173\000\000\000\ +\\174\000\000\000\ +\\175\000\000\000\ +\\176\000\000\000\ +\\177\000\000\000\ +\\178\000\000\000\ +\\179\000\000\000\ +\\180\000\036\000\015\000\050\000\014\000\051\000\013\000\053\000\012\000\ +\\054\000\011\000\000\000\ +\\181\000\023\000\132\000\000\000\ +\\182\000\000\000\ +\\183\000\056\000\028\000\057\000\027\000\000\000\ +\\184\000\000\000\ +\\185\000\000\000\ +\\186\000\000\000\ +\\187\000\056\000\028\000\057\000\027\000\000\000\ +\\188\000\000\000\ +\\189\000\000\000\ +\\190\000\000\000\ +\\191\000\000\000\ +\\192\000\037\000\044\000\038\000\043\000\000\000\ +\\193\000\000\000\ +\\194\000\000\000\ +\\195\000\056\000\028\000\057\000\027\000\000\000\ +\\196\000\000\000\ +\\197\000\000\000\ +\\198\000\057\000\033\000\000\000\ +\\199\000\000\000\ +\\200\000\000\000\ +\\201\000\000\000\ +\\202\000\000\000\ +\\203\000\020\000\131\000\000\000\ +\\204\000\000\000\ +\\205\000\000\000\ +\\206\000\020\000\127\000\000\000\ +\\207\000\000\000\ +\\208\000\061\000\017\000\000\000\ +\\209\000\000\000\ +\\210\000\056\000\028\000\057\000\027\000\000\000\ +\\211\000\000\000\ +\\212\000\000\000\ +\\213\000\000\000\ +\\214\000\020\000\166\000\000\000\ +\\215\000\000\000\ +\\216\000\000\000\ +\\217\000\026\000\144\000\000\000\ +\\218\000\000\000\ +\\219\000\020\000\125\000\000\000\ +\\220\000\000\000\ +\\221\000\000\000\ +\\222\000\000\000\ +\\223\000\000\000\ +\\224\000\039\000\056\000\040\000\055\000\043\000\054\000\044\000\053\000\ +\\045\000\052\000\046\000\051\000\056\000\028\000\057\000\027\000\ +\\060\000\050\000\000\000\ +\\225\000\000\000\ +\\226\000\000\000\ +\\227\000\000\000\ +\\228\000\000\000\ +\\229\000\000\000\ +\\230\000\000\000\ +\\231\000\000\000\ +\\232\000\000\000\ +\\233\000\000\000\ +\\234\000\000\000\ +\\235\000\000\000\ +\\236\000\000\000\ +\\237\000\000\000\ +\\238\000\000\000\ +\\239\000\000\000\ +\\240\000\000\000\ +\\241\000\000\000\ +\\242\000\002\000\136\000\000\000\ +\\242\000\002\000\137\000\000\000\ +\\242\000\002\000\158\000\000\000\ +\\243\000\000\000\ +\\244\000\000\000\ +\\245\000\002\000\081\000\000\000\ +\\246\000\000\000\ +\\247\000\020\000\128\000\000\000\ +\\248\000\000\000\ +\\249\000\000\000\ +\\250\000\000\000\ +\\251\000\000\000\ +\\254\000\000\000\ +\\255\000\020\000\155\000\000\000\ +\\000\001\000\000\ +\\001\001\000\000\ +\\002\001\000\000\ +\\005\001\000\000\ +\" +val actionRowNumbers = +"\021\000\045\000\012\000\031\000\ +\\052\000\124\000\123\000\013\000\ +\\046\000\080\000\014\000\015\000\ +\\016\000\017\000\033\000\042\000\ +\\043\000\033\000\033\000\064\000\ +\\022\000\052\000\001\000\130\000\ +\\129\000\126\000\125\000\081\000\ +\\028\000\070\000\052\000\002\000\ +\\059\000\052\000\026\000\052\000\ +\\055\000\029\000\064\000\064\000\ +\\052\000\033\000\033\000\020\000\ +\\096\000\024\000\119\000\118\000\ +\\023\000\106\000\032\000\033\000\ +\\033\000\033\000\033\000\051\000\ +\\003\000\036\000\033\000\071\000\ +\\050\000\037\000\060\000\048\000\ +\\044\000\047\000\056\000\010\000\ +\\062\000\063\000\049\000\067\000\ +\\066\000\027\000\065\000\082\000\ +\\097\000\041\000\041\000\033\000\ +\\025\000\033\000\033\000\033\000\ +\\033\000\105\000\041\000\041\000\ +\\099\000\098\000\004\000\091\000\ +\\018\000\090\000\072\000\078\000\ +\\077\000\121\000\030\000\005\000\ +\\075\000\061\000\131\000\058\000\ +\\053\000\041\000\068\000\044\000\ +\\083\000\101\000\114\000\100\000\ +\\115\000\006\000\041\000\041\000\ +\\041\000\041\000\108\000\107\000\ +\\104\000\103\000\089\000\033\000\ +\\038\000\036\000\033\000\036\000\ +\\074\000\037\000\033\000\011\000\ +\\127\000\069\000\034\000\033\000\ +\\120\000\110\000\116\000\109\000\ +\\113\000\112\000\039\000\092\000\ +\\093\000\095\000\094\000\079\000\ +\\122\000\073\000\076\000\054\000\ +\\057\000\041\000\007\000\008\000\ +\\035\000\088\000\086\000\019\000\ +\\128\000\117\000\102\000\009\000\ +\\039\000\085\000\040\000\111\000\ +\\087\000\084\000\000\000" +val gotoT = +"\ +\\001\000\170\000\007\000\001\000\000\000\ +\\000\000\ +\\000\000\ +\\002\000\004\000\000\000\ +\\008\000\008\000\023\000\007\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\004\000\024\000\005\000\023\000\006\000\022\000\024\000\021\000\ +\\038\000\020\000\000\000\ +\\000\000\ +\\022\000\030\000\025\000\029\000\026\000\028\000\000\000\ +\\004\000\024\000\005\000\023\000\006\000\034\000\015\000\033\000\ +\\016\000\032\000\000\000\ +\\004\000\024\000\005\000\023\000\006\000\037\000\010\000\036\000\ +\\011\000\035\000\000\000\ +\\017\000\040\000\020\000\039\000\021\000\038\000\000\000\ +\\004\000\047\000\005\000\046\000\030\000\045\000\033\000\044\000\ +\\034\000\043\000\000\000\ +\\008\000\055\000\023\000\007\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\022\000\059\000\025\000\029\000\026\000\028\000\000\000\ +\\008\000\060\000\023\000\007\000\000\000\ +\\000\000\ +\\004\000\024\000\005\000\023\000\006\000\034\000\015\000\062\000\ +\\016\000\032\000\000\000\ +\\008\000\063\000\023\000\007\000\000\000\ +\\000\000\ +\\008\000\065\000\023\000\007\000\000\000\ +\\004\000\024\000\005\000\023\000\006\000\037\000\010\000\036\000\ +\\011\000\066\000\000\000\ +\\000\000\ +\\017\000\068\000\020\000\039\000\021\000\038\000\000\000\ +\\017\000\069\000\020\000\039\000\021\000\038\000\000\000\ +\\008\000\070\000\023\000\007\000\000\000\ +\\004\000\024\000\005\000\023\000\006\000\073\000\018\000\072\000\ +\\019\000\071\000\000\000\ +\\004\000\024\000\005\000\023\000\006\000\073\000\018\000\074\000\ +\\019\000\071\000\000\000\ +\\000\000\ +\\004\000\047\000\005\000\046\000\030\000\045\000\033\000\044\000\ +\\034\000\076\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\004\000\047\000\005\000\046\000\030\000\080\000\000\000\ +\\000\000\ +\\004\000\085\000\000\000\ +\\004\000\047\000\005\000\046\000\030\000\086\000\000\000\ +\\004\000\047\000\005\000\046\000\030\000\087\000\000\000\ +\\004\000\047\000\005\000\046\000\030\000\088\000\000\000\ +\\004\000\047\000\005\000\046\000\030\000\089\000\000\000\ +\\000\000\ +\\004\000\024\000\005\000\023\000\006\000\092\000\040\000\091\000\ +\\041\000\090\000\000\000\ +\\029\000\094\000\000\000\ +\\004\000\047\000\005\000\046\000\028\000\098\000\030\000\097\000\ +\\031\000\096\000\000\000\ +\\000\000\ +\\000\000\ +\\027\000\099\000\000\000\ +\\000\000\ +\\000\000\ +\\003\000\101\000\000\000\ +\\000\000\ +\\000\000\ +\\004\000\024\000\005\000\023\000\006\000\104\000\009\000\103\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\004\000\024\000\005\000\023\000\006\000\073\000\018\000\106\000\ +\\019\000\071\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\004\000\024\000\005\000\023\000\006\000\022\000\024\000\108\000\ +\\038\000\020\000\000\000\ +\\000\000\ +\\005\000\110\000\032\000\109\000\000\000\ +\\005\000\112\000\032\000\111\000\000\000\ +\\004\000\047\000\005\000\046\000\030\000\097\000\031\000\113\000\000\000\ +\\000\000\ +\\004\000\047\000\005\000\046\000\030\000\116\000\000\000\ +\\004\000\047\000\005\000\046\000\030\000\117\000\000\000\ +\\004\000\047\000\005\000\046\000\030\000\118\000\000\000\ +\\004\000\047\000\005\000\046\000\030\000\119\000\000\000\ +\\000\000\ +\\005\000\112\000\032\000\120\000\000\000\ +\\005\000\112\000\032\000\121\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\005\000\132\000\014\000\131\000\000\000\ +\\000\000\ +\\003\000\133\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\005\000\138\000\032\000\137\000\000\000\ +\\005\000\112\000\032\000\139\000\000\000\ +\\005\000\112\000\032\000\140\000\000\000\ +\\005\000\112\000\032\000\141\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\004\000\024\000\005\000\023\000\006\000\092\000\040\000\091\000\ +\\041\000\143\000\000\000\ +\\039\000\144\000\000\000\ +\\029\000\147\000\000\000\ +\\004\000\047\000\005\000\046\000\030\000\097\000\031\000\148\000\000\000\ +\\029\000\149\000\000\000\ +\\000\000\ +\\027\000\150\000\000\000\ +\\004\000\024\000\005\000\023\000\006\000\104\000\009\000\151\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\004\000\047\000\005\000\046\000\030\000\097\000\031\000\154\000\000\000\ +\\004\000\047\000\005\000\046\000\030\000\097\000\031\000\154\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\036\000\158\000\037\000\157\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\005\000\132\000\014\000\160\000\000\000\ +\\000\000\ +\\000\000\ +\\004\000\047\000\005\000\046\000\030\000\097\000\031\000\154\000\000\000\ +\\000\000\ +\\000\000\ +\\035\000\165\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\036\000\158\000\037\000\168\000\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\\000\000\ +\" +val numstates = 171 +val numrules = 89 +val s = Unsynchronized.ref "" and index = Unsynchronized.ref 0 +val string_to_int = fn () => +let val i = !index +in index := i+2; Char.ord(String.sub(!s,i)) + Char.ord(String.sub(!s,i+1)) * 256 +end +val string_to_list = fn s' => + let val len = String.size s' + fun f () = + if !index < len then string_to_int() :: f() + else nil + in index := 0; s := s'; f () + end +val string_to_pairlist = fn (conv_key,conv_entry) => + let fun f () = + case string_to_int() + of 0 => EMPTY + | n => PAIR(conv_key (n-1),conv_entry (string_to_int()),f()) + in f + end +val string_to_pairlist_default = fn (conv_key,conv_entry) => + let val conv_row = string_to_pairlist(conv_key,conv_entry) + in fn () => + let val default = conv_entry(string_to_int()) + val row = conv_row() + in (row,default) + end + end +val string_to_table = fn (convert_row,s') => + let val len = String.size s' + fun f ()= + if !index < len then convert_row() :: f() + else nil + in (s := s'; index := 0; f ()) + end +local + val memo = Array.array(numstates+numrules,ERROR) + val _ =let fun g i=(Array.update(memo,i,REDUCE(i-numstates)); g(i+1)) + fun f i = + if i=numstates then g i + else (Array.update(memo,i,SHIFT (STATE i)); f (i+1)) + in f 0 handle General.Subscript => () + end +in +val entry_to_action = fn 0 => ACCEPT | 1 => ERROR | j => Array.sub(memo,(j-2)) +end +val gotoT=Array.fromList(string_to_table(string_to_pairlist(NT,STATE),gotoT)) +val actionRows=string_to_table(string_to_pairlist_default(T,entry_to_action),actionRows) +val actionRowNumbers = string_to_list actionRowNumbers +val actionT = let val actionRowLookUp= +let val a=Array.fromList(actionRows) in fn i=>Array.sub(a,i) end +in Array.fromList(List.map actionRowLookUp actionRowNumbers) +end +in LrTable.mkLrTable {actions=actionT,gotos=gotoT,numRules=numrules, +numStates=numstates,initialState=STATE 0} +end +end +local open Header in +type pos = ( int * int * int ) +type arg = unit +structure MlyValue = +struct +datatype svalue = VOID | ntVOID of unit -> unit + | OF of unit -> (string) | STAR of unit -> (string) + | INTEGER_LITERAL of unit -> (string) + | UNDERSCORE of unit -> (string) + | LOWER_STRING_LITERAL of unit -> (string) + | UPPER_STRING_LITERAL of unit -> (string) + | STRING_LITERAL of unit -> (string) + | TRANSACTIONS of unit -> (string) | ANALYSIS of unit -> (string) + | ARROW of unit -> (string) | SETS of unit -> (string) + | TYPES of unit -> (string) | equal of unit -> (string) + | QUESTION of unit -> (string) | slash of unit -> (string) + | ATTACK of unit -> (string) | NEW of unit -> (string) + | DELETE of unit -> (string) | INSERT of unit -> (string) + | NOTIN of unit -> (string) | IN of unit -> (string) + | SEND of unit -> (string) | RECEIVE of unit -> (string) + | PRIVATE of unit -> (string) | PUBLIC of unit -> (string) + | FUNCTIONS of unit -> (string) | Sets of unit -> (string) + | TBETWEEN of unit -> (string) | TSECRET of unit -> (string) + | ON of unit -> (string) | WEAKLY of unit -> (string) + | AUTHENTICATES of unit -> (string) | GOALS of unit -> (string) + | ABSTRACTION of unit -> (string) | ACTIONS of unit -> (string) + | WHERE of unit -> (string) | KNOWLEDGE of unit -> (string) + | PROTOCOL of unit -> (string) | UNION of unit -> (string) + | CLOSESQB of unit -> (string) | OPENSQB of unit -> (string) + | COMMA of unit -> (string) | DOT of unit -> (string) + | EXCLAM of unit -> (string) | UNEQUAL of unit -> (string) + | PERCENT of unit -> (string) | FSECCH of unit -> (string) + | FAUTHCH of unit -> (string) | INSECCH of unit -> (string) + | CONFCH of unit -> (string) | AUTHCH of unit -> (string) + | SECCH of unit -> (string) | SEMICOLON of unit -> (string) + | COLON of unit -> (string) | CLOSESCRYPT of unit -> (string) + | OPENSCRYPT of unit -> (string) | CLOSEB of unit -> (string) + | OPENB of unit -> (string) | CLOSEP of unit -> (string) + | OPENP of unit -> (string) + | parameters of unit -> ( ( string * string ) list) + | parameter of unit -> (string*string) | typ of unit -> (string) + | transaction of unit -> (TracProtocol.transaction_name) + | ineqs of unit -> ( ( string * string ) list) + | ineq of unit -> (string*string) | ineq_aux of unit -> (string) + | actions of unit -> ( ( TracProtocol.prot_label * TracProtocol.action ) list) + | action of unit -> (TracProtocol.prot_label*TracProtocol.action) + | setexp of unit -> (string*Trac_Term.Msg list) + | msgs of unit -> (Trac_Term.Msg list) + | msg of unit -> (Trac_Term.Msg) | result of unit -> (string list) + | keys of unit -> (Trac_Term.Msg list) + | head_params of unit -> (string list) + | head of unit -> (string*string list) + | rule of unit -> (TracProtocol.ruleT) + | transaction_spec of unit -> (TracProtocol.transaction list) + | transaction_spec_head of unit -> (string option) + | analysis_spec of unit -> (TracProtocol.anaT) + | pub_fun_spec of unit -> (TracProtocol.funT list) + | priv_fun_spec of unit -> (TracProtocol.funT list) + | fun_spec of unit -> (TracProtocol.funT) + | fun_specs of unit -> (TracProtocol.funT list) + | priv_or_pub_fun_spec of unit -> (TracProtocol.fun_spec) + | set_spec of unit -> (TracProtocol.set_spec) + | set_specs of unit -> (TracProtocol.set_spec list) + | lidents of unit -> (string list) + | uidents of unit -> (string list) + | idents of unit -> (string list) + | type_specs of unit -> ( ( string * TracProtocol.type_spec_elem ) list) + | type_spec of unit -> ( ( string * TracProtocol.type_spec_elem ) ) + | type_union of unit -> ( ( string list ) ) + | protocol_spec of unit -> (TracProtocol.protocol) + | trac_protocol of unit -> (TracProtocol.protocol) + | ident of unit -> (string) | lident of unit -> (string) + | uident of unit -> (string) | arity of unit -> (string) + | name of unit -> (string) + | START of unit -> (TracProtocol.protocol) +end +type svalue = MlyValue.svalue +type result = TracProtocol.protocol +end +structure EC= +struct +open LrTable +infix 5 $$ +fun x $$ y = y::x +val is_keyword = +fn _ => false +val preferred_change : (term list * term list) list = +nil +val noShift = +fn (T 0) => true | _ => false +val showTerminal = +fn (T 0) => "EOF" + | (T 1) => "OPENP" + | (T 2) => "CLOSEP" + | (T 3) => "OPENB" + | (T 4) => "CLOSEB" + | (T 5) => "OPENSCRYPT" + | (T 6) => "CLOSESCRYPT" + | (T 7) => "COLON" + | (T 8) => "SEMICOLON" + | (T 9) => "SECCH" + | (T 10) => "AUTHCH" + | (T 11) => "CONFCH" + | (T 12) => "INSECCH" + | (T 13) => "FAUTHCH" + | (T 14) => "FSECCH" + | (T 15) => "PERCENT" + | (T 16) => "UNEQUAL" + | (T 17) => "EXCLAM" + | (T 18) => "DOT" + | (T 19) => "COMMA" + | (T 20) => "OPENSQB" + | (T 21) => "CLOSESQB" + | (T 22) => "UNION" + | (T 23) => "PROTOCOL" + | (T 24) => "KNOWLEDGE" + | (T 25) => "WHERE" + | (T 26) => "ACTIONS" + | (T 27) => "ABSTRACTION" + | (T 28) => "GOALS" + | (T 29) => "AUTHENTICATES" + | (T 30) => "WEAKLY" + | (T 31) => "ON" + | (T 32) => "TSECRET" + | (T 33) => "TBETWEEN" + | (T 34) => "Sets" + | (T 35) => "FUNCTIONS" + | (T 36) => "PUBLIC" + | (T 37) => "PRIVATE" + | (T 38) => "RECEIVE" + | (T 39) => "SEND" + | (T 40) => "IN" + | (T 41) => "NOTIN" + | (T 42) => "INSERT" + | (T 43) => "DELETE" + | (T 44) => "NEW" + | (T 45) => "ATTACK" + | (T 46) => "slash" + | (T 47) => "QUESTION" + | (T 48) => "equal" + | (T 49) => "TYPES" + | (T 50) => "SETS" + | (T 51) => "ARROW" + | (T 52) => "ANALYSIS" + | (T 53) => "TRANSACTIONS" + | (T 54) => "STRING_LITERAL" + | (T 55) => "UPPER_STRING_LITERAL" + | (T 56) => "LOWER_STRING_LITERAL" + | (T 57) => "UNDERSCORE" + | (T 58) => "INTEGER_LITERAL" + | (T 59) => "STAR" + | (T 60) => "OF" + | _ => "bogus-term" +local open Header in +val errtermvalue= +fn _ => MlyValue.VOID +end +val terms : term list = nil + $$ (T 0)end +structure Actions = +struct +exception mlyAction of int +local open Header in +val actions = +fn (i392,defaultPos,stack, + (()):arg) => +case (i392,stack) +of ( 0, ( ( _, ( MlyValue.trac_protocol trac_protocol1, +trac_protocol1left, trac_protocol1right)) :: rest671)) => let val +result = MlyValue.START (fn _ => let val (trac_protocol as +trac_protocol1) = trac_protocol1 () + in (trac_protocol) +end) + in ( LrTable.NT 0, ( result, trac_protocol1left, trac_protocol1right) +, rest671) +end +| ( 1, ( ( _, ( MlyValue.protocol_spec protocol_spec1, _, +protocol_spec1right)) :: ( _, ( MlyValue.name name1, _, _)) :: ( _, ( +MlyValue.COLON COLON1, _, _)) :: ( _, ( MlyValue.PROTOCOL PROTOCOL1, +PROTOCOL1left, _)) :: rest671)) => let val result = +MlyValue.trac_protocol (fn _ => let val PROTOCOL1 = PROTOCOL1 () + val COLON1 = COLON1 () + val (name as name1) = name1 () + val (protocol_spec as protocol_spec1) = protocol_spec1 () + in (TracProtocol.update_name protocol_spec name) +end) + in ( LrTable.NT 6, ( result, PROTOCOL1left, protocol_spec1right), +rest671) +end +| ( 2, ( ( _, ( MlyValue.protocol_spec protocol_spec1, _, +protocol_spec1right)) :: ( _, ( MlyValue.type_specs type_specs1, _, _) +) :: ( _, ( MlyValue.COLON COLON1, _, _)) :: ( _, ( MlyValue.TYPES +TYPES1, TYPES1left, _)) :: rest671)) => let val result = +MlyValue.protocol_spec (fn _ => let val TYPES1 = TYPES1 () + val COLON1 = COLON1 () + val (type_specs as type_specs1) = type_specs1 () + val (protocol_spec as protocol_spec1) = protocol_spec1 () + in (TracProtocol.update_type_spec protocol_spec type_specs) +end) + in ( LrTable.NT 7, ( result, TYPES1left, protocol_spec1right), +rest671) +end +| ( 3, ( ( _, ( MlyValue.protocol_spec protocol_spec1, _, +protocol_spec1right)) :: ( _, ( MlyValue.set_specs set_specs1, _, _)) + :: ( _, ( MlyValue.COLON COLON1, _, _)) :: ( _, ( MlyValue.SETS SETS1 +, SETS1left, _)) :: rest671)) => let val result = +MlyValue.protocol_spec (fn _ => let val SETS1 = SETS1 () + val COLON1 = COLON1 () + val (set_specs as set_specs1) = set_specs1 () + val (protocol_spec as protocol_spec1) = protocol_spec1 () + in (TracProtocol.update_sets protocol_spec set_specs) +end) + in ( LrTable.NT 7, ( result, SETS1left, protocol_spec1right), rest671 +) +end +| ( 4, ( ( _, ( MlyValue.protocol_spec protocol_spec1, _, +protocol_spec1right)) :: ( _, ( MlyValue.priv_or_pub_fun_spec +priv_or_pub_fun_spec1, _, _)) :: ( _, ( MlyValue.COLON COLON1, _, _)) + :: ( _, ( MlyValue.FUNCTIONS FUNCTIONS1, FUNCTIONS1left, _)) :: +rest671)) => let val result = MlyValue.protocol_spec (fn _ => let + val FUNCTIONS1 = FUNCTIONS1 () + val COLON1 = COLON1 () + val (priv_or_pub_fun_spec as priv_or_pub_fun_spec1) = +priv_or_pub_fun_spec1 () + val (protocol_spec as protocol_spec1) = protocol_spec1 () + in ( +TracProtocol.update_functions protocol_spec (SOME priv_or_pub_fun_spec) +) +end) + in ( LrTable.NT 7, ( result, FUNCTIONS1left, protocol_spec1right), +rest671) +end +| ( 5, ( ( _, ( MlyValue.protocol_spec protocol_spec1, _, +protocol_spec1right)) :: ( _, ( MlyValue.analysis_spec analysis_spec1, + _, _)) :: ( _, ( MlyValue.COLON COLON1, _, _)) :: ( _, ( +MlyValue.ANALYSIS ANALYSIS1, ANALYSIS1left, _)) :: rest671)) => let + val result = MlyValue.protocol_spec (fn _ => let val ANALYSIS1 = +ANALYSIS1 () + val COLON1 = COLON1 () + val (analysis_spec as analysis_spec1) = analysis_spec1 () + val (protocol_spec as protocol_spec1) = protocol_spec1 () + in (TracProtocol.update_analysis protocol_spec analysis_spec) +end) + in ( LrTable.NT 7, ( result, ANALYSIS1left, protocol_spec1right), +rest671) +end +| ( 6, ( ( _, ( MlyValue.protocol_spec protocol_spec1, _, +protocol_spec1right)) :: ( _, ( MlyValue.transaction_spec +transaction_spec1, _, _)) :: ( _, ( MlyValue.COLON COLON1, _, _)) :: ( + _, ( MlyValue.transaction_spec_head transaction_spec_head1, +transaction_spec_head1left, _)) :: rest671)) => let val result = +MlyValue.protocol_spec (fn _ => let val (transaction_spec_head as +transaction_spec_head1) = transaction_spec_head1 () + val COLON1 = COLON1 () + val (transaction_spec as transaction_spec1) = transaction_spec1 () + val (protocol_spec as protocol_spec1) = protocol_spec1 () + in ( +TracProtocol.update_transactions transaction_spec_head protocol_spec transaction_spec +) +end) + in ( LrTable.NT 7, ( result, transaction_spec_head1left, +protocol_spec1right), rest671) +end +| ( 7, ( rest671)) => let val result = MlyValue.protocol_spec (fn _ + => (TracProtocol.empty)) + in ( LrTable.NT 7, ( result, defaultPos, defaultPos), rest671) +end +| ( 8, ( ( _, ( MlyValue.ident ident1, ident1left, ident1right)) :: +rest671)) => let val result = MlyValue.type_union (fn _ => let val ( +ident as ident1) = ident1 () + in ([ident]) +end) + in ( LrTable.NT 8, ( result, ident1left, ident1right), rest671) +end +| ( 9, ( ( _, ( MlyValue.type_union type_union1, _, type_union1right) +) :: ( _, ( MlyValue.UNION UNION1, _, _)) :: ( _, ( MlyValue.ident +ident1, ident1left, _)) :: rest671)) => let val result = +MlyValue.type_union (fn _ => let val (ident as ident1) = ident1 () + val UNION1 = UNION1 () + val (type_union as type_union1) = type_union1 () + in (ident::type_union) +end) + in ( LrTable.NT 8, ( result, ident1left, type_union1right), rest671) + +end +| ( 10, ( ( _, ( MlyValue.type_spec type_spec1, type_spec1left, +type_spec1right)) :: rest671)) => let val result = +MlyValue.type_specs (fn _ => let val (type_spec as type_spec1) = +type_spec1 () + in ([type_spec]) +end) + in ( LrTable.NT 10, ( result, type_spec1left, type_spec1right), +rest671) +end +| ( 11, ( ( _, ( MlyValue.type_specs type_specs1, _, type_specs1right +)) :: ( _, ( MlyValue.type_spec type_spec1, type_spec1left, _)) :: +rest671)) => let val result = MlyValue.type_specs (fn _ => let val ( +type_spec as type_spec1) = type_spec1 () + val (type_specs as type_specs1) = type_specs1 () + in (type_spec::type_specs) +end) + in ( LrTable.NT 10, ( result, type_spec1left, type_specs1right), +rest671) +end +| ( 12, ( ( _, ( MlyValue.CLOSEB CLOSEB1, _, CLOSEB1right)) :: ( _, ( + MlyValue.lidents lidents1, _, _)) :: ( _, ( MlyValue.OPENB OPENB1, _, + _)) :: ( _, ( MlyValue.equal equal1, _, _)) :: ( _, ( MlyValue.ident +ident1, ident1left, _)) :: rest671)) => let val result = +MlyValue.type_spec (fn _ => let val (ident as ident1) = ident1 () + val equal1 = equal1 () + val OPENB1 = OPENB1 () + val (lidents as lidents1) = lidents1 () + val CLOSEB1 = CLOSEB1 () + in ((ident, TracProtocol.Consts lidents)) +end) + in ( LrTable.NT 9, ( result, ident1left, CLOSEB1right), rest671) +end +| ( 13, ( ( _, ( MlyValue.type_union type_union1, _, type_union1right +)) :: ( _, ( MlyValue.equal equal1, _, _)) :: ( _, ( MlyValue.ident +ident1, ident1left, _)) :: rest671)) => let val result = +MlyValue.type_spec (fn _ => let val (ident as ident1) = ident1 () + val equal1 = equal1 () + val (type_union as type_union1) = type_union1 () + in ((ident, TracProtocol.Union type_union)) +end) + in ( LrTable.NT 9, ( result, ident1left, type_union1right), rest671) + +end +| ( 14, ( ( _, ( MlyValue.set_spec set_spec1, set_spec1left, +set_spec1right)) :: rest671)) => let val result = MlyValue.set_specs + (fn _ => let val (set_spec as set_spec1) = set_spec1 () + in ([set_spec]) +end) + in ( LrTable.NT 14, ( result, set_spec1left, set_spec1right), rest671 +) +end +| ( 15, ( ( _, ( MlyValue.set_specs set_specs1, _, set_specs1right)) + :: ( _, ( MlyValue.set_spec set_spec1, set_spec1left, _)) :: rest671) +) => let val result = MlyValue.set_specs (fn _ => let val (set_spec + as set_spec1) = set_spec1 () + val (set_specs as set_specs1) = set_specs1 () + in (set_spec::set_specs) +end) + in ( LrTable.NT 14, ( result, set_spec1left, set_specs1right), +rest671) +end +| ( 16, ( ( _, ( MlyValue.arity arity1, _, arity1right)) :: ( _, ( +MlyValue.slash slash1, _, _)) :: ( _, ( MlyValue.ident ident1, +ident1left, _)) :: rest671)) => let val result = MlyValue.set_spec + (fn _ => let val (ident as ident1) = ident1 () + val slash1 = slash1 () + val (arity as arity1) = arity1 () + in ((ident, arity)) +end) + in ( LrTable.NT 15, ( result, ident1left, arity1right), rest671) +end +| ( 17, ( ( _, ( MlyValue.priv_or_pub_fun_spec priv_or_pub_fun_spec1, + _, priv_or_pub_fun_spec1right)) :: ( _, ( MlyValue.pub_fun_spec +pub_fun_spec1, pub_fun_spec1left, _)) :: rest671)) => let val result + = MlyValue.priv_or_pub_fun_spec (fn _ => let val (pub_fun_spec as +pub_fun_spec1) = pub_fun_spec1 () + val (priv_or_pub_fun_spec as priv_or_pub_fun_spec1) = +priv_or_pub_fun_spec1 () + in (TracProtocol.update_fun_public priv_or_pub_fun_spec pub_fun_spec) + +end) + in ( LrTable.NT 16, ( result, pub_fun_spec1left, +priv_or_pub_fun_spec1right), rest671) +end +| ( 18, ( ( _, ( MlyValue.priv_or_pub_fun_spec priv_or_pub_fun_spec1, + _, priv_or_pub_fun_spec1right)) :: ( _, ( MlyValue.priv_fun_spec +priv_fun_spec1, priv_fun_spec1left, _)) :: rest671)) => let val +result = MlyValue.priv_or_pub_fun_spec (fn _ => let val ( +priv_fun_spec as priv_fun_spec1) = priv_fun_spec1 () + val (priv_or_pub_fun_spec as priv_or_pub_fun_spec1) = +priv_or_pub_fun_spec1 () + in ( +TracProtocol.update_fun_private priv_or_pub_fun_spec priv_fun_spec) + +end) + in ( LrTable.NT 16, ( result, priv_fun_spec1left, +priv_or_pub_fun_spec1right), rest671) +end +| ( 19, ( rest671)) => let val result = +MlyValue.priv_or_pub_fun_spec (fn _ => (TracProtocol.fun_empty)) + in ( LrTable.NT 16, ( result, defaultPos, defaultPos), rest671) +end +| ( 20, ( ( _, ( MlyValue.fun_specs fun_specs1, _, fun_specs1right)) + :: ( _, ( MlyValue.PUBLIC PUBLIC1, PUBLIC1left, _)) :: rest671)) => + let val result = MlyValue.pub_fun_spec (fn _ => let val PUBLIC1 = +PUBLIC1 () + val (fun_specs as fun_specs1) = fun_specs1 () + in (fun_specs) +end) + in ( LrTable.NT 20, ( result, PUBLIC1left, fun_specs1right), rest671) + +end +| ( 21, ( ( _, ( MlyValue.fun_specs fun_specs1, _, fun_specs1right)) + :: ( _, ( MlyValue.PRIVATE PRIVATE1, PRIVATE1left, _)) :: rest671)) + => let val result = MlyValue.priv_fun_spec (fn _ => let val +PRIVATE1 = PRIVATE1 () + val (fun_specs as fun_specs1) = fun_specs1 () + in (fun_specs) +end) + in ( LrTable.NT 19, ( result, PRIVATE1left, fun_specs1right), rest671 +) +end +| ( 22, ( ( _, ( MlyValue.fun_spec fun_spec1, fun_spec1left, +fun_spec1right)) :: rest671)) => let val result = MlyValue.fun_specs + (fn _ => let val (fun_spec as fun_spec1) = fun_spec1 () + in ([fun_spec]) +end) + in ( LrTable.NT 17, ( result, fun_spec1left, fun_spec1right), rest671 +) +end +| ( 23, ( ( _, ( MlyValue.fun_specs fun_specs1, _, fun_specs1right)) + :: ( _, ( MlyValue.fun_spec fun_spec1, fun_spec1left, _)) :: rest671) +) => let val result = MlyValue.fun_specs (fn _ => let val (fun_spec + as fun_spec1) = fun_spec1 () + val (fun_specs as fun_specs1) = fun_specs1 () + in (fun_spec::fun_specs) +end) + in ( LrTable.NT 17, ( result, fun_spec1left, fun_specs1right), +rest671) +end +| ( 24, ( ( _, ( MlyValue.arity arity1, _, arity1right)) :: ( _, ( +MlyValue.slash slash1, _, _)) :: ( _, ( MlyValue.ident ident1, +ident1left, _)) :: rest671)) => let val result = MlyValue.fun_spec + (fn _ => let val (ident as ident1) = ident1 () + val slash1 = slash1 () + val (arity as arity1) = arity1 () + in ((ident, arity)) +end) + in ( LrTable.NT 18, ( result, ident1left, arity1right), rest671) +end +| ( 25, ( ( _, ( MlyValue.rule rule1, rule1left, rule1right)) :: +rest671)) => let val result = MlyValue.analysis_spec (fn _ => let + val (rule as rule1) = rule1 () + in ([rule]) +end) + in ( LrTable.NT 21, ( result, rule1left, rule1right), rest671) +end +| ( 26, ( ( _, ( MlyValue.analysis_spec analysis_spec1, _, +analysis_spec1right)) :: ( _, ( MlyValue.rule rule1, rule1left, _)) :: + rest671)) => let val result = MlyValue.analysis_spec (fn _ => let + val (rule as rule1) = rule1 () + val (analysis_spec as analysis_spec1) = analysis_spec1 () + in (rule::analysis_spec) +end) + in ( LrTable.NT 21, ( result, rule1left, analysis_spec1right), +rest671) +end +| ( 27, ( ( _, ( MlyValue.result result1, _, result1right)) :: ( _, ( + MlyValue.ARROW ARROW1, _, _)) :: ( _, ( MlyValue.head head1, +head1left, _)) :: rest671)) => let val result = MlyValue.rule (fn _ + => let val (head as head1) = head1 () + val ARROW1 = ARROW1 () + val (result as result1) = result1 () + in ((head,[],result)) +end) + in ( LrTable.NT 24, ( result, head1left, result1right), rest671) +end +| ( 28, ( ( _, ( MlyValue.result result1, _, result1right)) :: ( _, ( + MlyValue.ARROW ARROW1, _, _)) :: ( _, ( MlyValue.keys keys1, _, _)) + :: ( _, ( MlyValue.QUESTION QUESTION1, _, _)) :: ( _, ( MlyValue.head + head1, head1left, _)) :: rest671)) => let val result = MlyValue.rule + (fn _ => let val (head as head1) = head1 () + val QUESTION1 = QUESTION1 () + val (keys as keys1) = keys1 () + val ARROW1 = ARROW1 () + val (result as result1) = result1 () + in ((head,keys,result)) +end) + in ( LrTable.NT 24, ( result, head1left, result1right), rest671) +end +| ( 29, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, ( + MlyValue.head_params head_params1, _, _)) :: ( _, ( MlyValue.OPENP +OPENP1, _, _)) :: ( _, ( MlyValue.LOWER_STRING_LITERAL +LOWER_STRING_LITERAL1, LOWER_STRING_LITERAL1left, _)) :: rest671)) => + let val result = MlyValue.head (fn _ => let val ( +LOWER_STRING_LITERAL as LOWER_STRING_LITERAL1) = LOWER_STRING_LITERAL1 + () + val OPENP1 = OPENP1 () + val (head_params as head_params1) = head_params1 () + val CLOSEP1 = CLOSEP1 () + in ((LOWER_STRING_LITERAL,head_params)) +end) + in ( LrTable.NT 25, ( result, LOWER_STRING_LITERAL1left, CLOSEP1right +), rest671) +end +| ( 30, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1, + UPPER_STRING_LITERAL1left, UPPER_STRING_LITERAL1right)) :: rest671)) + => let val result = MlyValue.head_params (fn _ => let val ( +UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1 + () + in ([UPPER_STRING_LITERAL]) +end) + in ( LrTable.NT 26, ( result, UPPER_STRING_LITERAL1left, +UPPER_STRING_LITERAL1right), rest671) +end +| ( 31, ( ( _, ( MlyValue.head_params head_params1, _, +head_params1right)) :: ( _, ( MlyValue.COMMA COMMA1, _, _)) :: ( _, ( +MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1, +UPPER_STRING_LITERAL1left, _)) :: rest671)) => let val result = +MlyValue.head_params (fn _ => let val (UPPER_STRING_LITERAL as +UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1 () + val COMMA1 = COMMA1 () + val (head_params as head_params1) = head_params1 () + in ([UPPER_STRING_LITERAL]@head_params) +end) + in ( LrTable.NT 26, ( result, UPPER_STRING_LITERAL1left, +head_params1right), rest671) +end +| ( 32, ( ( _, ( MlyValue.msgs msgs1, msgs1left, msgs1right)) :: +rest671)) => let val result = MlyValue.keys (fn _ => let val (msgs + as msgs1) = msgs1 () + in (msgs) +end) + in ( LrTable.NT 27, ( result, msgs1left, msgs1right), rest671) +end +| ( 33, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1, + UPPER_STRING_LITERAL1left, UPPER_STRING_LITERAL1right)) :: rest671)) + => let val result = MlyValue.result (fn _ => let val ( +UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1 + () + in ([UPPER_STRING_LITERAL]) +end) + in ( LrTable.NT 28, ( result, UPPER_STRING_LITERAL1left, +UPPER_STRING_LITERAL1right), rest671) +end +| ( 34, ( ( _, ( MlyValue.result result1, _, result1right)) :: ( _, ( + MlyValue.COMMA COMMA1, _, _)) :: ( _, ( MlyValue.UPPER_STRING_LITERAL + UPPER_STRING_LITERAL1, UPPER_STRING_LITERAL1left, _)) :: rest671)) => + let val result = MlyValue.result (fn _ => let val ( +UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1 + () + val COMMA1 = COMMA1 () + val (result as result1) = result1 () + in ([UPPER_STRING_LITERAL]@result) +end) + in ( LrTable.NT 28, ( result, UPPER_STRING_LITERAL1left, result1right +), rest671) +end +| ( 35, ( ( _, ( MlyValue.TRANSACTIONS TRANSACTIONS1, +TRANSACTIONS1left, TRANSACTIONS1right)) :: rest671)) => let val +result = MlyValue.transaction_spec_head (fn _ => let val +TRANSACTIONS1 = TRANSACTIONS1 () + in (NONE) +end) + in ( LrTable.NT 22, ( result, TRANSACTIONS1left, TRANSACTIONS1right), + rest671) +end +| ( 36, ( ( _, ( MlyValue.LOWER_STRING_LITERAL LOWER_STRING_LITERAL1, + _, LOWER_STRING_LITERAL1right)) :: ( _, ( MlyValue.OF OF1, _, _)) :: +( _, ( MlyValue.TRANSACTIONS TRANSACTIONS1, TRANSACTIONS1left, _)) :: +rest671)) => let val result = MlyValue.transaction_spec_head (fn _ => + let val TRANSACTIONS1 = TRANSACTIONS1 () + val OF1 = OF1 () + val (LOWER_STRING_LITERAL as LOWER_STRING_LITERAL1) = +LOWER_STRING_LITERAL1 () + in (SOME LOWER_STRING_LITERAL) +end) + in ( LrTable.NT 22, ( result, TRANSACTIONS1left, +LOWER_STRING_LITERAL1right), rest671) +end +| ( 37, ( ( _, ( MlyValue.DOT DOT1, _, DOT1right)) :: ( _, ( +MlyValue.actions actions1, _, _)) :: ( _, ( MlyValue.transaction +transaction1, transaction1left, _)) :: rest671)) => let val result = +MlyValue.transaction_spec (fn _ => let val (transaction as +transaction1) = transaction1 () + val (actions as actions1) = actions1 () + val DOT1 = DOT1 () + in ([TracProtocol.mkTransaction transaction actions]) +end) + in ( LrTable.NT 23, ( result, transaction1left, DOT1right), rest671) + +end +| ( 38, ( ( _, ( MlyValue.transaction_spec transaction_spec1, _, +transaction_spec1right)) :: ( _, ( MlyValue.DOT DOT1, _, _)) :: ( _, ( + MlyValue.actions actions1, _, _)) :: ( _, ( MlyValue.transaction +transaction1, transaction1left, _)) :: rest671)) => let val result = +MlyValue.transaction_spec (fn _ => let val (transaction as +transaction1) = transaction1 () + val (actions as actions1) = actions1 () + val DOT1 = DOT1 () + val (transaction_spec as transaction_spec1) = transaction_spec1 () + in ( +(TracProtocol.mkTransaction transaction actions)::transaction_spec) + +end) + in ( LrTable.NT 23, ( result, transaction1left, +transaction_spec1right), rest671) +end +| ( 39, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1, + _, UPPER_STRING_LITERAL1right)) :: ( _, ( MlyValue.UNEQUAL UNEQUAL1, +UNEQUAL1left, _)) :: rest671)) => let val result = MlyValue.ineq_aux + (fn _ => let val UNEQUAL1 = UNEQUAL1 () + val (UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = +UPPER_STRING_LITERAL1 () + in (UPPER_STRING_LITERAL) +end) + in ( LrTable.NT 34, ( result, UNEQUAL1left, +UPPER_STRING_LITERAL1right), rest671) +end +| ( 40, ( ( _, ( MlyValue.ineq_aux ineq_aux1, _, ineq_aux1right)) :: +( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1, +UPPER_STRING_LITERAL1left, _)) :: rest671)) => let val result = +MlyValue.ineq (fn _ => let val (UPPER_STRING_LITERAL as +UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1 () + val (ineq_aux as ineq_aux1) = ineq_aux1 () + in ((UPPER_STRING_LITERAL,ineq_aux)) +end) + in ( LrTable.NT 35, ( result, UPPER_STRING_LITERAL1left, +ineq_aux1right), rest671) +end +| ( 41, ( ( _, ( MlyValue.ineq ineq1, ineq1left, ineq1right)) :: +rest671)) => let val result = MlyValue.ineqs (fn _ => let val (ineq + as ineq1) = ineq1 () + in ([ineq]) +end) + in ( LrTable.NT 36, ( result, ineq1left, ineq1right), rest671) +end +| ( 42, ( ( _, ( MlyValue.ineqs ineqs1, _, ineqs1right)) :: ( _, ( +MlyValue.COMMA COMMA1, _, _)) :: ( _, ( MlyValue.ineq ineq1, ineq1left +, _)) :: rest671)) => let val result = MlyValue.ineqs (fn _ => let + val (ineq as ineq1) = ineq1 () + val COMMA1 = COMMA1 () + val (ineqs as ineqs1) = ineqs1 () + in ([ineq]@ineqs) +end) + in ( LrTable.NT 36, ( result, ineq1left, ineqs1right), rest671) +end +| ( 43, ( ( _, ( MlyValue.ineqs ineqs1, _, ineqs1right)) :: ( _, ( +MlyValue.WHERE WHERE1, _, _)) :: ( _, ( MlyValue.CLOSEP CLOSEP1, _, _) +) :: ( _, ( MlyValue.parameters parameters1, _, _)) :: ( _, ( +MlyValue.OPENP OPENP1, _, _)) :: ( _, ( MlyValue.ident ident1, +ident1left, _)) :: rest671)) => let val result = MlyValue.transaction + (fn _ => let val (ident as ident1) = ident1 () + val OPENP1 = OPENP1 () + val (parameters as parameters1) = parameters1 () + val CLOSEP1 = CLOSEP1 () + val WHERE1 = WHERE1 () + val (ineqs as ineqs1) = ineqs1 () + in ((ident,parameters,ineqs)) +end) + in ( LrTable.NT 37, ( result, ident1left, ineqs1right), rest671) +end +| ( 44, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, ( + MlyValue.parameters parameters1, _, _)) :: ( _, ( MlyValue.OPENP +OPENP1, _, _)) :: ( _, ( MlyValue.ident ident1, ident1left, _)) :: +rest671)) => let val result = MlyValue.transaction (fn _ => let val + (ident as ident1) = ident1 () + val OPENP1 = OPENP1 () + val (parameters as parameters1) = parameters1 () + val CLOSEP1 = CLOSEP1 () + in ((ident,parameters,[])) +end) + in ( LrTable.NT 37, ( result, ident1left, CLOSEP1right), rest671) +end +| ( 45, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, ( + MlyValue.OPENP OPENP1, _, _)) :: ( _, ( MlyValue.ident ident1, +ident1left, _)) :: rest671)) => let val result = MlyValue.transaction + (fn _ => let val (ident as ident1) = ident1 () + val OPENP1 = OPENP1 () + val CLOSEP1 = CLOSEP1 () + in ((ident,[],[])) +end) + in ( LrTable.NT 37, ( result, ident1left, CLOSEP1right), rest671) +end +| ( 46, ( ( _, ( MlyValue.parameter parameter1, parameter1left, +parameter1right)) :: rest671)) => let val result = +MlyValue.parameters (fn _ => let val (parameter as parameter1) = +parameter1 () + in ([parameter]) +end) + in ( LrTable.NT 40, ( result, parameter1left, parameter1right), +rest671) +end +| ( 47, ( ( _, ( MlyValue.parameters parameters1, _, parameters1right +)) :: ( _, ( MlyValue.COMMA COMMA1, _, _)) :: ( _, ( +MlyValue.parameter parameter1, parameter1left, _)) :: rest671)) => let + val result = MlyValue.parameters (fn _ => let val (parameter as +parameter1) = parameter1 () + val COMMA1 = COMMA1 () + val (parameters as parameters1) = parameters1 () + in (parameter::parameters) +end) + in ( LrTable.NT 40, ( result, parameter1left, parameters1right), +rest671) +end +| ( 48, ( ( _, ( MlyValue.typ typ1, _, typ1right)) :: ( _, ( +MlyValue.COLON COLON1, _, _)) :: ( _, ( MlyValue.ident ident1, +ident1left, _)) :: rest671)) => let val result = MlyValue.parameter + (fn _ => let val (ident as ident1) = ident1 () + val COLON1 = COLON1 () + val (typ as typ1) = typ1 () + in ((ident, typ)) +end) + in ( LrTable.NT 39, ( result, ident1left, typ1right), rest671) +end +| ( 49, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1, + UPPER_STRING_LITERAL1left, UPPER_STRING_LITERAL1right)) :: rest671)) + => let val result = MlyValue.typ (fn _ => let val ( +UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1 + () + in (UPPER_STRING_LITERAL) +end) + in ( LrTable.NT 38, ( result, UPPER_STRING_LITERAL1left, +UPPER_STRING_LITERAL1right), rest671) +end +| ( 50, ( ( _, ( MlyValue.LOWER_STRING_LITERAL LOWER_STRING_LITERAL1, + LOWER_STRING_LITERAL1left, LOWER_STRING_LITERAL1right)) :: rest671)) + => let val result = MlyValue.typ (fn _ => let val ( +LOWER_STRING_LITERAL as LOWER_STRING_LITERAL1) = LOWER_STRING_LITERAL1 + () + in (LOWER_STRING_LITERAL) +end) + in ( LrTable.NT 38, ( result, LOWER_STRING_LITERAL1left, +LOWER_STRING_LITERAL1right), rest671) +end +| ( 51, ( ( _, ( MlyValue.action action1, action1left, action1right)) + :: rest671)) => let val result = MlyValue.actions (fn _ => let val + (action as action1) = action1 () + in ([action]) +end) + in ( LrTable.NT 33, ( result, action1left, action1right), rest671) + +end +| ( 52, ( ( _, ( MlyValue.actions actions1, _, actions1right)) :: ( _ +, ( MlyValue.action action1, action1left, _)) :: rest671)) => let val + result = MlyValue.actions (fn _ => let val (action as action1) = +action1 () + val (actions as actions1) = actions1 () + in (action::actions) +end) + in ( LrTable.NT 33, ( result, action1left, actions1right), rest671) + +end +| ( 53, ( ( _, ( MlyValue.msg msg1, _, msg1right)) :: ( _, ( +MlyValue.RECEIVE RECEIVE1, RECEIVE1left, _)) :: rest671)) => let val +result = MlyValue.action (fn _ => let val (RECEIVE as RECEIVE1) = +RECEIVE1 () + val (msg as msg1) = msg1 () + in ((TracProtocol.LabelN,TracProtocol.RECEIVE(msg))) +end) + in ( LrTable.NT 32, ( result, RECEIVE1left, msg1right), rest671) +end +| ( 54, ( ( _, ( MlyValue.msg msg1, _, msg1right)) :: ( _, ( +MlyValue.SEND SEND1, SEND1left, _)) :: rest671)) => let val result = +MlyValue.action (fn _ => let val (SEND as SEND1) = SEND1 () + val (msg as msg1) = msg1 () + in ((TracProtocol.LabelN,TracProtocol.SEND(msg))) +end) + in ( LrTable.NT 32, ( result, SEND1left, msg1right), rest671) +end +| ( 55, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, ( + MlyValue.IN IN1, _, _)) :: ( _, ( MlyValue.msg msg1, msg1left, _)) :: + rest671)) => let val result = MlyValue.action (fn _ => let val (msg + as msg1) = msg1 () + val (IN as IN1) = IN1 () + val (setexp as setexp1) = setexp1 () + in ((TracProtocol.LabelN,TracProtocol.IN(msg,setexp))) +end) + in ( LrTable.NT 32, ( result, msg1left, setexp1right), rest671) +end +| ( 56, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, ( + MlyValue.NOTIN NOTIN1, _, _)) :: ( _, ( MlyValue.msg msg1, msg1left, + _)) :: rest671)) => let val result = MlyValue.action (fn _ => let + val (msg as msg1) = msg1 () + val (NOTIN as NOTIN1) = NOTIN1 () + val (setexp as setexp1) = setexp1 () + in ((TracProtocol.LabelN,TracProtocol.NOTIN(msg,setexp))) +end) + in ( LrTable.NT 32, ( result, msg1left, setexp1right), rest671) +end +| ( 57, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, ( + MlyValue.UNDERSCORE UNDERSCORE1, _, _)) :: ( _, ( MlyValue.OPENP +OPENP1, _, _)) :: ( _, ( MlyValue.lident lident1, _, _)) :: ( _, ( +MlyValue.NOTIN NOTIN1, _, _)) :: ( _, ( MlyValue.msg msg1, msg1left, _ +)) :: rest671)) => let val result = MlyValue.action (fn _ => let val + (msg as msg1) = msg1 () + val NOTIN1 = NOTIN1 () + val (lident as lident1) = lident1 () + val OPENP1 = OPENP1 () + val UNDERSCORE1 = UNDERSCORE1 () + val CLOSEP1 = CLOSEP1 () + in ((TracProtocol.LabelN,TracProtocol.NOTINANY(msg,lident))) +end) + in ( LrTable.NT 32, ( result, msg1left, CLOSEP1right), rest671) +end +| ( 58, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, ( + MlyValue.msg msg1, _, _)) :: ( _, ( MlyValue.INSERT INSERT1, +INSERT1left, _)) :: rest671)) => let val result = MlyValue.action (fn + _ => let val (INSERT as INSERT1) = INSERT1 () + val (msg as msg1) = msg1 () + val (setexp as setexp1) = setexp1 () + in ((TracProtocol.LabelN,TracProtocol.INSERT(msg,setexp))) +end) + in ( LrTable.NT 32, ( result, INSERT1left, setexp1right), rest671) + +end +| ( 59, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, ( + MlyValue.msg msg1, _, _)) :: ( _, ( MlyValue.DELETE DELETE1, +DELETE1left, _)) :: rest671)) => let val result = MlyValue.action (fn + _ => let val (DELETE as DELETE1) = DELETE1 () + val (msg as msg1) = msg1 () + val (setexp as setexp1) = setexp1 () + in ((TracProtocol.LabelN,TracProtocol.DELETE(msg,setexp))) +end) + in ( LrTable.NT 32, ( result, DELETE1left, setexp1right), rest671) + +end +| ( 60, ( ( _, ( MlyValue.uident uident1, _, uident1right)) :: ( _, ( + MlyValue.NEW NEW1, NEW1left, _)) :: rest671)) => let val result = +MlyValue.action (fn _ => let val (NEW as NEW1) = NEW1 () + val (uident as uident1) = uident1 () + in ((TracProtocol.LabelS,TracProtocol.NEW(uident))) +end) + in ( LrTable.NT 32, ( result, NEW1left, uident1right), rest671) +end +| ( 61, ( ( _, ( MlyValue.ATTACK ATTACK1, ATTACK1left, ATTACK1right)) + :: rest671)) => let val result = MlyValue.action (fn _ => let val ( +ATTACK as ATTACK1) = ATTACK1 () + in ((TracProtocol.LabelN,TracProtocol.ATTACK)) +end) + in ( LrTable.NT 32, ( result, ATTACK1left, ATTACK1right), rest671) + +end +| ( 62, ( ( _, ( MlyValue.msg msg1, _, msg1right)) :: ( _, ( +MlyValue.RECEIVE RECEIVE1, _, _)) :: ( _, ( MlyValue.STAR STAR1, +STAR1left, _)) :: rest671)) => let val result = MlyValue.action (fn _ + => let val STAR1 = STAR1 () + val (RECEIVE as RECEIVE1) = RECEIVE1 () + val (msg as msg1) = msg1 () + in ((TracProtocol.LabelS,TracProtocol.RECEIVE(msg))) +end) + in ( LrTable.NT 32, ( result, STAR1left, msg1right), rest671) +end +| ( 63, ( ( _, ( MlyValue.msg msg1, _, msg1right)) :: ( _, ( +MlyValue.SEND SEND1, _, _)) :: ( _, ( MlyValue.STAR STAR1, STAR1left, + _)) :: rest671)) => let val result = MlyValue.action (fn _ => let + val STAR1 = STAR1 () + val (SEND as SEND1) = SEND1 () + val (msg as msg1) = msg1 () + in ((TracProtocol.LabelS,TracProtocol.SEND(msg))) +end) + in ( LrTable.NT 32, ( result, STAR1left, msg1right), rest671) +end +| ( 64, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, ( + MlyValue.IN IN1, _, _)) :: ( _, ( MlyValue.msg msg1, _, _)) :: ( _, ( + MlyValue.STAR STAR1, STAR1left, _)) :: rest671)) => let val result = + MlyValue.action (fn _ => let val STAR1 = STAR1 () + val (msg as msg1) = msg1 () + val (IN as IN1) = IN1 () + val (setexp as setexp1) = setexp1 () + in ((TracProtocol.LabelS,TracProtocol.IN(msg,setexp))) +end) + in ( LrTable.NT 32, ( result, STAR1left, setexp1right), rest671) +end +| ( 65, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, ( + MlyValue.NOTIN NOTIN1, _, _)) :: ( _, ( MlyValue.msg msg1, _, _)) :: +( _, ( MlyValue.STAR STAR1, STAR1left, _)) :: rest671)) => let val +result = MlyValue.action (fn _ => let val STAR1 = STAR1 () + val (msg as msg1) = msg1 () + val (NOTIN as NOTIN1) = NOTIN1 () + val (setexp as setexp1) = setexp1 () + in ((TracProtocol.LabelS,TracProtocol.NOTIN(msg,setexp))) +end) + in ( LrTable.NT 32, ( result, STAR1left, setexp1right), rest671) +end +| ( 66, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, ( + MlyValue.UNDERSCORE UNDERSCORE1, _, _)) :: ( _, ( MlyValue.OPENP +OPENP1, _, _)) :: ( _, ( MlyValue.lident lident1, _, _)) :: ( _, ( +MlyValue.NOTIN NOTIN1, _, _)) :: ( _, ( MlyValue.msg msg1, _, _)) :: ( + _, ( MlyValue.STAR STAR1, STAR1left, _)) :: rest671)) => let val +result = MlyValue.action (fn _ => let val STAR1 = STAR1 () + val (msg as msg1) = msg1 () + val NOTIN1 = NOTIN1 () + val (lident as lident1) = lident1 () + val OPENP1 = OPENP1 () + val UNDERSCORE1 = UNDERSCORE1 () + val CLOSEP1 = CLOSEP1 () + in ((TracProtocol.LabelS,TracProtocol.NOTINANY(msg,lident))) +end) + in ( LrTable.NT 32, ( result, STAR1left, CLOSEP1right), rest671) +end +| ( 67, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, ( + MlyValue.msg msg1, _, _)) :: ( _, ( MlyValue.INSERT INSERT1, _, _)) + :: ( _, ( MlyValue.STAR STAR1, STAR1left, _)) :: rest671)) => let + val result = MlyValue.action (fn _ => let val STAR1 = STAR1 () + val (INSERT as INSERT1) = INSERT1 () + val (msg as msg1) = msg1 () + val (setexp as setexp1) = setexp1 () + in ((TracProtocol.LabelS,TracProtocol.INSERT(msg,setexp))) +end) + in ( LrTable.NT 32, ( result, STAR1left, setexp1right), rest671) +end +| ( 68, ( ( _, ( MlyValue.setexp setexp1, _, setexp1right)) :: ( _, ( + MlyValue.msg msg1, _, _)) :: ( _, ( MlyValue.DELETE DELETE1, _, _)) + :: ( _, ( MlyValue.STAR STAR1, STAR1left, _)) :: rest671)) => let + val result = MlyValue.action (fn _ => let val STAR1 = STAR1 () + val (DELETE as DELETE1) = DELETE1 () + val (msg as msg1) = msg1 () + val (setexp as setexp1) = setexp1 () + in ((TracProtocol.LabelS,TracProtocol.DELETE(msg,setexp))) +end) + in ( LrTable.NT 32, ( result, STAR1left, setexp1right), rest671) +end +| ( 69, ( ( _, ( MlyValue.lident lident1, lident1left, lident1right)) + :: rest671)) => let val result = MlyValue.setexp (fn _ => let val ( +lident as lident1) = lident1 () + in ((lident,[])) +end) + in ( LrTable.NT 31, ( result, lident1left, lident1right), rest671) + +end +| ( 70, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, ( + MlyValue.msgs msgs1, _, _)) :: ( _, ( MlyValue.OPENP OPENP1, _, _)) + :: ( _, ( MlyValue.lident lident1, lident1left, _)) :: rest671)) => + let val result = MlyValue.setexp (fn _ => let val (lident as +lident1) = lident1 () + val OPENP1 = OPENP1 () + val (msgs as msgs1) = msgs1 () + val CLOSEP1 = CLOSEP1 () + in ((lident,msgs)) +end) + in ( LrTable.NT 31, ( result, lident1left, CLOSEP1right), rest671) + +end +| ( 71, ( ( _, ( MlyValue.uident uident1, uident1left, uident1right)) + :: rest671)) => let val result = MlyValue.msg (fn _ => let val ( +uident as uident1) = uident1 () + in (Var uident) +end) + in ( LrTable.NT 29, ( result, uident1left, uident1right), rest671) + +end +| ( 72, ( ( _, ( MlyValue.lident lident1, lident1left, lident1right)) + :: rest671)) => let val result = MlyValue.msg (fn _ => let val ( +lident as lident1) = lident1 () + in (Const lident) +end) + in ( LrTable.NT 29, ( result, lident1left, lident1right), rest671) + +end +| ( 73, ( ( _, ( MlyValue.CLOSEP CLOSEP1, _, CLOSEP1right)) :: ( _, ( + MlyValue.msgs msgs1, _, _)) :: ( _, ( MlyValue.OPENP OPENP1, _, _)) + :: ( _, ( MlyValue.lident lident1, lident1left, _)) :: rest671)) => + let val result = MlyValue.msg (fn _ => let val (lident as lident1) + = lident1 () + val OPENP1 = OPENP1 () + val (msgs as msgs1) = msgs1 () + val CLOSEP1 = CLOSEP1 () + in (Fun (lident,msgs)) +end) + in ( LrTable.NT 29, ( result, lident1left, CLOSEP1right), rest671) + +end +| ( 74, ( ( _, ( MlyValue.msg msg1, msg1left, msg1right)) :: rest671) +) => let val result = MlyValue.msgs (fn _ => let val (msg as msg1) = + msg1 () + in ([msg]) +end) + in ( LrTable.NT 30, ( result, msg1left, msg1right), rest671) +end +| ( 75, ( ( _, ( MlyValue.msgs msgs1, _, msgs1right)) :: ( _, ( +MlyValue.COMMA COMMA1, _, _)) :: ( _, ( MlyValue.msg msg1, msg1left, _ +)) :: rest671)) => let val result = MlyValue.msgs (fn _ => let val ( +msg as msg1) = msg1 () + val COMMA1 = COMMA1 () + val (msgs as msgs1) = msgs1 () + in (msg::msgs) +end) + in ( LrTable.NT 30, ( result, msg1left, msgs1right), rest671) +end +| ( 76, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1, + UPPER_STRING_LITERAL1left, UPPER_STRING_LITERAL1right)) :: rest671)) + => let val result = MlyValue.name (fn _ => let val ( +UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1 + () + in (UPPER_STRING_LITERAL) +end) + in ( LrTable.NT 1, ( result, UPPER_STRING_LITERAL1left, +UPPER_STRING_LITERAL1right), rest671) +end +| ( 77, ( ( _, ( MlyValue.LOWER_STRING_LITERAL LOWER_STRING_LITERAL1, + LOWER_STRING_LITERAL1left, LOWER_STRING_LITERAL1right)) :: rest671)) + => let val result = MlyValue.name (fn _ => let val ( +LOWER_STRING_LITERAL as LOWER_STRING_LITERAL1) = LOWER_STRING_LITERAL1 + () + in (LOWER_STRING_LITERAL) +end) + in ( LrTable.NT 1, ( result, LOWER_STRING_LITERAL1left, +LOWER_STRING_LITERAL1right), rest671) +end +| ( 78, ( ( _, ( MlyValue.UPPER_STRING_LITERAL UPPER_STRING_LITERAL1, + UPPER_STRING_LITERAL1left, UPPER_STRING_LITERAL1right)) :: rest671)) + => let val result = MlyValue.uident (fn _ => let val ( +UPPER_STRING_LITERAL as UPPER_STRING_LITERAL1) = UPPER_STRING_LITERAL1 + () + in (UPPER_STRING_LITERAL) +end) + in ( LrTable.NT 3, ( result, UPPER_STRING_LITERAL1left, +UPPER_STRING_LITERAL1right), rest671) +end +| ( 79, ( ( _, ( MlyValue.uident uident1, uident1left, uident1right)) + :: rest671)) => let val result = MlyValue.uidents (fn _ => let val + (uident as uident1) = uident1 () + in ([uident]) +end) + in ( LrTable.NT 12, ( result, uident1left, uident1right), rest671) + +end +| ( 80, ( ( _, ( MlyValue.uidents uidents1, _, uidents1right)) :: ( _ +, ( MlyValue.COMMA COMMA1, _, _)) :: ( _, ( MlyValue.uident uident1, +uident1left, _)) :: rest671)) => let val result = MlyValue.uidents + (fn _ => let val (uident as uident1) = uident1 () + val COMMA1 = COMMA1 () + val (uidents as uidents1) = uidents1 () + in (uident::uidents) +end) + in ( LrTable.NT 12, ( result, uident1left, uidents1right), rest671) + +end +| ( 81, ( ( _, ( MlyValue.LOWER_STRING_LITERAL LOWER_STRING_LITERAL1, + LOWER_STRING_LITERAL1left, LOWER_STRING_LITERAL1right)) :: rest671)) + => let val result = MlyValue.lident (fn _ => let val ( +LOWER_STRING_LITERAL as LOWER_STRING_LITERAL1) = LOWER_STRING_LITERAL1 + () + in (LOWER_STRING_LITERAL) +end) + in ( LrTable.NT 4, ( result, LOWER_STRING_LITERAL1left, +LOWER_STRING_LITERAL1right), rest671) +end +| ( 82, ( ( _, ( MlyValue.lident lident1, lident1left, lident1right)) + :: rest671)) => let val result = MlyValue.lidents (fn _ => let val + (lident as lident1) = lident1 () + in ([lident]) +end) + in ( LrTable.NT 13, ( result, lident1left, lident1right), rest671) + +end +| ( 83, ( ( _, ( MlyValue.lidents lidents1, _, lidents1right)) :: ( _ +, ( MlyValue.COMMA COMMA1, _, _)) :: ( _, ( MlyValue.lident lident1, +lident1left, _)) :: rest671)) => let val result = MlyValue.lidents + (fn _ => let val (lident as lident1) = lident1 () + val COMMA1 = COMMA1 () + val (lidents as lidents1) = lidents1 () + in (lident::lidents) +end) + in ( LrTable.NT 13, ( result, lident1left, lidents1right), rest671) + +end +| ( 84, ( ( _, ( MlyValue.uident uident1, uident1left, uident1right)) + :: rest671)) => let val result = MlyValue.ident (fn _ => let val ( +uident as uident1) = uident1 () + in (uident) +end) + in ( LrTable.NT 5, ( result, uident1left, uident1right), rest671) +end +| ( 85, ( ( _, ( MlyValue.lident lident1, lident1left, lident1right)) + :: rest671)) => let val result = MlyValue.ident (fn _ => let val ( +lident as lident1) = lident1 () + in (lident) +end) + in ( LrTable.NT 5, ( result, lident1left, lident1right), rest671) +end +| ( 86, ( ( _, ( MlyValue.ident ident1, ident1left, ident1right)) :: +rest671)) => let val result = MlyValue.idents (fn _ => let val ( +ident as ident1) = ident1 () + in ([ident]) +end) + in ( LrTable.NT 11, ( result, ident1left, ident1right), rest671) +end +| ( 87, ( ( _, ( MlyValue.idents idents1, _, idents1right)) :: ( _, ( + MlyValue.COMMA COMMA1, _, _)) :: ( _, ( MlyValue.ident ident1, +ident1left, _)) :: rest671)) => let val result = MlyValue.idents (fn + _ => let val (ident as ident1) = ident1 () + val COMMA1 = COMMA1 () + val (idents as idents1) = idents1 () + in (ident::idents) +end) + in ( LrTable.NT 11, ( result, ident1left, idents1right), rest671) +end +| ( 88, ( ( _, ( MlyValue.INTEGER_LITERAL INTEGER_LITERAL1, +INTEGER_LITERAL1left, INTEGER_LITERAL1right)) :: rest671)) => let val + result = MlyValue.arity (fn _ => let val (INTEGER_LITERAL as +INTEGER_LITERAL1) = INTEGER_LITERAL1 () + in (INTEGER_LITERAL) +end) + in ( LrTable.NT 2, ( result, INTEGER_LITERAL1left, +INTEGER_LITERAL1right), rest671) +end +| _ => raise (mlyAction i392) +end +val void = MlyValue.VOID +val extract = fn a => (fn MlyValue.START x => x +| _ => let exception ParseInternal + in raise ParseInternal end) a () +end +end +structure Tokens : TracTransaction_TOKENS = +struct +type svalue = ParserData.svalue +type ('a,'b) token = ('a,'b) Token.token +fun EOF (p1,p2) = Token.TOKEN (ParserData.LrTable.T 0,( +ParserData.MlyValue.VOID,p1,p2)) +fun OPENP (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 1,( +ParserData.MlyValue.OPENP (fn () => i),p1,p2)) +fun CLOSEP (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 2,( +ParserData.MlyValue.CLOSEP (fn () => i),p1,p2)) +fun OPENB (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 3,( +ParserData.MlyValue.OPENB (fn () => i),p1,p2)) +fun CLOSEB (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 4,( +ParserData.MlyValue.CLOSEB (fn () => i),p1,p2)) +fun OPENSCRYPT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 5,( +ParserData.MlyValue.OPENSCRYPT (fn () => i),p1,p2)) +fun CLOSESCRYPT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 6,( +ParserData.MlyValue.CLOSESCRYPT (fn () => i),p1,p2)) +fun COLON (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 7,( +ParserData.MlyValue.COLON (fn () => i),p1,p2)) +fun SEMICOLON (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 8,( +ParserData.MlyValue.SEMICOLON (fn () => i),p1,p2)) +fun SECCH (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 9,( +ParserData.MlyValue.SECCH (fn () => i),p1,p2)) +fun AUTHCH (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 10,( +ParserData.MlyValue.AUTHCH (fn () => i),p1,p2)) +fun CONFCH (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 11,( +ParserData.MlyValue.CONFCH (fn () => i),p1,p2)) +fun INSECCH (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 12,( +ParserData.MlyValue.INSECCH (fn () => i),p1,p2)) +fun FAUTHCH (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 13,( +ParserData.MlyValue.FAUTHCH (fn () => i),p1,p2)) +fun FSECCH (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 14,( +ParserData.MlyValue.FSECCH (fn () => i),p1,p2)) +fun PERCENT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 15,( +ParserData.MlyValue.PERCENT (fn () => i),p1,p2)) +fun UNEQUAL (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 16,( +ParserData.MlyValue.UNEQUAL (fn () => i),p1,p2)) +fun EXCLAM (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 17,( +ParserData.MlyValue.EXCLAM (fn () => i),p1,p2)) +fun DOT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 18,( +ParserData.MlyValue.DOT (fn () => i),p1,p2)) +fun COMMA (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 19,( +ParserData.MlyValue.COMMA (fn () => i),p1,p2)) +fun OPENSQB (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 20,( +ParserData.MlyValue.OPENSQB (fn () => i),p1,p2)) +fun CLOSESQB (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 21,( +ParserData.MlyValue.CLOSESQB (fn () => i),p1,p2)) +fun UNION (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 22,( +ParserData.MlyValue.UNION (fn () => i),p1,p2)) +fun PROTOCOL (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 23,( +ParserData.MlyValue.PROTOCOL (fn () => i),p1,p2)) +fun KNOWLEDGE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 24,( +ParserData.MlyValue.KNOWLEDGE (fn () => i),p1,p2)) +fun WHERE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 25,( +ParserData.MlyValue.WHERE (fn () => i),p1,p2)) +fun ACTIONS (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 26,( +ParserData.MlyValue.ACTIONS (fn () => i),p1,p2)) +fun ABSTRACTION (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 27,( +ParserData.MlyValue.ABSTRACTION (fn () => i),p1,p2)) +fun GOALS (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 28,( +ParserData.MlyValue.GOALS (fn () => i),p1,p2)) +fun AUTHENTICATES (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 29,( +ParserData.MlyValue.AUTHENTICATES (fn () => i),p1,p2)) +fun WEAKLY (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 30,( +ParserData.MlyValue.WEAKLY (fn () => i),p1,p2)) +fun ON (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 31,( +ParserData.MlyValue.ON (fn () => i),p1,p2)) +fun TSECRET (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 32,( +ParserData.MlyValue.TSECRET (fn () => i),p1,p2)) +fun TBETWEEN (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 33,( +ParserData.MlyValue.TBETWEEN (fn () => i),p1,p2)) +fun Sets (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 34,( +ParserData.MlyValue.Sets (fn () => i),p1,p2)) +fun FUNCTIONS (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 35,( +ParserData.MlyValue.FUNCTIONS (fn () => i),p1,p2)) +fun PUBLIC (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 36,( +ParserData.MlyValue.PUBLIC (fn () => i),p1,p2)) +fun PRIVATE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 37,( +ParserData.MlyValue.PRIVATE (fn () => i),p1,p2)) +fun RECEIVE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 38,( +ParserData.MlyValue.RECEIVE (fn () => i),p1,p2)) +fun SEND (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 39,( +ParserData.MlyValue.SEND (fn () => i),p1,p2)) +fun IN (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 40,( +ParserData.MlyValue.IN (fn () => i),p1,p2)) +fun NOTIN (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 41,( +ParserData.MlyValue.NOTIN (fn () => i),p1,p2)) +fun INSERT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 42,( +ParserData.MlyValue.INSERT (fn () => i),p1,p2)) +fun DELETE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 43,( +ParserData.MlyValue.DELETE (fn () => i),p1,p2)) +fun NEW (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 44,( +ParserData.MlyValue.NEW (fn () => i),p1,p2)) +fun ATTACK (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 45,( +ParserData.MlyValue.ATTACK (fn () => i),p1,p2)) +fun slash (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 46,( +ParserData.MlyValue.slash (fn () => i),p1,p2)) +fun QUESTION (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 47,( +ParserData.MlyValue.QUESTION (fn () => i),p1,p2)) +fun equal (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 48,( +ParserData.MlyValue.equal (fn () => i),p1,p2)) +fun TYPES (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 49,( +ParserData.MlyValue.TYPES (fn () => i),p1,p2)) +fun SETS (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 50,( +ParserData.MlyValue.SETS (fn () => i),p1,p2)) +fun ARROW (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 51,( +ParserData.MlyValue.ARROW (fn () => i),p1,p2)) +fun ANALYSIS (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 52,( +ParserData.MlyValue.ANALYSIS (fn () => i),p1,p2)) +fun TRANSACTIONS (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 53,( +ParserData.MlyValue.TRANSACTIONS (fn () => i),p1,p2)) +fun STRING_LITERAL (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 54,( +ParserData.MlyValue.STRING_LITERAL (fn () => i),p1,p2)) +fun UPPER_STRING_LITERAL (i,p1,p2) = Token.TOKEN ( +ParserData.LrTable.T 55,(ParserData.MlyValue.UPPER_STRING_LITERAL + (fn () => i),p1,p2)) +fun LOWER_STRING_LITERAL (i,p1,p2) = Token.TOKEN ( +ParserData.LrTable.T 56,(ParserData.MlyValue.LOWER_STRING_LITERAL + (fn () => i),p1,p2)) +fun UNDERSCORE (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 57,( +ParserData.MlyValue.UNDERSCORE (fn () => i),p1,p2)) +fun INTEGER_LITERAL (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 58,( +ParserData.MlyValue.INTEGER_LITERAL (fn () => i),p1,p2)) +fun STAR (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 59,( +ParserData.MlyValue.STAR (fn () => i),p1,p2)) +fun OF (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 60,( +ParserData.MlyValue.OF (fn () => i),p1,p2)) +end +end diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex @@ -0,0 +1,139 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +structure Tokens = Tokens +open TracProtocol + +type pos = int * int * int +type svalue = Tokens.svalue + +type ('a,'b) token = ('a,'b) Tokens.token +type lexresult= (svalue,pos) token + + +val pos = ref (0,0,0) + + fun eof () = Tokens.EOF((!pos,!pos)) + fun error (e,p : (int * int * int),_) = TextIO.output (TextIO.stdOut, + String.concat[ + "Line ", (Int.toString (#1 p)), "/", + (Int.toString (#2 p - #3 p)),": ", e, "\n" + ]) + + fun inputPos yypos = ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))), + (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))) + fun inputPos_half yypos = (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))) + + + +%% +%header (functor TracTransactionLexFun(structure Tokens: TracTransaction_TOKENS)); +alpha=[A-Za-z_]; +upper=[A-Z]; +lower=[a-z]; +digit=[0-9]; +ws = [\ \t]; +%% + +\n => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos ); lex()); +{ws}+ => (pos := (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))); lex()); + +(#)[^\n]*\n => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos ); lex()); + +"/*""/"*([^*/]|[^*]"/"|"*"[^/])*"*"*"*/" => (lex()); + +"(" => (Tokens.OPENP(yytext,inputPos_half yypos,inputPos_half yypos)); +")" => (Tokens.CLOSEP(yytext,inputPos_half yypos,inputPos_half yypos)); +"{" => (Tokens.OPENB(yytext,inputPos_half yypos,inputPos_half yypos)); +"}" => (Tokens.CLOSEB(yytext,inputPos_half yypos,inputPos_half yypos)); +"{|" => (Tokens.OPENSCRYPT(yytext,inputPos_half yypos,inputPos_half yypos)); +"|}" => (Tokens.CLOSESCRYPT(yytext,inputPos_half yypos,inputPos_half yypos)); +":" => (Tokens.COLON(yytext,inputPos_half yypos,inputPos_half yypos)); +";" => (Tokens.SEMICOLON(yytext,inputPos_half yypos,inputPos_half yypos)); +"->" => (Tokens.ARROW(yytext,inputPos_half yypos,inputPos_half yypos)); +"%" => (Tokens.PERCENT(yytext,inputPos_half yypos,inputPos_half yypos)); +"!=" => (Tokens.UNEQUAL(yytext,inputPos_half yypos,inputPos_half yypos)); +"!" => (Tokens.EXCLAM (yytext,inputPos_half yypos,inputPos_half yypos)); +"." => (Tokens.DOT(yytext,inputPos_half yypos,inputPos_half yypos)); +"," => (Tokens.COMMA(yytext,inputPos_half yypos,inputPos_half yypos)); +"[" => (Tokens.OPENSQB(yytext,inputPos_half yypos,inputPos_half yypos)); +"]" => (Tokens.CLOSESQB(yytext,inputPos_half yypos,inputPos_half yypos)); +"++" => (Tokens.UNION(yytext,inputPos_half yypos,inputPos_half yypos)); +"Protocol" => (Tokens.PROTOCOL(yytext,inputPos_half yypos,inputPos_half yypos)); +"Knowledge" => (Tokens.KNOWLEDGE(yytext,inputPos_half yypos,inputPos_half yypos)); +"where" => (Tokens.WHERE(yytext,inputPos_half yypos,inputPos_half yypos)); +"Types" => (Tokens.TYPES(yytext,inputPos_half yypos,inputPos_half yypos)); +"Actions" => (Tokens.ACTIONS(yytext,inputPos_half yypos,inputPos_half yypos)); +"Abstraction" => (Tokens.ABSTRACTION(yytext,inputPos_half yypos,inputPos_half yypos)); +"Goals" => (Tokens.GOALS(yytext,inputPos_half yypos,inputPos_half yypos)); +"authenticates" => (Tokens.AUTHENTICATES(yytext,inputPos_half yypos,inputPos_half yypos)); +"weakly" => (Tokens.WEAKLY(yytext,inputPos_half yypos,inputPos_half yypos)); +"on" => (Tokens.ON(yytext,inputPos_half yypos,inputPos_half yypos)); +"secret" => (Tokens.TSECRET(yytext,inputPos_half yypos,inputPos_half yypos)); +"between" => (Tokens.TBETWEEN(yytext,inputPos_half yypos,inputPos_half yypos)); +"Sets" => (Tokens.SETS(yytext,inputPos_half yypos,inputPos_half yypos)); +"Functions" => (Tokens.FUNCTIONS(yytext,inputPos_half yypos,inputPos_half yypos)); +"Public" => (Tokens.PUBLIC(yytext,inputPos_half yypos,inputPos_half yypos)); +"Private" => (Tokens.PRIVATE(yytext,inputPos_half yypos,inputPos_half yypos)); +"Analysis" => (Tokens.ANALYSIS(yytext,inputPos_half yypos,inputPos_half yypos)); +"Transactions" => (Tokens.TRANSACTIONS(yytext,inputPos_half yypos,inputPos_half yypos)); +"receive" => (Tokens.RECEIVE(yytext,inputPos_half yypos,inputPos_half yypos)); +"send" => (Tokens.SEND(yytext,inputPos_half yypos,inputPos_half yypos)); +"in" => (Tokens.IN(yytext,inputPos_half yypos,inputPos_half yypos)); +"notin" => (Tokens.NOTIN(yytext,inputPos_half yypos,inputPos_half yypos)); +"insert" => (Tokens.INSERT(yytext,inputPos_half yypos,inputPos_half yypos)); +"delete" => (Tokens.DELETE(yytext,inputPos_half yypos,inputPos_half yypos)); +"new" => (Tokens.NEW(yytext,inputPos_half yypos,inputPos_half yypos)); +"attack" => (Tokens.ATTACK(yytext,inputPos_half yypos,inputPos_half yypos)); +"/" => (Tokens.slash(yytext,inputPos_half yypos,inputPos_half yypos)); +"?" => (Tokens.QUESTION(yytext,inputPos_half yypos,inputPos_half yypos)); +"=" => (Tokens.equal(yytext,inputPos_half yypos,inputPos_half yypos)); +"_" => (Tokens.UNDERSCORE(yytext,inputPos_half yypos,inputPos_half yypos)); +"*" => (Tokens.STAR(yytext,inputPos_half yypos,inputPos_half yypos)); +"of" => (Tokens.OF(yytext,inputPos_half yypos,inputPos_half yypos)); + + +{digit}+ => (Tokens.INTEGER_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos)); +"'"({alpha}|{ws}|{digit})*(("."|"_"|"/"|"-")*({alpha}|{ws}|{digit})*)*"'" => (Tokens.STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos)); +{lower}({alpha}|{digit})*("'")* => (Tokens.LOWER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos)); +{upper}({alpha}|{digit})*("'")* => (Tokens.UPPER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos)); + + +. => (error ("ignoring bad character "^yytext, + ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))), + ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))))); + lex()); diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex.sml b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex.sml new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex.sml @@ -0,0 +1,2131 @@ + (***** GENERATED FILE -- DO NOT EDIT ****) +functor TracTransactionLexFun(structure Tokens: TracTransaction_TOKENS)= + struct + structure UserDeclarations = + struct +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +structure Tokens = Tokens +open TracProtocol + +type pos = int * int * int +type svalue = Tokens.svalue + +type ('a,'b) token = ('a,'b) Tokens.token +type lexresult= (svalue,pos) token + + +val pos = Unsynchronized.ref (0,0,0) + + fun eof () = Tokens.EOF((!pos,!pos)) + fun error (e,p : (int * int * int),_) = TextIO.output (TextIO.stdOut, + String.concat[ + "Line ", (Int.toString (#1 p)), "/", + (Int.toString (#2 p - #3 p)),": ", e, "\n" + ]) + + fun inputPos yypos = ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))), + (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))) + fun inputPos_half yypos = (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))) + + + +end (* end of user routines *) +exception LexError (* raised if illegal leaf action tried *) +structure Internal = + struct + +datatype yyfinstate = N of int +type statedata = {fin : yyfinstate list, trans: string} +(* transition & final state table *) +val tab = let +val s = [ + (0, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (1, +"\003\003\003\003\003\003\003\003\003\210\212\003\003\003\003\003\ +\\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\ +\\210\208\003\205\003\204\003\200\199\198\197\195\194\192\191\181\ +\\179\179\179\179\179\179\179\179\179\179\178\177\003\176\003\175\ +\\003\151\087\087\087\087\142\137\087\087\087\128\087\087\087\087\ +\\110\087\087\106\090\087\087\087\087\087\087\086\003\085\003\084\ +\\003\066\059\009\053\009\009\009\009\047\009\009\009\009\040\037\ +\\009\009\030\022\009\009\009\012\009\009\009\007\005\004\003\003\ +\\003" +), + (5, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\000\ +\\000" +), + (7, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\ +\\000" +), + (9, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (11, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (12, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\017\010\010\013\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (13, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\014\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (14, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\015\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (15, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\016\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (17, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\018\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (18, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\019\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (19, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\020\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (20, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\021\010\000\000\000\000\000\ +\\000" +), + (22, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\023\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (23, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\026\010\010\010\010\010\010\010\010\010\010\024\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (24, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\025\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (26, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\027\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (27, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\028\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (28, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\029\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (30, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\031\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (31, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\032\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (32, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\033\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (33, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\034\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (34, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\035\010\010\010\010\000\000\000\000\000\ +\\000" +), + (35, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\036\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (37, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\039\010\010\010\010\010\010\010\038\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (40, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\045\010\010\010\010\010\010\010\010\010\041\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (41, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\042\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (42, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\043\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (43, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\044\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (45, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\046\010\010\010\000\000\000\000\000\ +\\000" +), + (47, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\048\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (48, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\049\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (49, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\050\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (50, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\051\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (51, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\052\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (53, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\054\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (54, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\055\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (55, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\056\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (56, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\057\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (57, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\058\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (59, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\060\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (60, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\061\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (61, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\062\010\010\010\000\000\000\000\000\ +\\000" +), + (62, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\063\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (63, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\064\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (64, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\065\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (66, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\079\067\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (67, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\068\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (68, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\069\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (69, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\070\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (70, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\071\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (71, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\072\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (72, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\073\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (73, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\074\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (74, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\075\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (75, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\076\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (76, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\077\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (77, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\078\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (79, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\080\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (80, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\081\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (81, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\082\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (82, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\ +\\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\000\ +\\000\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\010\ +\\000\010\010\010\010\010\010\010\010\010\010\083\010\010\010\010\ +\\010\010\010\010\010\010\010\010\010\010\010\000\000\000\000\000\ +\\000" +), + (87, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (89, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (90, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\095\088\088\088\088\088\088\091\088\000\000\000\000\000\ +\\000" +), + (91, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\092\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (92, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\093\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (93, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\094\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (95, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\096\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (96, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\097\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (97, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\098\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (98, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\099\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (99, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\100\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (100, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\101\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (101, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\102\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (102, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\103\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (103, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\104\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (104, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\105\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (106, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\107\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (107, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\108\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (108, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\109\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (110, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\116\088\088\111\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (111, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\112\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (112, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\113\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (113, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\114\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (114, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\115\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (116, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\123\088\088\088\088\088\117\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (117, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\118\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (118, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\119\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (119, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\120\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (120, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\121\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (121, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\122\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (123, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\124\088\088\088\088\000\000\000\000\000\ +\\000" +), + (124, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\125\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (125, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\126\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (126, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\127\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (128, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\129\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (129, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\130\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (130, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\131\088\088\088\000\000\000\000\000\ +\\000" +), + (131, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\132\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (132, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\133\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (133, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\134\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (134, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\135\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (135, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\136\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (137, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\138\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (138, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\139\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (139, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\140\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (140, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\141\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (142, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\143\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (143, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\144\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (144, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\145\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (145, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\146\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (146, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\147\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (147, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\148\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (148, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\149\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (149, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\150\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (151, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\165\159\088\088\088\088\088\088\088\088\088\088\152\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (152, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\153\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (153, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\154\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (154, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\155\088\000\000\000\000\000\ +\\000" +), + (155, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\156\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (156, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\157\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (157, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\158\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (159, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\160\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (160, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\161\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (161, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\162\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (162, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\163\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (163, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\164\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (165, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\166\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (166, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\167\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (167, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\168\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (168, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\169\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (169, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\170\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (170, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\171\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (171, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\172\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (172, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\173\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (173, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\089\000\000\000\000\000\000\000\000\ +\\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\000\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\088\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\088\ +\\000\088\088\088\088\088\088\088\088\088\088\088\088\088\174\088\ +\\088\088\088\088\088\088\088\088\088\088\088\000\000\000\000\000\ +\\000" +), + (179, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\180\180\180\180\180\180\180\180\180\180\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (181, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\182\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (182, +"\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\184\183\183\183\183\190\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183" +), + (183, +"\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\184\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183" +), + (184, +"\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\ +\\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\ +\\185\185\185\185\185\185\185\185\185\185\188\185\185\185\185\187\ +\\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\ +\\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\ +\\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\ +\\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\ +\\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\185\ +\\185" +), + (185, +"\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\184\183\183\183\183\186\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183" +), + (186, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\185\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (188, +"\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\184\183\183\183\183\189\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\183\ +\\183" +), + (192, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\193\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (195, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\196\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (200, +"\000\000\000\000\000\000\000\000\000\201\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\201\000\000\000\000\000\000\203\000\000\000\000\000\202\202\202\ +\\201\201\201\201\201\201\201\201\201\201\000\000\000\000\000\000\ +\\000\201\201\201\201\201\201\201\201\201\201\201\201\201\201\201\ +\\201\201\201\201\201\201\201\201\201\201\201\000\000\000\000\201\ +\\000\201\201\201\201\201\201\201\201\201\201\201\201\201\201\201\ +\\201\201\201\201\201\201\201\201\201\201\201\000\000\000\000\000\ +\\000" +), + (202, +"\000\000\000\000\000\000\000\000\000\202\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\202\000\000\000\000\000\000\203\000\000\000\000\000\202\202\202\ +\\202\202\202\202\202\202\202\202\202\202\000\000\000\000\000\000\ +\\000\202\202\202\202\202\202\202\202\202\202\202\202\202\202\202\ +\\202\202\202\202\202\202\202\202\202\202\202\000\000\000\000\202\ +\\000\202\202\202\202\202\202\202\202\202\202\202\202\202\202\202\ +\\202\202\202\202\202\202\202\202\202\202\202\000\000\000\000\000\ +\\000" +), + (205, +"\206\206\206\206\206\206\206\206\206\206\207\206\206\206\206\206\ +\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\ +\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\ +\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\ +\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\ +\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\ +\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\ +\\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\206\ +\\206" +), + (208, +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\209\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), + (210, +"\000\000\000\000\000\000\000\000\000\211\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\211\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\\000" +), +(0, "")] +fun f x = x +val s = List.map f (List.rev (tl (List.rev s))) +exception LexHackingError +fun look ((j,x)::r, i: int) = if i = j then x else look(r, i) + | look ([], i) = raise LexHackingError +fun g {fin=x, trans=i} = {fin=x, trans=look(s,i)} +in Vector.fromList(List.map g +[{fin = [], trans = 0}, +{fin = [], trans = 1}, +{fin = [], trans = 1}, +{fin = [(N 295)], trans = 0}, +{fin = [(N 28),(N 295)], trans = 0}, +{fin = [(N 295)], trans = 5}, +{fin = [(N 34)], trans = 0}, +{fin = [(N 26),(N 295)], trans = 7}, +{fin = [(N 31)], trans = 0}, +{fin = [(N 288),(N 295)], trans = 9}, +{fin = [(N 288)], trans = 9}, +{fin = [(N 288)], trans = 11}, +{fin = [(N 288),(N 295)], trans = 12}, +{fin = [(N 288)], trans = 13}, +{fin = [(N 288)], trans = 14}, +{fin = [(N 288)], trans = 15}, +{fin = [(N 84),(N 288)], trans = 9}, +{fin = [(N 288)], trans = 17}, +{fin = [(N 288)], trans = 18}, +{fin = [(N 288)], trans = 19}, +{fin = [(N 288)], trans = 20}, +{fin = [(N 137),(N 288)], trans = 9}, +{fin = [(N 288),(N 295)], trans = 22}, +{fin = [(N 288)], trans = 23}, +{fin = [(N 288)], trans = 24}, +{fin = [(N 220),(N 288)], trans = 9}, +{fin = [(N 288)], trans = 26}, +{fin = [(N 288)], trans = 27}, +{fin = [(N 288)], trans = 28}, +{fin = [(N 147),(N 288)], trans = 9}, +{fin = [(N 288),(N 295)], trans = 30}, +{fin = [(N 288)], trans = 31}, +{fin = [(N 288)], trans = 32}, +{fin = [(N 288)], trans = 33}, +{fin = [(N 288)], trans = 34}, +{fin = [(N 288)], trans = 35}, +{fin = [(N 215),(N 288)], trans = 9}, +{fin = [(N 288),(N 295)], trans = 37}, +{fin = [(N 140),(N 288)], trans = 9}, +{fin = [(N 267),(N 288)], trans = 9}, +{fin = [(N 288),(N 295)], trans = 40}, +{fin = [(N 288)], trans = 41}, +{fin = [(N 288)], trans = 42}, +{fin = [(N 288)], trans = 43}, +{fin = [(N 229),(N 288)], trans = 9}, +{fin = [(N 288)], trans = 45}, +{fin = [(N 247),(N 288)], trans = 9}, +{fin = [(N 288),(N 295)], trans = 47}, +{fin = [(N 223),(N 288)], trans = 48}, +{fin = [(N 288)], trans = 49}, +{fin = [(N 288)], trans = 50}, +{fin = [(N 288)], trans = 51}, +{fin = [(N 236),(N 288)], trans = 9}, +{fin = [(N 288),(N 295)], trans = 53}, +{fin = [(N 288)], trans = 54}, +{fin = [(N 288)], trans = 55}, +{fin = [(N 288)], trans = 56}, +{fin = [(N 288)], trans = 57}, +{fin = [(N 243),(N 288)], trans = 9}, +{fin = [(N 288),(N 295)], trans = 59}, +{fin = [(N 288)], trans = 60}, +{fin = [(N 288)], trans = 61}, +{fin = [(N 288)], trans = 62}, +{fin = [(N 288)], trans = 63}, +{fin = [(N 288)], trans = 64}, +{fin = [(N 155),(N 288)], trans = 9}, +{fin = [(N 288),(N 295)], trans = 66}, +{fin = [(N 288)], trans = 67}, +{fin = [(N 288)], trans = 68}, +{fin = [(N 288)], trans = 69}, +{fin = [(N 288)], trans = 70}, +{fin = [(N 288)], trans = 71}, +{fin = [(N 288)], trans = 72}, +{fin = [(N 288)], trans = 73}, +{fin = [(N 288)], trans = 74}, +{fin = [(N 288)], trans = 75}, +{fin = [(N 288)], trans = 76}, +{fin = [(N 288)], trans = 77}, +{fin = [(N 130),(N 288)], trans = 9}, +{fin = [(N 288)], trans = 79}, +{fin = [(N 288)], trans = 80}, +{fin = [(N 288)], trans = 81}, +{fin = [(N 288)], trans = 82}, +{fin = [(N 254),(N 288)], trans = 9}, +{fin = [(N 262),(N 295)], trans = 0}, +{fin = [(N 56),(N 295)], trans = 0}, +{fin = [(N 54),(N 295)], trans = 0}, +{fin = [(N 293),(N 295)], trans = 87}, +{fin = [(N 293)], trans = 87}, +{fin = [(N 293)], trans = 89}, +{fin = [(N 293),(N 295)], trans = 90}, +{fin = [(N 293)], trans = 91}, +{fin = [(N 293)], trans = 92}, +{fin = [(N 293)], trans = 93}, +{fin = [(N 90),(N 293)], trans = 87}, +{fin = [(N 293)], trans = 95}, +{fin = [(N 293)], trans = 96}, +{fin = [(N 293)], trans = 97}, +{fin = [(N 293)], trans = 98}, +{fin = [(N 293)], trans = 99}, +{fin = [(N 293)], trans = 100}, +{fin = [(N 293)], trans = 101}, +{fin = [(N 293)], trans = 102}, +{fin = [(N 293)], trans = 103}, +{fin = [(N 293)], trans = 104}, +{fin = [(N 207),(N 293)], trans = 87}, +{fin = [(N 293),(N 295)], trans = 106}, +{fin = [(N 293)], trans = 107}, +{fin = [(N 293)], trans = 108}, +{fin = [(N 160),(N 293)], trans = 87}, +{fin = [(N 293),(N 295)], trans = 110}, +{fin = [(N 293)], trans = 111}, +{fin = [(N 293)], trans = 112}, +{fin = [(N 293)], trans = 113}, +{fin = [(N 293)], trans = 114}, +{fin = [(N 177),(N 293)], trans = 87}, +{fin = [(N 293)], trans = 116}, +{fin = [(N 293)], trans = 117}, +{fin = [(N 293)], trans = 118}, +{fin = [(N 293)], trans = 119}, +{fin = [(N 293)], trans = 120}, +{fin = [(N 293)], trans = 121}, +{fin = [(N 68),(N 293)], trans = 87}, +{fin = [(N 293)], trans = 123}, +{fin = [(N 293)], trans = 124}, +{fin = [(N 293)], trans = 125}, +{fin = [(N 293)], trans = 126}, +{fin = [(N 185),(N 293)], trans = 87}, +{fin = [(N 293),(N 295)], trans = 128}, +{fin = [(N 293)], trans = 129}, +{fin = [(N 293)], trans = 130}, +{fin = [(N 293)], trans = 131}, +{fin = [(N 293)], trans = 132}, +{fin = [(N 293)], trans = 133}, +{fin = [(N 293)], trans = 134}, +{fin = [(N 293)], trans = 135}, +{fin = [(N 78),(N 293)], trans = 87}, +{fin = [(N 293),(N 295)], trans = 137}, +{fin = [(N 293)], trans = 138}, +{fin = [(N 293)], trans = 139}, +{fin = [(N 293)], trans = 140}, +{fin = [(N 116),(N 293)], trans = 87}, +{fin = [(N 293),(N 295)], trans = 142}, +{fin = [(N 293)], trans = 143}, +{fin = [(N 293)], trans = 144}, +{fin = [(N 293)], trans = 145}, +{fin = [(N 293)], trans = 146}, +{fin = [(N 293)], trans = 147}, +{fin = [(N 293)], trans = 148}, +{fin = [(N 293)], trans = 149}, +{fin = [(N 170),(N 293)], trans = 87}, +{fin = [(N 293),(N 295)], trans = 151}, +{fin = [(N 293)], trans = 152}, +{fin = [(N 293)], trans = 153}, +{fin = [(N 293)], trans = 154}, +{fin = [(N 293)], trans = 155}, +{fin = [(N 293)], trans = 156}, +{fin = [(N 293)], trans = 157}, +{fin = [(N 194),(N 293)], trans = 87}, +{fin = [(N 293)], trans = 159}, +{fin = [(N 293)], trans = 160}, +{fin = [(N 293)], trans = 161}, +{fin = [(N 293)], trans = 162}, +{fin = [(N 293)], trans = 163}, +{fin = [(N 98),(N 293)], trans = 87}, +{fin = [(N 293)], trans = 165}, +{fin = [(N 293)], trans = 166}, +{fin = [(N 293)], trans = 167}, +{fin = [(N 293)], trans = 168}, +{fin = [(N 293)], trans = 169}, +{fin = [(N 293)], trans = 170}, +{fin = [(N 293)], trans = 171}, +{fin = [(N 293)], trans = 172}, +{fin = [(N 293)], trans = 173}, +{fin = [(N 110),(N 293)], trans = 87}, +{fin = [(N 258),(N 295)], trans = 0}, +{fin = [(N 260),(N 295)], trans = 0}, +{fin = [(N 38),(N 295)], trans = 0}, +{fin = [(N 36),(N 295)], trans = 0}, +{fin = [(N 270),(N 295)], trans = 179}, +{fin = [(N 270)], trans = 179}, +{fin = [(N 256),(N 295)], trans = 181}, +{fin = [], trans = 182}, +{fin = [], trans = 183}, +{fin = [], trans = 184}, +{fin = [], trans = 185}, +{fin = [], trans = 186}, +{fin = [(N 20)], trans = 0}, +{fin = [], trans = 188}, +{fin = [(N 20)], trans = 186}, +{fin = [], trans = 182}, +{fin = [(N 50),(N 295)], trans = 0}, +{fin = [(N 295)], trans = 192}, +{fin = [(N 41)], trans = 0}, +{fin = [(N 52),(N 295)], trans = 0}, +{fin = [(N 295)], trans = 195}, +{fin = [(N 59)], trans = 0}, +{fin = [(N 264),(N 295)], trans = 0}, +{fin = [(N 24),(N 295)], trans = 0}, +{fin = [(N 22),(N 295)], trans = 0}, +{fin = [(N 295)], trans = 200}, +{fin = [], trans = 200}, +{fin = [], trans = 202}, +{fin = [(N 283)], trans = 0}, +{fin = [(N 43),(N 295)], trans = 0}, +{fin = [(N 295)], trans = 205}, +{fin = [], trans = 205}, +{fin = [(N 8)], trans = 0}, +{fin = [(N 48),(N 295)], trans = 208}, +{fin = [(N 46)], trans = 0}, +{fin = [(N 4),(N 295)], trans = 210}, +{fin = [(N 4)], trans = 210}, +{fin = [(N 1)], trans = 0}]) +end +structure StartStates = + struct + datatype yystartstate = STARTSTATE of int + +(* start state definitions *) + +val INITIAL = STARTSTATE 1; + +end +type result = UserDeclarations.lexresult + exception LexerError (* raised if illegal leaf action tried *) +end + +fun makeLexer yyinput = +let val yygone0=1 + val yyb = Unsynchronized.ref "\n" (* buffer *) + val yybl = Unsynchronized.ref 1 (*buffer length *) + val yybufpos = Unsynchronized.ref 1 (* location of next character to use *) + val yygone = Unsynchronized.ref yygone0 (* position in file of beginning of buffer *) + val yydone = Unsynchronized.ref false (* eof found yet? *) + val yybegin = Unsynchronized.ref 1 (*Current 'start state' for lexer *) + + val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) => + yybegin := x + +fun lex () : Internal.result = +let fun continue() = lex() in + let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0) = + let fun action (i,nil) = raise LexError + | action (i,nil::l) = action (i-1,l) + | action (i,(node::acts)::l) = + case node of + Internal.N yyk => + (let fun yymktext() = String.substring(!yyb,i0,i-i0) + val yypos = i0+ !yygone + open UserDeclarations Internal.StartStates + in (yybufpos := i; case yyk of + + (* Application actions *) + + 1 => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos ); lex()) +| 110 => let val yytext=yymktext() in Tokens.ABSTRACTION(yytext,inputPos_half yypos,inputPos_half yypos) end +| 116 => let val yytext=yymktext() in Tokens.GOALS(yytext,inputPos_half yypos,inputPos_half yypos) end +| 130 => let val yytext=yymktext() in Tokens.AUTHENTICATES(yytext,inputPos_half yypos,inputPos_half yypos) end +| 137 => let val yytext=yymktext() in Tokens.WEAKLY(yytext,inputPos_half yypos,inputPos_half yypos) end +| 140 => let val yytext=yymktext() in Tokens.ON(yytext,inputPos_half yypos,inputPos_half yypos) end +| 147 => let val yytext=yymktext() in Tokens.TSECRET(yytext,inputPos_half yypos,inputPos_half yypos) end +| 155 => let val yytext=yymktext() in Tokens.TBETWEEN(yytext,inputPos_half yypos,inputPos_half yypos) end +| 160 => let val yytext=yymktext() in Tokens.SETS(yytext,inputPos_half yypos,inputPos_half yypos) end +| 170 => let val yytext=yymktext() in Tokens.FUNCTIONS(yytext,inputPos_half yypos,inputPos_half yypos) end +| 177 => let val yytext=yymktext() in Tokens.PUBLIC(yytext,inputPos_half yypos,inputPos_half yypos) end +| 185 => let val yytext=yymktext() in Tokens.PRIVATE(yytext,inputPos_half yypos,inputPos_half yypos) end +| 194 => let val yytext=yymktext() in Tokens.ANALYSIS(yytext,inputPos_half yypos,inputPos_half yypos) end +| 20 => (lex()) +| 207 => let val yytext=yymktext() in Tokens.TRANSACTIONS(yytext,inputPos_half yypos,inputPos_half yypos) end +| 215 => let val yytext=yymktext() in Tokens.RECEIVE(yytext,inputPos_half yypos,inputPos_half yypos) end +| 22 => let val yytext=yymktext() in Tokens.OPENP(yytext,inputPos_half yypos,inputPos_half yypos) end +| 220 => let val yytext=yymktext() in Tokens.SEND(yytext,inputPos_half yypos,inputPos_half yypos) end +| 223 => let val yytext=yymktext() in Tokens.IN(yytext,inputPos_half yypos,inputPos_half yypos) end +| 229 => let val yytext=yymktext() in Tokens.NOTIN(yytext,inputPos_half yypos,inputPos_half yypos) end +| 236 => let val yytext=yymktext() in Tokens.INSERT(yytext,inputPos_half yypos,inputPos_half yypos) end +| 24 => let val yytext=yymktext() in Tokens.CLOSEP(yytext,inputPos_half yypos,inputPos_half yypos) end +| 243 => let val yytext=yymktext() in Tokens.DELETE(yytext,inputPos_half yypos,inputPos_half yypos) end +| 247 => let val yytext=yymktext() in Tokens.NEW(yytext,inputPos_half yypos,inputPos_half yypos) end +| 254 => let val yytext=yymktext() in Tokens.ATTACK(yytext,inputPos_half yypos,inputPos_half yypos) end +| 256 => let val yytext=yymktext() in Tokens.slash(yytext,inputPos_half yypos,inputPos_half yypos) end +| 258 => let val yytext=yymktext() in Tokens.QUESTION(yytext,inputPos_half yypos,inputPos_half yypos) end +| 26 => let val yytext=yymktext() in Tokens.OPENB(yytext,inputPos_half yypos,inputPos_half yypos) end +| 260 => let val yytext=yymktext() in Tokens.equal(yytext,inputPos_half yypos,inputPos_half yypos) end +| 262 => let val yytext=yymktext() in Tokens.UNDERSCORE(yytext,inputPos_half yypos,inputPos_half yypos) end +| 264 => let val yytext=yymktext() in Tokens.STAR(yytext,inputPos_half yypos,inputPos_half yypos) end +| 267 => let val yytext=yymktext() in Tokens.OF(yytext,inputPos_half yypos,inputPos_half yypos) end +| 270 => let val yytext=yymktext() in Tokens.INTEGER_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end +| 28 => let val yytext=yymktext() in Tokens.CLOSEB(yytext,inputPos_half yypos,inputPos_half yypos) end +| 283 => let val yytext=yymktext() in Tokens.STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end +| 288 => let val yytext=yymktext() in Tokens.LOWER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end +| 293 => let val yytext=yymktext() in Tokens.UPPER_STRING_LITERAL(yytext,inputPos_half yypos,inputPos_half yypos) end +| 295 => let val yytext=yymktext() in error ("ignoring bad character "^yytext, + ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos)))), + ((#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))))); + lex() end +| 31 => let val yytext=yymktext() in Tokens.OPENSCRYPT(yytext,inputPos_half yypos,inputPos_half yypos) end +| 34 => let val yytext=yymktext() in Tokens.CLOSESCRYPT(yytext,inputPos_half yypos,inputPos_half yypos) end +| 36 => let val yytext=yymktext() in Tokens.COLON(yytext,inputPos_half yypos,inputPos_half yypos) end +| 38 => let val yytext=yymktext() in Tokens.SEMICOLON(yytext,inputPos_half yypos,inputPos_half yypos) end +| 4 => (pos := (#1 (!pos), yypos - (#3(!pos)), (#3 (!pos))); lex()) +| 41 => let val yytext=yymktext() in Tokens.ARROW(yytext,inputPos_half yypos,inputPos_half yypos) end +| 43 => let val yytext=yymktext() in Tokens.PERCENT(yytext,inputPos_half yypos,inputPos_half yypos) end +| 46 => let val yytext=yymktext() in Tokens.UNEQUAL(yytext,inputPos_half yypos,inputPos_half yypos) end +| 48 => let val yytext=yymktext() in Tokens.EXCLAM (yytext,inputPos_half yypos,inputPos_half yypos) end +| 50 => let val yytext=yymktext() in Tokens.DOT(yytext,inputPos_half yypos,inputPos_half yypos) end +| 52 => let val yytext=yymktext() in Tokens.COMMA(yytext,inputPos_half yypos,inputPos_half yypos) end +| 54 => let val yytext=yymktext() in Tokens.OPENSQB(yytext,inputPos_half yypos,inputPos_half yypos) end +| 56 => let val yytext=yymktext() in Tokens.CLOSESQB(yytext,inputPos_half yypos,inputPos_half yypos) end +| 59 => let val yytext=yymktext() in Tokens.UNION(yytext,inputPos_half yypos,inputPos_half yypos) end +| 68 => let val yytext=yymktext() in Tokens.PROTOCOL(yytext,inputPos_half yypos,inputPos_half yypos) end +| 78 => let val yytext=yymktext() in Tokens.KNOWLEDGE(yytext,inputPos_half yypos,inputPos_half yypos) end +| 8 => (pos := ((#1 (!pos)) + 1, yypos - (#3(!pos)),yypos ); lex()) +| 84 => let val yytext=yymktext() in Tokens.WHERE(yytext,inputPos_half yypos,inputPos_half yypos) end +| 90 => let val yytext=yymktext() in Tokens.TYPES(yytext,inputPos_half yypos,inputPos_half yypos) end +| 98 => let val yytext=yymktext() in Tokens.ACTIONS(yytext,inputPos_half yypos,inputPos_half yypos) end +| _ => raise Internal.LexerError + + ) end ) + + val {fin,trans} = Vector.sub(Internal.tab, s) + val NewAcceptingLeaves = fin::AcceptingLeaves + in if l = !yybl then + if trans = #trans(Vector.sub(Internal.tab,0)) + then action(l,NewAcceptingLeaves +) else let val newchars= if !yydone then "" else yyinput 1024 + in if (String.size newchars)=0 + then (yydone := true; + if (l=i0) then UserDeclarations.eof () + else action(l,NewAcceptingLeaves)) + else (if i0=l then yyb := newchars + else yyb := String.substring(!yyb,i0,l-i0)^newchars; + yygone := !yygone+i0; + yybl := String.size (!yyb); + scan (s,AcceptingLeaves,l-i0,0)) + end + else let val NewChar = Char.ord(CharVector.sub(!yyb,l)) + val NewChar = if NewChar<128 then NewChar else 128 + val NewState = Char.ord(CharVector.sub(trans,NewChar)) + in if NewState=0 then action(l,NewAcceptingLeaves) + else scan(NewState,NewAcceptingLeaves,l+1,i0) + end + end +(* + val start= if String.substring(!yyb,!yybufpos-1,1)="\n" +then !yybegin+1 else !yybegin +*) + in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos) + end +end + in lex + end +end diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_protocol_parser.thy b/thys/Automated_Stateful_Protocol_Verification/trac/trac_protocol_parser.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_protocol_parser.thy @@ -0,0 +1,118 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: trac_protocol_parser.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section \Parser for the Trac Format\ +theory + trac_protocol_parser + imports + "trac_term" +begin + +ML_file "trac_parser/trac_protocol.grm.sig" +ML_file "trac_parser/trac_protocol.lex.sml" +ML_file "trac_parser/trac_protocol.grm.sml" + +ML\ +structure TracProtocolParser : sig + val parse_file: string -> TracProtocol.protocol + val parse_str: string -> TracProtocol.protocol +end = +struct + + structure TracLrVals = + TracTransactionLrValsFun(structure Token = LrParser.Token) + + structure TracLex = + TracTransactionLexFun(structure Tokens = TracLrVals.Tokens) + + structure TracParser = + Join(structure LrParser = LrParser + structure ParserData = TracLrVals.ParserData + structure Lex = TracLex) + + fun invoke lexstream = + let fun print_error (s,i:(int * int * int),_) = + error("Error, line .... " ^ (Int.toString (#1 i)) ^"."^(Int.toString (#2 i ))^ ", " ^ s ^ "\n") + in TracParser.parse(0,lexstream,print_error,()) + end + + fun parse_fp lexer = let + val dummyEOF = TracLrVals.Tokens.EOF((0,0,0),(0,0,0)) + fun loop lexer = + let + val _ = (TracLex.UserDeclarations.pos := (0,0,0);()) + val (res,lexer) = invoke lexer + val (nextToken,lexer) = TracParser.Stream.get lexer + in if TracParser.sameToken(nextToken,dummyEOF) then ((),res) + else loop lexer + end + in (#2(loop lexer)) + end + + fun parse_file tracFile = + let + val infile = TextIO.openIn tracFile + val lexer = TracParser.makeLexer (fn _ => case ((TextIO.inputLine) infile) of + SOME s => s + | NONE => "") + in + parse_fp lexer + handle LrParser.ParseError => TracProtocol.empty + end + + fun parse_str str = + let + val parsed = Unsynchronized.ref false + fun input_string _ = if !parsed then "" else (parsed := true ;str) + val lexer = TracParser.makeLexer input_string + in + parse_fp lexer + handle LrParser.ParseError => TracProtocol.empty + end + +end +\ + + +end diff --git a/thys/Automated_Stateful_Protocol_Verification/trac/trac_term.thy b/thys/Automated_Stateful_Protocol_Verification/trac/trac_term.thy new file mode 100644 --- /dev/null +++ b/thys/Automated_Stateful_Protocol_Verification/trac/trac_term.thy @@ -0,0 +1,565 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2020 +(C) Copyright Achim D. Brucker, University of Exeter, 2020 +(C) Copyright Anders Schlichtkrull, DTU, 2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: trac_term.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, University of Exeter + Author: Anders Schlichtkrull, DTU +*) + +section \Abstract Syntax for Trac Terms\ +theory + trac_term + imports + "First_Order_Terms.Term" + "ml_yacc_lib" + (* Alternatively (provides, as a side-effect, ml-yacc-lib): + "HOL-TPTP.TPTP_Parser" + *) +begin +datatype cMsg = cVar "string * string" + | cConst string + | cFun "string * cMsg list" + +ML\ +structure Trac_Utils = +struct + + fun list_find p ts = + let + fun aux _ [] = NONE + | aux n (t::ts) = + if p t + then SOME (t,n) + else aux (n+1) ts + in + aux 0 ts + end + + fun map_prod f (a,b) = (f a, f b) + + + + fun list_product [] = [[]] + | list_product (xs::xss) = + List.concat (map (fn x => map (fn ys => x::ys) (list_product xss)) xs) + + fun list_toString elem_toString xs = + let + fun aux [] = "" + | aux [x] = elem_toString x + | aux (x::y::xs) = elem_toString x ^ ", " ^ aux (y::xs) + in + "[" ^ aux xs ^ "]" + end + + val list_to_str = list_toString (fn x => x) + + fun list_triangle_product _ [] = [] + | list_triangle_product f (x::xs) = map (f x) xs@list_triangle_product f xs + + fun list_subseqs [] = [[]] + | list_subseqs (x::xs) = let val xss = list_subseqs xs in map (cons x) xss@xss end + + fun list_intersect xs ys = + List.exists (fn x => member (op =) ys x) xs orelse + List.exists (fn y => member (op =) xs y) ys + + fun list_partitions xs constrs = + let + val peq = eq_set (op =) + val pseq = eq_set peq + val psseq = eq_set pseq + + fun illegal p q = + let + val pq = union (op =) p q + fun f (a,b) = member (op =) pq a andalso member (op =) pq b + in + List.exists f constrs + end + + fun merges _ [] = [] + | merges q (p::ps) = + if illegal p q then map (cons p) (merges q ps) + else (union (op =) p q::ps)::(map (cons p) (merges q ps)) + + fun merges_all [] = [] + | merges_all (p::ps) = merges p ps@map (cons p) (merges_all ps) + + fun step pss = fold (union pseq) (map merges_all pss) [] + + fun loop pss pssprev = + let val pss' = step pss + in if psseq (pss,pss') then pssprev else loop pss' (union pseq pss' pssprev) + end + + val init = [map single xs] + in + loop init init + end + + fun mk_unique [] = [] + | mk_unique (x::xs) = x::mk_unique(List.filter (fn y => y <> x) xs) + + fun list_rm_pair sel l x = filter (fn e => sel e <> x) l + + fun list_minus list_rm l m = List.foldl (fn (a,b) => list_rm b a) l m + + fun list_upto n = + let + fun aux m = if m >= n then [] else m::aux (m+1) + in + aux 0 + end +end +\ + +ML\ +structure Trac_Term (* : TRAC_TERM *) = +struct +open Trac_Utils +exception TypeError + +type TypeDecl = string * string + +datatype Msg = Var of string + | Const of string + | Fun of string * Msg list + | Attack + +datatype VarType = EnumType of string + | ValueType + | Untyped + +datatype cMsg = cVar of string * VarType + | cConst of string + | cFun of string * cMsg list + | cAttack + | cSet of string * cMsg list + | cAbs of (string * string list) list + | cOccursFact of cMsg + | cPrivFunSec + | cEnum of string + +fun type_of et vt n = + case List.find (fn (v,_) => v = n) et of + SOME (_,t) => EnumType t + | NONE => + if List.exists (fn v => v = n) vt + then ValueType + else Untyped + +fun certifyMsg et vt (Var n) = cVar (n, type_of et vt n) + | certifyMsg _ _ (Const c) = cConst c + | certifyMsg et vt (Fun (f, ts)) = cFun (f, map (certifyMsg et vt) ts) + | certifyMsg _ _ Attack = cAttack + +fun mk_Value_cVar x = cVar (x,ValueType) + +val fv_Msg = + let + fun aux (Var x) = [x] + | aux (Fun (_,ts)) = List.concat (map aux ts) + | aux _ = [] + in + mk_unique o aux + end + +val fv_cMsg = + let + fun aux (cVar x) = [x] + | aux (cFun (_,ts)) = List.concat (map aux ts) + | aux (cSet (_,ts)) = List.concat (map aux ts) + | aux (cOccursFact bs) = aux bs + | aux _ = [] + in + mk_unique o aux + end + +fun subst_apply' (delta:(string * VarType) -> cMsg) (t:cMsg) = + case t of + cVar x => delta x + | cFun (f,ts) => cFun (f, map (subst_apply' delta) ts) + | cSet (s,ts) => cSet (s, map (subst_apply' delta) ts) + | cOccursFact bs => cOccursFact (subst_apply' delta bs) + | c => c + +fun subst_apply (delta:(string * cMsg) list) = + subst_apply' (fn (n,tau) => ( + case List.find (fn x => fst x = n) delta of + SOME x => snd x + | NONE => cVar (n,tau))) +end +\ + +ML\ + +structure TracProtocol (* : TRAC_TERM *) = +struct +open Trac_Utils +datatype type_spec_elem = + Consts of string list +| Union of string list + +fun is_Consts t = case t of Consts _ => true | _ => false +fun the_Consts t = case t of Consts cs => cs | _ => error "Consts" + +type type_spec = (string * type_spec_elem) list +type set_spec = (string * string) + +fun extract_Consts (tspec:type_spec) = + (List.concat o map the_Consts o filter is_Consts o map snd) tspec + +type funT = (string * string) +type fun_spec = {private: funT list, public: funT list} + +type ruleT = (string * string list) * Trac_Term.Msg list * string list +type anaT = ruleT list + +datatype prot_label = LabelN | LabelS + +datatype action = RECEIVE of Trac_Term.Msg + | SEND of Trac_Term.Msg + | IN of Trac_Term.Msg * (string * Trac_Term.Msg list) + | NOTIN of Trac_Term.Msg * (string * Trac_Term.Msg list) + | NOTINANY of Trac_Term.Msg * string + | INSERT of Trac_Term.Msg * (string * Trac_Term.Msg list) + | DELETE of Trac_Term.Msg * (string * Trac_Term.Msg list) + | NEW of string + | ATTACK + +datatype cAction = cReceive of Trac_Term.cMsg + | cSend of Trac_Term.cMsg + | cInequality of Trac_Term.cMsg * Trac_Term.cMsg + | cInSet of Trac_Term.cMsg * Trac_Term.cMsg + | cNotInSet of Trac_Term.cMsg * Trac_Term.cMsg + | cNotInAny of Trac_Term.cMsg * string + | cInsert of Trac_Term.cMsg * Trac_Term.cMsg + | cDelete of Trac_Term.cMsg * Trac_Term.cMsg + | cNew of string + | cAssertAttack + +type transaction_name = string * (string * string) list * (string * string) list + +type transaction={transaction:transaction_name,actions:(prot_label * action) list} + +type cTransaction={ + transaction:transaction_name, + receive_actions:(prot_label * cAction) list, + checksingle_actions:(prot_label * cAction) list, + checkall_actions:(prot_label * cAction) list, + fresh_actions:(prot_label * cAction) list, + update_actions:(prot_label * cAction) list, + send_actions:(prot_label * cAction) list, + attack_actions:(prot_label * cAction) list} + +fun mkTransaction transaction actions = {transaction=transaction, + actions=actions}:transaction + +fun is_RECEIVE a = case a of RECEIVE _ => true | _ => false +fun is_SEND a = case a of SEND _ => true | _ => false +fun is_IN a = case a of IN _ => true | _ => false +fun is_NOTIN a = case a of NOTIN _ => true | _ => false +fun is_NOTINANY a = case a of NOTINANY _ => true | _ => false +fun is_INSERT a = case a of INSERT _ => true | _ => false +fun is_DELETE a = case a of DELETE _ => true | _ => false +fun is_NEW a = case a of NEW _ => true | _ => false +fun is_ATTACK a = case a of ATTACK => true | _ => false + +fun the_RECEIVE a = case a of RECEIVE t => t | _ => error "RECEIVE" +fun the_SEND a = case a of SEND t => t | _ => error "SEND" +fun the_IN a = case a of IN t => t | _ => error "IN" +fun the_NOTIN a = case a of NOTIN t => t | _ => error "NOTIN" +fun the_NOTINANY a = case a of NOTINANY t => t | _ => error "NOTINANY" +fun the_INSERT a = case a of INSERT t => t | _ => error "INSERT" +fun the_DELETE a = case a of DELETE t => t | _ => error "DELETE" +fun the_NEW a = case a of NEW t => t | _ => error "FRESH" + +fun maybe_the_RECEIVE a = case a of RECEIVE t => SOME t | _ => NONE +fun maybe_the_SEND a = case a of SEND t => SOME t | _ => NONE +fun maybe_the_IN a = case a of IN t => SOME t | _ => NONE +fun maybe_the_NOTIN a = case a of NOTIN t => SOME t | _ => NONE +fun maybe_the_NOTINANY a = case a of NOTINANY t => SOME t | _ => NONE +fun maybe_the_INSERT a = case a of INSERT t => SOME t | _ => NONE +fun maybe_the_DELETE a = case a of DELETE t => SOME t | _ => NONE +fun maybe_the_NEW a = case a of NEW t => SOME t | _ => NONE + +fun is_Receive a = case a of cReceive _ => true | _ => false +fun is_Send a = case a of cSend _ => true | _ => false +fun is_Inequality a = case a of cInequality _ => true | _ => false +fun is_InSet a = case a of cInSet _ => true | _ => false +fun is_NotInSet a = case a of cNotInSet _ => true | _ => false +fun is_NotInAny a = case a of cNotInAny _ => true | _ => false +fun is_Insert a = case a of cInsert _ => true | _ => false +fun is_Delete a = case a of cDelete _ => true | _ => false +fun is_Fresh a = case a of cNew _ => true | _ => false +fun is_Attack a = case a of cAssertAttack => true | _ => false + +fun the_Receive a = case a of cReceive t => t | _ => error "Receive" +fun the_Send a = case a of cSend t => t | _ => error "Send" +fun the_Inequality a = case a of cInequality t => t | _ => error "Inequality" +fun the_InSet a = case a of cInSet t => t | _ => error "InSet" +fun the_NotInSet a = case a of cNotInSet t => t | _ => error "NotInSet" +fun the_NotInAny a = case a of cNotInAny t => t | _ => error "NotInAny" +fun the_Insert a = case a of cInsert t => t | _ => error "Insert" +fun the_Delete a = case a of cDelete t => t | _ => error "Delete" +fun the_Fresh a = case a of cNew t => t | _ => error "New" + +fun maybe_the_Receive a = case a of cReceive t => SOME t | _ => NONE +fun maybe_the_Send a = case a of cSend t => SOME t | _ => NONE +fun maybe_the_Inequality a = case a of cInequality t => SOME t | _ => NONE +fun maybe_the_InSet a = case a of cInSet t => SOME t | _ => NONE +fun maybe_the_NotInSet a = case a of cNotInSet t => SOME t | _ => NONE +fun maybe_the_NotInAny a = case a of cNotInAny t => SOME t | _ => NONE +fun maybe_the_Insert a = case a of cInsert t => SOME t | _ => NONE +fun maybe_the_Delete a = case a of cDelete t => SOME t | _ => NONE +fun maybe_the_Fresh a = case a of cNew t => SOME t | _ => NONE + +fun certifyAction et vt (lbl,SEND t) = (lbl,cSend (Trac_Term.certifyMsg et vt t)) + | certifyAction et vt (lbl,RECEIVE t) = (lbl,cReceive (Trac_Term.certifyMsg et vt t)) + | certifyAction et vt (lbl,IN (x,(s,ps))) = (lbl,cInSet + (Trac_Term.certifyMsg et vt x, Trac_Term.cSet (s, map (Trac_Term.certifyMsg et vt) ps))) + | certifyAction et vt (lbl,NOTIN (x,(s,ps))) = (lbl,cNotInSet + (Trac_Term.certifyMsg et vt x, Trac_Term.cSet (s, map (Trac_Term.certifyMsg et vt) ps))) + | certifyAction et vt (lbl,NOTINANY (x,s)) = (lbl,cNotInAny (Trac_Term.certifyMsg et vt x, s)) + | certifyAction et vt (lbl,INSERT (x,(s,ps))) = (lbl,cInsert + (Trac_Term.certifyMsg et vt x, Trac_Term.cSet (s, map (Trac_Term.certifyMsg et vt) ps))) + | certifyAction et vt (lbl,DELETE (x,(s,ps))) = (lbl,cDelete + (Trac_Term.certifyMsg et vt x, Trac_Term.cSet (s, map (Trac_Term.certifyMsg et vt) ps))) + | certifyAction _ _ (lbl,NEW x) = (lbl,cNew x) + | certifyAction _ _ (lbl,ATTACK) = (lbl,cAssertAttack) + +fun certifyTransaction (tr:transaction) = + let + val mk_cOccurs = Trac_Term.cOccursFact + fun mk_Value_cVar x = Trac_Term.cVar (x,Trac_Term.ValueType) + fun mk_cInequality x y = cInequality (mk_Value_cVar x, mk_Value_cVar y) + val mk_cInequalities = list_triangle_product mk_cInequality + + val fresh_vals = map_filter (maybe_the_NEW o snd) (#actions tr) + val decl_vars = map fst (#2 (#transaction tr)) + val neq_constrs = #3 (#transaction tr) + + val _ = if List.exists (fn x => List.exists (fn y => x = y) fresh_vals) decl_vars + orelse List.exists (fn x => List.exists (fn y => x = y) decl_vars) fresh_vals + then error "the fresh and the declared variables must not overlap" + else () + + val _ = case List.find (fn (x,y) => x = y) neq_constrs of + SOME (x,y) => error ("illegal inequality constraint: " ^ x ^ " != " ^ y) + | NONE => () + + val nonfresh_vals = map fst (filter (fn x => snd x = "value") (#2 (#transaction tr))) + val enum_vars = filter (fn x => snd x <> "value") (#2 (#transaction tr)) + + fun lblS t = (LabelS,t) + + val cactions = map (certifyAction enum_vars (nonfresh_vals@fresh_vals)) (#actions tr) + + val nonfresh_occurs = map (lblS o cReceive o mk_cOccurs o mk_Value_cVar) nonfresh_vals + val receives = filter (is_Receive o snd) cactions + val value_inequalities = map lblS (mk_cInequalities nonfresh_vals) + val checksingles = filter (fn (_,a) => is_InSet a orelse is_NotInSet a) cactions + val checkalls = filter (is_NotInAny o snd) cactions + val updates = filter (fn (_,a) => is_Insert a orelse is_Delete a) cactions + val fresh = filter (is_Fresh o snd) cactions + val sends = filter (is_Send o snd) cactions + val fresh_occurs = map (lblS o cSend o mk_cOccurs o mk_Value_cVar) fresh_vals + val attack_signals = filter (is_Attack o snd) cactions + in + {transaction = #transaction tr, + receive_actions = nonfresh_occurs@receives, + checksingle_actions = value_inequalities@checksingles, + checkall_actions = checkalls, + fresh_actions = fresh, + update_actions = updates, + send_actions = sends@fresh_occurs, + attack_actions = attack_signals}:cTransaction + end + +fun subst_apply_action (delta:(string * Trac_Term.cMsg) list) (lbl:prot_label,a:cAction) = + let + val apply = Trac_Term.subst_apply delta + in + case a of + cReceive t => (lbl,cReceive (apply t)) + | cSend t => (lbl,cSend (apply t)) + | cInequality (x,y) => (lbl,cInequality (apply x, apply y)) + | cInSet (x,s) => (lbl,cInSet (apply x, apply s)) + | cNotInSet (x,s) => (lbl,cNotInSet (apply x, apply s)) + | cNotInAny (x,s) => (lbl,cNotInAny (apply x, s)) + | cInsert (x,s) => (lbl,cInsert (apply x, apply s)) + | cDelete (x,s) => (lbl,cDelete (apply x, apply s)) + | cNew x => (lbl,cNew x) + | cAssertAttack => (lbl,cAssertAttack) + end + +fun subst_apply_actions delta = + map (subst_apply_action delta) + + +type protocol = { + name:string + ,type_spec:type_spec + ,set_spec:set_spec list + ,function_spec:fun_spec option + ,analysis_spec:anaT + ,transaction_spec:(string option * transaction list) list + ,fixed_point: (Trac_Term.cMsg list * (string * string list) list list * + ((string * string list) list * (string * string list) list) list) option +} + +exception TypeError + +val fun_empty = { + public=[] + ,private=[] + }:fun_spec + +fun update_fun_public (fun_spec:fun_spec) public = + ({public = public + ,private = #private fun_spec + }):fun_spec + +fun update_fun_private (fun_spec:fun_spec) private = + ({public = #public fun_spec + ,private = private + }):fun_spec + + +val empty={ + name="" + ,type_spec=[] + ,set_spec=[] + ,function_spec=NONE + ,analysis_spec=[] + ,transaction_spec=[] + ,fixed_point = NONE + }:protocol + +fun update_name (protocol_spec:protocol) name = + ({name = name + ,type_spec = #type_spec protocol_spec + ,set_spec = #set_spec protocol_spec + ,function_spec = #function_spec protocol_spec + ,analysis_spec = #analysis_spec protocol_spec + ,transaction_spec = #transaction_spec protocol_spec + ,fixed_point = #fixed_point protocol_spec + }):protocol +fun update_sets (protocol_spec:protocol) set_spec = + ({name = #name protocol_spec + ,type_spec = #type_spec protocol_spec + ,set_spec = + if has_duplicates (op =) (map fst set_spec) + then error "Multiple declarations of the same set family" + else set_spec + ,function_spec = #function_spec protocol_spec + ,analysis_spec = #analysis_spec protocol_spec + ,transaction_spec = #transaction_spec protocol_spec + ,fixed_point = #fixed_point protocol_spec + }):protocol +fun update_type_spec (protocol_spec:protocol) type_spec = + ({name = #name protocol_spec + ,type_spec = + if has_duplicates (op =) (map fst type_spec) + then error "Multiple declarations of the same enumeration type" + else type_spec + ,set_spec = #set_spec protocol_spec + ,function_spec = #function_spec protocol_spec + ,analysis_spec = #analysis_spec protocol_spec + ,transaction_spec = #transaction_spec protocol_spec + ,fixed_point = #fixed_point protocol_spec + }):protocol +fun update_functions (protocol_spec:protocol) function_spec = + ({name = #name protocol_spec + ,type_spec = #type_spec protocol_spec + ,set_spec = #set_spec protocol_spec + ,function_spec = case function_spec of + SOME fs => + if has_duplicates (op =) (map fst ((#public fs)@(#private fs))) + then error "Multiple declarations of the same constant or function symbol" + else SOME fs + | NONE => NONE + ,analysis_spec = #analysis_spec protocol_spec + ,transaction_spec = #transaction_spec protocol_spec + ,fixed_point = #fixed_point protocol_spec + }):protocol +fun update_analysis (protocol_spec:protocol) analysis_spec = + ({name = #name protocol_spec + ,type_spec = #type_spec protocol_spec + ,set_spec = #set_spec protocol_spec + ,function_spec = #function_spec protocol_spec + ,analysis_spec = + if has_duplicates (op =) (map (#1 o #1) analysis_spec) + then error "Multiple analysis rules declared for the same function symbol" + else if List.exists (has_duplicates (op =)) (map (#2 o #1) analysis_spec) + then error "The heads of the analysis rules must be linear terms" + else if let fun f ((_,xs),ts,ys) = + subset (op =) (ys@List.concat (map Trac_Term.fv_Msg ts), xs) + in List.exists (not o f) analysis_spec end + then error "Variables occurring in the body of an analysis rule should also occur in its head" + else analysis_spec + ,transaction_spec = #transaction_spec protocol_spec + ,fixed_point = #fixed_point protocol_spec + }):protocol +fun update_transactions (prot_name:string option) (protocol_spec:protocol) transaction_spec = + ({name = #name protocol_spec + ,type_spec = #type_spec protocol_spec + ,set_spec = #set_spec protocol_spec + ,function_spec = #function_spec protocol_spec + ,analysis_spec = #analysis_spec protocol_spec + ,transaction_spec = (prot_name,transaction_spec)::(#transaction_spec protocol_spec) + ,fixed_point = #fixed_point protocol_spec + }):protocol +fun update_fixed_point (protocol_spec:protocol) fixed_point = + ({name = #name protocol_spec + ,type_spec = #type_spec protocol_spec + ,set_spec = #set_spec protocol_spec + ,function_spec = #function_spec protocol_spec + ,analysis_spec = #analysis_spec protocol_spec + ,transaction_spec = #transaction_spec protocol_spec + ,fixed_point = fixed_point + }):protocol + + +end +\ + + +end diff --git a/thys/ROOTS b/thys/ROOTS --- a/thys/ROOTS +++ b/thys/ROOTS @@ -1,541 +1,543 @@ ADS_Functor AODV Attack_Trees Auto2_HOL Auto2_Imperative_HOL AVL-Trees AWN Abortable_Linearizable_Modules Abs_Int_ITP2012 Abstract-Hoare-Logics Abstract-Rewriting Abstract_Completeness Abstract_Soundness Adaptive_State_Counting Affine_Arithmetic Aggregation_Algebras Akra_Bazzi Algebraic_Numbers Algebraic_VCs Allen_Calculus Amortized_Complexity AnselmGod Applicative_Lifting Approximation_Algorithms Architectural_Design_Patterns Aristotles_Assertoric_Syllogistic Arith_Prog_Rel_Primes ArrowImpossibilityGS AutoFocus-Stream +Automated_Stateful_Protocol_Verification Automatic_Refinement AxiomaticCategoryTheory BDD BNF_Operations Banach_Steinhaus Bell_Numbers_Spivey Berlekamp_Zassenhaus Bernoulli Bertrands_Postulate Bicategory BinarySearchTree Binding_Syntax_Theory Binomial-Heaps Binomial-Queues BNF_CC Bondy Boolean_Expression_Checkers Bounded_Deducibility_Security Buchi_Complementation Budan_Fourier Buffons_Needle Buildings BytecodeLogicJmlTypes C2KA_DistributedSystems CAVA_Automata CAVA_LTL_Modelchecker CCS CISC-Kernel CRDT CYK CakeML CakeML_Codegen Call_Arity Card_Equiv_Relations Card_Multisets Card_Number_Partitions Card_Partitions Cartan_FP Case_Labeling Catalan_Numbers Category Category2 Category3 Cauchy Cayley_Hamilton Certification_Monads Chord_Segments Circus Clean ClockSynchInst Closest_Pair_Points CofGroups Coinductive Coinductive_Languages Collections Comparison_Sort_Lower_Bound Compiling-Exceptions-Correctly Completeness Complete_Non_Orders Complex_Geometry Complx ComponentDependencies ConcurrentGC ConcurrentIMP Concurrent_Ref_Alg Concurrent_Revisions Consensus_Refined Constructive_Cryptography Constructor_Funs Containers CoreC++ Core_DOM Count_Complex_Roots CryptHOL CryptoBasedCompositionalProperties DFS_Framework DPT-SAT-Solver DataRefinementIBP Datatype_Order_Generator Decl_Sem_Fun_PL Decreasing-Diagrams Decreasing-Diagrams-II Deep_Learning Density_Compiler Dependent_SIFUM_Refinement Dependent_SIFUM_Type_Systems Depth-First-Search Derangements Deriving Descartes_Sign_Rule Dict_Construction Differential_Dynamic_Logic Differential_Game_Logic Dijkstra_Shortest_Path Diophantine_Eqns_Lin_Hom Dirichlet_L Dirichlet_Series Discrete_Summation DiscretePricing DiskPaxos DynamicArchitectures Dynamic_Tables E_Transcendental Echelon_Form EdmondsKarp_Maxflow Efficient-Mergesort Elliptic_Curves_Group_Law Encodability_Process_Calculi Epistemic_Logic Ergodic_Theory Error_Function Euler_MacLaurin Euler_Partition Example-Submission Factored_Transition_System_Bounding Farkas FFT FLP FOL-Fitting FOL_Harrison FOL_Seq_Calc1 Falling_Factorial_Sum FeatherweightJava Featherweight_OCL Fermat3_4 FileRefinement FinFun Finger-Trees Finite_Automata_HF First_Order_Terms First_Welfare_Theorem Fishburn_Impossibility Fisher_Yates Flow_Networks Floyd_Warshall Flyspeck-Tame FocusStreamsCaseStudies Forcing Formal_SSA Formula_Derivatives Fourier Free-Boolean-Algebra Free-Groups FunWithFunctions FunWithTilings Functional-Automata Functional_Ordered_Resolution_Prover Furstenberg_Topology GPU_Kernel_PL Gabow_SCC Game_Based_Crypto Gauss-Jordan-Elim-Fun Gauss_Jordan Gauss_Sums Gaussian_Integers GenClock General-Triangle Generalized_Counting_Sort Generic_Deriving Generic_Join GewirthPGCProof Girth_Chromatic GoedelGod Goodstein_Lambda GraphMarkingIBP Graph_Saturation Graph_Theory Green Groebner_Bases Groebner_Macaulay Gromov_Hyperbolicity Group-Ring-Module HOL-CSP HOLCF-Prelude HRB-Slicing Heard_Of Hello_World HereditarilyFinite Hermite Hidden_Markov_Models Higher_Order_Terms Hoare_Time HotelKeyCards Huffman Hybrid_Logic Hybrid_Multi_Lane_Spatial_Logic Hybrid_Systems_VCs HyperCTL IEEE_Floating_Point IMAP-CRDT IMO2019 IMP2 IMP2_Binary_Heap IP_Addresses Imperative_Insertion_Sort Impossible_Geometry Incompleteness Incredible_Proof_Machine Inductive_Confidentiality InfPathElimination InformationFlowSlicing InformationFlowSlicing_Inter Integration Interval_Arithmetic_Word32 Iptables_Semantics Irrational_Series_Erdos_Straus Irrationality_J_Hancl Isabelle_C Isabelle_Meta_Model Jacobson_Basic_Algebra Jinja JinjaThreads JiveDataStoreModel Jordan_Hoelder Jordan_Normal_Form KAD KAT_and_DRA KBPs KD_Tree Key_Agreement_Strong_Adversaries Kleene_Algebra Knot_Theory Knuth_Bendix_Order Knuth_Morris_Pratt Koenigsberg_Friendship Kruskal Kuratowski_Closure_Complement LLL_Basis_Reduction LLL_Factorization LOFT LTL LTL_to_DRA LTL_to_GBA LTL_Master_Theorem LTL_Normal_Form Lam-ml-Normalization LambdaAuth LambdaMu Lambda_Free_KBOs Lambda_Free_RPOs Lambert_W Landau_Symbols Laplace_Transform Latin_Square LatticeProperties Lambda_Free_EPO Launchbury Lazy-Lists-II Lazy_Case Lehmer Lifting_Definition_Option LightweightJava LinearQuantifierElim Linear_Inequalities Linear_Programming Linear_Recurrences Liouville_Numbers List-Index List-Infinite List_Interleaving List_Inversions List_Update LocalLexing Localization_Ring Locally-Nameless-Sigma Lowe_Ontological_Argument Lower_Semicontinuous Lp Lucas_Theorem MFMC_Countable MSO_Regex_Equivalence Markov_Models Marriage Mason_Stothers Matrices_for_ODEs Matrix Matrix_Tensor Matroids Max-Card-Matching Median_Of_Medians_Selection Menger Mersenne_Primes MFODL_Monitor_Optimized MFOTL_Monitor MiniML Minimal_SSA Minkowskis_Theorem Minsky_Machines Modal_Logics_for_NTS Modular_Assembly_Kit_Security Monad_Memo_DP Monad_Normalisation MonoBoolTranAlgebra MonoidalCategory Monomorphic_Monad MuchAdoAboutTwo Multirelations Multi_Party_Computation Myhill-Nerode Name_Carrying_Type_Inference Nat-Interval-Logic Native_Word Nested_Multisets_Ordinals Network_Security_Policy_Verification Neumann_Morgenstern_Utility No_FTL_observers Nominal2 Noninterference_CSP Noninterference_Concurrent_Composition Noninterference_Generic_Unwinding Noninterference_Inductive_Unwinding Noninterference_Ipurge_Unwinding Noninterference_Sequential_Composition NormByEval Nullstellensatz Octonions Open_Induction OpSets Optics Optimal_BST Orbit_Stabiliser Order_Lattice_Props Ordered_Resolution_Prover Ordinal Ordinals_and_Cardinals Ordinary_Differential_Equations PCF PLM Pell POPLmark-deBruijn PSemigroupsConvolution Pairing_Heap Paraconsistency Parity_Game Partial_Function_MR Partial_Order_Reduction Password_Authentication_Protocol Perfect-Number-Thm Perron_Frobenius Pi_Calculus Pi_Transcendental Planarity_Certificates Polynomial_Factorization Polynomial_Interpolation Polynomials Poincare_Bendixson Poincare_Disc Pop_Refinement Posix-Lexing Possibilistic_Noninterference Power_Sum_Polynomials Pratt_Certificate Presburger-Automata Prim_Dijkstra_Simple Prime_Distribution_Elementary Prime_Harmonic_Series Prime_Number_Theorem Priority_Queue_Braun Priority_Search_Trees Probabilistic_Noninterference Probabilistic_Prime_Tests Probabilistic_System_Zoo Probabilistic_Timed_Automata Probabilistic_While Projective_Geometry Program-Conflict-Analysis Promela Proof_Strategy_Language PropResPI Propositional_Proof_Systems Prpu_Maxflow PseudoHoops Psi_Calculi Ptolemys_Theorem QHLProver QR_Decomposition Quantales Quaternions Quick_Sort_Cost RIPEMD-160-SPARK ROBDD RSAPSS Ramsey-Infinite Random_BSTs Randomised_BSTs Random_Graph_Subgraph_Threshold Randomised_Social_Choice Rank_Nullity_Theorem Real_Impl Recursion-Addition Recursion-Theory-I Refine_Imperative_HOL Refine_Monadic RefinementReactive Regex_Equivalence Regular-Sets Regular_Algebras Relation_Algebra Relational-Incorrectness-Logic Rep_Fin_Groups Residuated_Lattices Resolution_FOL Rewriting_Z Ribbon_Proofs Robbins-Conjecture Root_Balanced_Tree Routing Roy_Floyd_Warshall SATSolverVerification SDS_Impossibility SIFPL SIFUM_Type_Systems SPARCv8 Safe_OCL Saturation_Framework Secondary_Sylow Security_Protocol_Refinement Selection_Heap_Sort SenSocialChoice Separata Separation_Algebra Separation_Logic_Imperative_HOL SequentInvertibility Shivers-CFA ShortestPath Show Sigma_Commit_Crypto Signature_Groebner Simpl Simple_Firewall Simplex Skew_Heap Skip_Lists Slicing Sliding_Window_Algorithm Smooth_Manifolds Sort_Encodings Source_Coding_Theorem Special_Function_Bounds Splay_Tree Sqrt_Babylonian Stable_Matching Statecharts +Stateful_Protocol_Composition_and_Typing Stellar_Quorums Stern_Brocot Stewart_Apollonius Stirling_Formula Stochastic_Matrices Stone_Algebras Stone_Kleene_Relation_Algebras Stone_Relation_Algebras Store_Buffer_Reduction Stream-Fusion Stream_Fusion_Code Strong_Security Sturm_Sequences Sturm_Tarski Stuttering_Equivalence Subresultants Subset_Boolean_Algebras SumSquares SuperCalc Surprise_Paradox Symmetric_Polynomials Szpilrajn TESL_Language TLA Tail_Recursive_Functions Tarskis_Geometry Taylor_Models Timed_Automata Topology TortoiseHare Transcendence_Series_Hancl_Rucki Transformer_Semantics Transition_Systems_and_Automata Transitive-Closure Transitive-Closure-II Treaps Tree-Automata Tree_Decomposition Triangle Trie Twelvefold_Way Tycon Types_Tableaus_and_Goedels_God Universal_Turing_Machine UPF UPF_Firewall UpDown_Scheme UTP Valuation VectorSpace VeriComp Verified-Prover VerifyThis2018 VerifyThis2019 Vickrey_Clarke_Groves VolpanoSmith WHATandWHERE_Security WebAssembly Weight_Balanced_Trees Well_Quasi_Orders Winding_Number_Eval WOOT_Strong_Eventual_Consistency Word_Lib WorkerWrapper XML Zeta_Function Zeta_3_Irrational ZFC_in_HOL pGCL diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Examples.thy b/thys/Stateful_Protocol_Composition_and_Typing/Examples.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Examples.thy @@ -0,0 +1,5 @@ +theory Examples + imports "examples/Example_Keyserver" + "examples/Example_TLS" +begin +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Intruder_Deduction.thy b/thys/Stateful_Protocol_Composition_and_Typing/Intruder_Deduction.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Intruder_Deduction.thy @@ -0,0 +1,1200 @@ +(* +(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: Intruder_Deduction.thy + Author: Andreas Viktor Hess, DTU +*) + +section \Dolev-Yao Intruder Model\ +theory Intruder_Deduction +imports Messages More_Unification +begin + +subsection \Syntax for the Intruder Deduction Relations\ +consts INTRUDER_SYNTH::"('f,'v) terms \ ('f,'v) term \ bool" (infix "\\<^sub>c" 50) +consts INTRUDER_DEDUCT::"('f,'v) terms \ ('f,'v) term \ bool" (infix "\" 50) + + +subsection \Intruder Model Locale\ +text \ + The intruder model is parameterized over arbitrary function symbols (e.g, cryptographic operators) + and variables. It requires three functions: + - \arity\ that assigns an arity to each function symbol. + - \public\ that partitions the function symbols into those that will be available to the intruder + and those that will not. + - \Ana\, the analysis interface, that defines how messages can be decomposed (e.g., decryption). +\ +locale intruder_model = + fixes arity :: "'fun \ nat" + and public :: "'fun \ bool" + and Ana :: "('fun,'var) term \ (('fun,'var) term list \ ('fun,'var) term list)" + assumes Ana_keys_fv: "\t K R. Ana t = (K,R) \ fv\<^sub>s\<^sub>e\<^sub>t (set K) \ fv t" + and Ana_keys_wf: "\t k K R f T. + Ana t = (K,R) \ (\g S. Fun g S \ t \ length S = arity g) + \ k \ set K \ Fun f T \ k \ length T = arity f" + and Ana_var[simp]: "\x. Ana (Var x) = ([],[])" + and Ana_fun_subterm: "\f T K R. Ana (Fun f T) = (K,R) \ set R \ set T" + and Ana_subst: "\t \ K R. \Ana t = (K,R); K \ [] \ R \ []\ \ Ana (t \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \,R \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" +begin + +lemma Ana_subterm: assumes "Ana t = (K,T)" shows "set T \ subterms t" +using assms +by (cases t) + (simp add: psubsetI, + metis Ana_fun_subterm Fun_gt_params UN_I term.order_refl + params_subterms psubsetI subset_antisym subset_trans) + +lemma Ana_subterm': "s \ set (snd (Ana t)) \ s \ t" +using Ana_subterm by (cases "Ana t") auto + +lemma Ana_vars: assumes "Ana t = (K,M)" shows "fv\<^sub>s\<^sub>e\<^sub>t (set K) \ fv t" "fv\<^sub>s\<^sub>e\<^sub>t (set M) \ fv t" +by (rule Ana_keys_fv[OF assms]) (use Ana_subterm[OF assms] subtermeq_vars_subset in auto) + +abbreviation \ where "\ \ UNIV::'var set" +abbreviation \n ("\\<^sup>_") where "\\<^sup>n \ {f::'fun. arity f = n}" +abbreviation \npub ("\\<^sub>p\<^sub>u\<^sub>b\<^sup>_") where "\\<^sub>p\<^sub>u\<^sub>b\<^sup>n \ {f. public f} \ \\<^sup>n" +abbreviation \npriv ("\\<^sub>p\<^sub>r\<^sub>i\<^sub>v\<^sup>_") where "\\<^sub>p\<^sub>r\<^sub>i\<^sub>v\<^sup>n \ {f. \public f} \ \\<^sup>n" +abbreviation \\<^sub>p\<^sub>u\<^sub>b where "\\<^sub>p\<^sub>u\<^sub>b \ (\n. \\<^sub>p\<^sub>u\<^sub>b\<^sup>n)" +abbreviation \\<^sub>p\<^sub>r\<^sub>i\<^sub>v where "\\<^sub>p\<^sub>r\<^sub>i\<^sub>v \ (\n. \\<^sub>p\<^sub>r\<^sub>i\<^sub>v\<^sup>n)" +abbreviation \ where "\ \ (\n. \\<^sup>n)" +abbreviation \ where "\ \ \\<^sup>0" +abbreviation \\<^sub>p\<^sub>u\<^sub>b where "\\<^sub>p\<^sub>u\<^sub>b \ {f. public f} \ \" +abbreviation \\<^sub>p\<^sub>r\<^sub>i\<^sub>v where "\\<^sub>p\<^sub>r\<^sub>i\<^sub>v \ {f. \public f} \ \" +abbreviation \\<^sub>f where "\\<^sub>f \ \ - \" +abbreviation \\<^sub>f\<^sub>p\<^sub>u\<^sub>b where "\\<^sub>f\<^sub>p\<^sub>u\<^sub>b \ \\<^sub>f \ \\<^sub>p\<^sub>u\<^sub>b" +abbreviation \\<^sub>f\<^sub>p\<^sub>r\<^sub>i\<^sub>v where "\\<^sub>f\<^sub>p\<^sub>r\<^sub>i\<^sub>v \ \\<^sub>f \ \\<^sub>p\<^sub>r\<^sub>i\<^sub>v" + +lemma disjoint_fun_syms: "\\<^sub>f \ \ = {}" by auto +lemma id_union_univ: "\\<^sub>f \ \ = UNIV" "\ = UNIV" by auto +lemma const_arity_eq_zero[dest]: "c \ \ \ arity c = 0" by simp +lemma const_pub_arity_eq_zero[dest]: "c \ \\<^sub>p\<^sub>u\<^sub>b \ arity c = 0 \ public c" by simp +lemma const_priv_arity_eq_zero[dest]: "c \ \\<^sub>p\<^sub>r\<^sub>i\<^sub>v \ arity c = 0 \ \public c" by simp +lemma fun_arity_gt_zero[dest]: "f \ \\<^sub>f \ arity f > 0" by fastforce +lemma pub_fun_public[dest]: "f \ \\<^sub>f\<^sub>p\<^sub>u\<^sub>b \ public f" by fastforce +lemma pub_fun_arity_gt_zero[dest]: "f \ \\<^sub>f\<^sub>p\<^sub>u\<^sub>b \ arity f > 0" by fastforce + +lemma \\<^sub>f_unfold: "\\<^sub>f = {f::'fun. arity f > 0}" by auto +lemma \_unfold: "\ = {f::'fun. arity f = 0}" by auto +lemma \pub_unfold: "\\<^sub>p\<^sub>u\<^sub>b = {f::'fun. arity f = 0 \ public f}" by auto +lemma \priv_unfold: "\\<^sub>p\<^sub>r\<^sub>i\<^sub>v = {f::'fun. arity f = 0 \ \public f}" by auto +lemma \npub_unfold: "(\\<^sub>p\<^sub>u\<^sub>b\<^sup>n) = {f::'fun. arity f = n \ public f}" by auto +lemma \npriv_unfold: "(\\<^sub>p\<^sub>r\<^sub>i\<^sub>v\<^sup>n) = {f::'fun. arity f = n \ \public f}" by auto +lemma \fpub_unfold: "\\<^sub>f\<^sub>p\<^sub>u\<^sub>b = {f::'fun. arity f > 0 \ public f}" by auto +lemma \fpriv_unfold: "\\<^sub>f\<^sub>p\<^sub>r\<^sub>i\<^sub>v = {f::'fun. arity f > 0 \ \public f}" by auto +lemma \n_m_eq: "\(\\<^sup>n) \ {}; (\\<^sup>n) = (\\<^sup>m)\ \ n = m" by auto + + +subsection \Term Well-formedness\ +definition "wf\<^sub>t\<^sub>r\<^sub>m t \ \f T. Fun f T \ t \ length T = arity f" + +abbreviation "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s T \ \t \ T. wf\<^sub>t\<^sub>r\<^sub>m t" + +lemma Ana_keys_wf': "Ana t = (K,T) \ wf\<^sub>t\<^sub>r\<^sub>m t \ k \ set K \ wf\<^sub>t\<^sub>r\<^sub>m k" +using Ana_keys_wf unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by metis + +lemma wf_trm_Var[simp]: "wf\<^sub>t\<^sub>r\<^sub>m (Var x)" unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by simp + +lemma wf_trm_subst_range_Var[simp]: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" by simp + +lemma wf_trm_subst_range_iff: "(\x. wf\<^sub>t\<^sub>r\<^sub>m (\ x)) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +by force + +lemma wf_trm_subst_rangeD: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ wf\<^sub>t\<^sub>r\<^sub>m (\ x)" +by (metis wf_trm_subst_range_iff) + +lemma wf_trm_subst_rangeI[intro]: + "(\x. wf\<^sub>t\<^sub>r\<^sub>m (\ x)) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +by (metis wf_trm_subst_range_iff) + +lemma wf_trmI[intro]: + assumes "\t. t \ set T \ wf\<^sub>t\<^sub>r\<^sub>m t" "length T = arity f" + shows "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" +using assms unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto + +lemma wf_trm_subterm: "\wf\<^sub>t\<^sub>r\<^sub>m t; s \ t\ \ wf\<^sub>t\<^sub>r\<^sub>m s" +unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (induct t) auto + +lemma wf_trm_subtermeq: + assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "s \ t" + shows "wf\<^sub>t\<^sub>r\<^sub>m s" +proof (cases "s = t") + case False thus "wf\<^sub>t\<^sub>r\<^sub>m s" using assms(2) wf_trm_subterm[OF assms(1)] by simp +qed (metis assms(1)) + +lemma wf_trm_param: + assumes "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" "t \ set T" + shows "wf\<^sub>t\<^sub>r\<^sub>m t" +by (meson assms subtermeqI'' wf_trm_subtermeq) + +lemma wf_trm_param_idx: + assumes "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" + and "i < length T" + shows "wf\<^sub>t\<^sub>r\<^sub>m (T ! i)" +using wf_trm_param[OF assms(1), of "T ! i"] assms(2) +by fastforce + +lemma wf_trm_subst: + assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "wf\<^sub>t\<^sub>r\<^sub>m t = wf\<^sub>t\<^sub>r\<^sub>m (t \ \)" +proof + show "wf\<^sub>t\<^sub>r\<^sub>m t \ wf\<^sub>t\<^sub>r\<^sub>m (t \ \)" + proof (induction t) + case (Fun f T) + hence "\t. t \ set T \ wf\<^sub>t\<^sub>r\<^sub>m t" + by (meson wf\<^sub>t\<^sub>r\<^sub>m_def Fun_param_is_subterm term.order_trans) + hence "\t. t \ set T \ wf\<^sub>t\<^sub>r\<^sub>m (t \ \)" using Fun.IH by auto + moreover have "length (map (\t. t \ \) T) = arity f" + using Fun.prems unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto + ultimately show ?case by fastforce + qed (simp add: wf_trm_subst_rangeD[OF assms]) + + show "wf\<^sub>t\<^sub>r\<^sub>m (t \ \) \ wf\<^sub>t\<^sub>r\<^sub>m t" + proof (induction t) + case (Fun f T) + hence "wf\<^sub>t\<^sub>r\<^sub>m t" when "t \ set (map (\s. s \ \) T)" for t + by (metis that wf\<^sub>t\<^sub>r\<^sub>m_def Fun_param_is_subterm term.order_trans subst_apply_term.simps(2)) + hence "wf\<^sub>t\<^sub>r\<^sub>m t" when "t \ set T" for t using that Fun.IH by auto + moreover have "length (map (\t. t \ \) T) = arity f" + using Fun.prems unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto + ultimately show ?case by fastforce + qed (simp add: assms) +qed + +lemma wf_trm_subst_singleton: + assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" shows "wf\<^sub>t\<^sub>r\<^sub>m (t \ Var(v := t'))" +proof - + have "wf\<^sub>t\<^sub>r\<^sub>m ((Var(v := t')) w)" for w using assms(2) unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by simp + thus ?thesis using assms(1) wf_trm_subst[of "Var(v := t')" t, OF wf_trm_subst_rangeI] by simp +qed + +lemma wf_trm_subst_rm_vars: + assumes "wf\<^sub>t\<^sub>r\<^sub>m (t \ \)" + shows "wf\<^sub>t\<^sub>r\<^sub>m (t \ rm_vars X \)" +using assms +proof (induction t) + case (Fun f T) + have "wf\<^sub>t\<^sub>r\<^sub>m (t \ \)" when "t \ set T" for t + using that wf_trm_param[of f "map (\t. t \ \) T"] Fun.prems + by auto + hence "wf\<^sub>t\<^sub>r\<^sub>m (t \ rm_vars X \)" when "t \ set T" for t using that Fun.IH by simp + moreover have "length T = arity f" using Fun.prems unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto + ultimately show ?case unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto +qed simp + +lemma wf_trm_subst_rm_vars': "wf\<^sub>t\<^sub>r\<^sub>m (\ v) \ wf\<^sub>t\<^sub>r\<^sub>m (rm_vars X \ v)" +by auto + +lemma wf_trms_subst: + assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (M \\<^sub>s\<^sub>e\<^sub>t \)" +by (metis (no_types, lifting) assms imageE wf_trm_subst) + +lemma wf_trms_subst_rm_vars: + assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (M \\<^sub>s\<^sub>e\<^sub>t \)" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (M \\<^sub>s\<^sub>e\<^sub>t rm_vars X \)" +using assms wf_trm_subst_rm_vars by blast + +lemma wf_trms_subst_rm_vars': + assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (rm_vars X \))" +using assms by force + +lemma wf_trms_subst_compose: + assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" +using assms subst_img_comp_subset' wf_trm_subst by blast + +lemma wf_trm_subst_compose: + fixes \::"('fun, 'v) subst" + assumes "wf\<^sub>t\<^sub>r\<^sub>m (\ x)" "\x. wf\<^sub>t\<^sub>r\<^sub>m (\ x)" + shows "wf\<^sub>t\<^sub>r\<^sub>m ((\ \\<^sub>s \) x)" +using wf_trm_subst[of \ "\ x", OF wf_trm_subst_rangeI[OF assms(2)]] assms(1) + subst_subst_compose[of "Var x" \ \] + subst_apply_term.simps(1)[of x \] + subst_apply_term.simps(1)[of x "\ \\<^sub>s \"] +by argo + +lemma wf_trms_Var_range: + assumes "subst_range \ \ range Var" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +using assms by fastforce + +lemma wf_trms_subst_compose_Var_range: + assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + and "subst_range \ \ range Var" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" +using assms wf_trms_subst_compose wf_trms_Var_range by metis+ + +lemma wf_trm_subst_inv: "wf\<^sub>t\<^sub>r\<^sub>m (t \ \) \ wf\<^sub>t\<^sub>r\<^sub>m t" +unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (induct t) auto + +lemma wf_trms_subst_inv: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (M \\<^sub>s\<^sub>e\<^sub>t \) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" +using wf_trm_subst_inv by fast + +lemma wf_trm_subterms: "wf\<^sub>t\<^sub>r\<^sub>m t \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subterms t)" +using wf_trm_subterm by blast + +lemma wf_trms_subterms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subterms\<^sub>s\<^sub>e\<^sub>t M)" +using wf_trm_subterms by blast + +lemma wf_trm_arity: "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T) \ length T = arity f" +unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by blast + +lemma wf_trm_subterm_arity: "wf\<^sub>t\<^sub>r\<^sub>m t \ Fun f T \ t \ length T = arity f" +unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by blast + +lemma unify_list_wf_trm: + assumes "Unification.unify E B = Some U" "\(s,t) \ set E. wf\<^sub>t\<^sub>r\<^sub>m s \ wf\<^sub>t\<^sub>r\<^sub>m t" + and "\(v,t) \ set B. wf\<^sub>t\<^sub>r\<^sub>m t" + shows "\(v,t) \ set U. wf\<^sub>t\<^sub>r\<^sub>m t" +using assms +proof (induction E B arbitrary: U rule: Unification.unify.induct) + case (1 B U) thus ?case by auto +next + case (2 f T g S E B U) + have wf_fun: "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun g S)" using "2.prems"(2) by auto + from "2.prems"(1) obtain E' where *: "decompose (Fun f T) (Fun g S) = Some E'" + and [simp]: "f = g" "length T = length S" "E' = zip T S" + and **: "Unification.unify (E'@E) B = Some U" + by (auto split: option.splits) + hence "t \ Fun f T" "t' \ Fun g S" when "(t,t') \ set E'" for t t' + using that by (metis zip_arg_subterm(1), metis zip_arg_subterm(2)) + hence "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" when "(t,t') \ set E'" for t t' + using wf_trm_subterm wf_fun \f = g\ that by blast+ + thus ?case using "2.IH"[OF * ** _ "2.prems"(3)] "2.prems"(2) by fastforce +next + case (3 v t E B) + hence *: "\(w,x) \ set ((v, t) # B). wf\<^sub>t\<^sub>r\<^sub>m x" + and **: "\(s,t) \ set E. wf\<^sub>t\<^sub>r\<^sub>m s \ wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t" + by auto + + show ?case + proof (cases "t = Var v") + case True thus ?thesis using "3.prems" "3.IH"(1) by auto + next + case False + hence "v \ fv t" using "3.prems"(1) by auto + hence "Unification.unify (subst_list (subst v t) E) ((v, t)#B) = Some U" + using \t \ Var v\ "3.prems"(1) by auto + moreover have "\(s, t) \ set (subst_list (subst v t) E). wf\<^sub>t\<^sub>r\<^sub>m s \ wf\<^sub>t\<^sub>r\<^sub>m t" + using wf_trm_subst_singleton[OF _ \wf\<^sub>t\<^sub>r\<^sub>m t\] "3.prems"(2) + unfolding subst_list_def subst_def by auto + ultimately show ?thesis using "3.IH"(2)[OF \t \ Var v\ \v \ fv t\ _ _ *] by metis + qed +next + case (4 f T v E B U) + hence *: "\(w,x) \ set ((v, Fun f T) # B). wf\<^sub>t\<^sub>r\<^sub>m x" + and **: "\(s,t) \ set E. wf\<^sub>t\<^sub>r\<^sub>m s \ wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" + by auto + + have "v \ fv (Fun f T)" using "4.prems"(1) by force + hence "Unification.unify (subst_list (subst v (Fun f T)) E) ((v, Fun f T)#B) = Some U" + using "4.prems"(1) by auto + moreover have "\(s, t) \ set (subst_list (subst v (Fun f T)) E). wf\<^sub>t\<^sub>r\<^sub>m s \ wf\<^sub>t\<^sub>r\<^sub>m t" + using wf_trm_subst_singleton[OF _ \wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)\] "4.prems"(2) + unfolding subst_list_def subst_def by auto + ultimately show ?case using "4.IH"[OF \v \ fv (Fun f T)\ _ _ *] by metis +qed + +lemma mgu_wf_trm: + assumes "mgu s t = Some \" "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t" + shows "wf\<^sub>t\<^sub>r\<^sub>m (\ v)" +proof - + from assms obtain \' where "subst_of \' = \" "\(v,t) \ set \'. wf\<^sub>t\<^sub>r\<^sub>m t" + using unify_list_wf_trm[of "[(s,t)]" "[]"] by (auto split: option.splits) + thus ?thesis + proof (induction \' arbitrary: \ v rule: List.rev_induct) + case (snoc x \' \ v) + define \ where "\ = subst_of \'" + hence "wf\<^sub>t\<^sub>r\<^sub>m (\ v)" for v using snoc.prems(2) snoc.IH[of \] by fastforce + moreover obtain w t where x: "x = (w,t)" by (metis surj_pair) + hence \: "\ = Var(w := t) \\<^sub>s \" using snoc.prems(1) by (simp add: subst_def \_def) + moreover have "wf\<^sub>t\<^sub>r\<^sub>m t" using snoc.prems(2) x by auto + ultimately show ?case using wf_trm_subst[of _ t] unfolding subst_compose_def by auto + qed (simp add: wf\<^sub>t\<^sub>r\<^sub>m_def) +qed + +lemma mgu_wf_trms: + assumes "mgu s t = Some \" "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +using mgu_wf_trm[OF assms] by simp + +subsection \Definitions: Intruder Deduction Relations\ +text \ + A standard Dolev-Yao intruder. +\ +inductive intruder_deduct::"('fun,'var) terms \ ('fun,'var) term \ bool" +where + Axiom[simp]: "t \ M \ intruder_deduct M t" +| Compose[simp]: "\length T = arity f; public f; \t. t \ set T \ intruder_deduct M t\ + \ intruder_deduct M (Fun f T)" +| Decompose: "\intruder_deduct M t; Ana t = (K, T); \k. k \ set K \ intruder_deduct M k; + t\<^sub>i \ set T\ + \ intruder_deduct M t\<^sub>i" + +text \ + A variant of the intruder relation which limits the intruder to composition only. +\ +inductive intruder_synth::"('fun,'var) terms \ ('fun,'var) term \ bool" +where + AxiomC[simp]: "t \ M \ intruder_synth M t" +| ComposeC[simp]: "\length T = arity f; public f; \t. t \ set T \ intruder_synth M t\ + \ intruder_synth M (Fun f T)" + +adhoc_overloading INTRUDER_DEDUCT intruder_deduct +adhoc_overloading INTRUDER_SYNTH intruder_synth + +lemma intruder_deduct_induct[consumes 1, case_names Axiom Compose Decompose]: + assumes "M \ t" "\t. t \ M \ P M t" + "\T f. \length T = arity f; public f; + \t. t \ set T \ M \ t; + \t. t \ set T \ P M t\ \ P M (Fun f T)" + "\t K T t\<^sub>i. \M \ t; P M t; Ana t = (K, T); \k. k \ set K \ M \ k; + \k. k \ set K \ P M k; t\<^sub>i \ set T\ \ P M t\<^sub>i" + shows "P M t" +using assms by (induct rule: intruder_deduct.induct) blast+ + +lemma intruder_synth_induct[consumes 1, case_names AxiomC ComposeC]: + fixes M::"('fun,'var) terms" and t::"('fun,'var) term" + assumes "M \\<^sub>c t" "\t. t \ M \ P M t" + "\T f. \length T = arity f; public f; + \t. t \ set T \ M \\<^sub>c t; + \t. t \ set T \ P M t\ \ P M (Fun f T)" + shows "P M t" +using assms by (induct rule: intruder_synth.induct) auto + + +subsection \Definitions: Analyzed Knowledge and Public Ground Well-formed Terms (PGWTs)\ +definition analyzed::"('fun,'var) terms \ bool" where + "analyzed M \ \t. M \ t \ M \\<^sub>c t" + +definition analyzed_in where + "analyzed_in t M \ \K R. (Ana t = (K,R) \ (\k \ set K. M \\<^sub>c k)) \ (\r \ set R. M \\<^sub>c r)" + +definition decomp_closure::"('fun,'var) terms \ ('fun,'var) terms \ bool" where + "decomp_closure M M' \ \t. M \ t \ (\t' \ M. t \ t') \ t \ M'" + +inductive public_ground_wf_term::"('fun,'var) term \ bool" where + PGWT[simp]: "\public f; arity f = length T; + \t. t \ set T \ public_ground_wf_term t\ + \ public_ground_wf_term (Fun f T)" + +abbreviation "public_ground_wf_terms \ {t. public_ground_wf_term t}" + +lemma public_const_deduct: + assumes "c \ \\<^sub>p\<^sub>u\<^sub>b" + shows "M \ Fun c []" "M \\<^sub>c Fun c []" +proof - + have "arity c = 0" "public c" using const_arity_eq_zero \c \ \\<^sub>p\<^sub>u\<^sub>b\ by auto + thus "M \ Fun c []" "M \\<^sub>c Fun c []" + using intruder_synth.ComposeC[OF _ \public c\, of "[]"] + intruder_deduct.Compose[OF _ \public c\, of "[]"] + by auto +qed + +lemma public_const_deduct'[simp]: + assumes "arity c = 0" "public c" + shows "M \ Fun c []" "M \\<^sub>c Fun c []" +using intruder_deduct.Compose[of "[]" c] intruder_synth.ComposeC[of "[]" c] assms by simp_all + +lemma private_fun_deduct_in_ik: + assumes t: "M \ t" "Fun f T \ subterms t" + and f: "\public f" + shows "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t M" +using t +proof (induction t rule: intruder_deduct.induct) + case Decompose thus ?case by (meson Ana_subterm psubsetD term.order_trans) +qed (auto simp add: f in_subterms_Union) + +lemma private_fun_deduct_in_ik': + assumes t: "M \ Fun f T" + and f: "\public f" + and M: "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t M \ Fun f T \ M" + shows "Fun f T \ M" +by (rule M[OF private_fun_deduct_in_ik[OF t term.order_refl f]]) + +lemma pgwt_public: "\public_ground_wf_term t; Fun f T \ t\ \ public f" +by (induct t rule: public_ground_wf_term.induct) auto + +lemma pgwt_ground: "public_ground_wf_term t \ fv t = {}" +by (induct t rule: public_ground_wf_term.induct) auto + +lemma pgwt_fun: "public_ground_wf_term t \ \f T. t = Fun f T" +using pgwt_ground[of t] by (cases t) auto + +lemma pgwt_arity: "\public_ground_wf_term t; Fun f T \ t\ \ arity f = length T" +by (induct t rule: public_ground_wf_term.induct) auto + +lemma pgwt_wellformed: "public_ground_wf_term t \ wf\<^sub>t\<^sub>r\<^sub>m t" +by (induct t rule: public_ground_wf_term.induct) auto + +lemma pgwt_deducible: "public_ground_wf_term t \ M \\<^sub>c t" +by (induct t rule: public_ground_wf_term.induct) auto + +lemma pgwt_is_empty_synth: "public_ground_wf_term t \ {} \\<^sub>c t" +proof - + { fix M::"('fun,'var) term set" assume "M \\<^sub>c t" "M = {}" hence "public_ground_wf_term t" + by (induct t rule: intruder_synth.induct) auto + } + thus ?thesis using pgwt_deducible by auto +qed + +lemma ideduct_synth_subst_apply: + fixes M::"('fun,'var) terms" and t::"('fun,'var) term" + assumes "{} \\<^sub>c t" "\v. M \\<^sub>c \ v" + shows "M \\<^sub>c t \ \" +proof - + { fix M'::"('fun,'var) term set" assume "M' \\<^sub>c t" "M' = {}" hence "M \\<^sub>c t \ \" + proof (induction t rule: intruder_synth.induct) + case (ComposeC T f M') + hence "length (map (\t. t \ \) T) = arity f" "\x. x \ set (map (\t. t \ \) T) \ M \\<^sub>c x" + by auto + thus ?case using intruder_synth.ComposeC[of "map (\t. t \ \) T" f M] \public f\ by fastforce + qed simp + } + thus ?thesis using assms by metis +qed + + +subsection \Lemmata: Monotonicity, deduction private constants, etc.\ +context +begin +lemma ideduct_mono: + "\M \ t; M \ M'\ \ M' \ t" +proof (induction rule: intruder_deduct.induct) + case (Decompose M t K T t\<^sub>i) + have "\k. k \ set K \ M' \ k" using Decompose.IH \M \ M'\ by simp + moreover have "M' \ t" using Decompose.IH \M \ M'\ by simp + ultimately show ?case using Decompose.hyps intruder_deduct.Decompose by blast +qed auto + +lemma ideduct_synth_mono: + fixes M::"('fun,'var) terms" and t::"('fun,'var) term" + shows "\M \\<^sub>c t; M \ M'\ \ M' \\<^sub>c t" +by (induct rule: intruder_synth.induct) auto + +lemma ideduct_reduce: + "\M \ M' \ t; \t'. t' \ M' \ M \ t'\ \ M \ t" +proof (induction rule: intruder_deduct_induct) + case Decompose thus ?case using intruder_deduct.Decompose by blast +qed auto + +lemma ideduct_synth_reduce: + fixes M::"('fun,'var) terms" and t::"('fun,'var) term" + shows "\M \ M' \\<^sub>c t; \t'. t' \ M' \ M \\<^sub>c t'\ \ M \\<^sub>c t" +by (induct rule: intruder_synth_induct) auto + +lemma ideduct_mono_eq: + assumes "\t. M \ t \ M' \ t" shows "M \ N \ t \ M' \ N \ t" +proof + show "M \ N \ t \ M' \ N \ t" + proof (induction t rule: intruder_deduct_induct) + case (Axiom t) thus ?case + proof (cases "t \ M") + case True + hence "M \ t" using intruder_deduct.Axiom by metis + thus ?thesis using assms ideduct_mono[of M' t "M' \ N"] by simp + qed auto + next + case (Compose T f) thus ?case using intruder_deduct.Compose by auto + next + case (Decompose t K T t\<^sub>i) thus ?case using intruder_deduct.Decompose[of "M' \ N" t K T] by auto + qed + + show "M' \ N \ t \ M \ N \ t" + proof (induction t rule: intruder_deduct_induct) + case (Axiom t) thus ?case + proof (cases "t \ M'") + case True + hence "M' \ t" using intruder_deduct.Axiom by metis + thus ?thesis using assms ideduct_mono[of M t "M \ N"] by simp + qed auto + next + case (Compose T f) thus ?case using intruder_deduct.Compose by auto + next + case (Decompose t K T t\<^sub>i) thus ?case using intruder_deduct.Decompose[of "M \ N" t K T] by auto + qed +qed + +lemma deduct_synth_subterm: + fixes M::"('fun,'var) terms" and t::"('fun,'var) term" + assumes "M \\<^sub>c t" "s \ subterms t" "\m \ M. \s \ subterms m. M \\<^sub>c s" + shows "M \\<^sub>c s" +using assms by (induct t rule: intruder_synth.induct) auto + +lemma deduct_if_synth[intro, dest]: "M \\<^sub>c t \ M \ t" +by (induct rule: intruder_synth.induct) auto + +private lemma ideduct_ik_eq: assumes "\t \ M. M' \ t" shows "M' \ t \ M' \ M \ t" +by (meson assms ideduct_mono ideduct_reduce sup_ge1) + +private lemma synth_if_deduct_empty: "{} \ t \ {} \\<^sub>c t" +proof (induction t rule: intruder_deduct_induct) + case (Decompose t K M m) + then obtain f T where "t = Fun f T" "m \ set T" + using Ana_fun_subterm Ana_var by (cases t) fastforce+ + with Decompose.IH(1) show ?case by (induction rule: intruder_synth_induct) auto +qed auto + +private lemma ideduct_deduct_synth_mono_eq: + assumes "\t. M \ t \ M' \\<^sub>c t" "M \ M'" + and "\t. M' \ N \ t \ M' \ N \ D \\<^sub>c t" + shows "M \ N \ t \ M' \ N \ D \\<^sub>c t" +proof - + have "\m \ M'. M \ m" using assms(1) by auto + hence "\t. M \ t \ M' \ t" by (metis assms(1,2) deduct_if_synth ideduct_reduce sup.absorb2) + hence "\t. M' \ N \ t \ M \ N \ t" by (meson ideduct_mono_eq) + thus ?thesis by (meson assms(3)) +qed + +lemma ideduct_subst: "M \ t \ M \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" +proof (induction t rule: intruder_deduct_induct) + case (Compose T f) + hence "length (map (\t. t \ \) T) = arity f" "\t. t \ set T \ M \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" by auto + thus ?case using intruder_deduct.Compose[OF _ Compose.hyps(2), of "map (\t. t \ \) T"] by auto +next + case (Decompose t K M' m') + hence "Ana (t \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, M' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" + "\k. k \ set (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \) \ M \\<^sub>s\<^sub>e\<^sub>t \ \ k" + "m' \ \ \ set (M' \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" + using Ana_subst[OF Decompose.hyps(2)] by fastforce+ + thus ?case using intruder_deduct.Decompose[OF Decompose.IH(1)] by metis +qed simp + +lemma ideduct_synth_subst: + fixes M::"('fun,'var) terms" and t::"('fun,'var) term" and \::"('fun,'var) subst" + shows "M \\<^sub>c t \ M \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \" +proof (induction t rule: intruder_synth_induct) + case (ComposeC T f) + hence "length (map (\t. t \ \) T) = arity f" "\t. t \ set T \ M \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \" by auto + thus ?case using intruder_synth.ComposeC[OF _ ComposeC.hyps(2), of "map (\t. t \ \) T"] by auto +qed simp + +lemma ideduct_vars: + assumes "M \ t" + shows "fv t \ fv\<^sub>s\<^sub>e\<^sub>t M" +using assms +proof (induction t rule: intruder_deduct_induct) + case (Decompose t K T t\<^sub>i) thus ?case + using Ana_vars(2) fv_subset by blast +qed auto + +lemma ideduct_synth_vars: + fixes M::"('fun,'var) terms" and t::"('fun,'var) term" + assumes "M \\<^sub>c t" + shows "fv t \ fv\<^sub>s\<^sub>e\<^sub>t M" +using assms by (induct t rule: intruder_synth_induct) auto + +lemma ideduct_synth_priv_fun_in_ik: + fixes M::"('fun,'var) terms" and t::"('fun,'var) term" + assumes "M \\<^sub>c t" "f \ funs_term t" "\public f" + shows "f \ \(funs_term ` M)" +using assms by (induct t rule: intruder_synth_induct) auto + +lemma ideduct_synth_priv_const_in_ik: + fixes M::"('fun,'var) terms" and t::"('fun,'var) term" + assumes "M \\<^sub>c Fun c []" "\public c" + shows "Fun c [] \ M" +using intruder_synth.cases[OF assms(1)] assms(2) by fast + +lemma ideduct_synth_ik_replace: + fixes M::"('fun,'var) terms" and t::"('fun,'var) term" + assumes "\t \ M. N \\<^sub>c t" + and "M \\<^sub>c t" + shows "N \\<^sub>c t" +using assms(2,1) by (induct t rule: intruder_synth.induct) auto +end + +subsection \Lemmata: Analyzed Intruder Knowledge Closure\ +lemma deducts_eq_if_analyzed: "analyzed M \ M \ t \ M \\<^sub>c t" +unfolding analyzed_def by auto + +lemma closure_is_superset: "decomp_closure M M' \ M \ M'" +unfolding decomp_closure_def by force + +lemma deduct_if_closure_deduct: "\M' \ t; decomp_closure M M'\ \ M \ t" +proof (induction t rule: intruder_deduct.induct) + case (Decompose M' t K T t\<^sub>i) + thus ?case using intruder_deduct.Decompose[OF _ \Ana t = (K,T)\ _ \t\<^sub>i \ set T\] by simp +qed (auto simp add: decomp_closure_def) + +lemma deduct_if_closure_synth: "\decomp_closure M M'; M' \\<^sub>c t\ \ M \ t" +using deduct_if_closure_deduct by blast + +lemma decomp_closure_subterms_composable: + assumes "decomp_closure M M'" + and "M' \\<^sub>c t'" "M' \ t" "t \ t'" + shows "M' \\<^sub>c t" +using \M' \\<^sub>c t'\ assms +proof (induction t' rule: intruder_synth.induct) + case (AxiomC t' M') + have "M \ t" using \M' \ t\ deduct_if_closure_deduct AxiomC.prems(1) by blast + moreover + { have "\s \ M. t' \ s" using \t' \ M'\ AxiomC.prems(1) unfolding decomp_closure_def by blast + hence "\s \ M. t \ s" using \t \ t'\ term.order_trans by auto + } + ultimately have "t \ M'" using AxiomC.prems(1) unfolding decomp_closure_def by blast + thus ?case by simp +next + case (ComposeC T f M') + let ?t' = "Fun f T" + { assume "t = ?t'" have "M' \\<^sub>c t" using \M' \\<^sub>c ?t'\ \t = ?t'\ by simp } + moreover + { assume "t \ ?t'" + have "\x \ set T. t \ x" using \t \ ?t'\ \t \ ?t'\ by simp + hence "M' \\<^sub>c t" using ComposeC.IH ComposeC.prems(1,3) ComposeC.hyps(3) by blast + } + ultimately show ?case using cases_simp[of "t = ?t'" "M' \\<^sub>c t"] by simp +qed + +lemma decomp_closure_analyzed: + assumes "decomp_closure M M'" + shows "analyzed M'" +proof - + { fix t assume "M' \ t" have "M' \\<^sub>c t" using \M' \ t\ assms + proof (induction t rule: intruder_deduct.induct) + case (Decompose M' t K T t\<^sub>i) + hence "M' \ t\<^sub>i" using Decompose.hyps intruder_deduct.Decompose by blast + moreover have "t\<^sub>i \ t" + using Decompose.hyps(4) Ana_subterm[OF Decompose.hyps(2)] by blast + moreover have "M' \\<^sub>c t" using Decompose.IH(1) Decompose.prems by blast + ultimately show "M' \\<^sub>c t\<^sub>i" using decomp_closure_subterms_composable Decompose.prems by blast + qed auto + } + moreover have "\t. M \\<^sub>c t \ M \ t" by auto + ultimately show ?thesis by (auto simp add: decomp_closure_def analyzed_def) +qed + +lemma analyzed_if_all_analyzed_in: + assumes M: "\t \ M. analyzed_in t M" + shows "analyzed M" +proof (unfold analyzed_def, intro allI iffI) + fix t + assume t: "M \ t" + thus "M \\<^sub>c t" + proof (induction t rule: intruder_deduct_induct) + case (Decompose t K T t\<^sub>i) + { assume "t \ M" + hence ?case + using M Decompose.IH(2) Decompose.hyps(2,4) + unfolding analyzed_in_def by fastforce + } moreover { + fix f S assume "t = Fun f S" "\s. s \ set S \ M \\<^sub>c s" + hence ?case using Ana_fun_subterm[of f S] Decompose.hyps(2,4) by blast + } ultimately show ?case using intruder_synth.cases[OF Decompose.IH(1), of ?case] by blast + qed simp_all +qed auto + +lemma analyzed_is_all_analyzed_in: + "(\t \ M. analyzed_in t M) \ analyzed M" +proof + show "analyzed M \ \t \ M. analyzed_in t M" + unfolding analyzed_in_def analyzed_def + by (auto intro: intruder_deduct.Decompose[OF intruder_deduct.Axiom]) +qed (rule analyzed_if_all_analyzed_in) + +lemma ik_has_synth_ik_closure: + fixes M :: "('fun,'var) terms" + shows "\M'. (\t. M \ t \ M' \\<^sub>c t) \ decomp_closure M M' \ (finite M \ finite M')" +proof - + let ?M' = "{t. M \ t \ (\t' \ M. t \ t')}" + + have M'_closes: "decomp_closure M ?M'" unfolding decomp_closure_def by simp + hence "M \ ?M'" using closure_is_superset by simp + + have "\t. ?M' \\<^sub>c t \ M \ t" using deduct_if_closure_synth[OF M'_closes] by blast + moreover have "\t. M \ t \ ?M' \ t" using ideduct_mono[OF _ \M \ ?M'\] by simp + moreover have "analyzed ?M'" using decomp_closure_analyzed[OF M'_closes] . + ultimately have "\t. M \ t \ ?M' \\<^sub>c t" unfolding analyzed_def by blast + moreover have "finite M \ finite ?M'" by auto + ultimately show ?thesis using M'_closes by blast +qed + + +subsection \Intruder Variants: Numbered and Composition-Restricted Intruder Deduction Relations\ +text \ + A variant of the intruder relation which restricts composition to only those terms that satisfy + a given predicate Q. +\ +inductive intruder_deduct_restricted:: + "('fun,'var) terms \ (('fun,'var) term \ bool) \ ('fun,'var) term \ bool" + ("\_;_\ \\<^sub>r _" 50) +where + AxiomR[simp]: "t \ M \ \M; Q\ \\<^sub>r t" +| ComposeR[simp]: "\length T = arity f; public f; \t. t \ set T \ \M; Q\ \\<^sub>r t; Q (Fun f T)\ + \ \M; Q\ \\<^sub>r Fun f T" +| DecomposeR: "\\M; Q\ \\<^sub>r t; Ana t = (K, T); \k. k \ set K \ \M; Q\ \\<^sub>r k; t\<^sub>i \ set T\ + \ \M; Q\ \\<^sub>r t\<^sub>i" + +text \ + A variant of the intruder relation equipped with a number representing the heigth of the + derivation tree (i.e., \\M; k\ \\<^sub>n t\ iff k is the maximum number of applications of the compose + an decompose rules in any path of the derivation tree for \M \ t\). +\ +inductive intruder_deduct_num:: + "('fun,'var) terms \ nat \ ('fun,'var) term \ bool" + ("\_; _\ \\<^sub>n _" 50) +where + AxiomN[simp]: "t \ M \ \M; 0\ \\<^sub>n t" +| ComposeN[simp]: "\length T = arity f; public f; \t. t \ set T \ \M; steps t\ \\<^sub>n t\ + \ \M; Suc (Max (insert 0 (steps ` set T)))\ \\<^sub>n Fun f T" +| DecomposeN: "\\M; n\ \\<^sub>n t; Ana t = (K, T); \k. k \ set K \ \M; steps k\ \\<^sub>n k; t\<^sub>i \ set T\ + \ \M; Suc (Max (insert n (steps ` set K)))\ \\<^sub>n t\<^sub>i" + +lemma intruder_deduct_restricted_induct[consumes 1, case_names AxiomR ComposeR DecomposeR]: + assumes "\M; Q\ \\<^sub>r t" "\t. t \ M \ P M Q t" + "\T f. \length T = arity f; public f; + \t. t \ set T \ \M; Q\ \\<^sub>r t; + \t. t \ set T \ P M Q t; Q (Fun f T) + \ \ P M Q (Fun f T)" + "\t K T t\<^sub>i. \\M; Q\ \\<^sub>r t; P M Q t; Ana t = (K, T); \k. k \ set K \ \M; Q\ \\<^sub>r k; + \k. k \ set K \ P M Q k; t\<^sub>i \ set T\ \ P M Q t\<^sub>i" + shows "P M Q t" +using assms by (induct t rule: intruder_deduct_restricted.induct) blast+ + +lemma intruder_deduct_num_induct[consumes 1, case_names AxiomN ComposeN DecomposeN]: + assumes "\M; n\ \\<^sub>n t" "\t. t \ M \ P M 0 t" + "\T f steps. + \length T = arity f; public f; + \t. t \ set T \ \M; steps t\ \\<^sub>n t; + \t. t \ set T \ P M (steps t) t\ + \ P M (Suc (Max (insert 0 (steps ` set T)))) (Fun f T)" + "\t K T t\<^sub>i steps n. + \\M; n\ \\<^sub>n t; P M n t; Ana t = (K, T); + \k. k \ set K \ \M; steps k\ \\<^sub>n k; + t\<^sub>i \ set T; \k. k \ set K \ P M (steps k) k\ + \ P M (Suc (Max (insert n (steps ` set K)))) t\<^sub>i" + shows "P M n t" +using assms by (induct rule: intruder_deduct_num.induct) blast+ + +lemma ideduct_restricted_mono: + "\\M; P\ \\<^sub>r t; M \ M'\ \ \M'; P\ \\<^sub>r t" +proof (induction rule: intruder_deduct_restricted_induct) + case (DecomposeR t K T t\<^sub>i) + have "\k. k \ set K \ \M'; P\ \\<^sub>r k" using DecomposeR.IH \M \ M'\ by simp + moreover have "\M'; P\ \\<^sub>r t" using DecomposeR.IH \M \ M'\ by simp + ultimately show ?case + using DecomposeR + intruder_deduct_restricted.DecomposeR[OF _ DecomposeR.hyps(2) _ DecomposeR.hyps(4)] + by blast +qed auto + + +subsection \Lemmata: Intruder Deduction Equivalences\ +lemma deduct_if_restricted_deduct: "\M;P\ \\<^sub>r m \ M \ m" +proof (induction m rule: intruder_deduct_restricted_induct) + case (DecomposeR t K T t\<^sub>i) thus ?case using intruder_deduct.Decompose by blast +qed simp_all + +lemma restricted_deduct_if_restricted_ik: + assumes "\M;P\ \\<^sub>r m" "\m \ M. P m" + and P: "\t t'. P t \ t' \ t \ P t'" + shows "P m" +using assms(1) +proof (induction m rule: intruder_deduct_restricted_induct) + case (DecomposeR t K T t\<^sub>i) + obtain f S where "t = Fun f S" using Ana_var \t\<^sub>i \ set T\ \Ana t = (K, T)\ by (cases t) auto + thus ?case using DecomposeR assms(2) P Ana_subterm by blast +qed (simp_all add: assms(2)) + +lemma deduct_restricted_if_synth: + assumes P: "P m" "\t t'. P t \ t' \ t \ P t'" + and m: "M \\<^sub>c m" + shows "\M; P\ \\<^sub>r m" +using m P(1) +proof (induction m rule: intruder_synth_induct) + case (ComposeC T f) + hence "\M; P\ \\<^sub>r t" when t: "t \ set T" for t + using t P(2) subtermeqI''[of _ T f] + by fastforce + thus ?case + using intruder_deduct_restricted.ComposeR[OF ComposeC.hyps(1,2)] ComposeC.prems(1) + by metis +qed simp + +lemma deduct_zero_in_ik: + assumes "\M; 0\ \\<^sub>n t" shows "t \ M" +proof - + { fix k assume "\M; k\ \\<^sub>n t" hence "k > 0 \ t \ M" by (induct t) auto + } thus ?thesis using assms by auto +qed + +lemma deduct_if_deduct_num: "\M; k\ \\<^sub>n t \ M \ t" +by (induct t rule: intruder_deduct_num.induct) + (metis intruder_deduct.Axiom, + metis intruder_deduct.Compose, + metis intruder_deduct.Decompose) + +lemma deduct_num_if_deduct: "M \ t \ \k. \M; k\ \\<^sub>n t" +proof (induction t rule: intruder_deduct_induct) + case (Compose T f) + then obtain steps where *: "\t \ set T. \M; steps t\ \\<^sub>n t" by moura + then obtain n where "\t \ set T. steps t \ n" + using finite_nat_set_iff_bounded_le[of "steps ` set T"] + by auto + thus ?case using ComposeN[OF Compose.hyps(1,2), of M steps] * by force +next + case (Decompose t K T t\<^sub>i) + hence "\u. u \ insert t (set K) \ \k. \M; k\ \\<^sub>n u" by auto + then obtain steps where *: "\M; steps t\ \\<^sub>n t" "\t \ set K. \M; steps t\ \\<^sub>n t" by moura + then obtain n where "steps t \ n" "\t \ set K. steps t \ n" + using finite_nat_set_iff_bounded_le[of "steps ` insert t (set K)"] + by auto + thus ?case using DecomposeN[OF _ Decompose.hyps(2) _ Decompose.hyps(4), of M _ steps] * by force +qed (metis AxiomN) + +lemma deduct_normalize: + assumes M: "\m \ M. \f T. Fun f T \ m \ P f T" + and t: "\M; k\ \\<^sub>n t" "Fun f T \ t" "\P f T" + shows "\l \ k. (\M; l\ \\<^sub>n Fun f T) \ (\t \ set T. \j < l. \M; j\ \\<^sub>n t)" +using t +proof (induction t rule: intruder_deduct_num_induct) + case (AxiomN t) thus ?case using M by auto +next + case (ComposeN T' f' steps) thus ?case + proof (cases "Fun f' T' = Fun f T") + case True + hence "\M; Suc (Max (insert 0 (steps ` set T')))\ \\<^sub>n Fun f T" "T = T'" + using intruder_deduct_num.ComposeN[OF ComposeN.hyps] by auto + moreover have "\t. t \ set T \ \M; steps t\ \\<^sub>n t" + using True ComposeN.hyps(3) by auto + moreover have "\t. t \ set T \ steps t < Suc (Max (insert 0 (steps ` set T)))" + using Max_less_iff[of "insert 0 (steps ` set T)" "Suc (Max (insert 0 (steps ` set T)))"] + by auto + ultimately show ?thesis by auto + next + case False + then obtain t' where t': "t' \ set T'" "Fun f T \ t'" using ComposeN by auto + hence "\l \ steps t'. (\M; l\ \\<^sub>n Fun f T) \ (\t \ set T. \j < l. \M; j\ \\<^sub>n t)" + using ComposeN.IH[OF _ _ ComposeN.prems(2)] by auto + moreover have "steps t' < Suc (Max (insert 0 (steps ` set T')))" + using Max_less_iff[of "insert 0 (steps ` set T')" "Suc (Max (insert 0 (steps ` set T')))"] + using t'(1) by auto + ultimately show ?thesis using ComposeN.hyps(3)[OF t'(1)] + by (meson Suc_le_eq le_Suc_eq le_trans) + qed +next + case (DecomposeN t K T' t\<^sub>i steps n) + hence *: "Fun f T \ t" + using term.order_trans[of "Fun f T" t\<^sub>i t] Ana_subterm[of t K T'] + by blast + have "\l \ n. (\M; l\ \\<^sub>n Fun f T) \ (\t' \ set T. \j < l. \M; j\ \\<^sub>n t')" + using DecomposeN.IH(1)[OF * DecomposeN.prems(2)] by auto + moreover have "n < Suc (Max (insert n (steps ` set K)))" + using Max_less_iff[of "insert n (steps ` set K)" "Suc (Max (insert n (steps ` set K)))"] + by auto + ultimately show ?case using DecomposeN.hyps(4) by (meson Suc_le_eq le_Suc_eq le_trans) +qed + +lemma deduct_inv: + assumes "\M; n\ \\<^sub>n t" + shows "t \ M \ + (\f T. t = Fun f T \ public f \ length T = arity f \ (\t \ set T. \l < n. \M; l\ \\<^sub>n t)) \ + (\m \ subterms\<^sub>s\<^sub>e\<^sub>t M. + (\l < n. \M; l\ \\<^sub>n m) \ (\k \ set (fst (Ana m)). \l < n. \M; l\ \\<^sub>n k) \ + t \ set (snd (Ana m)))" + (is "?P t n \ ?Q t n \ ?R t n") +using assms +proof (induction n arbitrary: t rule: nat_less_induct) + case (1 n t) thus ?case + proof (cases n) + case 0 + hence "t \ M" using deduct_zero_in_ik "1.prems"(1) by metis + thus ?thesis by auto + next + case (Suc n') + hence "\M; Suc n'\ \\<^sub>n t" + "\m < Suc n'. \x. (\M; m\ \\<^sub>n x) \ ?P x m \ ?Q x m \ ?R x m" + using "1.prems" "1.IH" by blast+ + hence "?P t (Suc n') \ ?Q t (Suc n') \ ?R t (Suc n')" + proof (induction t rule: intruder_deduct_num_induct) + case (AxiomN t) thus ?case by simp + next + case (ComposeN T f steps) + have "\t. t \ set T \ steps t < Suc (Max (insert 0 (steps ` set T)))" + using Max_less_iff[of "insert 0 (steps ` set T)" "Suc (Max (insert 0 (steps ` set T)))"] + by auto + thus ?case using ComposeN.hyps by metis + next + case (DecomposeN t K T t\<^sub>i steps n) + have 0: "n < Suc (Max (insert n (steps ` set K)))" + "\k. k \ set K \ steps k < Suc (Max (insert n (steps ` set K)))" + using Max_less_iff[of "insert n (steps ` set K)" "Suc (Max (insert n (steps ` set K)))"] + by auto + + have IH1: "?P t j \ ?Q t j \ ?R t j" when jt: "j < n" "\M; j\ \\<^sub>n t" for j t + using jt DecomposeN.prems(1) 0(1) + by simp + + have IH2: "?P t n \ ?Q t n \ ?R t n" + using DecomposeN.IH(1) IH1 + by simp + + have 1: "\k \ set (fst (Ana t)). \l < Suc (Max (insert n (steps ` set K))). \M; l\ \\<^sub>n k" + using DecomposeN.hyps(1,2,3) 0(2) + by auto + + have 2: "t\<^sub>i \ set (snd (Ana t))" + using DecomposeN.hyps(2,4) + by fastforce + + have 3: "t \ subterms\<^sub>s\<^sub>e\<^sub>t M" when "t \ set (snd (Ana m))" "m \\<^sub>s\<^sub>e\<^sub>t M" for m + using that(1) Ana_subterm[of m _ "snd (Ana m)"] in_subterms_subset_Union[OF that(2)] + by (metis (no_types, lifting) prod.collapse psubsetD subsetCE subsetD) + + have 4: "?R t\<^sub>i (Suc (Max (insert n (steps ` set K))))" when "?R t n" + using that 0(1) 1 2 3 DecomposeN.hyps(1) + by (metis (no_types, lifting)) + + have 5: "?R t\<^sub>i (Suc (Max (insert n (steps ` set K))))" when "?P t n" + using that 0(1) 1 2 DecomposeN.hyps(1) + by blast + + have 6: ?case when *: "?Q t n" + proof - + obtain g S where g: + "t = Fun g S" "public g" "length S = arity g" "\t \ set S. \l < n. \M; l\ \\<^sub>n t" + using * by moura + then obtain l where l: "l < n" "\M; l\ \\<^sub>n t\<^sub>i" + using 0(1) DecomposeN.hyps(2,4) Ana_fun_subterm[of g S K T] by blast + + have **: "l < Suc (Max (insert n (steps ` set K)))" using l(1) 0(1) by simp + + show ?thesis using IH1[OF l] less_trans[OF _ **] by fastforce + qed + + show ?case using IH2 4 5 6 by argo + qed + thus ?thesis using Suc by fast + qed +qed + +lemma restricted_deduct_if_deduct: + assumes M: "\m \ M. \f T. Fun f T \ m \ P (Fun f T)" + and P_subterm: "\f T t. M \ Fun f T \ P (Fun f T) \ t \ set T \ P t" + and P_Ana_key: "\t K T k. M \ t \ P t \ Ana t = (K, T) \ M \ k \ k \ set K \ P k" + and m: "M \ m" "P m" + shows "\M; P\ \\<^sub>r m" +proof - + { fix k assume "\M; k\ \\<^sub>n m" + hence ?thesis using m(2) + proof (induction k arbitrary: m rule: nat_less_induct) + case (1 n m) thus ?case + proof (cases n) + case 0 + hence "m \ M" using deduct_zero_in_ik "1.prems"(1) by metis + thus ?thesis by auto + next + case (Suc n') + hence "\M; Suc n'\ \\<^sub>n m" + "\m < Suc n'. \x. (\M; m\ \\<^sub>n x) \ P x \ \M;P\ \\<^sub>r x" + using "1.prems" "1.IH" by blast+ + thus ?thesis using "1.prems"(2) + proof (induction m rule: intruder_deduct_num_induct) + case (ComposeN T f steps) + have *: "steps t < Suc (Max (insert 0 (steps ` set T)))" when "t \ set T" for t + using Max_less_iff[of "insert 0 (steps ` set T)"] that + by blast + + have **: "P t" when "t \ set T" for t + using P_subterm ComposeN.prems(2) that + Fun_param_is_subterm[OF that] + intruder_deduct.Compose[OF ComposeN.hyps(1,2)] + deduct_if_deduct_num[OF ComposeN.hyps(3)] + by blast + + have "\M; P\ \\<^sub>r t" when "t \ set T" for t + using ComposeN.prems(1) ComposeN.hyps(3)[OF that] *[OF that] **[OF that] + by blast + thus ?case + by (metis intruder_deduct_restricted.ComposeR[OF ComposeN.hyps(1,2)] ComposeN.prems(2)) + next + case (DecomposeN t K T t\<^sub>i steps l) + show ?case + proof (cases "P t") + case True + hence "\k. k \ set K \ P k" + using P_Ana_key DecomposeN.hyps(1,2,3) deduct_if_deduct_num + by blast + moreover have + "\k m x. k \ set K \ m < steps k \ \M; m\ \\<^sub>n x \ P x \ \M;P\ \\<^sub>r x" + proof - + fix k m x assume *: "k \ set K" "m < steps k" "\M; m\ \\<^sub>n x" "P x" + have "steps k \ insert l (steps ` set K)" using *(1) by simp + hence "m < Suc (Max (insert l (steps ` set K)))" + using less_trans[OF *(2), of "Suc (Max (insert l (steps ` set K)))"] + Max_less_iff[of "insert l (steps ` set K)" + "Suc (Max (insert l (steps ` set K)))"] + by auto + thus "\M;P\ \\<^sub>r x" using DecomposeN.prems(1) *(3,4) by simp + qed + ultimately have "\k. k \ set K \ \M; P\ \\<^sub>r k" + using DecomposeN.IH(2) by auto + moreover have "\M; P\ \\<^sub>r t" + using True DecomposeN.prems(1) DecomposeN.hyps(1) le_imp_less_Suc + Max_less_iff[of "insert l (steps ` set K)" "Suc (Max (insert l (steps ` set K)))"] + by blast + ultimately show ?thesis + using intruder_deduct_restricted.DecomposeR[OF _ DecomposeN.hyps(2) + _ DecomposeN.hyps(4)] + by metis + next + case False + obtain g S where gS: "t = Fun g S" using DecomposeN.hyps(2,4) by (cases t) moura+ + hence *: "Fun g S \ t" "\P (Fun g S)" using False by force+ + have "\jM; j\ \\<^sub>n t\<^sub>i" + using gS DecomposeN.hyps(2,4) Ana_fun_subterm[of g S K T] + deduct_normalize[of M "\f T. P (Fun f T)", OF M DecomposeN.hyps(1) *] + by force + hence "\jM; j\ \\<^sub>n t\<^sub>i" + using Max_less_iff[of "insert l (steps ` set K)" + "Suc (Max (insert l (steps ` set K)))"] + less_trans[of _ l "Suc (Max (insert l (steps ` set K)))"] + by blast + thus ?thesis using DecomposeN.prems(1,2) by meson + qed + qed auto + qed + qed + } thus ?thesis using deduct_num_if_deduct m(1) by metis +qed + +lemma restricted_deduct_if_deduct': + assumes "\m \ M. P m" + and "\t t'. P t \ t' \ t \ P t'" + and "\t K T k. P t \ Ana t = (K, T) \ k \ set K \ P k" + and "M \ m" "P m" + shows "\M; P\ \\<^sub>r m" +using restricted_deduct_if_deduct[of M P m] assms +by blast + +lemma private_const_deduct: + assumes c: "\public c" "M \ (Fun c []::('fun,'var) term)" + shows "Fun c [] \ M \ + (\m \ subterms\<^sub>s\<^sub>e\<^sub>t M. M \ m \ (\k \ set (fst (Ana m)). M \ m) \ + Fun c [] \ set (snd (Ana m)))" +proof - + obtain n where "\M; n\ \\<^sub>n Fun c []" + using c(2) deduct_num_if_deduct by moura + hence "Fun c [] \ M \ + (\m \ subterms\<^sub>s\<^sub>e\<^sub>t M. + (\l < n. \M; l\ \\<^sub>n m) \ + (\k \ set (fst (Ana m)). \l < n. \M; l\ \\<^sub>n k) \ Fun c [] \ set (snd (Ana m)))" + using deduct_inv[of M n "Fun c []"] c(1) by fast + thus ?thesis using deduct_if_deduct_num[of M] by blast +qed + +lemma private_fun_deduct_in_ik'': + assumes t: "M \ Fun f T" "Fun c [] \ set T" "\m \ subterms\<^sub>s\<^sub>e\<^sub>t M. Fun f T \ set (snd (Ana m))" + and c: "\public c" "Fun c [] \ M" "\m \ subterms\<^sub>s\<^sub>e\<^sub>t M. Fun c [] \ set (snd (Ana m))" + shows "Fun f T \ M" +proof - + have *: "\n. \M; n\ \\<^sub>n Fun c []" + using private_const_deduct[OF c(1)] c(2,3) deduct_if_deduct_num + by blast + + obtain n where n: "\M; n\ \\<^sub>n Fun f T" + using t(1) deduct_num_if_deduct + by blast + + show ?thesis + using deduct_inv[OF n] t(2,3) * + by blast +qed + +end + +subsection \Executable Definitions for Code Generation\ +fun intruder_synth' where + "intruder_synth' pu ar M (Var x) = (Var x \ M)" +| "intruder_synth' pu ar M (Fun f T) = ( + Fun f T \ M \ (pu f \ length T = ar f \ list_all (intruder_synth' pu ar M) T))" + +definition "wf\<^sub>t\<^sub>r\<^sub>m' ar t \ (\s \ subterms t. is_Fun s \ ar (the_Fun s) = length (args s))" + +definition "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' ar M \ (\t \ M. wf\<^sub>t\<^sub>r\<^sub>m' ar t)" + +definition "analyzed_in' An pu ar t M \ (case An t of + (K,T) \ (\k \ set K. intruder_synth' pu ar M k) \ (\s \ set T. intruder_synth' pu ar M s))" + +lemma (in intruder_model) intruder_synth'_induct[consumes 1, case_names Var Fun]: + assumes "intruder_synth' public arity M t" + "\x. intruder_synth' public arity M (Var x) \ P (Var x)" + "\f T. (\z. z \ set T \ intruder_synth' public arity M z \ P z) \ + intruder_synth' public arity M (Fun f T) \ P (Fun f T) " + shows "P t" +using assms by (induct public arity M t rule: intruder_synth'.induct) auto + +lemma (in intruder_model) wf\<^sub>t\<^sub>r\<^sub>m_code[code_unfold]: + "wf\<^sub>t\<^sub>r\<^sub>m t = wf\<^sub>t\<^sub>r\<^sub>m' arity t" +unfolding wf\<^sub>t\<^sub>r\<^sub>m_def wf\<^sub>t\<^sub>r\<^sub>m'_def +by auto + +lemma (in intruder_model) wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[code_unfold]: + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M = wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity M" +using wf\<^sub>t\<^sub>r\<^sub>m_code +unfolding wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s'_def +by auto + +lemma (in intruder_model) intruder_synth_code[code_unfold]: + "intruder_synth M t = intruder_synth' public arity M t" + (is "?A \ ?B") +proof + show "?A \ ?B" + proof (induction t rule: intruder_synth_induct) + case (AxiomC t) thus ?case by (cases t) auto + qed (fastforce simp add: list_all_iff) + + show "?B \ ?A" + proof (induction t rule: intruder_synth'_induct) + case (Fun f T) thus ?case + proof (cases "Fun f T \ M") + case False + hence "public f" "length T = arity f" "list_all (intruder_synth' public arity M) T" + using Fun.hyps by fastforce+ + thus ?thesis + using Fun.IH intruder_synth.ComposeC[of T f M] Ball_set[of T] + by blast + qed simp + qed simp +qed + +lemma (in intruder_model) analyzed_in_code[code_unfold]: + "analyzed_in t M = analyzed_in' Ana public arity t M" +using intruder_synth_code[of M] +unfolding analyzed_in_def analyzed_in'_def +by fastforce + +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Labeled_Stateful_Strands.thy b/thys/Stateful_Protocol_Composition_and_Typing/Labeled_Stateful_Strands.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Labeled_Stateful_Strands.thy @@ -0,0 +1,906 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2018-2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Labeled_Stateful_Strands.thy + Author: Andreas Viktor Hess, DTU +*) + +section \Labeled Stateful Strands\ +theory Labeled_Stateful_Strands +imports Stateful_Strands Labeled_Strands +begin + +subsection \Definitions\ +text\Syntax for stateful strand labels\ +abbreviation Star_step ("\\, _\") where + "\\, (s::('a,'b) stateful_strand_step)\ \ (\, s)" + +abbreviation LabelN_step ("\_, _\") where + "\(l::'a), (s::('b,'c) stateful_strand_step)\ \ (ln l, s)" + + +text\Database projection\ +abbreviation dbproj where "dbproj l D \ filter (\d. fst d = l) D" + +text\The type of labeled stateful strands\ +type_synonym ('a,'b,'c) labeled_stateful_strand_step = "'c strand_label \ ('a,'b) stateful_strand_step" +type_synonym ('a,'b,'c) labeled_stateful_strand = "('a,'b,'c) labeled_stateful_strand_step list" + +text\Dual strands\ +fun dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p::"('a,'b,'c) labeled_stateful_strand_step \ ('a,'b,'c) labeled_stateful_strand_step" +where + "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,send\t\) = (l,receive\t\)" +| "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,receive\t\) = (l,send\t\)" +| "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 \ ('a,'b,'c) labeled_stateful_strand" +where + "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ map dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p" + +text\Substitution application\ +fun subst_apply_labeled_stateful_strand_step:: + "('a,'b,'c) labeled_stateful_strand_step \ ('a,'b) subst \ + ('a,'b,'c) labeled_stateful_strand_step" + (infix "\\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p" 51) where + "(l,s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = (l,s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + +definition subst_apply_labeled_stateful_strand:: + "('a,'b,'c) labeled_stateful_strand \ ('a,'b) subst \ ('a,'b,'c) labeled_stateful_strand" + (infix "\\<^sub>l\<^sub>s\<^sub>s\<^sub>t" 51) where + "S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ map (\x. x \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) S" + +text\Definitions lifted from stateful strands\ +abbreviation wfrestrictedvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t where "wfrestrictedvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ 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 \ 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 \ 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 \ 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 \ 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 \ 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 \ 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 \ 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 \ 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 \ fv\<^sub>s\<^sub>s\<^sub>t (unlabel S)" + +text\Labeled set-operations\ +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\t,s\) = {(i,t,s)}" +| "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,delete\t,s\) = {(i,t,s)}" +| "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,\_: t \ s\) = {(i,t,s)}" +| "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,\_\\\: _ \\: F'\) = ((\(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 \ \(setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ` set S)" + + +subsection \Minor Lemmata\ +lemma subst_lsst_nil[simp]: "[] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = []" +by (simp add: subst_apply_labeled_stateful_strand_def) + +lemma subst_lsst_cons: "a#A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = (a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)#(A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" +by (simp add: subst_apply_labeled_stateful_strand_def) + +lemma subst_lsst_singleton: "[(l,s)] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = [(l,s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)]" +by (simp add: subst_apply_labeled_stateful_strand_def) + +lemma subst_lsst_append: "A@B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@(B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" +by (simp add: subst_apply_labeled_stateful_strand_def) + +lemma subst_lsst_append_inv: + assumes "A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = B1@B2" + shows "\A1 A2. A = A1@A2 \ A1 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = B1 \ A2 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = 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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = b" "A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = 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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = b" "A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = 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 \ set A \ x \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \ set (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" +by (metis image_eqI set_map subst_apply_labeled_stateful_strand_def) + +lemma subst_lsst_unlabel_cons: "unlabel ((l,b)#A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)#(unlabel (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" +by (simp add: subst_apply_labeled_stateful_strand_def) + +lemma subst_lsst_unlabel: "unlabel (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = unlabel A \\<^sub>s\<^sub>s\<^sub>t \" +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 \ set (unlabel A)" + shows "x \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \ set (unlabel (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" +proof - + obtain l where x: "(l,x) \ 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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + shows "\C. C \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = B \ prefix C A" +using assms +proof (induction A rule: List.rev_induct) + case (snoc a A) thus ?case + proof (cases "B = A@[a] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \") + 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\t\)#A) = (l,receive\t\)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,receive\t\)#A) = (l,send\t\)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,\a: t \ s\)#A) = (l,\a: t \ s\)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,insert\t,s\)#A) = (l,insert\t,s\)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,delete\t,s\)#A) = (l,delete\t,s\)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,\a: t \ s\)#A) = (l,\a: t \ s\)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((l,\X\\\: F \\: G\)#A) = (l,\X\\\: F \\: G\)#(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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p s) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" +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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" +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 \] + 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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) = unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \\<^sub>s\<^sub>s\<^sub>t \" +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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)#(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))" +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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t B) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" +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] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@[dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \]" +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) \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + shows "\b. (l,b) \ set A \ 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) \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) \ 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) \ 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\t\ \ b = send\t\" + and "a = send\t\ \ b = receive\t\" + and "(\t. a = receive\t\ \ a = send\t\) \ b = a" +proof - + show "l = k" using assms by (cases a) auto + show "a = receive\t\ \ b = send\t\" using assms by (cases a) auto + show "a = send\t\ \ b = receive\t\" using assms by (cases a) auto + show "(\t. a = receive\t\ \ a = send\t\) \ 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 \ 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 \ 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) \ 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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = 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) \ set A" + and "\is_Receive x" "\is_Send x" + shows "(l,x) \ 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 \ set (unlabel A)" + and "\is_Receive x" "\is_Send x" + shows "x \ 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\t\) \ set A \ (l,receive\t\) \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + "(l,receive\t\) \ set A \ (l,send\t\) \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + "(l,\c: t \ s\) \ set A \ (l,\c: t \ s\) \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + "(l,insert\t,s\) \ set A \ (l,insert\t,s\) \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + "(l,delete\t,s\) \ set A \ (l,delete\t,s\) \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + "(l,\c: t \ s\) \ set A \ (l,\c: t \ s\) \ set (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + "(l,\X\\\: F \\: G\) \ set A \ (l,\X\\\: F \\: G\) \ 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\t\ \ set (unlabel A) \ receive\t\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "receive\t\ \ set (unlabel A) \ send\t\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "\c: t \ s\ \ set (unlabel A) \ \c: t \ s\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "insert\t,s\ \ set (unlabel A) \ insert\t,s\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "delete\t,s\ \ set (unlabel A) \ delete\t,s\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "\c: t \ s\ \ set (unlabel A) \ \c: t \ s\ \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "\X\\\: F \\: G\ \ set (unlabel A) \ \X\\\: F \\: G\ \ 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) \ list_all is_Send (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "list_all is_Send (unlabel A) \ list_all is_Receive (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "list_all is_Equality (unlabel A) \ list_all is_Equality (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "list_all is_Insert (unlabel A) \ list_all is_Insert (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "list_all is_Delete (unlabel A) \ list_all is_Delete (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "list_all is_InSet (unlabel A) \ list_all is_InSet (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "list_all is_NegChecks (unlabel A) \ list_all is_NegChecks (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "list_all is_Assignment (unlabel A) \ list_all is_Assignment (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "list_all is_Check (unlabel A) \ list_all is_Check (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + "list_all is_Update (unlabel A) \ 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 \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A))" + shows "\l B s'. (l,s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (l,s') \ 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 \ 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 \ set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)))" + shows "\l B s'. (l,s) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,s') \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \ prefix ((B \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)@[(l,s') \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \]) (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" +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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_set_prefix_obtain[OF assms] by moura + + obtain C where C: "C \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = B@[(l,s')]" + using subst_lsst_prefix[OF B(2)] by moura + + obtain D u where D: "C = D@[(l,u)]" "D \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = B" "[(l,u)] \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = [(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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" +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 \ subst_domain \ = {}" + shows "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \" +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 \::"('a,'b) subst" + assumes "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + shows "\s \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S. \X. set X \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ t = s \ rm_vars (set X) \" +using assms +proof (induction S) + case (Cons a S) + obtain l b where a: "a = (l,b)" by (metis surj_pair) + hence "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ t \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + using Cons.prems trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst_cons by fast + thus ?case + proof + assume *: "t \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + show ?thesis using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst''[OF *] a by auto + next + assume *: "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + 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 \ \::"('a,'b) subst" + assumes "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>e\<^sub>t \" + shows "\s \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S. \X. set X \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ t = s \ rm_vars (set X) \ \\<^sub>s \" +proof - + obtain s where s: "s \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" "t = s \ \" 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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) = (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)) \ (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)))" +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 \] by (cases b) auto +qed + +lemma dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_funs_term: + "\(funs_term ` (trms\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S)))) = \(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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \))) \ D = db'\<^sub>s\<^sub>s\<^sub>t (unlabel (T \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) \ 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 \ set (unlabel D) \ List.insert d (unlabel D) = unlabel (List.insert (i,d) D)" + "(i,d) \ set D \ 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) \ + (\j. (j,d) \ set D \ 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 \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = proj l A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" +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) \ set A" +unfolding proj_def by auto + +lemma proj_proj_set_subset[simp]: + "set (proj n (proj m A)) \ set (proj n A)" + "set (proj n (proj m A)) \ set (proj m A)" + "set (proj_unl n (proj m A)) \ set (proj_unl n A)" + "set (proj_unl n (proj m A)) \ set (proj_unl m A)" +unfolding unlabel_def proj_def by auto + +lemma proj_in_set_iff: + "(ln i, d) \ set (proj i D) \ (ln i, d) \ set D" + "(\, d) \ set (proj i D) \ (\, d) \ 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 (\,d) D) = List.insert (\,d) (proj i D)" + "i \ j \ 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\D. d \ set Di] = [d\proj i D. d \ 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 ((\,d)#D) = (\,d)#proj i D" + "i \ j \ 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: "\b \ set B. \a \ set A. \\. b = a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \ P \" + and b: "b \ set (proj l B)" + shows "\a \ set (proj l A). \\. b = a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \ P \" +proof - + obtain a \ where a: "a \ set A" "b = a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" "P \" using B b proj_set_subset by fast + obtain k b' where b': "b = (k, b')" "k = (ln l) \ k = \" 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 \ (proj i D) = dbproj \ D" + "i \ j \ 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 \ j \ dbproj j ((i,d)#D) = dbproj j D" +by auto + +lemma dbproj_subset[simp]: + "set (unlabel (dbproj i D)) \ set (unlabel D)" +unfolding unlabel_def by auto + +lemma dbproj_subseq: + assumes "Di \ set (subseqs (dbproj k D))" + shows "dbproj k Di = Di" (is ?A) + and "i \ k \ dbproj i Di = []" (is "i \ k \ ?B") +proof - + have *: "set Di \ 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 "\j d. (j,d) \ set Di \ j = k" using * by auto + moreover have "\j d. (j,d) \ set (dbproj i Di) \ j = i" by auto + moreover have "\j d. (j,d) \ set (dbproj i Di) \ (j,d) \ set Di" by auto + ultimately show "i \ k \ ?B" by (metis set_empty subrelI subset_empty) +qed + +lemma dbproj_subseq_subset: + assumes "Di \ set (subseqs (dbproj i D))" + shows "set Di \ set D" +by (metis Pow_iff assms filter_set image_eqI member_filter subseqs_powset subsetCE subsetI) + +lemma dbproj_subseq_in_subseqs: + assumes "Di \ set (subseqs (dbproj i D))" + shows "Di \ set (subseqs D)" +using assms in_set_subseqs subseq_filter_left subseq_order.dual_order.trans by blast + +lemma proj_subseq: + assumes "Di \ set (subseqs (dbproj (ln j) D))" "j \ i" + shows "[d\proj i D. d \ set Di] = proj i D" +proof - + have "set Di \ set (dbproj (ln j) D)" using subseqs_powset[of "dbproj (ln j) D"] assms by auto + hence "\k d. (k,d) \ set Di \ k = ln j" by auto + moreover have "\k d. (k,d) \ set (proj i D) \ k \ ln j" + using assms(2) unfolding proj_def by auto + ultimately have "\d. d \ set (proj i D) \ d \ set Di" by auto + thus ?thesis by simp +qed + +lemma unlabel_subseqsD: + assumes "A \ set (subseqs (unlabel B))" + shows "\C \ set (subseqs B). unlabel C = A" +using assms map_subseqs unfolding unlabel_def by (metis imageE set_map) + +lemma unlabel_filter_eq: + assumes "\(j, p) \ set A \ B. \(k, q) \ set A \ B. p = q \ j = k" (is "?P (set A)") + shows "[d\unlabel A. d \ snd ` B] = unlabel [d\A. d \ B]" +using assms unfolding unlabel_def +proof (induction A) + case (Cons a A) + have "set A \ set (a#A)" "{a} \ set (a#A)" by auto + hence *: "?P (set A)" "?P {a}" using Cons.prems by fast+ + hence IH: "[d\map snd A . d \ snd ` B] = map snd [d\A . d \ B]" using Cons.IH by auto + + { assume "snd a \ snd ` B" + then obtain b where b: "b \ B" "snd a = snd b" by moura + hence "fst a = fst b" using *(2) by auto + hence "a \ B" using b by (metis surjective_pairing) + } hence **: "a \ B \ snd a \ snd ` B" by metis + + show ?case by (cases "a \ B") (simp add: ** IH)+ +qed simp + +lemma subseqs_mem_dbproj: + assumes "Di \ set (subseqs D)" "list_all (\d. fst d = i) Di" + shows "Di \ 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 \ set (subseqs D)") + case True + hence "Di \ 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' \ 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' \ 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 \\<^sub>s\<^sub>s\<^sub>t \ = unlabel (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" +unfolding unlabel_def subst_apply_stateful_strand_def subst_apply_labeled_stateful_strand_def +by auto + +lemma subterms_subst_lsst: + assumes "\x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S). (\f. \ x = Fun f []) \ (\y. \ x = Var y)" + and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ subst_domain \ = {}" + shows "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) = subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \\<^sub>s\<^sub>e\<^sub>t \" +using subterms_subst''[OF assms(1)] trms\<^sub>s\<^sub>s\<^sub>t_subst[OF assms(2)] unlabel_subst[of S \] +by simp + +lemma subterms_subst_lsst_ik: + assumes "\x \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t S). (\f. \ x = Fun f []) \ (\y. \ x = Var y)" + shows "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) = subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \\<^sub>s\<^sub>e\<^sub>t \" +using subterms_subst''[OF assms(1)] ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel S" \] unlabel_subst[of S \] +by simp + +lemma labeled_stateful_strand_subst_comp: + assumes "range_vars \ \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t S = {}" + shows "S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \ = (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" +using assms +proof (induction S) + case (Cons s S) + obtain l x where s: "s = (l,x)" by (metis surj_pair) + hence IH: "S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \ = (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \" using Cons by auto + + have "x \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \\<^sub>s \ = (x \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" + using s Cons.prems stateful_strand_step_subst_comp[of \ x \] 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) \ fv\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + "bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + "vars\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \ 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) \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel A)" (is ?A) + "trms\<^sub>s\<^sub>s\<^sub>t (proj_unl m (proj n A)) \ 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)) \ 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) \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B))" (is ?A) + "trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \ 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) \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B))" + "trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n B) \ 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 \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" + shows "fst p = fst a" (is ?P) + and "is_Update (snd a) \ is_InSet (snd a) \ 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 \ 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) \ setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + "setops\<^sub>s\<^sub>s\<^sub>t (proj_unl m (proj n A)) \ setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n A)" + "setops\<^sub>s\<^sub>s\<^sub>t (proj_unl m (proj n A)) \ 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) \ setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B))" + "setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \ 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) \ setops\<^sub>s\<^sub>s\<^sub>t (unlabel (A@B))" + "setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n B) \ 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) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj m (proj n A)) \ 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 \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B)" + "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) \ 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 \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B)" + "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n B) \ 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 \ set N \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t M \ 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: + "\list_ex (is_LabelN l) A \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l A) \ 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: + "\list_ex (is_LabelN l) A \ setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l A) \ 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: + "\list_ex (is_LabelN l) A \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l A) \ 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\t\) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = {}" + "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,receive\t\) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = {}" + "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,\ac: s \ t\) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = {}" + "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,insert\t,s\) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = {(l,t \ \,s \ \)}" + "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,delete\t,s\) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = {(l,t \ \,s \ \)}" + "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,\ac: t \ s\) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = {(l,t \ \,s \ \)}" + "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p ((l,\X\\\: F \\: F'\) \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = + ((\(t,s). (l,t \ rm_vars (set X) \,s \ rm_vars (set X) \)) ` set F')" (is "?A = ?B") +proof - + have "?A = (\(t,s). (l,t,s)) ` set (F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)" 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)) \ subst_domain \ = {}" + shows "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = (\p. (fst a,snd p \\<^sub>p \)) ` 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) \ = \" using a assms rm_vars_apply'[of \ "set X"] by auto + have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = (\p. (fst a, p)) ` set (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using * NegChecks a by auto + moreover have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = (\p. (fst a, p)) ` set G" using NegChecks a by simp + hence "(\p. (fst a,snd p \\<^sub>p \)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = (\p. (fst a, p \\<^sub>p \)) ` set G" + by (metis (mono_tags, lifting) image_cong image_image snd_conv) + hence "(\p. (fst a,snd p \\<^sub>p \)) ` setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = (\p. (fst a, p)) ` (set G \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \)" + 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)) \ subst_domain \ = {}" + shows "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = (\(i,p). (i,p \\<^sub>p \)) ` 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 \ subst_domain \ = {}" + shows "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = (\p. (fst p,snd p \\<^sub>p \)) ` 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 \ subst_domain \ = {}" and *: "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a)) \ subst_domain \ = {}" + using Cons.prems by auto + hence IH: "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = (\p. (fst p,snd p \\<^sub>p \)) ` 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 \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + shows "\q \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. fst p = fst q \ snd p = snd q \\<^sub>p rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a))) \" + (is "\q \ 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 \ (\(t, s). (l, t \ rm_vars (set X) \, s \ rm_vars (set X) \)) ` set F'" + using p a setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(7)[of l X F F' \] by blast + then obtain s t where st: + "(t,s) \ set F'" "p = (l, t \ rm_vars (set X) \, s \ rm_vars (set X) \)" + by auto + hence "(l,t,s) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" "fst p = fst (l,t,s)" + "snd p = snd (l,t,s) \\<^sub>p rm_vars (set X) \" + 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 \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + shows "\q \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. fst p = fst q \ (\X \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. snd p = snd q \\<^sub>p rm_vars X \)" + (is "\q \ 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 \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)") + case False + hence "p \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + using Cons.prems setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_cons[of "a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" "A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \"] subst_lsst_cons[of a A \] by auto + moreover have "(set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a))) \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A)" using 0 by simp + ultimately have "\q \ 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 \] 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 diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Labeled_Strands.thy b/thys/Stateful_Protocol_Composition_and_Typing/Labeled_Strands.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Labeled_Strands.thy @@ -0,0 +1,372 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2018-2020 +(C) Copyright Sebastian A. Mödersheim, DTU, 2018-2020 +(C) Copyright Achim D. Brucker, University of Sheffield, 2018-2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Labeled_Strands.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, The University of Sheffield +*) + +section \Labeled Strands\ +theory Labeled_Strands +imports Strands_and_Constraints +begin + +subsection \Definitions: Labeled Strands and Constraints\ +datatype 'l strand_label = + LabelN (the_LabelN: "'l") ("ln _") +| LabelS ("\") + +text \Labeled strands are strands whose steps are equipped with labels\ +type_synonym ('a,'b,'c) labeled_strand_step = "'c strand_label \ ('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 \ fst x = ln n" +abbreviation is_LabelS where "is_LabelS x \ fst x = \" + +definition unlabel where "unlabel S \ map snd S" +definition proj where "proj n S \ filter (\s. is_LabelN n s \ is_LabelS s) S" +abbreviation proj_unl where "proj_unl n S \ unlabel (proj n S)" + +abbreviation wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t where "wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t S \ wfrestrictedvars\<^sub>s\<^sub>t (unlabel S)" + +abbreviation subst_apply_labeled_strand_step (infix "\\<^sub>l\<^sub>s\<^sub>t\<^sub>p" 51) where + "x \\<^sub>l\<^sub>s\<^sub>t\<^sub>p \ \ (case x of (l, s) \ (l, s \\<^sub>s\<^sub>t\<^sub>p \))" + +abbreviation subst_apply_labeled_strand (infix "\\<^sub>l\<^sub>s\<^sub>t" 51) where + "S \\<^sub>l\<^sub>s\<^sub>t \ \ map (\x. x \\<^sub>l\<^sub>s\<^sub>t\<^sub>p \) S" + +abbreviation trms\<^sub>l\<^sub>s\<^sub>t where "trms\<^sub>l\<^sub>s\<^sub>t S \ 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 \ 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 \ 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 \ 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 \ bvars\<^sub>s\<^sub>t (unlabel S)" +abbreviation fv\<^sub>l\<^sub>s\<^sub>t where "fv\<^sub>l\<^sub>s\<^sub>t S \ 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 \ wf\<^sub>s\<^sub>t V (unlabel S)" + + +subsection \Lemmata: Projections\ +lemma is_LabelS_proj_iff_not_is_LabelN: + "list_all is_LabelS (proj l A) \ \list_ex (is_LabelN l) A" +by (induct A) (auto simp add: proj_def) + +lemma proj_subset_if_no_label: + assumes "\list_ex (is_LabelN l) A" + shows "set (proj l A) \ set (proj l' A)" + and "set (proj_unl l A) \ set (proj_unl l' A)" +using assms by (induct A) (auto simp add: unlabel_def proj_def) + +lemma proj_in_setD: + assumes a: "a \ set (proj l A)" + obtains k b where "a = (k, b)" "k = (ln l) \ k = \" +using that a unfolding proj_def by (cases a) auto + +lemma proj_set_mono: + assumes "set A \ set B" + shows "set (proj n A) \ set (proj n B)" + and "set (proj_unl n A) \ 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 \ set B \ set (unlabel A) \ set (unlabel B)" +by (auto simp add: unlabel_def) + +lemma unlabel_in: "(l,x) \ set A \ x \ set (unlabel A)" +unfolding unlabel_def by force + +lemma unlabel_mem_has_label: "x \ set (unlabel A) \ \l. (l,x) \ 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 \ l' \ proj_unl l' [(ln l, a)] = []" + "proj_unl l [(\, a)] = [a]" + "unlabel [(l'', a)] = [a]" +unfolding proj_def unlabel_def by simp_all + +lemma unlabel_nil_only_if_nil[simp]: "unlabel A = [] \ 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 ((\,a)#A) = (\,a)#proj n A" + "m \ n \ proj n ((ln m,a)#A) = proj n A" + "l = (ln n) \ proj n ((l,a)#A) = (l,a)#proj n A" + "l = \ \ proj n ((l,a)#A) = (l,a)#proj n A" + "fst b \ \ \ fst b \ (ln n) \ 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 \ l' \ proj_unl l' ((ln l, a)#A) = proj_unl l' A" + "proj_unl l ((\, 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)) \ 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 (\, x)) \ trms_proj\<^sub>l\<^sub>s\<^sub>t l [(\, x)]" +by auto + +lemma trms\<^sub>l\<^sub>s\<^sub>t_union[simp]: "trms\<^sub>l\<^sub>s\<^sub>t A = (\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] = (\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 "\m. n \ m \ 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 "\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 "\l. trms_proj\<^sub>l\<^sub>s\<^sub>t l (a#A) = trms_proj\<^sub>l\<^sub>s\<^sub>t l [a] \ trms_proj\<^sub>l\<^sub>s\<^sub>t l A" + unfolding unlabel_def proj_def by auto + hence "(\l. trms_proj\<^sub>l\<^sub>s\<^sub>t l (a#A)) = (\l. trms_proj\<^sub>l\<^sub>s\<^sub>t l [a]) \ (\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 \ 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 \ 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 \ trms_proj\<^sub>l\<^sub>s\<^sub>t l (A@B)" + "trms_proj\<^sub>l\<^sub>s\<^sub>t l B \ 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 \ trms\<^sub>l\<^sub>s\<^sub>t (A@B)" + "trms\<^sub>l\<^sub>s\<^sub>t B \ 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 = (\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] = (\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 "\m. n \ m \ 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 "\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 "\l. vars_proj\<^sub>l\<^sub>s\<^sub>t l (a#A) = vars_proj\<^sub>l\<^sub>s\<^sub>t l [a] \ vars_proj\<^sub>l\<^sub>s\<^sub>t l A" + unfolding unlabel_def proj_def by auto + hence "(\l. vars_proj\<^sub>l\<^sub>s\<^sub>t l (a#A)) = (\l. vars_proj\<^sub>l\<^sub>s\<^sub>t l [a]) \ (\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 \ \A'. (\n. A = (ln n, b)#A') \ A = (\, b)#A'" +proof - + assume *: "unlabel A = b#B" + then obtain l A' where "A = (l,b)#A'" unfolding unlabel_def by moura + thus "\A'. (\l. A = (ln l, b)#A') \ A = (\, b)#A'" by (metis strand_label.exhaust) +qed + +lemma unlabel_snoc_inv: + "unlabel A = B@[b] \ \A'. (\n. A = A'@[(ln n, b)]) \ A = A'@[(\, 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 "\A'. (\n. A = A'@[(ln n, b)]) \ A = A'@[(\, 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) \ set A \ (\, Receive t) \ 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) \ 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) = (\l. ik\<^sub>s\<^sub>t (proj_unl l A))" +proof + show "(\l. ik\<^sub>s\<^sub>t (proj_unl l A)) \ 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) \ (\l. ik\<^sub>s\<^sub>t (proj_unl l A))" + proof + fix t assume "t \ ik\<^sub>s\<^sub>t (unlabel A)" + then obtain l where "(l, Receive t) \ set A" + using ik\<^sub>s\<^sub>t_is_rcv_set unlabel_mem_has_label[of _ A] + by moura + thus "t \ (\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) \ 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)) \\<^sub>s\<^sub>e\<^sub>t I = (ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t I) \ (ik\<^sub>s\<^sub>t (proj_unl l B) \\<^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) \ trms_proj\<^sub>l\<^sub>s\<^sub>t n A" +by auto + +lemma prefix_proj: + "prefix A B \ prefix (unlabel A) (unlabel B)" + "prefix A B \ prefix (proj n A) (proj n B)" + "prefix A B \ prefix (proj_unl n A) (proj_unl n B)" +unfolding prefix_def unlabel_def proj_def by auto + + +subsection \Lemmata: Well-formedness\ +lemma wfvarsoccs\<^sub>s\<^sub>t_proj_union: + "wfvarsoccs\<^sub>s\<^sub>t (unlabel A) = (\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]) = (\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 "\m. n \ m \ 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 "\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]) \ wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A)" + for l + unfolding unlabel_def proj_def by auto + hence "(\l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l (a#A))) = + (\l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a])) \ (\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 "\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) \ a = (\, 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 \ wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \ V" + proof + fix x assume "x \ fv t" + hence "x \ V \ wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A)" using wf_append_exec[OF *] b Receive by auto + thus "x \ wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \ V" using wfvarsoccs\<^sub>s\<^sub>t_proj_union[of A] by auto + qed + hence "fv t \ wfrestrictedvars\<^sub>s\<^sub>t (unlabel A) \ 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 \ wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \ V" when "ac = Assign" + proof + fix x assume "x \ fv t" + hence "x \ V \ wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A)" using wf_append_exec[OF *] b Equality that by auto + thus "x \ wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \ V" using wfvarsoccs\<^sub>s\<^sub>t_proj_union[of A] by auto + qed + hence "fv t \ wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t A \ 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 diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Lazy_Intruder.thy b/thys/Stateful_Protocol_Composition_and_Typing/Lazy_Intruder.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Lazy_Intruder.thy @@ -0,0 +1,884 @@ +(* +(C) Copyright Andreas Viktor Hess, DTU, 2015-2020 + +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +- Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +- Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(* Title: Lazy_Intruder.thy + Author: Andreas Viktor Hess, DTU +*) + +section \The Lazy Intruder\ +theory Lazy_Intruder +imports Strands_and_Constraints Intruder_Deduction +begin + +context intruder_model +begin + +subsection \Definition of the Lazy Intruder\ +text \The lazy intruder constraint reduction system, defined as a relation on constraint states\ +inductive_set LI_rel:: + "((('fun,'var) strand \ (('fun,'var) subst)) \ + ('fun,'var) strand \ (('fun,'var) subst)) set" + and LI_rel' (infix "\" 50) + and LI_rel_trancl (infix "\\<^sup>+" 50) + and LI_rel_rtrancl (infix "\\<^sup>*" 50) +where + "A \ B \ (A,B) \ LI_rel" +| "A \\<^sup>+ B \ (A,B) \ LI_rel\<^sup>+" +| "A \\<^sup>* B \ (A,B) \ LI_rel\<^sup>*" + +| Compose: "\simple S; length T = arity f; public f\ + \ (S@Send (Fun f T)#S',\) \ (S@(map Send T)@S',\)" +| Unify: "\simple S; Fun f T' \ ik\<^sub>s\<^sub>t S; Some \ = mgu (Fun f T) (Fun f T')\ + \ (S@Send (Fun f T)#S',\) \ ((S@S') \\<^sub>s\<^sub>t \,\ \\<^sub>s \)" +| Equality: "\simple S; Some \ = mgu t t'\ + \ (S@Equality _ t t'#S',\) \ ((S@S') \\<^sub>s\<^sub>t \,\ \\<^sub>s \)" + + +subsection \Lemma: The Lazy Intruder is Well-founded\ +context +begin +private lemma LI_compose_measure_lt: "((S@(map Send T)@S',\\<^sub>1), (S@Send (Fun f T)#S',\\<^sub>2)) \ 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 \ = mgu (Fun f T) t" "fv t \ fv\<^sub>s\<^sub>t S" + shows "(((S@S') \\<^sub>s\<^sub>t \,\\<^sub>1), (S@Send (Fun f T)#S',\\<^sub>2)) \ measure\<^sub>s\<^sub>t" +proof (cases "\ = Var") + assume "\ = Var" + hence "(S@S') \\<^sub>s\<^sub>t \ = 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 "\ \ Var" + then obtain v where "v \ fv (Fun f T) \ fv t" "subst_elim \ v" + using mgu_eliminates[OF assms(1)[symmetric]] by metis + hence v_in: "v \ 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 \ \ fv (Fun f T) \ fv\<^sub>s\<^sub>t S" + using assms(2) mgu_vars_bounded[OF assms(1)[symmetric]] by auto + hence img_bound: "range_vars \ \ 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 \ fv\<^sub>s\<^sub>t ((S@Send (Fun f T)#S') \\<^sub>s\<^sub>t \)" + using strand_fv_subst_subset_if_subst_elim[OF \subst_elim \ v\] v_in by metis + hence v_not_in: "v \ fv\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" by auto + + have "fv\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \) \ 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') \\<^sub>s\<^sub>t \) \ 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') \\<^sub>s\<^sub>t \)) < 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 \ = mgu t t'" + shows "(((S@S') \\<^sub>s\<^sub>t \,\\<^sub>1), (S@Equality a t t'#S',\\<^sub>2)) \ measure\<^sub>s\<^sub>t" +proof (cases "\ = Var") + assume "\ = Var" + hence "(S@S') \\<^sub>s\<^sub>t \ = 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 "\ \ Var" + then obtain v where "v \ fv t \ fv t'" "subst_elim \ v" + using mgu_eliminates[OF assms(1)[symmetric]] by metis + hence v_in: "v \ fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" using assms by auto + + have "range_vars \ \ fv t \ fv t' \ fv\<^sub>s\<^sub>t S" + using assms mgu_vars_bounded[OF assms(1)[symmetric]] by auto + hence img_bound: "range_vars \ \ 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 \ fv\<^sub>s\<^sub>t ((S@Equality a t t'#S') \\<^sub>s\<^sub>t \)" + using strand_fv_subst_subset_if_subst_elim[OF \subst_elim \ v\] v_in by metis + hence v_not_in: "v \ fv\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" by auto + + have "fv\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \) \ 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') \\<^sub>s\<^sub>t \) \ 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') \\<^sub>s\<^sub>t \)) < 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,\\<^sub>1) \ (S\<^sub>2,\\<^sub>2) \ ((S\<^sub>2,\\<^sub>2),(S\<^sub>1,\\<^sub>1)) \ measure\<^sub>s\<^sub>t" +proof (induction rule: LI_rel.induct) + case (Compose S T f S' \) thus ?case using LI_compose_measure_lt[of S T S'] by metis +next + case (Unify S f U \ T S' \) + hence "fv (Fun f U) \ 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,\\<^sub>1) \\<^sup>+ (S\<^sub>2,\\<^sub>2) \ ((S\<^sub>2,\\<^sub>2),(S\<^sub>1,\\<^sub>1)) \ 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>+)\)" +proof - + have "(LI_rel\<^sup>+)\ \ 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: "\(\f. \i. f i \\<^sup>+ f (Suc i))" +proof - + have "\(\f. \i. (f (Suc i), f i) \ (LI_rel\<^sup>+)\)" + 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',\), ((S@S') \\<^sub>s\<^sub>t \,\ \\<^sub>s \)) | \ T'. + simple S \ Fun f T' \ M \ Some \ = 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 = "\\. ((S@Send (Fun f T)#S',\), ((S@S') \\<^sub>s\<^sub>t \,\ \\<^sub>s \))" + let ?A = "\B. {?a \ | \ T'. simple S \ Fun f T' \ B \ Some \ = mgu (Fun f T) (Fun f T')}" + + have "?A (insert m M) = (?A M) \ (?A {m})" by auto + moreover have "finite (?A {m})" + proof (cases "\\. Some \ = mgu (Fun f T) (Fun g U)") + case True + then obtain \ where \: "Some \ = mgu (Fun f T) (Fun g U)" by blast + + have A_m_eq: "\\'. ?a \' \ ?A {m} \ ?a \ = ?a \'" + proof - + fix \' assume "?a \' \ ?A {m}" + hence "\\. Some \ = mgu (Fun f T) (Fun g U) \ ?a \ = ?a \'" + using \m = Fun g U\ by auto + thus "?a \ = ?a \'" by (metis \ option.inject) + qed + + have "?A {m} = {} \ ?A {m} = {?a \}" + proof (cases "simple S \ ?A {m} \ {}") + case True + hence "simple S" "?A {m} \ {}" by meson+ + hence "?A {m} = {?a \ | \. Some \ = mgu (Fun f T) (Fun g U)}" using \m = Fun g U\ by auto + hence "?a \ \ ?A {m}" using \ by auto + show ?thesis + proof (rule ccontr) + assume "\(?A {m} = {} \ ?A {m} = {?a \})" + then obtain B where B: "?A {m} = insert (?a \) B" "?a \ \ B" "B \ {}" + using \?A {m} \ {}\ \?a \ \ ?A {m}\ by (metis (no_types, lifting) Set.set_insert) + then obtain b where b: "?a \ \ b" "b \ B" by (metis (no_types, lifting) ex_in_conv) + then obtain \' where \': "b = ?a \'" using B(1) by blast + moreover have "?a \' \ ?A {m}" using B(1) b(2) \' by auto + hence "?a \ = ?a \'" 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 \m = Fun g U\ by blast + thus ?thesis by (metis finite.emptyI) + qed + ultimately show ?thesis using insert.IH by auto + qed simp +qed fastforce +end + + +subsection \Lemma: The Lazy Intruder Preserves Well-formedness\ +context +begin +private lemma LI_preserves_subst_wf_single: + assumes "(S\<^sub>1,\\<^sub>1) \ (S\<^sub>2,\\<^sub>2)" "fv\<^sub>s\<^sub>t S\<^sub>1 \ bvars\<^sub>s\<^sub>t S\<^sub>1 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>1" + and "subst_domain \\<^sub>1 \ vars\<^sub>s\<^sub>t S\<^sub>1 = {}" "range_vars \\<^sub>1 \ bvars\<^sub>s\<^sub>t S\<^sub>1 = {}" + shows "fv\<^sub>s\<^sub>t S\<^sub>2 \ bvars\<^sub>s\<^sub>t S\<^sub>2 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>2" + and "subst_domain \\<^sub>2 \ vars\<^sub>s\<^sub>t S\<^sub>2 = {}" "range_vars \\<^sub>2 \ bvars\<^sub>s\<^sub>t S\<^sub>2 = {}" +using assms +proof (induction rule: LI_rel.induct) + case (Compose S X f S' \) + { 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 \ T S' \) + hence "fv (Fun f U) \ fv\<^sub>s\<^sub>t S" using fv_subset_if_in_strand_ik' by blast + hence *: "subst_domain \ \ range_vars \ \ 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') \ fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" "vars\<^sub>s\<^sub>t (S@S') \ vars\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" + by auto + hence **: "fv\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" + "vars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) \ vars\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" + using subst_sends_strand_fv_to_img[of "S@S'" \] + strand_subst_vars_union_bound[of "S@S'" \] * + by blast+ + + have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" by (fact mgu_gives_wellformed_subst[OF Unify.hyps(3)[symmetric]]) + + { case 1 + have "bvars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = bvars\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" + using bvars_subst_ident[of "S@S'" \] by auto + thus ?case using 1 ** by blast + } + { case 2 + hence "subst_domain \ \ subst_domain \ = {}" "subst_domain \ \ range_vars \ = {}" + using * by blast+ + thus ?case by (metis wf_subst_compose[OF \wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\ \wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\]) + } + { case 3 + hence "subst_domain \ \ vars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = {}" using ** by blast + moreover have "v \ fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" when "v \ subst_domain \" for v + using * that by blast + hence "subst_domain \ \ fv\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = {}" + 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' \\<^sub>s\<^sub>t \) = bvars\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" + using bvars_subst_ident[of "S@S'" \] by auto + hence "subst_domain \ \ bvars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = {}" using 3(1) * by blast + ultimately show ?case + using ** * subst_domain_compose[of \ \] vars\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>t[of "S@S' \\<^sub>s\<^sub>t \"] + by blast + } + { case 4 + have ***: "bvars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = bvars\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" + using bvars_subst_ident[of "S@S'" \] by auto + hence "range_vars \ \ bvars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = {}" using 4(1) * by blast + thus ?case using subst_img_comp_subset[of \ \] 4(4) *** by blast + } +next + case (Equality S \ t t' a S' \) + hence *: "subst_domain \ \ range_vars \ \ 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') \ fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" "vars\<^sub>s\<^sub>t (S@S') \ vars\<^sub>s\<^sub>t (S@Equality a t t'#S')" + by auto + hence **: "fv\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" + "vars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) \ vars\<^sub>s\<^sub>t (S@Equality a t t'#S')" + using subst_sends_strand_fv_to_img[of "S@S'" \] + strand_subst_vars_union_bound[of "S@S'" \] * + by blast+ + + have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" by (fact mgu_gives_wellformed_subst[OF Equality.hyps(2)[symmetric]]) + + { case 1 + have "bvars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = bvars\<^sub>s\<^sub>t (S@Equality a t t'#S')" + using bvars_subst_ident[of "S@S'" \] by auto + thus ?case using 1 ** by blast + } + { case 2 + hence "subst_domain \ \ subst_domain \ = {}" "subst_domain \ \ range_vars \ = {}" + using * by blast+ + thus ?case by (metis wf_subst_compose[OF \wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\ \wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\]) + } + { case 3 + hence "subst_domain \ \ vars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = {}" using ** by blast + moreover have "v \ fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" when "v \ subst_domain \" for v + using * that by blast + hence "subst_domain \ \ fv\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = {}" + 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' \\<^sub>s\<^sub>t \) = bvars\<^sub>s\<^sub>t (S@Equality a t t'#S')" + using bvars_subst_ident[of "S@S'" \] by auto + hence "subst_domain \ \ bvars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = {}" using 3(1) * by blast + ultimately show ?case + using ** * subst_domain_compose[of \ \] vars\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>t[of "S@S' \\<^sub>s\<^sub>t \"] + by blast + } + { case 4 + have ***: "bvars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = bvars\<^sub>s\<^sub>t (S@Equality a t t'#S')" + using bvars_subst_ident[of "S@S'" \] by auto + hence "range_vars \ \ bvars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = {}" using 4(1) * by blast + thus ?case using subst_img_comp_subset[of \ \] 4(4) *** by blast + } +qed + +private lemma LI_preserves_subst_wf: + assumes "(S\<^sub>1,\\<^sub>1) \\<^sup>* (S\<^sub>2,\\<^sub>2)" "fv\<^sub>s\<^sub>t S\<^sub>1 \ bvars\<^sub>s\<^sub>t S\<^sub>1 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>1" + and "subst_domain \\<^sub>1 \ vars\<^sub>s\<^sub>t S\<^sub>1 = {}" "range_vars \\<^sub>1 \ bvars\<^sub>s\<^sub>t S\<^sub>1 = {}" + shows "fv\<^sub>s\<^sub>t S\<^sub>2 \ bvars\<^sub>s\<^sub>t S\<^sub>2 = {}" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>2" + and "subst_domain \\<^sub>2 \ vars\<^sub>s\<^sub>t S\<^sub>2 = {}" "range_vars \\<^sub>2 \ bvars\<^sub>s\<^sub>t S\<^sub>2 = {}" +using assms +proof (induction S\<^sub>2 \\<^sub>2 rule: rtrancl_induct2) + case (step S\<^sub>i \\<^sub>i S\<^sub>j \\<^sub>j) + { case 1 thus ?case using LI_preserves_subst_wf_single[OF \(S\<^sub>i,\\<^sub>i) \ (S\<^sub>j,\\<^sub>j)\] step.IH by metis } + { case 2 thus ?case using LI_preserves_subst_wf_single[OF \(S\<^sub>i,\\<^sub>i) \ (S\<^sub>j,\\<^sub>j)\] step.IH by metis } + { case 3 thus ?case using LI_preserves_subst_wf_single[OF \(S\<^sub>i,\\<^sub>i) \ (S\<^sub>j,\\<^sub>j)\] step.IH by metis } + { case 4 thus ?case using LI_preserves_subst_wf_single[OF \(S\<^sub>i,\\<^sub>i) \ (S\<^sub>j,\\<^sub>j)\] step.IH by metis } +qed metis + +lemma LI_preserves_wellformedness: + assumes "(S\<^sub>1,\\<^sub>1) \\<^sup>* (S\<^sub>2,\\<^sub>2)" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \\<^sub>1" + shows "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>2 \\<^sub>2" +proof - + have *: "wf\<^sub>s\<^sub>t {} S\<^sub>j" + when "(S\<^sub>i, \\<^sub>i) \ (S\<^sub>j, \\<^sub>j)" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>i \\<^sub>i" for S\<^sub>i \\<^sub>i S\<^sub>j \\<^sub>j + using that + proof (induction rule: LI_rel.induct) + case (Unify S f U \ T S' \) + have "fv (Fun f T) \ fv (Fun f U) \ fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" using Unify.hyps(2) by force + hence "subst_domain \ \ range_vars \ \ 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 \ \ range_vars \) \ 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 \ t t' a S' \) + have "fv t \ fv t' \ fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" using Equality.hyps(2) by force + hence "subst_domain \ \ range_vars \ \ 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 \ \ range_vars \) \ 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 \\<^sub>i S\<^sub>j \\<^sub>j) thus ?case + using LI_preserves_subst_wf_single[OF \(S\<^sub>i,\\<^sub>i) \ (S\<^sub>j,\\<^sub>j)\] *[OF \(S\<^sub>i,\\<^sub>i) \ (S\<^sub>j,\\<^sub>j)\] + 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,\) \\<^sup>* (S',\')" "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 \ S' \' + assume "(S,\) \ (S',\')" "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' \) + hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" + and *: "t \ set S \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p t)" "t \ set S' \ 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 \ 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 \ 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 \ T S' \) + 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 \)" + using mgu_wf_trm[OF Unify.hyps(3)[symmetric]] by simp + + { fix s assume "s \ set (S@S' \\<^sub>s\<^sub>t \)" + hence "\s' \ set (S@S'). s = s' \\<^sub>s\<^sub>t\<^sub>p \ \ 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' \\<^sub>s\<^sub>t\<^sub>p \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')" "s' \ set (S@S')" + from s'(2) have "trms\<^sub>s\<^sub>t\<^sub>p (s' \\<^sub>s\<^sub>t\<^sub>p \) = trms\<^sub>s\<^sub>t\<^sub>p s' \\<^sub>s\<^sub>e\<^sub>t (rm_vars (set (bvars\<^sub>s\<^sub>t\<^sub>p s')) \)" + 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]] \wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')\ 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 \ t t' a S' \) + 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 \)" + using mgu_wf_trm[OF Equality.hyps(2)[symmetric]] by simp + + { fix s assume "s \ set (S@S' \\<^sub>s\<^sub>t \)" + hence "\s' \ set (S@S'). s = s' \\<^sub>s\<^sub>t\<^sub>p \ \ 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' \\<^sub>s\<^sub>t\<^sub>p \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')" "s' \ set (S@S')" + from s'(2) have "trms\<^sub>s\<^sub>t\<^sub>p (s' \\<^sub>s\<^sub>t\<^sub>p \) = trms\<^sub>s\<^sub>t\<^sub>p s' \\<^sub>s\<^sub>e\<^sub>t (rm_vars (set (bvars\<^sub>s\<^sub>t\<^sub>p s')) \)" + 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]] \wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p s')\ 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 \Theorem: Soundness of the Lazy Intruder\ +context +begin +private lemma LI_soundness_single: + assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \\<^sub>1" "(S\<^sub>1,\\<^sub>1) \ (S\<^sub>2,\\<^sub>2)" "\ \\<^sub>c \S\<^sub>2,\\<^sub>2\" + shows "\ \\<^sub>c \S\<^sub>1,\\<^sub>1\" +using assms(2,1,3) +proof (induction rule: LI_rel.induct) + case (Compose S T f S' \) + hence *: "\{}; S\\<^sub>c \" "\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; map Send T\\<^sub>c \" "\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; S'\\<^sub>c \" + unfolding constr_sem_c_def by force+ + + have "ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c Fun f T \ \" + using *(2) Compose.hyps(2) ComposeC[OF _ Compose.hyps(3), of "map (\x. x \ \) T"] + unfolding subst_compose_def by force + thus "\ \\<^sub>c \S@Send (Fun f T)#S',\\" + using *(1,3) \\ \\<^sub>c \S@map Send T@S',\\\ + by (auto simp add: constr_sem_c_def) +next + case (Unify S f U \ T S' \) + have "(\ \\<^sub>s \) supports \" "\{}; S@S' \\<^sub>s\<^sub>t \\\<^sub>c \" + using Unify.prems(2) unfolding constr_sem_c_def by metis+ + then obtain \ where \: "\ \\<^sub>s \ \\<^sub>s \ = \" unfolding subst_compose_def by auto + + have \fun_id: "Fun f U \ \ = Fun f U" "Fun f T \ \ = Fun f T" + using Unify.prems(1) trm_subst_ident[of "Fun f U" \] + 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" \] + unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by fastforce + hence \\_disj: + "subst_domain \ \ subst_domain \ = {}" + "subst_domain \ \ range_vars \ = {}" + "subst_domain \ \ range_vars \ = {}" + 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 \\_support: "\ supports \" "\ supports \" + by (simp_all add: subst_support_comp_split[OF \(\ \\<^sub>s \) supports \\]) + + have "fv (Fun f T) \ fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" "fv (Fun f U) \ fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" + using Unify.hyps(2) by force+ + hence \_vars_bound: "subst_domain \ \ range_vars \ \ fv\<^sub>s\<^sub>t (S@Send (Fun f T)#S')" + using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] by blast + + have "\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; [Send (Fun f T)]\\<^sub>c \" + proof - + from Unify.hyps(2) have "Fun f U \ \ \ ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \" by blast + hence "Fun f U \ \ \ ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \" by blast + moreover have "Unifier \ (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 \ \ \ ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \" + using \ by (metis \fun_id subst_subst_compose) + thus ?thesis by simp + qed + + have "\{}; S\\<^sub>c \" "\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; S'\\<^sub>c \" + proof - + have "(S@S' \\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>t \ = S@S' \\<^sub>s\<^sub>t \" "(S@S') \\<^sub>s\<^sub>t \ = S@S'" + proof - + have "subst_domain \ \ 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 \ \ vars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = {}" + using \\_disj(2) strand_subst_vars_union_bound[of "S@S'" \] by blast + thus "(S@S' \\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>t \ = S@S' \\<^sub>s\<^sub>t \" "(S@S') \\<^sub>s\<^sub>t \ = S@S'" + using strand_subst_comp \subst_domain \ \ vars\<^sub>s\<^sub>t (S@S') = {}\ by (blast,blast) + qed + moreover have "subst_idem \" by (fact mgu_gives_subst_idem[OF Unify.hyps(3)[symmetric]]) + moreover have + "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t (S@S') = {}" + "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = {}" + "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t (S@S') = {}" + using wf_constr_bvars_disj[OF Unify.prems(1)] + wf_constr_bvars_disj'[OF Unify.prems(1) \_vars_bound] + by auto + ultimately have "\{}; S@S'\\<^sub>c \" + using \\{}; S@S' \\<^sub>s\<^sub>t \\\<^sub>c \\ \ + strand_sem_subst(1)[of \ "S@S' \\<^sub>s\<^sub>t \" "{}" "\ \\<^sub>s \"] + strand_sem_subst(2)[of \ "S@S'" "{}" "\ \\<^sub>s \"] + strand_sem_subst_subst_idem[of \ "S@S'" "{}" \] + unfolding constr_sem_c_def + by (metis subst_compose_assoc) + thus "\{}; S\\<^sub>c \" "\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; S'\\<^sub>c \" by auto + qed + + show "\ \\<^sub>c \S@Send (Fun f T)#S',\\" + using \\_support(1) \\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; [Send (Fun f T)]\\<^sub>c \\ \\{}; S\\<^sub>c \\ \\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; S'\\<^sub>c \\ + by (auto simp add: constr_sem_c_def) +next + case (Equality S \ t t' a S' \) + have "(\ \\<^sub>s \) supports \" "\{}; S@S' \\<^sub>s\<^sub>t \\\<^sub>c \" + using Equality.prems(2) unfolding constr_sem_c_def by metis+ + then obtain \ where \: "\ \\<^sub>s \ \\<^sub>s \ = \" unfolding subst_compose_def by auto + + have "fv t \ vars\<^sub>s\<^sub>t (S@Equality a t t'#S')" "fv t' \ vars\<^sub>s\<^sub>t (S@Equality a t t'#S')" + by auto + moreover have "subst_domain \ \ vars\<^sub>s\<^sub>t (S@Equality a t t'#S') = {}" + using Equality.prems(1) unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by auto + ultimately have \fun_id: "t \ \ = t" "t' \ \ = t'" + using trm_subst_ident[of t \] trm_subst_ident[of t' \] + by auto + hence \\_disj: + "subst_domain \ \ subst_domain \ = {}" + "subst_domain \ \ range_vars \ = {}" + "subst_domain \ \ range_vars \ = {}" + using trm_subst_disj mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] apply (blast,blast) + using Equality.prems(1) unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by blast + hence \\_support: "\ supports \" "\ supports \" + by (simp_all add: subst_support_comp_split[OF \(\ \\<^sub>s \) supports \\]) + + have "fv t \ fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" "fv t' \ fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" by auto + hence \_vars_bound: "subst_domain \ \ range_vars \ \ fv\<^sub>s\<^sub>t (S@Equality a t t'#S')" + using mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] by blast + + have "\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; [Equality a t t']\\<^sub>c \" + proof - + have "t \ \ = t' \ \" + using MGU_is_Unifier[OF mgu_gives_MGU[OF Equality.hyps(2)[symmetric]]] + by metis + hence "t \ (\ \\<^sub>s \) = t' \ (\ \\<^sub>s \)" by (metis \fun_id subst_subst_compose) + hence "t \ \ = t' \ \" by (metis \ subst_subst_compose) + thus ?thesis by simp + qed + + have "\{}; S\\<^sub>c \" "\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; S'\\<^sub>c \" + proof - + have "(S@S' \\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>t \ = S@S' \\<^sub>s\<^sub>t \" "(S@S') \\<^sub>s\<^sub>t \ = S@S'" + proof - + have "subst_domain \ \ vars\<^sub>s\<^sub>t (S@S') = {}" + using Equality.prems(1) + by (fastforce simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def simp del: subst_range.simps) + hence "subst_domain \ \ fv\<^sub>s\<^sub>t (S@S') = {}" by blast + hence "subst_domain \ \ fv\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = {}" + using \\_disj(2) subst_sends_strand_fv_to_img[of "S@S'" \] by blast + thus "(S@S' \\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>t \ = S@S' \\<^sub>s\<^sub>t \" "(S@S') \\<^sub>s\<^sub>t \ = S@S'" + using strand_subst_comp \subst_domain \ \ vars\<^sub>s\<^sub>t (S@S') = {}\ by (blast,blast) + qed + moreover have + "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t (S@S') = {}" + "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \) = {}" + "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t (S@S') = {}" + using wf_constr_bvars_disj[OF Equality.prems(1)] + wf_constr_bvars_disj'[OF Equality.prems(1) \_vars_bound] + by auto + ultimately have "\{}; S@S'\\<^sub>c \" + using \\{}; S@S' \\<^sub>s\<^sub>t \\\<^sub>c \\ \ + strand_sem_subst(1)[of \ "S@S' \\<^sub>s\<^sub>t \" "{}" "\ \\<^sub>s \"] + strand_sem_subst(2)[of \ "S@S'" "{}" "\ \\<^sub>s \"] + strand_sem_subst_subst_idem[of \ "S@S'" "{}" \] + mgu_gives_subst_idem[OF Equality.hyps(2)[symmetric]] + unfolding constr_sem_c_def + by (metis subst_compose_assoc) + thus "\{}; S\\<^sub>c \" "\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; S'\\<^sub>c \" by auto + qed + + show "\ \\<^sub>c \S@Equality a t t'#S',\\" + using \\_support(1) \\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; [Equality a t t']\\<^sub>c \\ \\{}; S\\<^sub>c \\ \\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; S'\\<^sub>c \\ + by (auto simp add: constr_sem_c_def) +qed + +theorem LI_soundness: + assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \\<^sub>1" "(S\<^sub>1,\\<^sub>1) \\<^sup>* (S\<^sub>2,\\<^sub>2)" "\ \\<^sub>c \S\<^sub>2, \\<^sub>2\" + shows "\ \\<^sub>c \S\<^sub>1, \\<^sub>1\" +using assms(2,1,3) +proof (induction S\<^sub>2 \\<^sub>2 rule: rtrancl_induct2) + case (step S\<^sub>i \\<^sub>i S\<^sub>j \\<^sub>j) thus ?case + using LI_preserves_wellformedness[OF \(S\<^sub>1, \\<^sub>1) \\<^sup>* (S\<^sub>i, \\<^sub>i)\ \wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \\<^sub>1\] + LI_soundness_single[OF _ \(S\<^sub>i, \\<^sub>i) \ (S\<^sub>j, \\<^sub>j)\ \\ \\<^sub>c \S\<^sub>j, \\<^sub>j\\] + step.IH[OF \wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \\<^sub>1\] + by metis +qed metis +end + +subsection \Theorem: Completeness of the Lazy Intruder\ +context +begin +private lemma LI_completeness_single: + assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \\<^sub>1" "\ \\<^sub>c \S\<^sub>1, \\<^sub>1\" "\simple S\<^sub>1" + shows "\S\<^sub>2 \\<^sub>2. (S\<^sub>1,\\<^sub>1) \ (S\<^sub>2,\\<^sub>2) \ (\ \\<^sub>c \S\<^sub>2, \\<^sub>2\)" +using not_simple_elim[OF \\simple S\<^sub>1\] +proof - + { \ \In this case \S\<^sub>1\ isn't simple because it contains an equality constraint, + so we can simply proceed with the reduction by computing the MGU for the equation\ + assume "\S' S'' a t t'. S\<^sub>1 = S'@Equality a t t'#S'' \ simple S'" + then obtain S a t t' S' where S\<^sub>1: "S\<^sub>1 = S@Equality a t t'#S'" "simple S" by moura + hence *: "wf\<^sub>s\<^sub>t {} S" "\ \\<^sub>c \S, \\<^sub>1\" "\\<^sub>1 supports \" "t \ \ = t' \ \" + using \\ \\<^sub>c \S\<^sub>1, \\<^sub>1\\ \wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \\<^sub>1\ wf_eq_fv[of "{}" S t t' S'] + fv_snd_rcv_strand_subset(5)[of S] + by (auto simp add: constr_sem_c_def wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def) + + from * have "Unifier \ t t'" by simp + then obtain \ where \: + "Some \ = mgu t t'" "subst_idem \" "subst_domain \ \ range_vars \ \ fv t \ fv t'" + using mgu_always_unifies mgu_gives_subst_idem mgu_vars_bounded by metis+ + + have "\ \\<^sub>\ \" + using mgu_gives_MGU[OF \(1)[symmetric]] + by (metis \Unifier \ t t'\) + hence "\ supports \" using subst_support_if_mgt_subst_idem[OF _ \(2)] by metis + hence "(\\<^sub>1 \\<^sub>s \) supports \" using subst_support_comp \\\<^sub>1 supports \\ by metis + + have "\{}; S@S' \\<^sub>s\<^sub>t \\\<^sub>c \" + proof - + have "subst_domain \ \ range_vars \ \ fv\<^sub>s\<^sub>t S\<^sub>1" using \(3) S\<^sub>1(1) by auto + hence "\{}; S\<^sub>1 \\<^sub>s\<^sub>t \\\<^sub>c \" + using \subst_idem \\ \\ \\<^sub>\ \\ \\ \\<^sub>c \S\<^sub>1, \\<^sub>1\\ strand_sem_subst + wf_constr_bvars_disj'(1)[OF assms(1)] + unfolding subst_idem_def constr_sem_c_def + by (metis (no_types) subst_compose_assoc) + thus "\{}; S@S' \\<^sub>s\<^sub>t \\\<^sub>c \" using S\<^sub>1(1) by force + qed + moreover have "(S@Equality a t t'#S', \\<^sub>1) \ (S@S' \\<^sub>s\<^sub>t \, \\<^sub>1 \\<^sub>s \)" + using LI_rel.Equality[OF \simple S\ \(1)] S\<^sub>1 by metis + ultimately have ?thesis + using S\<^sub>1(1) \(\\<^sub>1 \\<^sub>s \) supports \\ + by (auto simp add: constr_sem_c_def) + } moreover { + \ \In this case \S\<^sub>1\ isn't simple because it contains a deduction constraint for a composed + term, so we must look at how this composed term is derived under the interpretation \\\\ + assume "\S' S'' f T. S\<^sub>1 = S'@Send (Fun f T)#S'' \ simple S'" + with assms obtain S f T S' where S\<^sub>1: "S\<^sub>1 = S@Send (Fun f T)#S'" "simple S" by moura + hence "wf\<^sub>s\<^sub>t {} S" "\ \\<^sub>c \S, \\<^sub>1\" "\\<^sub>1 supports \" + using \\ \\<^sub>c \S\<^sub>1, \\<^sub>1\\ \wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \\<^sub>1\ + by (auto simp add: constr_sem_c_def wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def) + + \ \Lemma for a common subcase\ + have fun_sat: "\ \\<^sub>c \S@(map Send T)@S', \\<^sub>1\" when T: "\t. t \ set T \ ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \" + proof - + have "\t. t \ set T \ \ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; [Send t]\\<^sub>c \" using T by simp + hence "\ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \; map Send T\\<^sub>c \" using \\ \\<^sub>c \S\<^sub>1, \\<^sub>1\\ strand_sem_Send_map by metis + moreover have "\ik\<^sub>s\<^sub>t (S@(map Send T)) \\<^sub>s\<^sub>e\<^sub>t \; S'\\<^sub>c \" + using \\ \\<^sub>c \S\<^sub>1, \\<^sub>1\\ S\<^sub>1 + by (auto simp add: constr_sem_c_def) + ultimately show ?thesis + using \\ \\<^sub>c \S, \\<^sub>1\\ \\ \\<^sub>c \S\<^sub>1, \\<^sub>1\\ + by (force simp add: constr_sem_c_def) + qed + + from S\<^sub>1 \\ \\<^sub>c \S\<^sub>1, \\<^sub>1\\ have "ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c Fun f T \ \" by (auto simp add: constr_sem_c_def) + hence ?thesis + proof cases + \ \Case 1: \\(f(T))\ has been derived using the \AxiomC\ rule.\ + case AxiomC + hence ex_t: "\t. t \ ik\<^sub>s\<^sub>t S \ Fun f T \ \ = t \ \" by auto + show ?thesis + proof (cases "\T'. Fun f T' \ ik\<^sub>s\<^sub>t S \ Fun f T \ \ \ Fun f T' \ \") + \ \Case 1.1: \f(T)\ is equal to a variable in the intruder knowledge under \\\. + Hence there must exists a deduction constraint in the simple prefix of the constraint + in which this variable occurs/"is sent" for the first time. Since this variable itself + cannot have been derived from the \AxiomC\ rule (because it must be equal under the + interpretation to \f(T)\, which is by assumption not in the intruder knowledge under + \\\) it must be the case that we can derive it using the \ComposeC\ rule. Hence we can + apply the \Compose\ rule of the lazy intruder to \f(T)\.\ + case True + have "\v. Var v \ ik\<^sub>s\<^sub>t S \ Fun f T \ \ = \ v" + proof - + obtain t where "t \ ik\<^sub>s\<^sub>t S" "Fun f T \ \ = t \ \" using ex_t by moura + thus ?thesis + using \\T'. Fun f T' \ ik\<^sub>s\<^sub>t S \ Fun f T \ \ \ Fun f T' \ \\ + by (cases t) auto + qed + hence "\v \ wfrestrictedvars\<^sub>s\<^sub>t S. Fun f T \ \ = \ v" + using vars_subset_if_in_strand_ik2[of _ S] by fastforce + then obtain v S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f + where S: "S = S\<^sub>p\<^sub>r\<^sub>e@Send (Var v)#S\<^sub>s\<^sub>u\<^sub>f" "Fun f T \ \ = \ v" + "\(\w \ wfrestrictedvars\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e. Fun f T \ \ = \ w)" + using \wf\<^sub>s\<^sub>t {} S\ wf_simple_strand_first_Send_var_split[OF _ \simple S\, of "Fun f T" \] + by auto + hence "\w. Var w \ ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \ \ v \ Var w \ \" by auto + moreover have "\T'. Fun f T' \ ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \ Fun f T \ \ \ Fun f T' \ \" + using \\T'. Fun f T' \ ik\<^sub>s\<^sub>t S \ Fun f T \ \ \ Fun f T' \ \\ S(1) + by (meson contra_subsetD ik_append_subset(1)) + hence "\g T'. Fun g T' \ ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \ \ v \ Fun g T' \ \" using S(2) by simp + ultimately have "\t \ ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e. \ v \ t \ \" by (metis term.exhaust) + hence "\ v \ (ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e) \\<^sub>s\<^sub>e\<^sub>t \" by auto + + have "ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c \ v" + using S\<^sub>1(1) S(1) \\ \\<^sub>c \S\<^sub>1, \\<^sub>1\\ + by (auto simp add: constr_sem_c_def) + hence "ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c Fun f T \ \" using \Fun f T \ \ = \ v\ by metis + hence "length T = arity f" "public f" "\t. t \ set T \ ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \" + using \Fun f T \ \ = \ v\ \\ v \ ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \\<^sub>s\<^sub>e\<^sub>t \\ + intruder_synth.simps[of "ik\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e \\<^sub>s\<^sub>e\<^sub>t \" "\ v"] + by auto + hence *: "\t. t \ set T \ ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \" + using S(1) by (auto intro: ideduct_synth_mono) + hence "\ \\<^sub>c \S@(map Send T)@S', \\<^sub>1\" by (metis fun_sat) + moreover have "(S@Send (Fun f T)#S', \\<^sub>1) \ (S@map Send T@S', \\<^sub>1)" + by (metis LI_rel.Compose[OF \simple S\ \length T = arity f\ \public f\]) + ultimately show ?thesis using S\<^sub>1 by auto + next + \ \Case 1.2: \\(f(T))\ can be derived from an interpreted composed term in the intruder + knowledge. Use the \Unify\ rule on this composed term to further reduce the constraint.\ + case False + then obtain T' where t: "Fun f T' \ ik\<^sub>s\<^sub>t S" "Fun f T \ \ = Fun f T' \ \" + by auto + hence "fv (Fun f T') \ fv\<^sub>s\<^sub>t S\<^sub>1" + using S\<^sub>1(1) fv_subset_if_in_strand_ik'[OF t(1)] + fv_snd_rcv_strand_subset(2)[of S] + by auto + from t have "Unifier \ (Fun f T) (Fun f T')" by simp + then obtain \ where \: + "Some \ = mgu (Fun f T) (Fun f T')" "subst_idem \" + "subst_domain \ \ range_vars \ \ fv (Fun f T) \ fv (Fun f T')" + using mgu_always_unifies mgu_gives_subst_idem mgu_vars_bounded by metis+ + + have "\ \\<^sub>\ \" + using mgu_gives_MGU[OF \(1)[symmetric]] + by (metis \Unifier \ (Fun f T) (Fun f T')\) + hence "\ supports \" using subst_support_if_mgt_subst_idem[OF _ \(2)] by metis + hence "(\\<^sub>1 \\<^sub>s \) supports \" using subst_support_comp \\\<^sub>1 supports \\ by metis + + have "\{}; S@S' \\<^sub>s\<^sub>t \\\<^sub>c \" + proof - + have "subst_domain \ \ range_vars \ \ fv\<^sub>s\<^sub>t S\<^sub>1" + using \(3) S\<^sub>1(1) \fv (Fun f T') \ fv\<^sub>s\<^sub>t S\<^sub>1\ + unfolding range_vars_alt_def by (fastforce simp del: subst_range.simps) + hence "\{}; S\<^sub>1 \\<^sub>s\<^sub>t \\\<^sub>c \" + using \subst_idem \\ \\ \\<^sub>\ \\ \\ \\<^sub>c \S\<^sub>1, \\<^sub>1\\ strand_sem_subst + wf_constr_bvars_disj'(1)[OF assms(1)] + unfolding subst_idem_def constr_sem_c_def + by (metis (no_types) subst_compose_assoc) + thus "\{}; S@S' \\<^sub>s\<^sub>t \\\<^sub>c \" using S\<^sub>1(1) by force + qed + moreover have "(S@Send (Fun f T)#S', \\<^sub>1) \ (S@S' \\<^sub>s\<^sub>t \, \\<^sub>1 \\<^sub>s \)" + using LI_rel.Unify[OF \simple S\ t(1) \(1)] S\<^sub>1 by metis + ultimately show ?thesis + using S\<^sub>1(1) \(\\<^sub>1 \\<^sub>s \) supports \\ + by (auto simp add: constr_sem_c_def) + qed + next + \ \Case 2: \\(f(T))\ has been derived using the \ComposeC\ rule. + Simply use the \Compose\ rule of the lazy intruder to proceed with the reduction.\ + case (ComposeC T' g) + hence "f = g" "length T = arity f" "public f" + and "\x. x \ set T \ ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c x \ \" + by auto + hence "\ \\<^sub>c \S@(map Send T)@S', \\<^sub>1\" using fun_sat by metis + moreover have "(S\<^sub>1, \\<^sub>1) \ (S@(map Send T)@S', \\<^sub>1)" + using S\<^sub>1 LI_rel.Compose[OF \simple S\ \length T = arity f\ \public f\] + by metis + ultimately show ?thesis by metis + qed + } moreover have "\A B X F. S\<^sub>1 = A@Inequality X F#B \ ineq_model \ X F" + using assms(2) by (auto simp add: constr_sem_c_def) + ultimately show ?thesis using not_simple_elim[OF \\simple S\<^sub>1\] by metis +qed + +theorem LI_completeness: + assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \\<^sub>1" "\ \\<^sub>c \S\<^sub>1, \\<^sub>1\" + shows "\S\<^sub>2 \\<^sub>2. (S\<^sub>1,\\<^sub>1) \\<^sup>* (S\<^sub>2,\\<^sub>2) \ simple S\<^sub>2 \ (\ \\<^sub>c \S\<^sub>2, \\<^sub>2\)" +proof (cases "simple S\<^sub>1") + case False + let ?Stuck = "\S\<^sub>2 \\<^sub>2. \(\S\<^sub>3 \\<^sub>3. (S\<^sub>2,\\<^sub>2) \ (S\<^sub>3,\\<^sub>3) \ (\ \\<^sub>c \S\<^sub>3, \\<^sub>3\))" + let ?Sats = "{((S,\),(S',\')). (S,\) \ (S',\') \ (\ \\<^sub>c \S, \\) \ (\ \\<^sub>c \S', \'\)}" + + have simple_if_stuck: + "\S\<^sub>2 \\<^sub>2. \(S\<^sub>1,\\<^sub>1) \\<^sup>+ (S\<^sub>2,\\<^sub>2); \ \\<^sub>c \S\<^sub>2, \\<^sub>2\; ?Stuck S\<^sub>2 \\<^sub>2\ \ simple S\<^sub>2" + using LI_completeness_single + LI_preserves_wellformedness + \wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \\<^sub>1\ + trancl_into_rtrancl + by metis + + have base: "\b. ((S\<^sub>1,\\<^sub>1),b) \ ?Sats" + using LI_completeness_single[OF assms False] assms(2) + by auto + + have *: "\S \ S' \'. ((S,\),(S',\')) \ ?Sats\<^sup>+ \ (S,\) \\<^sup>+ (S',\') \ (\ \\<^sub>c \S', \'\)" + proof - + fix S \ S' \' + assume "((S,\),(S',\')) \ ?Sats\<^sup>+" + thus "(S,\) \\<^sup>+ (S',\') \ (\ \\<^sub>c \S', \'\)" + by (induct rule: trancl_induct2) auto + qed + + have "\S\<^sub>2 \\<^sub>2. ((S\<^sub>1,\\<^sub>1),(S\<^sub>2,\\<^sub>2)) \ ?Sats\<^sup>+ \ ?Stuck S\<^sub>2 \\<^sub>2" + proof (rule ccontr) + assume "\(\S\<^sub>2 \\<^sub>2. ((S\<^sub>1,\\<^sub>1),(S\<^sub>2,\\<^sub>2)) \ ?Sats\<^sup>+ \ ?Stuck S\<^sub>2 \\<^sub>2)" + hence sat_not_stuck: "\S\<^sub>2 \\<^sub>2. ((S\<^sub>1,\\<^sub>1),(S\<^sub>2,\\<^sub>2)) \ ?Sats\<^sup>+ \ \?Stuck S\<^sub>2 \\<^sub>2" by blast + + have "\S \. ((S\<^sub>1,\\<^sub>1),(S,\)) \ ?Sats\<^sup>+ \ (\b. ((S,\),b) \ ?Sats)" + proof (intro allI impI) + fix S \ assume a: "((S\<^sub>1,\\<^sub>1),(S,\)) \ ?Sats\<^sup>+" + have "\b. ((S\<^sub>1,\\<^sub>1),b) \ ?Sats\<^sup>+ \ \c. b \ c \ ((S\<^sub>1,\\<^sub>1),c) \ ?Sats\<^sup>+" + proof - + fix b assume in_sat: "((S\<^sub>1,\\<^sub>1),b) \ ?Sats\<^sup>+" + hence "\c. (b,c) \ ?Sats" using * sat_not_stuck by (cases b) blast + thus "\c. b \ c \ ((S\<^sub>1,\\<^sub>1),c) \ ?Sats\<^sup>+" + using trancl_into_trancl[OF in_sat] by blast + qed + hence "\S' \'. (S,\) \ (S',\') \ ((S\<^sub>1,\\<^sub>1),(S',\')) \ ?Sats\<^sup>+" using a by auto + then obtain S' \' where S'\': "(S,\) \ (S',\')" "((S\<^sub>1,\\<^sub>1),(S',\')) \ ?Sats\<^sup>+" by auto + hence "\ \\<^sub>c \S', \'\" using * by blast + moreover have "(S\<^sub>1, \\<^sub>1) \\<^sup>+ (S,\)" using a trancl_mono by blast + ultimately have "((S,\),(S',\')) \ ?Sats" using S'\'(1) * a by blast + thus "\b. ((S,\),b) \ ?Sats" using S'\'(2) by blast + qed + hence "\f. \i::nat. (f i, f (Suc i)) \ ?Sats" + using infinite_chain_intro'[OF base] by blast + moreover have "?Sats \ LI_rel\<^sup>+" by auto + hence "\(\f. \i::nat. (f i, f (Suc i)) \ ?Sats)" + using LI_no_infinite_chain infinite_chain_mono by blast + ultimately show False by auto + qed + hence "\S\<^sub>2 \\<^sub>2. (S\<^sub>1, \\<^sub>1) \\<^sup>+ (S\<^sub>2, \\<^sub>2) \ simple S\<^sub>2 \ (\ \\<^sub>c \S\<^sub>2, \\<^sub>2\)" + using simple_if_stuck * by blast + thus ?thesis by (meson trancl_into_rtrancl) +qed (blast intro: \\ \\<^sub>c \S\<^sub>1, \\<^sub>1\\) +end + + +subsection \Corollary: Soundness and Completeness as a Single Theorem\ +corollary LI_soundness_and_completeness: + assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S\<^sub>1 \\<^sub>1" + shows "\ \\<^sub>c \S\<^sub>1, \\<^sub>1\ \ (\S\<^sub>2 \\<^sub>2. (S\<^sub>1,\\<^sub>1) \\<^sup>* (S\<^sub>2,\\<^sub>2) \ simple S\<^sub>2 \ (\ \\<^sub>c \S\<^sub>2, \\<^sub>2\))" +by (metis LI_soundness[OF assms] LI_completeness[OF assms]) + +end + +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Messages.thy b/thys/Stateful_Protocol_Composition_and_Typing/Messages.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Messages.thy @@ -0,0 +1,538 @@ +(* +(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: Messages.thy + Author: Andreas Viktor Hess, DTU +*) + +section \Protocol Messages as (First-Order) Terms\ + +theory Messages + imports Miscellaneous "First_Order_Terms.Term" +begin + +subsection \Term-related definitions: subterms and free variables\ +abbreviation "the_Fun \ un_Fun1" +lemmas the_Fun_def = un_Fun1_def + +fun subterms::"('a,'b) term \ ('a,'b) terms" where + "subterms (Var x) = {Var x}" +| "subterms (Fun f T) = {Fun f T} \ (\t \ set T. subterms t)" + +abbreviation subtermeq (infix "\" 50) where "t' \ t \ (t' \ subterms t)" +abbreviation subterm (infix "\" 50) where "t' \ t \ (t' \ t \ t' \ t)" + +abbreviation "subterms\<^sub>s\<^sub>e\<^sub>t M \ \(subterms ` M)" +abbreviation subtermeqset (infix "\\<^sub>s\<^sub>e\<^sub>t" 50) where "t \\<^sub>s\<^sub>e\<^sub>t M \ (t \ subterms\<^sub>s\<^sub>e\<^sub>t M)" + +abbreviation fv where "fv \ vars_term" +lemmas fv_simps = term.simps(17,18) + +fun fv\<^sub>s\<^sub>e\<^sub>t where "fv\<^sub>s\<^sub>e\<^sub>t M = \(fv ` M)" + +abbreviation fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r where "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r p \ case p of (t,t') \ fv t \ fv t'" + +fun fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s where "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = \(fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r ` set F)" + +abbreviation ground where "ground M \ fv\<^sub>s\<^sub>e\<^sub>t M = {}" + + +subsection \Variants that return lists insteads of sets\ +fun fv_list where + "fv_list (Var x) = [x]" +| "fv_list (Fun f T) = concat (map fv_list T)" + +definition fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s where + "fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ concat (map (\(t,t'). fv_list t@fv_list t') F)" + +fun subterms_list::"('a,'b) term \ ('a,'b) term list" where + "subterms_list (Var x) = [Var x]" +| "subterms_list (Fun f T) = remdups (Fun f T#concat (map subterms_list T))" + +lemma fv_list_is_fv: "fv t = set (fv_list t)" +by (induct t) auto + +lemma fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = set (fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F)" +by (induct F) (auto simp add: fv_list_is_fv fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_def) + +lemma subterms_list_is_subterms: "subterms t = set (subterms_list t)" +by (induct t) auto + + +subsection \The subterm relation defined as a function\ +fun subterm_of where + "subterm_of t (Var y) = (t = Var y)" +| "subterm_of t (Fun f T) = (t = Fun f T \ list_ex (subterm_of t) T)" + +lemma subterm_of_iff_subtermeq[code_unfold]: "t \ t' = subterm_of t t'" +proof (induction t') + case (Fun f T) thus ?case + proof (cases "t = Fun f T") + case False thus ?thesis + using Fun.IH subterm_of.simps(2)[of t f T] + unfolding list_ex_iff by fastforce + qed simp +qed simp + +lemma subterm_of_ex_set_iff_subtermeqset[code_unfold]: "t \\<^sub>s\<^sub>e\<^sub>t M = (\t' \ M. subterm_of t t')" +using subterm_of_iff_subtermeq by blast + + +subsection \The subterm relation is a partial order on terms\ +interpretation "term": order "(\)" "(\)" +proof + show "s \ s" for s :: "('a,'b) term" + by (induct s rule: subterms.induct) auto + + show trans: "s \ t \ t \ u \ s \ u" for s t u :: "('a,'b) term" + by (induct u rule: subterms.induct) auto + + show "s \ t \ t \ s \ s = t" for s t :: "('a,'b) term" + proof (induction s arbitrary: t rule: subterms.induct[case_names Var Fun]) + case (Fun f T) + { assume 0: "t \ Fun f T" + then obtain u::"('a,'b) term" where u: "u \ set T" "t \ u" using Fun.prems(2) by auto + hence 1: "Fun f T \ u" using trans[OF Fun.prems(1)] by simp + + have 2: "u \ Fun f T" + by (cases u) (use u(1) in force, use u(1) subterms.simps(2)[of f T] in fastforce) + hence 3: "u = Fun f T" using Fun.IH[OF u(1) _ 1] by simp + + have "u \ t" using trans[OF 2 Fun.prems(1)] by simp + hence 4: "u = t" using Fun.IH[OF u(1) _ u(2)] by simp + + have "t = Fun f T" using 3 4 by simp + hence False using 0 by simp + } + thus ?case by auto + qed simp + thus "(s \ t) = (s \ t \ \(t \ s))" for s t :: "('a,'b) term" + by blast +qed + + +subsection \Lemmata concerning subterms and free variables\ +lemma fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_append: "fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F@G) = fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F@fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" +by (simp add: fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_def) + +lemma distinct_fv_list_idx_fv_disjoint: + assumes t: "distinct (fv_list t)" "Fun f T \ t" + and ij: "i < length T" "j < length T" "i < j" + shows "fv (T ! i) \ fv (T ! j) = {}" +using t +proof (induction t rule: fv_list.induct) + case (2 g S) + have "distinct (fv_list s)" when s: "s \ set S" for s + by (metis (no_types, lifting) s "2.prems"(1) concat_append distinct_append + map_append split_list fv_list.simps(2) concat.simps(2) list.simps(9)) + hence IH: "fv (T ! i) \ fv (T ! j) = {}" + when s: "s \ set S" "Fun f T \ s" for s + using "2.IH" s by blast + + show ?case + proof (cases "Fun f T = Fun g S") + case True + define U where "U \ map fv_list T" + + have a: "distinct (concat U)" + using "2.prems"(1) True unfolding U_def by auto + + have b: "i < length U" "j < length U" + using ij(1,2) unfolding U_def by simp_all + + show ?thesis + using b distinct_concat_idx_disjoint[OF a b ij(3)] + fv_list_is_fv[of "T ! i"] fv_list_is_fv[of "T ! j"] + unfolding U_def by force + qed (use IH "2.prems"(2) in auto) +qed force + +lemmas subtermeqI'[intro] = term.eq_refl + +lemma subtermeqI''[intro]: "t \ set T \ t \ Fun f T" +by force + +lemma finite_fv_set[intro]: "finite M \ finite (fv\<^sub>s\<^sub>e\<^sub>t M)" +by auto + +lemma finite_fun_symbols[simp]: "finite (funs_term t)" +by (induct t) simp_all + +lemma fv_set_mono: "M \ N \ fv\<^sub>s\<^sub>e\<^sub>t M \ fv\<^sub>s\<^sub>e\<^sub>t N" +by auto + +lemma subterms\<^sub>s\<^sub>e\<^sub>t_mono: "M \ N \ subterms\<^sub>s\<^sub>e\<^sub>t M \ subterms\<^sub>s\<^sub>e\<^sub>t N" +by auto + +lemma ground_empty[simp]: "ground {}" +by simp + +lemma ground_subset: "M \ N \ ground N \ ground M" +by auto + +lemma fv_map_fv_set: "\(set (map fv L)) = fv\<^sub>s\<^sub>e\<^sub>t (set L)" +by (induct L) auto + +lemma fv\<^sub>s\<^sub>e\<^sub>t_union: "fv\<^sub>s\<^sub>e\<^sub>t (M \ N) = fv\<^sub>s\<^sub>e\<^sub>t M \ fv\<^sub>s\<^sub>e\<^sub>t N" +by auto + +lemma finite_subset_Union: + fixes A::"'a set" and f::"'a \ 'b set" + assumes "finite (\a \ A. f a)" + shows "\B. finite B \ B \ A \ (\b \ B. f b) = (\a \ A. f a)" +by (metis assms eq_iff finite_subset_image finite_UnionD) + +lemma inv_set_fv: "finite M \ \(set (map fv (inv set M))) = fv\<^sub>s\<^sub>e\<^sub>t M" +using fv_map_fv_set[of "inv set M"] inv_set_fset by auto + +lemma ground_subterm: "fv t = {} \ t' \ t \ fv t' = {}" by (induct t) auto + +lemma empty_fv_not_var: "fv t = {} \ t \ Var x" by auto + +lemma empty_fv_exists_fun: "fv t = {} \ \f X. t = Fun f X" by (cases t) auto + +lemma vars_iff_subtermeq: "x \ fv t \ Var x \ t" by (induct t) auto + +lemma vars_iff_subtermeq_set: "x \ fv\<^sub>s\<^sub>e\<^sub>t M \ Var x \ subterms\<^sub>s\<^sub>e\<^sub>t M" +using vars_iff_subtermeq[of x] by auto + +lemma vars_if_subtermeq_set: "Var x \ subterms\<^sub>s\<^sub>e\<^sub>t M \ x \ fv\<^sub>s\<^sub>e\<^sub>t M" +by (metis vars_iff_subtermeq_set) + +lemma subtermeq_set_if_vars: "x \ fv\<^sub>s\<^sub>e\<^sub>t M \ Var x \ subterms\<^sub>s\<^sub>e\<^sub>t M" +by (metis vars_iff_subtermeq_set) + +lemma vars_iff_subterm_or_eq: "x \ fv t \ Var x \ t \ Var x = t" +by (induct t) (auto simp add: vars_iff_subtermeq) + +lemma var_is_subterm: "x \ fv t \ Var x \ subterms t" +by (simp add: vars_iff_subtermeq) + +lemma subterm_is_var: "Var x \ subterms t \ x \ fv t" +by (simp add: vars_iff_subtermeq) + +lemma no_var_subterm: "\t \ Var v" by auto + +lemma fun_if_subterm: "t \ u \ \f X. u = Fun f X" by (induct u) simp_all + +lemma subtermeq_vars_subset: "M \ N \ fv M \ fv N" by (induct N) auto + +lemma fv_subterms[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (subterms t) = fv t" +by (induct t) auto + +lemma fv_subterms_set[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t M) = fv\<^sub>s\<^sub>e\<^sub>t M" +using subtermeq_vars_subset by auto + +lemma fv_subset: "t \ M \ fv t \ fv\<^sub>s\<^sub>e\<^sub>t M" +by auto + +lemma fv_subset_subterms: "t \ subterms\<^sub>s\<^sub>e\<^sub>t M \ fv t \ fv\<^sub>s\<^sub>e\<^sub>t M" +using fv_subset fv_subterms_set by metis + +lemma subterms_finite[simp]: "finite (subterms t)" by (induction rule: subterms.induct) auto + +lemma subterms_union_finite: "finite M \ finite (\t \ M. subterms t)" +by (induction rule: subterms.induct) auto + +lemma subterms_subset: "t' \ t \ subterms t' \ subterms t" +by (induction rule: subterms.induct) auto + +lemma subterms_subset_set: "M \ subterms t \ subterms\<^sub>s\<^sub>e\<^sub>t M \ subterms t" +by (metis SUP_least contra_subsetD subterms_subset) + +lemma subset_subterms_Union[simp]: "M \ subterms\<^sub>s\<^sub>e\<^sub>t M" by auto + +lemma in_subterms_Union: "t \ M \ t \ subterms\<^sub>s\<^sub>e\<^sub>t M" using subset_subterms_Union by blast + +lemma in_subterms_subset_Union: "t \ subterms\<^sub>s\<^sub>e\<^sub>t M \ subterms t \ subterms\<^sub>s\<^sub>e\<^sub>t M" +using subterms_subset by auto + +lemma subterm_param_split: + assumes "t \ Fun f X" + shows "\pre x suf. t \ x \ X = pre@x#suf" +proof - + obtain x where "t \ x" "x \ set X" using assms by auto + then obtain pre suf where "X = pre@x#suf" "x \ set pre \ x \ set suf" + by (meson split_list_first split_list_last) + thus ?thesis using \t \ x\ by auto +qed + +lemma ground_iff_no_vars: "ground (M::('a,'b) terms) \ (\v. Var v \ (\m \ M. subterms m))" +proof + assume "ground M" + hence "\v. \m \ M. v \ fv m" by auto + hence "\v. \m \ M. Var v \ subterms m" by (simp add: vars_iff_subtermeq) + thus "(\v. Var v \ (\m \ M. subterms m))" by simp +next + assume no_vars: "\v. Var v \ (\m \ M. subterms m)" + moreover + { assume "\ground M" + then obtain v and m::"('a,'b) term" where "m \ M" "fv m \ {}" "v \ fv m" by auto + hence "Var v \ (subterms m)" by (simp add: vars_iff_subtermeq) + hence "\v. Var v \ (\t \ M. subterms t)" using \m \ M\ by auto + hence False using no_vars by simp + } + ultimately show "ground M" by blast +qed + +lemma index_Fun_subterms_subset[simp]: "i < length T \ subterms (T ! i) \ subterms (Fun f T)" +by auto + +lemma index_Fun_fv_subset[simp]: "i < length T \ fv (T ! i) \ fv (Fun f T)" +using subtermeq_vars_subset by fastforce + +lemma subterms_union_ground: + assumes "ground M" + shows "ground (subterms\<^sub>s\<^sub>e\<^sub>t M)" +proof - + { fix t assume "t \ M" + hence "fv t = {}" + using ground_iff_no_vars[of M] assms + by auto + hence "\t' \ subterms t. fv t' = {}" using subtermeq_vars_subset[of _ t] by simp + hence "ground (subterms t)" by auto + } + thus ?thesis by auto +qed + +lemma Var_subtermeq: "t \ Var v \ t = Var v" by simp + +lemma subtermeq_imp_funs_term_subset: "s \ t \ funs_term s \ funs_term t" +by (induct t arbitrary: s) auto + +lemma subterms_const: "subterms (Fun f []) = {Fun f []}" by simp + +lemma subterm_subtermeq_neq: "\t \ u; u \ v\ \ t \ v" +by (metis term.eq_iff) + +lemma subtermeq_subterm_neq: "\t \ u; u \ v\ \ t \ v" +by (metis term.eq_iff) + +lemma subterm_size_lt: "x \ y \ size x < size y" +using not_less_eq size_list_estimation by (induct y, simp, fastforce) + +lemma in_subterms_eq: "\x \ subterms y; y \ subterms x\ \ subterms x = subterms y" +using term.antisym by auto + +lemma Fun_gt_params: "Fun f X \ (\x \ set X. subterms x)" +proof - + have "size_list size X < size (Fun f X)" by simp + hence "Fun f X \ set X" by (meson less_not_refl size_list_estimation) + hence "\x \ set X. Fun f X \ subterms x \ x \ subterms (Fun f X)" + by (metis term.antisym[of "Fun f X" _]) + moreover have "\x \ set X. x \ subterms (Fun f X)" by fastforce + ultimately show ?thesis by auto +qed + +lemma params_subterms[simp]: "set X \ subterms (Fun f X)" by auto + +lemma params_subterms_Union[simp]: "subterms\<^sub>s\<^sub>e\<^sub>t (set X) \ subterms (Fun f X)" by auto + +lemma Fun_subterm_inside_params: "t \ Fun f X \ t \ (\x \ (set X). subterms x)" +using Fun_gt_params by fastforce + +lemma Fun_param_is_subterm: "x \ set X \ x \ Fun f X" +using Fun_subterm_inside_params by fastforce + +lemma Fun_param_in_subterms: "x \ set X \ x \ subterms (Fun f X)" +using Fun_subterm_inside_params by fastforce + +lemma Fun_not_in_param: "x \ set X \ \Fun f X \ x" +using term.antisym by fast + +lemma Fun_ex_if_subterm: "t \ s \ \f T. Fun f T \ s \ t \ set T" +proof (induction s) + case (Fun f T) + then obtain s' where s': "s' \ set T" "t \ s'" by auto + show ?case + proof (cases "t = s'") + case True thus ?thesis using s' by blast + next + case False + thus ?thesis + using Fun.IH[OF s'(1)] s'(2) term.order_trans[OF _ Fun_param_in_subterms[OF s'(1), of f]] + by metis + qed +qed simp + +lemma const_subterm_obtain: + assumes "fv t = {}" + obtains c where "Fun c [] \ t" +using assms +proof (induction t) + case (Fun f T) thus ?case by (cases "T = []") force+ +qed simp + +lemma const_subterm_obtain': "fv t = {} \ \c. Fun c [] \ t" +by (metis const_subterm_obtain) + +lemma subterms_singleton: + assumes "(\v. t = Var v) \ (\f. t = Fun f [])" + shows "subterms t = {t}" +using assms by (cases t) auto + +lemma subtermeq_Var_const: + assumes "s \ t" + shows "t = Var v \ s = Var v" "t = Fun f [] \ s = Fun f []" +using assms by fastforce+ + +lemma subterms_singleton': + assumes "subterms t = {t}" + shows "(\v. t = Var v) \ (\f. t = Fun f [])" +proof (cases t) + case (Fun f T) + { fix s S assume "T = s#S" + hence "s \ subterms t" using Fun by auto + hence "s = t" using assms by auto + hence False + using Fun_param_is_subterm[of s "s#S" f] \T = s#S\ Fun + by auto + } + hence "T = []" by (cases T) auto + thus ?thesis using Fun by simp +qed (simp add: assms) + +lemma funs_term_subterms_eq[simp]: + "(\s \ subterms t. funs_term s) = funs_term t" + "(\s \ subterms\<^sub>s\<^sub>e\<^sub>t M. funs_term s) = \(funs_term ` M)" +proof - + show "\t. \(funs_term ` subterms t) = funs_term t" + using term.order_refl subtermeq_imp_funs_term_subset by blast + thus "\(funs_term ` (subterms\<^sub>s\<^sub>e\<^sub>t M)) = \(funs_term ` M)" by force +qed + +lemmas subtermI'[intro] = Fun_param_is_subterm + +lemma funs_term_Fun_subterm: "f \ funs_term t \ \T. Fun f T \ subterms t" +proof (induction t) + case (Fun g T) + hence "f = g \ (\s \ set T. f \ funs_term s)" by simp + thus ?case + proof + assume "\s \ set T. f \ funs_term s" + then obtain s where "s \ set T" "\T. Fun f T \ subterms s" using Fun.IH by auto + thus ?thesis by auto + qed (auto simp add: Fun) +qed simp + +lemma funs_term_Fun_subterm': "Fun f T \ subterms t \ f \ funs_term t" +by (induct t) auto + +lemma zip_arg_subterm: + assumes "(s,t) \ set (zip X Y)" + shows "s \ Fun f X" "t \ Fun g Y" +proof - + from assms have *: "s \ set X" "t \ set Y" by (meson in_set_zipE)+ + show "s \ Fun f X" by (metis Fun_param_is_subterm[OF *(1)]) + show "t \ Fun g Y" by (metis Fun_param_is_subterm[OF *(2)]) +qed + +lemma fv_disj_Fun_subterm_param_cases: + assumes "fv t \ X = {}" "Fun f T \ subterms t" + shows "T = [] \ (\s\set T. s \ Var ` X)" +proof (cases T) + case (Cons s S) + hence "s \ subterms t" + using assms(2) term.order_trans[of _ "Fun f T" t] + by auto + hence "fv s \ X = {}" using assms(1) fv_subterms by force + thus ?thesis using Cons by auto +qed simp + +lemma fv_eq_FunI: + assumes "length T = length S" "\i. i < length T \ fv (T ! i) = fv (S ! i)" + shows "fv (Fun f T) = fv (Fun g S)" +using assms +proof (induction T arbitrary: S) + case (Cons t T S') + then obtain s S where S': "S' = s#S" by (cases S') simp_all + thus ?case using Cons by fastforce +qed simp + +lemma fv_eq_FunI': + assumes "length T = length S" "\i. i < length T \ x \ fv (T ! i) \ x \ fv (S ! i)" + shows "x \ fv (Fun f T) \ x \ fv (Fun g S)" +using assms +proof (induction T arbitrary: S) + case (Cons t T S') + then obtain s S where S': "S' = s#S" by (cases S') simp_all + thus ?case using Cons by fastforce +qed simp + +lemma finite_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[simp]: "finite (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s x)" by auto + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_Nil[simp]: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s [] = {}" by simp + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_singleton[simp]: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s [(t,s)] = fv t \ fv s" by simp + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_Cons: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ((s,t)#F) = fv s \ fv t \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" by simp + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_append: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F@G) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" by simp + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_mono: "set M \ set N \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s M \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s N" by auto + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_inI[intro]: + "f \ set F \ x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r f \ x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" + "f \ set F \ x \ fv (fst f) \ x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" + "f \ set F \ x \ fv (snd f) \ x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" + "(t,s) \ set F \ x \ fv t \ x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" + "(t,s) \ set F \ x \ fv s \ x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" +using UN_I by fastforce+ + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_cons_subset: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (f#F)" +by auto + + +subsection \Other lemmata\ +lemma nonvar_term_has_composed_shallow_term: + fixes t::"('f,'v) term" + assumes "\(\x. t = Var x)" + shows "\f T. Fun f T \ t \ (\s \ set T. (\c. s = Fun c []) \ (\x. s = Var x))" +proof - + let ?Q = "\S. \s \ set S. (\c. s = Fun c []) \ (\x. s = Var x)" + let ?P = "\t. \g S. Fun g S \ t \ ?Q S" + { fix t::"('f,'v) term" + have "(\x. t = Var x) \ ?P t" + proof (induction t) + case (Fun h R) show ?case + proof (cases "R = [] \ (\r \ set R. \x. r = Var x)") + case False + then obtain r g S where "r \ set R" "?P r" "Fun g S \ r" "?Q S" using Fun.IH by fast + thus ?thesis by auto + qed force + qed simp + } thus ?thesis using assms by blast +qed + +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Miscellaneous.thy b/thys/Stateful_Protocol_Composition_and_Typing/Miscellaneous.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Miscellaneous.thy @@ -0,0 +1,492 @@ +(* +(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: Miscellaneous.thy + Author: Andreas Viktor Hess, DTU +*) + +section \Miscellaneous Lemmata\ +theory Miscellaneous +imports Main "HOL-Library.Sublist" "HOL-Library.While_Combinator" +begin + +subsection \List: zip, filter, map\ +lemma zip_arg_subterm_split: + assumes "(x,y) \ set (zip xs ys)" + obtains xs' xs'' ys' ys'' where "xs = xs'@x#xs''" "ys = ys'@y#ys''" "length xs' = length ys'" +proof - + from assms have "\zs zs' vs vs'. xs = zs@x#zs' \ ys = vs@y#vs' \ length zs = length vs" + proof (induction ys arbitrary: xs) + case (Cons y' ys' xs) + then obtain x' xs' where x': "xs = x'#xs'" + by (metis empty_iff list.exhaust list.set(1) set_zip_leftD) + show ?case + by (cases "(x, y) \ set (zip xs' ys')", + metis \xs = x'#xs'\ Cons.IH[of xs'] Cons_eq_appendI list.size(4), + use Cons.prems x' in fastforce) + qed simp + thus ?thesis using that by blast +qed + +lemma zip_arg_index: + assumes "(x,y) \ set (zip xs ys)" + obtains i where "xs ! i = x" "ys ! i = y" "i < length xs" "i < length ys" +proof - + obtain xs1 xs2 ys1 ys2 where "xs = xs1@x#xs2" "ys = ys1@y#ys2" "length xs1 = length ys1" + using zip_arg_subterm_split[OF assms] by moura + thus ?thesis using nth_append_length[of xs1 x xs2] nth_append_length[of ys1 y ys2] that by simp +qed + +lemma filter_nth: "i < length (filter P xs) \ P (filter P xs ! i)" +using nth_mem by force + +lemma list_all_filter_eq: "list_all P xs \ filter P xs = xs" +by (metis list_all_iff filter_True) + +lemma list_all_filter_nil: + assumes "list_all P xs" + and "\x. P x \ \Q x" + shows "filter Q xs = []" +using assms by (induct xs) simp_all + +lemma list_all_concat: "list_all (list_all f) P \ list_all f (concat P)" +by (induct P) auto + +lemma map_upt_index_eq: + assumes "j < length xs" + shows "(map (\i. xs ! is i) [0..(i,p) \ insert x (set xs). \(i',p') \ insert x (set xs). p = p' \ i = i'" + shows "map snd (List.insert x xs) = List.insert (snd x) (map snd xs)" +using assms +proof (induction xs rule: List.rev_induct) + case (snoc y xs) + hence IH: "map snd (List.insert x xs) = List.insert (snd x) (map snd xs)" by fastforce + + obtain iy py where y: "y = (iy,py)" by (metis surj_pair) + obtain ix px where x: "x = (ix,px)" by (metis surj_pair) + + have "(ix,px) \ insert x (set (y#xs))" "(iy,py) \ insert x (set (y#xs))" using y x by auto + hence *: "iy = ix" when "py = px" using that snoc.prems by auto + + show ?case + proof (cases "px = py") + case True + hence "y = x" using * y x by auto + thus ?thesis using IH by simp + next + case False + hence "y \ x" using y x by simp + have "List.insert x (xs@[y]) = (List.insert x xs)@[y]" + proof - + have 1: "insert y (set xs) = set (xs@[y])" by simp + have 2: "x \ insert y (set xs) \ x \ set xs" using \y \ x\ by blast + show ?thesis using 1 2 by (metis (no_types) List.insert_def append_Cons insertCI) + qed + thus ?thesis using IH y x False by (auto simp add: List.insert_def) + qed +qed simp + +lemma map_append_inv: "map f xs = ys@zs \ \vs ws. xs = vs@ws \ map f vs = ys \ map f ws = zs" +proof (induction xs arbitrary: ys zs) + case (Cons x xs') + note prems = Cons.prems + note IH = Cons.IH + + show ?case + proof (cases ys) + case (Cons y ys') + then obtain vs' ws where *: "xs' = vs'@ws" "map f vs' = ys'" "map f ws = zs" + using prems IH[of ys' zs] by auto + hence "x#xs' = (x#vs')@ws" "map f (x#vs') = y#ys'" using Cons prems by force+ + thus ?thesis by (metis Cons *(3)) + qed (use prems in simp) +qed simp + + +subsection \List: subsequences\ +lemma subseqs_set_subset: + assumes "ys \ set (subseqs xs)" + shows "set ys \ set xs" +using assms subseqs_powset[of xs] by auto + +lemma subset_sublist_exists: + "ys \ set xs \ \zs. set zs = ys \ zs \ set (subseqs xs)" +proof (induction xs arbitrary: ys) + case Cons thus ?case by (metis (no_types, lifting) Pow_iff imageE subseqs_powset) +qed simp + +lemma map_subseqs: "map (map f) (subseqs xs) = subseqs (map f xs)" +proof (induct xs) + case (Cons x xs) + have "map (Cons (f x)) (map (map f) (subseqs xs)) = map (map f) (map (Cons x) (subseqs xs))" + by (induct "subseqs xs") auto + thus ?case by (simp add: Let_def Cons) +qed simp + +lemma subseqs_Cons: + assumes "ys \ set (subseqs xs)" + shows "ys \ set (subseqs (x#xs))" +by (metis assms Un_iff set_append subseqs.simps(2)) + +lemma subseqs_subset: + assumes "ys \ set (subseqs xs)" + shows "set ys \ set xs" +using assms by (metis Pow_iff image_eqI subseqs_powset) + + +subsection \List: prefixes, suffixes\ +lemma suffix_Cons': "suffix [x] (y#ys) \ suffix [x] ys \ (y = x \ ys = [])" +using suffix_Cons[of "[x]"] by auto + +lemma prefix_Cons': "prefix (x#xs) (x#ys) \ prefix xs ys" +by simp + +lemma prefix_map: "prefix xs (map f ys) \ \zs. prefix zs ys \ map f zs = xs" +using map_append_inv unfolding prefix_def by fast + +lemma length_prefix_ex: + assumes "n \ length xs" + shows "\ys zs. xs = ys@zs \ length ys = n" + using assms +proof (induction n) + case (Suc n) + then obtain ys zs where IH: "xs = ys@zs" "length ys = n" by moura + hence "length zs > 0" using Suc.prems(1) by auto + then obtain v vs where v: "zs = v#vs" by (metis Suc_length_conv gr0_conv_Suc) + hence "length (ys@[v]) = Suc n" using IH(2) by simp + thus ?case using IH(1) v by (metis append.assoc append_Cons append_Nil) +qed simp + +lemma length_prefix_ex': + assumes "n < length xs" + shows "\ys zs. xs = ys@xs ! n#zs \ length ys = n" +proof - + obtain ys zs where xs: "xs = ys@zs" "length ys = n" using assms length_prefix_ex[of n xs] by moura + hence "length zs > 0" using assms by auto + then obtain v vs where v: "zs = v#vs" by (metis Suc_length_conv gr0_conv_Suc) + hence "(ys@zs) ! n = v" using xs by auto + thus ?thesis using v xs by auto +qed + +lemma length_prefix_ex2: + assumes "i < length xs" "j < length xs" "i < j" + shows "\ys zs vs. xs = ys@xs ! i#zs@xs ! j#vs \ length ys = i \ length zs = j - i - 1" +by (smt assms length_prefix_ex' nth_append append.assoc append.simps(2) add_diff_cancel_left' + diff_Suc_1 length_Cons length_append) + + +subsection \List: products\ +lemma product_lists_Cons: + "x#xs \ set (product_lists (y#ys)) \ (xs \ set (product_lists ys) \ x \ set y)" +by auto + +lemma product_lists_in_set_nth: + assumes "xs \ set (product_lists ys)" + shows "\i set (ys ! i)" +proof - + have 0: "length ys = length xs" using assms(1) by (simp add: in_set_product_lists_length) + thus ?thesis using assms + proof (induction ys arbitrary: xs) + case (Cons y ys) + obtain x xs' where xs: "xs = x#xs'" using Cons.prems(1) by (metis length_Suc_conv) + hence "xs' \ set (product_lists ys) \ \i set (ys ! i)" + "length ys = length xs'" "x#xs' \ set (product_lists (y#ys))" + using Cons by simp_all + thus ?case using xs product_lists_Cons[of x xs' y ys] by (simp add: nth_Cons') + qed simp +qed + +lemma product_lists_in_set_nth': + assumes "\i set (xs ! i)" + and "length xs = length ys" + shows "ys \ set (product_lists xs)" +using assms +proof (induction xs arbitrary: ys) + case (Cons x xs) + obtain y ys' where ys: "ys = y#ys'" using Cons.prems(2) by (metis length_Suc_conv) + hence "ys' \ set (product_lists xs)" "y \ set x" "length xs = length ys'" + using Cons by fastforce+ + thus ?case using ys product_lists_Cons[of y ys' x xs] by (simp add: nth_Cons') +qed simp + + +subsection \Other Lemmata\ +lemma inv_set_fset: "finite M \ set (inv set M) = M" +unfolding inv_def by (metis (mono_tags) finite_list someI_ex) + +lemma lfp_eqI': + assumes "mono f" + and "f C = C" + and "\X \ Pow C. f X = X \ X = C" + shows "lfp f = C" +by (metis PowI assms lfp_lowerbound lfp_unfold subset_refl) + +lemma lfp_while': + fixes f::"'a set \ 'a set" and M::"'a set" + defines "N \ while (\A. f A \ A) f {}" + assumes f_mono: "mono f" + and N_finite: "finite N" + and N_supset: "f N \ N" + shows "lfp f = N" +proof - + have *: "f X \ N" when "X \ N" for X using N_supset monoD[OF f_mono that] by blast + show ?thesis + using lfp_while[OF f_mono * N_finite] + by (simp add: N_def) +qed + +lemma lfp_while'': + fixes f::"'a set \ 'a set" and M::"'a set" + defines "N \ while (\A. f A \ A) f {}" + assumes f_mono: "mono f" + and lfp_finite: "finite (lfp f)" + shows "lfp f = N" +proof - + have *: "f X \ lfp f" when "X \ lfp f" for X + using lfp_fixpoint[OF f_mono] monoD[OF f_mono that] + by blast + show ?thesis + using lfp_while[OF f_mono * lfp_finite] + by (simp add: N_def) +qed + +lemma preordered_finite_set_has_maxima: + assumes "finite A" "A \ {}" + shows "\a::'a::{preorder} \ A. \b \ A. \(a < b)" +using assms +proof (induction A rule: finite_induct) + case (insert a A) thus ?case + by (cases "A = {}", simp, metis insert_iff order_trans less_le_not_le) +qed simp + +lemma partition_index_bij: + fixes n::nat + obtains I k where + "bij_betw I {0.. n" + "\i. i < k \ P (I i)" + "\i. k \ i \ i < n \ \(P (I i))" +proof - + define A where "A = filter P [0..i. \P i) [0..n. (A@B) ! n)" + + note defs = A_def B_def k_def I_def + + have k1: "k \ n" by (metis defs(1,3) diff_le_self dual_order.trans length_filter_le length_upt) + + have "i < k \ P (A ! i)" for i by (metis defs(1,3) filter_nth) + hence k2: "i < k \ P ((A@B) ! i)" for i by (simp add: defs nth_append) + + have "i < length B \ \(P (B ! i))" for i by (metis defs(2) filter_nth) + hence "i < length B \ \(P ((A@B) ! (k + i)))" for i using k_def by simp + hence "k \ i \ i < k + length B \ \(P ((A@B) ! i))" for i + by (metis add.commute add_less_imp_less_right le_add_diff_inverse2) + hence k3: "k \ i \ i < n \ \(P ((A@B) ! i))" for i by (simp add: defs sum_length_filter_compl) + + have *: "length (A@B) = n" "set (A@B) = {0.. {0.. y \ {0.. (I x = I y) = (x = y)" + by (metis *(1,3) defs(4) nth_eq_iff_index_eq atLeastLessThan_iff) + next + fix x show "x \ {0.. I x \ {0.. {0.. \x \ {0..x. x \ set xs \ finite {y. P x y}" + shows "finite {ys. length xs = length ys \ (\y \ set ys. \x \ set xs. P x y)}" +proof - + define Q where "Q \ \ys. \y \ set ys. \x \ set xs. P x y" + define M where "M \ {y. \x \ set xs. P x y}" + + have 0: "finite M" using assms unfolding M_def by fastforce + + have "Q ys \ set ys \ M" + "(Q ys \ length ys = length xs) \ (length xs = length ys \ Q ys)" + for ys + unfolding Q_def M_def by auto + thus ?thesis + using finite_lists_length_eq[OF 0, of "length xs"] + unfolding Q_def by presburger +qed + +lemma trancl_eqI: + assumes "\(a,b) \ A. \(c,d) \ A. b = c \ (a,d) \ A" + shows "A = A\<^sup>+" +proof + show "A\<^sup>+ \ A" + proof + fix x assume x: "x \ A\<^sup>+" + then obtain a b where ab: "x = (a,b)" by (metis surj_pair) + hence "(a,b) \ A\<^sup>+" using x by metis + hence "(a,b) \ A" using assms by (induct rule: trancl_induct) auto + thus "x \ A" using ab by metis + qed +qed auto + +lemma trancl_eqI': + assumes "\(a,b) \ A. \(c,d) \ A. b = c \ a \ d \ (a,d) \ A" + and "\(a,b) \ A. a \ b" + shows "A = {(a,b) \ A\<^sup>+. a \ b}" +proof + show "{(a,b) \ A\<^sup>+. a \ b} \ A" + proof + fix x assume x: "x \ {(a,b) \ A\<^sup>+. a \ b}" + then obtain a b where ab: "x = (a,b)" by (metis surj_pair) + hence "(a,b) \ A\<^sup>+" "a \ b" using x by blast+ + hence "(a,b) \ A" + proof (induction rule: trancl_induct) + case base thus ?case by blast + next + case step thus ?case using assms(1) by force + qed + thus "x \ A" using ab by metis + qed +qed (use assms(2) in auto) + +lemma distinct_concat_idx_disjoint: + assumes xs: "distinct (concat xs)" + and ij: "i < length xs" "j < length xs" "i < j" + shows "set (xs ! i) \ set (xs ! j) = {}" +proof - + obtain ys zs vs where ys: "xs = ys@xs ! i#zs@xs ! j#vs" "length ys = i" "length zs = j - i - 1" + using length_prefix_ex2[OF ij] by moura + thus ?thesis + using xs concat_append[of "ys@xs ! i#zs" "xs ! j#vs"] + distinct_append[of "concat (ys@xs ! i#zs)" "concat (xs ! j#vs)"] + by auto +qed + +lemma remdups_ex2: + "length (remdups xs) > 1 \ \a \ set xs. \b \ set xs. a \ b" +by (metis distinct_Ex1 distinct_remdups less_trans nth_mem set_remdups zero_less_one zero_neq_one) + +lemma trancl_minus_refl_idem: + defines "cl \ \ts. {(a,b) \ ts\<^sup>+. a \ b}" + shows "cl (cl ts) = cl ts" +proof - + have 0: "(ts\<^sup>+)\<^sup>+ = ts\<^sup>+" "cl ts \ ts\<^sup>+" "(cl ts)\<^sup>+ \ (ts\<^sup>+)\<^sup>+" + proof - + show "(ts\<^sup>+)\<^sup>+ = ts\<^sup>+" "cl ts \ ts\<^sup>+" unfolding cl_def by auto + thus "(cl ts)\<^sup>+ \ (ts\<^sup>+)\<^sup>+" using trancl_mono[of _ "cl ts" "ts\<^sup>+"] by blast + qed + + have 1: "t \ cl (cl ts)" when t: "t \ cl ts" for t + using t 0 unfolding cl_def by fast + + have 2: "t \ cl ts" when t: "t \ cl (cl ts)" for t + proof - + obtain a b where ab: "t = (a,b)" by (metis surj_pair) + have "t \ (cl ts)\<^sup>+" and a_neq_b: "a \ b" using t unfolding cl_def ab by force+ + hence "t \ ts\<^sup>+" using 0 by blast + thus ?thesis using a_neq_b unfolding cl_def ab by blast + qed + + show ?thesis using 1 2 by blast +qed + + +subsection \Infinite Paths in Relations as Mappings from Naturals to States\ +context +begin + +private fun rel_chain_fun::"nat \ 'a \ 'a \ ('a \ 'a) set \ 'a" where + "rel_chain_fun 0 x _ _ = x" +| "rel_chain_fun (Suc i) x y r = (if i = 0 then y else SOME z. (rel_chain_fun i x y r, z) \ r)" + +lemma infinite_chain_intro: + fixes r::"('a \ 'a) set" + assumes "\(a,b) \ r. \c. (b,c) \ r" "r \ {}" + shows "\f. \i::nat. (f i, f (Suc i)) \ r" +proof - + from assms(2) obtain a b where "(a,b) \ r" by auto + + let ?P = "\i. (rel_chain_fun i a b r, rel_chain_fun (Suc i) a b r) \ r" + let ?Q = "\i. \z. (rel_chain_fun i a b r, z) \ r" + + have base: "?P 0" using \(a,b) \ r\ by auto + + have step: "?P (Suc i)" when i: "?P i" for i + proof - + have "?Q (Suc i)" using assms(1) i by auto + thus ?thesis using someI_ex[OF \?Q (Suc i)\] by auto + qed + + have "\i::nat. (rel_chain_fun i a b r, rel_chain_fun (Suc i) a b r) \ r" + using base step nat_induct[of ?P] by simp + thus ?thesis by fastforce +qed + +end + +lemma infinite_chain_intro': + fixes r::"('a \ 'a) set" + assumes base: "\b. (x,b) \ r" and step: "\b. (x,b) \ r\<^sup>+ \ (\c. (b,c) \ r)" + shows "\f. \i::nat. (f i, f (Suc i)) \ r" +proof - + let ?s = "{(a,b) \ r. a = x \ (x,a) \ r\<^sup>+}" + + have "?s \ {}" using base by auto + + have "\c. (b,c) \ ?s" when ab: "(a,b) \ ?s" for a b + proof (cases "a = x") + case False + hence "(x,a) \ r\<^sup>+" using ab by auto + hence "(x,b) \ r\<^sup>+" using \(a,b) \ ?s\ by auto + thus ?thesis using step by auto + qed (use ab step in auto) + hence "\f. \i. (f i, f (Suc i)) \ ?s" using infinite_chain_intro[of ?s] \?s \ {}\ by blast + thus ?thesis by auto +qed + +lemma infinite_chain_mono: + assumes "S \ T" "\f. \i::nat. (f i, f (Suc i)) \ S" + shows "\f. \i::nat. (f i, f (Suc i)) \ T" +using assms by auto + +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/More_Unification.thy b/thys/Stateful_Protocol_Composition_and_Typing/More_Unification.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/More_Unification.thy @@ -0,0 +1,3228 @@ +(* +(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. +*) + +(* +Based on src/HOL/ex/Unification.thy packaged with Isabelle/HOL 2015 having the following license: + +ISABELLE COPYRIGHT NOTICE, LICENCE AND DISCLAIMER. + +Copyright (c) 1986-2015, + University of Cambridge, + Technische Universitaet Muenchen, + and contributors. + + 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 University of Cambridge or the Technische +Universitaet Muenchen nor the names of their 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: More_Unification.thy + Author: Andreas Viktor Hess, DTU + + Originally based on src/HOL/ex/Unification.thy (Isabelle/HOL 2015) by: + Author: Martin Coen, Cambridge University Computer Laboratory + Author: Konrad Slind, TUM & Cambridge University Computer Laboratory + Author: Alexander Krauss, TUM +*) + +section \Definitions and Properties Related to Substitutions and Unification\ + +theory More_Unification + imports Messages "First_Order_Terms.Unification" +begin + +subsection \Substitutions\ + +abbreviation subst_apply_list (infix "\\<^sub>l\<^sub>i\<^sub>s\<^sub>t" 51) where + "T \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ \ map (\t. t \ \) T" + +abbreviation subst_apply_pair (infixl "\\<^sub>p" 60) where + "d \\<^sub>p \ \ (case d of (t,t') \ (t \ \, t' \ \))" + +abbreviation subst_apply_pair_set (infixl "\\<^sub>p\<^sub>s\<^sub>e\<^sub>t" 60) where + "M \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \ (\d. d \\<^sub>p \) ` M" + +definition subst_apply_pairs (infix "\\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s" 51) where + "F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \ \ map (\f. f \\<^sub>p \) F" + +abbreviation subst_more_general_than (infixl "\\<^sub>\" 50) where + "\ \\<^sub>\ \ \ \\. \ = \ \\<^sub>s \" + +abbreviation subst_support (infix "supports" 50) where + "\ supports \ \ (\x. \ x \ \ = \ x)" + +abbreviation rm_var where + "rm_var v s \ s(v := Var v)" + +abbreviation rm_vars where + "rm_vars vs \ \ (\v. if v \ vs then Var v else \ v)" + +definition subst_elim where + "subst_elim \ v \ \t. v \ fv (t \ \)" + +definition subst_idem where + "subst_idem s \ s \\<^sub>s s = s" + +lemma subst_support_def: "\ supports \ \ \ = \ \\<^sub>s \" +unfolding subst_compose_def by metis + +lemma subst_supportD: "\ supports \ \ \ \\<^sub>\ \" +using subst_support_def by auto + +lemma rm_vars_empty[simp]: "rm_vars {} s = s" "rm_vars (set []) s = s" +by simp_all + +lemma rm_vars_singleton: "rm_vars {v} s = rm_var v s" +by auto + +lemma subst_apply_terms_empty: "M \\<^sub>s\<^sub>e\<^sub>t Var = M" +by simp + +lemma subst_agreement: "(t \ r = t \ s) \ (\v \ fv t. Var v \ r = Var v \ s)" +by (induct t) auto + +lemma repl_invariance[dest?]: "v \ fv t \ t \ s(v := u) = t \ s" +by (simp add: subst_agreement) + +lemma subst_idx_map: + assumes "\i \ set I. i < length T" + shows "(map ((!) T) I) \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ = map ((!) (map (\t. t \ \) T)) I" +using assms by auto + +lemma subst_idx_map': + assumes "\i \ fv\<^sub>s\<^sub>e\<^sub>t (set K). i < length T" + shows "(K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T) \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \ = K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t ((!) (map (\t. t \ \) T))" (is "?A = ?B") +proof - + have "T ! i \ \ = (map (\t. t \ \) T) ! i" + when "i < length T" for i + using that by auto + hence "T ! i \ \ = (map (\t. t \ \) T) ! i" + when "i \ fv\<^sub>s\<^sub>e\<^sub>t (set K)" for i + using that assms by auto + hence "k \ (!) T \ \ = k \ (!) (map (\t. t \ \) T)" + when "fv k \ fv\<^sub>s\<^sub>e\<^sub>t (set K)" for k + using that by (induction k) force+ + thus ?thesis by auto +qed + +lemma subst_remove_var: "v \ fv s \ v \ fv (t \ Var(v := s))" +by (induct t) simp_all + +lemma subst_set_map: "x \ set X \ x \ s \ set (map (\x. x \ s) X)" +by simp + +lemma subst_set_idx_map: + assumes "\i \ I. i < length T" + shows "(!) T ` I \\<^sub>s\<^sub>e\<^sub>t \ = (!) (map (\t. t \ \) T) ` I" (is "?A = ?B") +proof + have *: "T ! i \ \ = (map (\t. t \ \) T) ! i" + when "i < length T" for i + using that by auto + + show "?A \ ?B" using * assms by blast + show "?B \ ?A" using * assms by auto +qed + +lemma subst_set_idx_map': + assumes "\i \ fv\<^sub>s\<^sub>e\<^sub>t K. i < length T" + shows "K \\<^sub>s\<^sub>e\<^sub>t (!) T \\<^sub>s\<^sub>e\<^sub>t \ = K \\<^sub>s\<^sub>e\<^sub>t (!) (map (\t. t \ \) T)" (is "?A = ?B") +proof + have "T ! i \ \ = (map (\t. t \ \) T) ! i" + when "i < length T" for i + using that by auto + hence "T ! i \ \ = (map (\t. t \ \) T) ! i" + when "i \ fv\<^sub>s\<^sub>e\<^sub>t K" for i + using that assms by auto + hence *: "k \ (!) T \ \ = k \ (!) (map (\t. t \ \) T)" + when "fv k \ fv\<^sub>s\<^sub>e\<^sub>t K" for k + using that by (induction k) force+ + + show "?A \ ?B" using * by auto + show "?B \ ?A" using * by force +qed + +lemma subst_term_list_obtain: + assumes "\i < length T. \s. P (T ! i) s \ S ! i = s \ \" + and "length T = length S" + shows "\U. length T = length U \ (\i < length T. P (T ! i) (U ! i)) \ S = map (\u. u \ \) U" +using assms +proof (induction T arbitrary: S) + case (Cons t T S') + then obtain s S where S': "S' = s#S" by (cases S') auto + + have "\i < length T. \s. P (T ! i) s \ S ! i = s \ \" "length T = length S" + using Cons.prems S' by force+ + then obtain U where U: + "length T = length U" "\i < length T. P (T ! i) (U ! i)" "S = map (\u. u \ \) U" + using Cons.IH by moura + + obtain u where u: "P t u" "s = u \ \" + using Cons.prems(1) S' by auto + + have 1: "length (t#T) = length (u#U)" + using Cons.prems(2) U(1) by fastforce + + have 2: "\i < length (t#T). P ((t#T) ! i) ((u#U) ! i)" + using u(1) U(2) by (simp add: nth_Cons') + + have 3: "S' = map (\u. u \ \) (u#U)" + using U u S' by simp + + show ?case using 1 2 3 by blast +qed simp + +lemma subst_mono: "t \ u \ t \ s \ u \ s" +by (induct u) auto + +lemma subst_mono_fv: "x \ fv t \ s x \ t \ s" +by (induct t) auto + +lemma subst_mono_neq: + assumes "t \ u" + shows "t \ s \ u \ s" +proof (cases u) + case (Var v) + hence False using \t \ u\ by simp + thus ?thesis .. +next + case (Fun f X) + then obtain x where "x \ set X" "t \ x" using \t \ u\ by auto + hence "t \ s \ x \ s" using subst_mono by metis + + obtain Y where "Fun f X \ s = Fun f Y" by auto + hence "x \ s \ set Y" using \x \ set X\ by auto + hence "x \ s \ Fun f X \ s" using \Fun f X \ s = Fun f Y\ Fun_param_is_subterm by simp + hence "t \ s \ Fun f X \ s" using \t \ s \ x \ s\ by (metis term.dual_order.trans term.eq_iff) + thus ?thesis using \u = Fun f X\ \t \ u\ by metis +qed + +lemma subst_no_occs[dest]: "\Var v \ t \ t \ Var(v := s) = t" +by (induct t) (simp_all add: map_idI) + +lemma var_comp[simp]: "\ \\<^sub>s Var = \" "Var \\<^sub>s \ = \" +unfolding subst_compose_def by simp_all + +lemma subst_comp_all: "M \\<^sub>s\<^sub>e\<^sub>t (\ \\<^sub>s \) = (M \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>s\<^sub>e\<^sub>t \" +using subst_subst_compose[of _ \ \] by auto + +lemma subst_all_mono: "M \ M' \ M \\<^sub>s\<^sub>e\<^sub>t s \ M' \\<^sub>s\<^sub>e\<^sub>t s" +by auto + +lemma subst_comp_set_image: "(\ \\<^sub>s \) ` X = \ ` X \\<^sub>s\<^sub>e\<^sub>t \" +using subst_compose by fastforce + +lemma subst_ground_ident[dest?]: "fv t = {} \ t \ s = t" +by (induct t, simp, metis subst_agreement empty_iff subst_apply_term_empty) + +lemma subst_ground_ident_compose: + "fv (\ x) = {} \ (\ \\<^sub>s \) x = \ x" + "fv (t \ \) = {} \ t \ (\ \\<^sub>s \) = t \ \" +using subst_subst_compose[of t \ \] +by (simp_all add: subst_compose_def subst_ground_ident) + +lemma subst_all_ground_ident[dest?]: "ground M \ M \\<^sub>s\<^sub>e\<^sub>t s = M" +proof - + assume "ground M" + hence "\t. t \ M \ fv t = {}" by auto + hence "\t. t \ M \ t \ s = t" by (metis subst_ground_ident) + moreover have "\t. t \ M \ t \ s \ M \\<^sub>s\<^sub>e\<^sub>t s" by (metis imageI) + ultimately show "M \\<^sub>s\<^sub>e\<^sub>t s = M" by (simp add: image_cong) +qed + +lemma subst_eqI[intro]: "(\t. t \ \ = t \ \) \ \ = \" +proof - + assume "\t. t \ \ = t \ \" + hence "\v. Var v \ \ = Var v \ \" by auto + thus "\ = \" by auto +qed + +lemma subst_cong: "\\ = \'; \ = \'\ \ (\ \\<^sub>s \) = (\' \\<^sub>s \')" +by auto + +lemma subst_mgt_bot[simp]: "Var \\<^sub>\ \" +by simp + +lemma subst_mgt_refl[simp]: "\ \\<^sub>\ \" +by (metis var_comp(1)) + +lemma subst_mgt_trans: "\\ \\<^sub>\ \; \ \\<^sub>\ \\ \ \ \\<^sub>\ \" +by (metis subst_compose_assoc) + +lemma subst_mgt_comp: "\ \\<^sub>\ \ \\<^sub>s \" +by auto + +lemma subst_mgt_comp': "\ \\<^sub>s \ \\<^sub>\ \ \ \ \\<^sub>\ \" +by (metis subst_compose_assoc) + +lemma var_self: "(\w. if w = v then Var v else Var w) = Var" +using subst_agreement by auto + +lemma var_same[simp]: "Var(v := t) = Var \ t = Var v" +by (intro iffI, metis fun_upd_same, simp add: var_self) + +lemma subst_eq_if_eq_vars: "(\v. (Var v) \ \ = (Var v) \ \) \ \ = \" +by (auto simp add: subst_agreement) + +lemma subst_all_empty[simp]: "{} \\<^sub>s\<^sub>e\<^sub>t \ = {}" +by simp + +lemma subst_all_insert:"(insert t M) \\<^sub>s\<^sub>e\<^sub>t \ = insert (t \ \) (M \\<^sub>s\<^sub>e\<^sub>t \)" +by auto + +lemma subst_apply_fv_subset: "fv t \ V \ fv (t \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" +by (induct t) auto + +lemma subst_apply_fv_empty: + assumes "fv t = {}" + shows "fv (t \ \) = {}" +using assms subst_apply_fv_subset[of t "{}" \] +by auto + +lemma subst_compose_fv: + assumes "fv (\ x) = {}" + shows "fv ((\ \\<^sub>s \) x) = {}" +using assms subst_apply_fv_empty +unfolding subst_compose_def by fast + +lemma subst_compose_fv': + fixes \ \::"('a,'b) subst" + assumes "y \ fv ((\ \\<^sub>s \) x)" + shows "\z. z \ fv (\ x)" +using assms subst_compose_fv +by fast + +lemma subst_apply_fv_unfold: "fv (t \ \) = fv\<^sub>s\<^sub>e\<^sub>t (\ ` fv t)" +by (induct t) auto + +lemma subst_apply_fv_unfold': "fv (t \ \) = (\v \ fv t. fv (\ v))" +using subst_apply_fv_unfold by simp + +lemma subst_apply_fv_union: "fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ fv (t \ \) = fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ fv t))" +proof - + have "fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ fv t)) = fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` fv t)" by auto + thus ?thesis using subst_apply_fv_unfold by metis +qed + +lemma subst_elimI[intro]: "(\t. v \ fv (t \ \)) \ subst_elim \ v" +by (auto simp add: subst_elim_def) + +lemma subst_elimI'[intro]: "(\w. v \ fv (Var w \ \)) \ subst_elim \ v" +by (simp add: subst_elim_def subst_apply_fv_unfold') + +lemma subst_elimD[dest]: "subst_elim \ v \ v \ fv (t \ \)" +by (auto simp add: subst_elim_def) + +lemma subst_elimD'[dest]: "subst_elim \ v \ \ v \ Var v" +by (metis subst_elim_def subst_apply_term.simps(1) term.set_intros(3)) + +lemma subst_elimD''[dest]: "subst_elim \ v \ v \ fv (\ w)" +by (metis subst_elim_def subst_apply_term.simps(1)) + +lemma subst_elim_rm_vars_dest[dest]: + "subst_elim (\::('a,'b) subst) v \ v \ vs \ subst_elim (rm_vars vs \) v" +proof - + assume assms: "subst_elim \ v" "v \ vs" + obtain f::"('a, 'b) subst \ 'b \ 'b" where + "\\ v. (\w. v \ fv (Var w \ \)) = (v \ fv (Var (f \ v) \ \))" + by moura + hence *: "\a \. a \ fv (Var (f \ a) \ \) \ subst_elim \ a" by blast + have "Var (f (rm_vars vs \) v) \ \ \ Var (f (rm_vars vs \) v) \ rm_vars vs \ + \ v \ fv (Var (f (rm_vars vs \) v) \ rm_vars vs \)" + using assms(1) by fastforce + moreover + { assume "Var (f (rm_vars vs \) v) \ \ \ Var (f (rm_vars vs \) v) \ rm_vars vs \" + hence "rm_vars vs \ (f (rm_vars vs \) v) \ \ (f (rm_vars vs \) v)" by auto + hence "f (rm_vars vs \) v \ vs" by meson + hence ?thesis using * assms(2) by force + } + ultimately show ?thesis using * by blast +qed + +lemma occs_subst_elim: "\Var v \ t \ subst_elim (Var(v := t)) v \ (Var(v := t)) = Var" +proof (cases "Var v = t") + assume "Var v \ t" "\Var v \ t" + hence "v \ fv t" by (simp add: vars_iff_subterm_or_eq) + thus ?thesis by (auto simp add: subst_remove_var) +qed auto + +lemma occs_subst_elim': "\Var v \ t \ subst_elim (Var(v := t)) v" +proof - + assume "\Var v \ t" + hence "v \ fv t" by (auto simp add: vars_iff_subterm_or_eq) + thus "subst_elim (Var(v := t)) v" by (simp add: subst_elim_def subst_remove_var) +qed + +lemma subst_elim_comp: "subst_elim \ v \ subst_elim (\ \\<^sub>s \) v" +by (auto simp add: subst_elim_def) + +lemma var_subst_idem: "subst_idem Var" +by (simp add: subst_idem_def) + +lemma var_upd_subst_idem: + assumes "\Var v \ t" shows "subst_idem (Var(v := t))" +unfolding subst_idem_def +proof + let ?\ = "Var(v := t)" + from assms have t_\_id: "t \ ?\ = t" by blast + fix s show "s \ (?\ \\<^sub>s ?\) = s \ ?\" + unfolding subst_compose_def + by (induction s, metis t_\_id fun_upd_def subst_apply_term.simps(1), simp) +qed + + +subsection \Lemmata: Domain and Range of Substitutions\ +lemma range_vars_alt_def: "range_vars s \ fv\<^sub>s\<^sub>e\<^sub>t (subst_range s)" +unfolding range_vars_def by simp + +lemma subst_dom_var_finite[simp]: "finite (subst_domain Var)" by simp + +lemma subst_range_Var[simp]: "subst_range Var = {}" by simp + +lemma range_vars_Var[simp]: "range_vars Var = {}" by fastforce + +lemma finite_subst_img_if_finite_dom: "finite (subst_domain \) \ finite (range_vars \)" +unfolding range_vars_alt_def by auto + +lemma finite_subst_img_if_finite_dom': "finite (subst_domain \) \ finite (subst_range \)" +by auto + +lemma subst_img_alt_def: "subst_range s = {t. \v. s v = t \ t \ Var v}" +by (auto simp add: subst_domain_def) + +lemma subst_fv_img_alt_def: "range_vars s = (\t \ {t. \v. s v = t \ t \ Var v}. fv t)" +unfolding range_vars_alt_def by (auto simp add: subst_domain_def) + +lemma subst_domI[intro]: "\ v \ Var v \ v \ subst_domain \" +by (simp add: subst_domain_def) + +lemma subst_imgI[intro]: "\ v \ Var v \ \ v \ subst_range \" +by (simp add: subst_domain_def) + +lemma subst_fv_imgI[intro]: "\ v \ Var v \ fv (\ v) \ range_vars \" +unfolding range_vars_alt_def by auto + +lemma subst_domain_subst_Fun_single[simp]: + "subst_domain (Var(x := Fun f T)) = {x}" (is "?A = ?B") +unfolding subst_domain_def by simp + +lemma subst_range_subst_Fun_single[simp]: + "subst_range (Var(x := Fun f T)) = {Fun f T}" (is "?A = ?B") +by simp + +lemma range_vars_subst_Fun_single[simp]: + "range_vars (Var(x := Fun f T)) = fv (Fun f T)" +unfolding range_vars_alt_def by force + +lemma var_renaming_is_Fun_iff: + assumes "subst_range \ \ range Var" + shows "is_Fun t = is_Fun (t \ \)" +proof (cases t) + case (Var x) + hence "\y. \ x = Var y" using assms by auto + thus ?thesis using Var by auto +qed simp + +lemma subst_fv_dom_img_subset: "fv t \ subst_domain \ \ fv (t \ \) \ range_vars \" +unfolding range_vars_alt_def by (induct t) auto + +lemma subst_fv_dom_img_subset_set: "fv\<^sub>s\<^sub>e\<^sub>t M \ subst_domain \ \ fv\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \) \ range_vars \" +proof - + assume assms: "fv\<^sub>s\<^sub>e\<^sub>t M \ subst_domain \" + obtain f::"'a set \ (('b, 'a) term \ 'a set) \ ('b, 'a) terms \ ('b, 'a) term" where + "\x y z. (\v. v \ z \ \ y v \ x) \ (f x y z \ z \ \ y (f x y z) \ x)" + by moura + hence *: + "\T g A. (\ \ (g ` T) \ A \ (\t. t \ T \ g t \ A)) \ + (\ (g ` T) \ A \ f A g T \ T \ \ g (f A g T) \ A)" + by (metis (no_types) SUP_le_iff) + hence **: "\t. t \ M \ fv t \ subst_domain \" by (metis (no_types) assms fv\<^sub>s\<^sub>e\<^sub>t.simps) + have "\t::('b, 'a) term. \f T. t \ f ` T \ (\t'::('b, 'a) term. t = f t' \ t' \ T)" by blast + hence "f (range_vars \) fv (M \\<^sub>s\<^sub>e\<^sub>t \) \ M \\<^sub>s\<^sub>e\<^sub>t \ \ + fv (f (range_vars \) fv (M \\<^sub>s\<^sub>e\<^sub>t \)) \ range_vars \" + by (metis (full_types) ** subst_fv_dom_img_subset) + thus ?thesis by (metis (no_types) * fv\<^sub>s\<^sub>e\<^sub>t.simps) +qed + +lemma subst_fv_dom_ground_if_ground_img: + assumes "fv t \ subst_domain s" "ground (subst_range s)" + shows "fv (t \ s) = {}" +using subst_fv_dom_img_subset[OF assms(1)] assms(2) by force + +lemma subst_fv_dom_ground_if_ground_img': + assumes "fv t \ subst_domain s" "\x. x \ subst_domain s \ fv (s x) = {}" + shows "fv (t \ s) = {}" +using subst_fv_dom_ground_if_ground_img[OF assms(1)] assms(2) by auto + +lemma subst_fv_unfold: "fv (t \ s) = (fv t - subst_domain s) \ fv\<^sub>s\<^sub>e\<^sub>t (s ` (fv t \ subst_domain s))" +proof (induction t) + case (Var v) thus ?case + proof (cases "v \ subst_domain s") + case True thus ?thesis by auto + next + case False + hence "fv (Var v \ s) = {v}" "fv (Var v) \ subst_domain s = {}" by auto + thus ?thesis by auto + qed +next + case Fun thus ?case by auto +qed + +lemma subst_fv_unfold_ground_img: "range_vars s = {} \ fv (t \ s) = fv t - subst_domain s" +using subst_fv_unfold[of t s] unfolding range_vars_alt_def by auto + +lemma subst_img_update: + "\\ v = Var v; t \ Var v\ \ range_vars (\(v := t)) = range_vars \ \ fv t" +proof - + assume "\ v = Var v" "t \ Var v" + hence "(\s \ {s. \w. (\(v := t)) w = s \ s \ Var w}. fv s) = fv t \ range_vars \" + unfolding range_vars_alt_def by (auto simp add: subst_domain_def) + thus "range_vars (\(v := t)) = range_vars \ \ fv t" + by (metis Un_commute subst_fv_img_alt_def) +qed + +lemma subst_dom_update1: "v \ subst_domain \ \ subst_domain (\(v := Var v)) = subst_domain \" +by (auto simp add: subst_domain_def) + +lemma subst_dom_update2: "t \ Var v \ subst_domain (\(v := t)) = insert v (subst_domain \)" +by (auto simp add: subst_domain_def) + +lemma subst_dom_update3: "t = Var v \ subst_domain (\(v := t)) = subst_domain \ - {v}" +by (auto simp add: subst_domain_def) + +lemma var_not_in_subst_dom[elim]: "v \ subst_domain s \ s v = Var v" +by (simp add: subst_domain_def) + +lemma subst_dom_vars_in_subst[elim]: "v \ subst_domain s \ s v \ Var v" +by (simp add: subst_domain_def) + +lemma subst_not_dom_fixed: "\v \ fv t; v \ subst_domain s\ \ v \ fv (t \ s)" by (induct t) auto + +lemma subst_not_img_fixed: "\v \ fv (t \ s); v \ range_vars s\ \ v \ fv t" +unfolding range_vars_alt_def by (induct t) force+ + +lemma ground_range_vars[intro]: "ground (subst_range s) \ range_vars s = {}" +unfolding range_vars_alt_def by metis + +lemma ground_subst_no_var[intro]: "ground (subst_range s) \ x \ range_vars s" +using ground_range_vars[of s] by blast + +lemma ground_img_obtain_fun: + assumes "ground (subst_range s)" "x \ subst_domain s" + obtains f T where "s x = Fun f T" "Fun f T \ subst_range s" "fv (Fun f T) = {}" +proof - + from assms(2) obtain t where t: "s x = t" "t \ subst_range s" by moura + hence "fv t = {}" using assms(1) by auto + thus ?thesis using t that by (cases t) simp_all +qed + +lemma ground_term_subst_domain_fv_subset: + "fv (t \ \) = {} \ fv t \ subst_domain \" +by (induct t) auto + +lemma ground_subst_range_empty_fv: + "ground (subst_range \) \ x \ subst_domain \ \ fv (\ x) = {}" +by simp + +lemma subst_Var_notin_img: "x \ range_vars s \ t \ s = Var x \ t = Var x" +using subst_not_img_fixed[of x t s] by (induct t) auto + +lemma fv_in_subst_img: "\s v = t; t \ Var v\ \ fv t \ range_vars s" +unfolding range_vars_alt_def by auto + +lemma empty_dom_iff_empty_subst: "subst_domain \ = {} \ \ = Var" by auto + +lemma subst_dom_cong: "(\v t. \ v = t \ \ v = t) \ subst_domain \ \ subst_domain \" +by (auto simp add: subst_domain_def) + +lemma subst_img_cong: "(\v t. \ v = t \ \ v = t) \ range_vars \ \ range_vars \" +unfolding range_vars_alt_def by (auto simp add: subst_domain_def) + +lemma subst_dom_elim: "subst_domain s \ range_vars s = {} \ fv (t \ s) \ subst_domain s = {}" +proof (induction t) + case (Var v) thus ?case + using fv_in_subst_img[of s] + by (cases "s v = Var v") (auto simp add: subst_domain_def) +next + case Fun thus ?case by auto +qed + +lemma subst_dom_insert_finite: "finite (subst_domain s) = finite (subst_domain (s(v := t)))" +proof + assume "finite (subst_domain s)" + have "subst_domain (s(v := t)) \ insert v (subst_domain s)" by (auto simp add: subst_domain_def) + thus "finite (subst_domain (s(v := t)))" + by (meson \finite (subst_domain s)\ finite_insert rev_finite_subset) +next + assume *: "finite (subst_domain (s(v := t)))" + hence "finite (insert v (subst_domain s))" + proof (cases "t = Var v") + case True + hence "finite (subst_domain s - {v})" by (metis * subst_dom_update3) + thus ?thesis by simp + qed (metis * subst_dom_update2[of t v s]) + thus "finite (subst_domain s)" by simp +qed + +lemma trm_subst_disj: "t \ \ = t \ fv t \ subst_domain \ = {}" +proof (induction t) + case (Fun f X) + hence "map (\x. x \ \) X = X" by simp + hence "\x. x \ set X \ x \ \ = x" using map_eq_conv by fastforce + thus ?case using Fun.IH by auto +qed (simp add: subst_domain_def) + +lemma trm_subst_ident[intro]: "fv t \ subst_domain \ = {} \ t \ \ = t" +proof - + assume "fv t \ subst_domain \ = {}" + hence "\v \ fv t. \w \ subst_domain \. v \ w" by auto + thus ?thesis + by (metis subst_agreement subst_apply_term.simps(1) subst_apply_term_empty subst_domI) +qed + +lemma trm_subst_ident'[intro]: "v \ subst_domain \ \ (Var v) \ \ = Var v" +using trm_subst_ident by (simp add: subst_domain_def) + +lemma trm_subst_ident''[intro]: "(\x. x \ fv t \ \ x = Var x) \ t \ \ = t" +proof - + assume "\x. x \ fv t \ \ x = Var x" + hence "fv t \ subst_domain \ = {}" by (auto simp add: subst_domain_def) + thus ?thesis using trm_subst_ident by auto +qed + +lemma set_subst_ident: "fv\<^sub>s\<^sub>e\<^sub>t M \ subst_domain \ = {} \ M \\<^sub>s\<^sub>e\<^sub>t \ = M" +proof - + assume "fv\<^sub>s\<^sub>e\<^sub>t M \ subst_domain \ = {}" + hence "\t \ M. t \ \ = t" by auto + thus ?thesis by force +qed + +lemma trm_subst_ident_subterms[intro]: + "fv t \ subst_domain \ = {} \ subterms t \\<^sub>s\<^sub>e\<^sub>t \ = subterms t" +using set_subst_ident[of "subterms t" \] fv_subterms[of t] by simp + +lemma trm_subst_ident_subterms'[intro]: + "v \ fv t \ subterms t \\<^sub>s\<^sub>e\<^sub>t Var(v := s) = subterms t" +using trm_subst_ident_subterms[of t "Var(v := s)"] +by (meson subst_no_occs trm_subst_disj vars_iff_subtermeq) + +lemma const_mem_subst_cases: + assumes "Fun c [] \ M \\<^sub>s\<^sub>e\<^sub>t \" + shows "Fun c [] \ M \ Fun c [] \ \ ` fv\<^sub>s\<^sub>e\<^sub>t M" +proof - + obtain m where m: "m \ M" "m \ \ = Fun c []" using assms by auto + thus ?thesis by (cases m) force+ +qed + +lemma const_mem_subst_cases': + assumes "Fun c [] \ M \\<^sub>s\<^sub>e\<^sub>t \" + shows "Fun c [] \ M \ Fun c [] \ subst_range \" +using const_mem_subst_cases[OF assms] by force + +lemma fv_subterms_substI[intro]: "y \ fv t \ \ y \ subterms t \\<^sub>s\<^sub>e\<^sub>t \" +using image_iff vars_iff_subtermeq by fastforce + +lemma fv_subterms_subst_eq[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (subterms (t \ \)) = fv\<^sub>s\<^sub>e\<^sub>t (subterms t \\<^sub>s\<^sub>e\<^sub>t \)" +using fv_subterms by (induct t) force+ + +lemma fv_subterms_set_subst: "fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t M \\<^sub>s\<^sub>e\<^sub>t \) = fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \))" +using fv_subterms_subst_eq[of _ \] by auto + +lemma fv_subterms_set_subst': "fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t M \\<^sub>s\<^sub>e\<^sub>t \) = fv\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \)" +using fv_subterms_set[of "M \\<^sub>s\<^sub>e\<^sub>t \"] fv_subterms_set_subst[of \ M] by simp + +lemma fv_subst_subset: "x \ fv t \ fv (\ x) \ fv (t \ \)" +by (metis fv_subset image_eqI subst_apply_fv_unfold) + +lemma fv_subst_subset': "fv s \ fv t \ fv (s \ \) \ fv (t \ \)" +using fv_subst_subset by (induct s) force+ + +lemma fv_subst_obtain_var: + fixes \::"('a,'b) subst" + assumes "x \ fv (t \ \)" + shows "\y \ fv t. x \ fv (\ y)" +using assms by (induct t) force+ + +lemma set_subst_all_ident: "fv\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \) \ subst_domain \ = {} \ M \\<^sub>s\<^sub>e\<^sub>t (\ \\<^sub>s \) = M \\<^sub>s\<^sub>e\<^sub>t \" +by (metis set_subst_ident subst_comp_all) + +lemma subterms_subst: + "subterms (t \ d) = (subterms t \\<^sub>s\<^sub>e\<^sub>t d) \ subterms\<^sub>s\<^sub>e\<^sub>t (d ` (fv t \ subst_domain d))" +by (induct t) (auto simp add: subst_domain_def) + +lemma subterms_subst': + fixes \::"('a,'b) subst" + assumes "\x \ fv t. (\f. \ x = Fun f []) \ (\y. \ x = Var y)" + shows "subterms (t \ \) = subterms t \\<^sub>s\<^sub>e\<^sub>t \" +using assms +proof (induction t) + case (Var x) thus ?case + proof (cases "x \ subst_domain \") + case True + hence "(\f. \ x = Fun f []) \ (\y. \ x = Var y)" using Var by simp + hence "subterms (\ x) = {\ x}" by auto + thus ?thesis by simp + qed auto +qed auto + +lemma subterms_subst'': + fixes \::"('a,'b) subst" + assumes "\x \ fv\<^sub>s\<^sub>e\<^sub>t M. (\f. \ x = Fun f []) \ (\y. \ x = Var y)" + shows "subterms\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \) = subterms\<^sub>s\<^sub>e\<^sub>t M \\<^sub>s\<^sub>e\<^sub>t \" +using subterms_subst'[of _ \] assms by auto + +lemma subterms_subst_subterm: + fixes \::"('a,'b) subst" + assumes "\x \ fv a. (\f. \ x = Fun f []) \ (\y. \ x = Var y)" + and "b \ subterms (a \ \)" + shows "\c \ subterms a. c \ \ = b" +using subterms_subst'[OF assms(1)] assms(2) by auto + +lemma subterms_subst_subset: "subterms t \\<^sub>s\<^sub>e\<^sub>t \ \ subterms (t \ \)" +by (induct t) auto + +lemma subterms_subst_subset': "subterms\<^sub>s\<^sub>e\<^sub>t M \\<^sub>s\<^sub>e\<^sub>t \ \ subterms\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \)" +using subterms_subst_subset by fast + +lemma subterms\<^sub>s\<^sub>e\<^sub>t_subst: + fixes \::"('a,'b) subst" + assumes "t \ subterms\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \)" + shows "t \ subterms\<^sub>s\<^sub>e\<^sub>t M \\<^sub>s\<^sub>e\<^sub>t \ \ (\x \ fv\<^sub>s\<^sub>e\<^sub>t M. t \ subterms (\ x))" +using assms subterms_subst[of _ \] by auto + +lemma rm_vars_dom: "subst_domain (rm_vars V s) = subst_domain s - V" +by (auto simp add: subst_domain_def) + +lemma rm_vars_dom_subset: "subst_domain (rm_vars V s) \ subst_domain s" +by (auto simp add: subst_domain_def) + +lemma rm_vars_dom_eq': + "subst_domain (rm_vars (UNIV - V) s) = subst_domain s \ V" +using rm_vars_dom[of "UNIV - V" s] by blast + +lemma rm_vars_img: "subst_range (rm_vars V s) = s ` subst_domain (rm_vars V s)" +by (auto simp add: subst_domain_def) + +lemma rm_vars_img_subset: "subst_range (rm_vars V s) \ subst_range s" +by (auto simp add: subst_domain_def) + +lemma rm_vars_img_fv_subset: "range_vars (rm_vars V s) \ range_vars s" +unfolding range_vars_alt_def by (auto simp add: subst_domain_def) + +lemma rm_vars_fv_obtain: + assumes "x \ fv (t \ rm_vars X \) - X" + shows "\y \ fv t - X. x \ fv (rm_vars X \ y)" +using assms by (induct t) (fastforce, force) + +lemma rm_vars_apply: "v \ subst_domain (rm_vars V s) \ (rm_vars V s) v = s v" +by (auto simp add: subst_domain_def) + +lemma rm_vars_apply': "subst_domain \ \ vs = {} \ rm_vars vs \ = \" +by force + +lemma rm_vars_ident: "fv t \ vs = {} \ t \ (rm_vars vs \) = t \ \" +by (induct t) auto + +lemma rm_vars_fv_subset: "fv (t \ rm_vars X \) \ fv t \ fv (t \ \)" +by (induct t) auto + +lemma rm_vars_fv_disj: + assumes "fv t \ X = {}" "fv (t \ \) \ X = {}" + shows "fv (t \ rm_vars X \) \ X = {}" +using rm_vars_ident[OF assms(1)] assms(2) by auto + +lemma rm_vars_ground_supports: + assumes "ground (subst_range \)" + shows "rm_vars X \ supports \" +proof + fix x + have *: "ground (subst_range (rm_vars X \))" + using rm_vars_img_subset[of X \] assms + by (auto simp add: subst_domain_def) + show "rm_vars X \ x \ \ = \ x " + proof (cases "x \ subst_domain (rm_vars X \)") + case True + hence "fv (rm_vars X \ x) = {}" using * by auto + thus ?thesis using True by auto + qed (simp add: subst_domain_def) +qed + +lemma rm_vars_split: + assumes "ground (subst_range \)" + shows "\ = rm_vars X \ \\<^sub>s rm_vars (subst_domain \ - X) \" +proof - + let ?s1 = "rm_vars X \" + let ?s2 = "rm_vars (subst_domain \ - X) \" + + have doms: "subst_domain ?s1 \ subst_domain \" "subst_domain ?s2 \ subst_domain \" + by (auto simp add: subst_domain_def) + + { fix x assume "x \ subst_domain \" + hence "\ x = Var x" "?s1 x = Var x" "?s2 x = Var x" using doms by auto + hence "\ x = (?s1 \\<^sub>s ?s2) x" by (simp add: subst_compose_def) + } moreover { + fix x assume "x \ subst_domain \" "x \ X" + hence "?s1 x = Var x" "?s2 x = \ x" using doms by auto + hence "\ x = (?s1 \\<^sub>s ?s2) x" by (simp add: subst_compose_def) + } moreover { + fix x assume "x \ subst_domain \" "x \ X" + hence "?s1 x = \ x" "fv (\ x) = {}" using assms doms by auto + hence "\ x = (?s1 \\<^sub>s ?s2) x" by (simp add: subst_compose subst_ground_ident) + } ultimately show ?thesis by blast +qed + +lemma rm_vars_fv_img_disj: + assumes "fv t \ X = {}" "X \ range_vars \ = {}" + shows "fv (t \ rm_vars X \) \ X = {}" +using assms +proof (induction t) + case (Var x) + hence *: "(rm_vars X \) x = \ x" by auto + show ?case + proof (cases "x \ subst_domain \") + case True + hence "\ x \ subst_range \" by auto + hence "fv (\ x) \ X = {}" using Var.prems(2) unfolding range_vars_alt_def by fastforce + thus ?thesis using * by auto + next + case False thus ?thesis using Var.prems(1) by auto + qed +next + case Fun thus ?case by auto +qed + +lemma subst_apply_dom_ident: "t \ \ = t \ subst_domain \ \ subst_domain \ \ t \ \ = t" +proof (induction t) + case (Fun f T) thus ?case by (induct T) auto +qed (auto simp add: subst_domain_def) + +lemma rm_vars_subst_apply_ident: + assumes "t \ \ = t" + shows "t \ (rm_vars vs \) = t" +using rm_vars_dom[of vs \] subst_apply_dom_ident[OF assms, of "rm_vars vs \"] by auto + +lemma rm_vars_subst_eq: + "t \ \ = t \ rm_vars (subst_domain \ - subst_domain \ \ fv t) \" +by (auto intro: term_subst_eq) + +lemma rm_vars_subst_eq': + "t \ \ = t \ rm_vars (UNIV - fv t) \" +by (auto intro: term_subst_eq) + +lemma rm_vars_comp: + assumes "range_vars \ \ vs = {}" + shows "t \ rm_vars vs (\ \\<^sub>s \) = t \ (rm_vars vs \ \\<^sub>s rm_vars vs \)" +using assms +proof (induction t) + case (Var x) thus ?case + proof (cases "x \ vs") + case True thus ?thesis using Var by auto + next + case False + have "subst_domain (rm_vars vs \) \ vs = {}" by (auto simp add: subst_domain_def) + moreover have "fv (\ x) \ vs = {}" + using Var False unfolding range_vars_alt_def by force + ultimately have "\ x \ (rm_vars vs \) = \ x \ \" + using rm_vars_ident by (simp add: subst_domain_def) + moreover have "(rm_vars vs (\ \\<^sub>s \)) x = (\ \\<^sub>s \) x" by (metis False) + ultimately show ?thesis using subst_compose by auto + qed +next + case Fun thus ?case by auto +qed + +lemma rm_vars_fv\<^sub>s\<^sub>e\<^sub>t_subst: + assumes "x \ fv\<^sub>s\<^sub>e\<^sub>t (rm_vars X \ ` Y)" + shows "x \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` Y) \ x \ X" +using assms by auto + +lemma disj_dom_img_var_notin: + assumes "subst_domain \ \ range_vars \ = {}" "\ v = t" "t \ Var v" + shows "v \ fv t" "\v \ fv (t \ \). v \ subst_domain \" +proof - + have "v \ subst_domain \" "fv t \ range_vars \" + using fv_in_subst_img[of \ v t, OF assms(2)] assms(2,3) + by (auto simp add: subst_domain_def) + thus "v \ fv t" using assms(1) by auto + + have *: "fv t \ subst_domain \ = {}" + using assms(1) \fv t \ range_vars \\ + by auto + hence "t \ \ = t" by blast + thus "\v \ fv (t \ \). v \ subst_domain \" using * by auto +qed + +lemma subst_sends_dom_to_img: "v \ subst_domain \ \ fv (Var v \ \) \ range_vars \" +unfolding range_vars_alt_def by auto + +lemma subst_sends_fv_to_img: "fv (t \ s) \ fv t \ range_vars s" +proof (induction t) + case (Var v) thus ?case + proof (cases "Var v \ s = Var v") + case True thus ?thesis by simp + next + case False + hence "v \ subst_domain s" by (meson trm_subst_ident') + hence "fv (Var v \ s) \ range_vars s" + using subst_sends_dom_to_img by simp + thus ?thesis by auto + qed +next + case Fun thus ?case by auto +qed + +lemma ident_comp_subst_trm_if_disj: + assumes "subst_domain \ \ range_vars \ = {}" "v \ subst_domain \" + shows "(\ \\<^sub>s \) v = \ v" +proof - + from assms have " subst_domain \ \ fv (\ v) = {}" + using fv_in_subst_img unfolding range_vars_alt_def by auto + thus "(\ \\<^sub>s \) v = \ v" unfolding subst_compose_def by blast +qed + +lemma ident_comp_subst_trm_if_disj': "fv (\ v) \ subst_domain \ = {} \ (\ \\<^sub>s \) v = \ v" +unfolding subst_compose_def by blast + +lemma subst_idemI[intro]: "subst_domain \ \ range_vars \ = {} \ subst_idem \" +using ident_comp_subst_trm_if_disj[of \ \] + var_not_in_subst_dom[of _ \] + subst_eq_if_eq_vars[of \] +by (metis subst_idem_def subst_compose_def var_comp(2)) + +lemma subst_idemI'[intro]: "ground (subst_range \) \ subst_idem \" +proof (intro subst_idemI) + assume "ground (subst_range \)" + hence "range_vars \ = {}" by (metis ground_range_vars) + thus "subst_domain \ \ range_vars \ = {}" by blast +qed + +lemma subst_idemE: "subst_idem \ \ subst_domain \ \ range_vars \ = {}" +proof - + assume "subst_idem \" + hence "\v. fv (\ v) \ subst_domain \ = {}" + unfolding subst_idem_def subst_compose_def by (metis trm_subst_disj) + thus ?thesis + unfolding range_vars_alt_def by auto +qed + +lemma subst_idem_rm_vars: "subst_idem \ \ subst_idem (rm_vars X \)" +proof - + assume "subst_idem \" + hence "subst_domain \ \ range_vars \ = {}" by (metis subst_idemE) + moreover have + "subst_domain (rm_vars X \) \ subst_domain \" + "range_vars (rm_vars X \) \ range_vars \" + unfolding range_vars_alt_def by (auto simp add: subst_domain_def) + ultimately show ?thesis by blast +qed + +lemma subst_fv_bounded_if_img_bounded: "range_vars \ \ fv t \ V \ fv (t \ \) \ fv t \ V" +proof (induction t) + case (Var v) thus ?case unfolding range_vars_alt_def by (cases "\ v = Var v") auto +qed (metis (no_types, lifting) Un_assoc Un_commute subst_sends_fv_to_img sup.absorb_iff2) + +lemma subst_fv_bound_singleton: "fv (t \ Var(v := t')) \ fv t \ fv t'" +using subst_fv_bounded_if_img_bounded[of "Var(v := t')" t "fv t'"] +unfolding range_vars_alt_def by (auto simp add: subst_domain_def) + +lemma subst_fv_bounded_if_img_bounded': + assumes "range_vars \ \ fv\<^sub>s\<^sub>e\<^sub>t M" + shows "fv\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t M" +proof + fix v assume *: "v \ fv\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \)" + + obtain t where t: "t \ M" "t \ \ \ M \\<^sub>s\<^sub>e\<^sub>t \" "v \ fv (t \ \)" + proof - + assume **: "\t. \t \ M; t \ \ \ M \\<^sub>s\<^sub>e\<^sub>t \; v \ fv (t \ \)\ \ thesis" + have "v \ \ (fv ` ((\t. t \ \) ` M))" using * by (metis fv\<^sub>s\<^sub>e\<^sub>t.simps) + hence "\t. t \ M \ v \ fv (t \ \)" by blast + thus ?thesis using ** imageI by blast + qed + + from \t \ M\ obtain M' where "t \ M'" "M = insert t M'" by (meson Set.set_insert) + hence "fv\<^sub>s\<^sub>e\<^sub>t M = fv t \ fv\<^sub>s\<^sub>e\<^sub>t M'" by simp + hence "fv (t \ \) \ fv\<^sub>s\<^sub>e\<^sub>t M" using subst_fv_bounded_if_img_bounded assms by simp + thus "v \ fv\<^sub>s\<^sub>e\<^sub>t M" using assms \v \ fv (t \ \)\ by auto +qed + +lemma ground_img_if_ground_subst: "(\v t. s v = t \ fv t = {}) \ range_vars s = {}" +unfolding range_vars_alt_def by auto + +lemma ground_subst_fv_subset: "ground (subst_range \) \ fv (t \ \) \ fv t" +using subst_fv_bounded_if_img_bounded[of \] +unfolding range_vars_alt_def by force + +lemma ground_subst_fv_subset': "ground (subst_range \) \ fv\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t M" +using subst_fv_bounded_if_img_bounded'[of \ M] +unfolding range_vars_alt_def by auto + +lemma subst_to_var_is_var[elim]: "t \ s = Var v \ \w. t = Var w" +using subst_apply_term.elims by blast + +lemma subst_dom_comp_inI: + assumes "y \ subst_domain \" + and "y \ subst_domain \" + shows "y \ subst_domain (\ \\<^sub>s \)" +using assms subst_domain_subst_compose[of \ \] by blast + +lemma subst_comp_notin_dom_eq: + "x \ subst_domain \1 \ (\1 \\<^sub>s \2) x = \2 x" +unfolding subst_compose_def by fastforce + +lemma subst_dom_comp_eq: + assumes "subst_domain \ \ range_vars \ = {}" + shows "subst_domain (\ \\<^sub>s \) = subst_domain \ \ subst_domain \" +proof (rule ccontr) + assume "subst_domain (\ \\<^sub>s \) \ subst_domain \ \ subst_domain \" + hence "subst_domain (\ \\<^sub>s \) \ subst_domain \ \ subst_domain \" + using subst_domain_compose[of \ \] by (simp add: subst_domain_def) + then obtain v where "v \ subst_domain (\ \\<^sub>s \)" "v \ subst_domain \ \ subst_domain \" by auto + hence v_in_some_subst: "\ v \ Var v \ \ v \ Var v" and "\ v \ \ = Var v" + unfolding subst_compose_def by (auto simp add: subst_domain_def) + then obtain w where "\ v = Var w" using subst_to_var_is_var by fastforce + show False + proof (cases "v = w") + case True + hence "\ v = Var v" using \\ v = Var w\ by simp + hence "\ v \ Var v" using v_in_some_subst by simp + thus False using \\ v = Var v\ \\ v \ \ = Var v\ by simp + next + case False + hence "v \ subst_domain \" using v_in_some_subst \\ v \ \ = Var v\ by auto + hence "v \ range_vars \" using assms by auto + moreover have "\ w = Var v" using \\ v \ \ = Var v\ \\ v = Var w\ by simp + hence "v \ range_vars \" using \v \ w\ subst_fv_imgI[of \ w] by simp + ultimately show False .. + qed +qed + +lemma subst_img_comp_subset[simp]: + "range_vars (\1 \\<^sub>s \2) \ range_vars \1 \ range_vars \2" +proof + let ?img = "range_vars" + fix x assume "x \ ?img (\1 \\<^sub>s \2)" + then obtain v t where vt: "x \ fv t" "t = (\1 \\<^sub>s \2) v" "t \ Var v" + unfolding range_vars_alt_def subst_compose_def by (auto simp add: subst_domain_def) + + { assume "x \ ?img \1" hence "x \ ?img \2" + by (metis (no_types, hide_lams) fv_in_subst_img Un_iff subst_compose_def + vt subsetCE subst_apply_term.simps(1) subst_sends_fv_to_img) + } + thus "x \ ?img \1 \ ?img \2" by auto +qed + +lemma subst_img_comp_subset': + assumes "t \ subst_range (\1 \\<^sub>s \2)" + shows "t \ subst_range \2 \ (\t' \ subst_range \1. t = t' \ \2)" +proof - + obtain x where x: "x \ subst_domain (\1 \\<^sub>s \2)" "(\1 \\<^sub>s \2) x = t" "t \ Var x" + using assms by (auto simp add: subst_domain_def) + { assume "x \ subst_domain \1" + hence "(\1 \\<^sub>s \2) x = \2 x" unfolding subst_compose_def by auto + hence ?thesis using x by auto + } moreover { + assume "x \ subst_domain \1" hence ?thesis using subst_compose x(2) by fastforce + } ultimately show ?thesis by metis +qed + +lemma subst_img_comp_subset'': + "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (\1 \\<^sub>s \2)) \ + subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \2) \ ((subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \1)) \\<^sub>s\<^sub>e\<^sub>t \2)" +proof + fix t assume "t \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (\1 \\<^sub>s \2))" + then obtain x where x: "x \ subst_domain (\1 \\<^sub>s \2)" "t \ subterms ((\1 \\<^sub>s \2) x)" + by auto + show "t \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \2) \ (subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \1) \\<^sub>s\<^sub>e\<^sub>t \2)" + proof (cases "x \ subst_domain \1") + case True thus ?thesis + using subst_compose[of \1 \2] x(2) subterms_subst + by fastforce + next + case False + hence "(\1 \\<^sub>s \2) x = \2 x" unfolding subst_compose_def by auto + thus ?thesis using x by (auto simp add: subst_domain_def) + qed +qed + +lemma subst_img_comp_subset''': + "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (\1 \\<^sub>s \2)) - range Var \ + subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \2) - range Var \ ((subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \1) - range Var) \\<^sub>s\<^sub>e\<^sub>t \2)" +proof + fix t assume t: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (\1 \\<^sub>s \2)) - range Var" + then obtain f T where fT: "t = Fun f T" by (cases t) simp_all + then obtain x where x: "x \ subst_domain (\1 \\<^sub>s \2)" "Fun f T \ subterms ((\1 \\<^sub>s \2) x)" + using t by auto + have "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \2) \ (subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \1) - range Var \\<^sub>s\<^sub>e\<^sub>t \2)" + proof (cases "x \ subst_domain \1") + case True + hence "Fun f T \ (subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \2)) \ (subterms (\1 x) \\<^sub>s\<^sub>e\<^sub>t \2)" + using x(2) subterms_subst[of "\1 x" \2] + unfolding subst_compose[of \1 \2 x] by auto + moreover have ?thesis when *: "Fun f T \ subterms (\1 x) \\<^sub>s\<^sub>e\<^sub>t \2" + proof - + obtain s where s: "s \ subterms (\1 x)" "Fun f T = s \ \2" using * by moura + show ?thesis + proof (cases s) + case (Var y) + hence "Fun f T \ subst_range \2" using s by force + thus ?thesis by blast + next + case (Fun g S) + hence "Fun f T \ (subterms (\1 x) - range Var) \\<^sub>s\<^sub>e\<^sub>t \2" using s by blast + thus ?thesis using True by auto + qed + qed + ultimately show ?thesis by blast + next + case False + hence "(\1 \\<^sub>s \2) x = \2 x" unfolding subst_compose_def by auto + thus ?thesis using x by (auto simp add: subst_domain_def) + qed + thus "t \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \2) - range Var \ + (subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \1) - range Var \\<^sub>s\<^sub>e\<^sub>t \2)" + using fT by auto +qed + +lemma subst_img_comp_subset_const: + assumes "Fun c [] \ subst_range (\1 \\<^sub>s \2)" + shows "Fun c [] \ subst_range \2 \ Fun c [] \ subst_range \1 \ + (\x. Var x \ subst_range \1 \ \2 x = Fun c [])" +proof (cases "Fun c [] \ subst_range \2") + case False + then obtain t where t: "t \ subst_range \1" "Fun c [] = t \ \2" + using subst_img_comp_subset'[OF assms] by auto + thus ?thesis by (cases t) auto +qed (simp add: subst_img_comp_subset'[OF assms]) + +lemma subst_img_comp_subset_const': + fixes \ \::"('f,'v) subst" + assumes "(\ \\<^sub>s \) x = Fun c []" + shows "\ x = Fun c [] \ (\z. \ x = Var z \ \ z = Fun c [])" +proof (cases "\ x = Fun c []") + case False + then obtain t where "\ x = t" "t \ \ = Fun c []" using assms unfolding subst_compose_def by auto + thus ?thesis by (cases t) auto +qed simp + +lemma subst_img_comp_subset_ground: + assumes "ground (subst_range \1)" + shows "subst_range (\1 \\<^sub>s \2) \ subst_range \1 \ subst_range \2" +proof + fix t assume t: "t \ subst_range (\1 \\<^sub>s \2)" + then obtain x where x: "x \ subst_domain (\1 \\<^sub>s \2)" "t = (\1 \\<^sub>s \2) x" by auto + + show "t \ subst_range \1 \ subst_range \2" + proof (cases "x \ subst_domain \1") + case True + hence "fv (\1 x) = {}" using assms ground_subst_range_empty_fv by fast + hence "t = \1 x" using x(2) unfolding subst_compose_def by blast + thus ?thesis using True by simp + next + case False + hence "t = \2 x" "x \ subst_domain \2" + using x subst_domain_compose[of \1 \2] + by (metis subst_comp_notin_dom_eq, blast) + thus ?thesis using x by simp + qed +qed + +lemma subst_fv_dom_img_single: + assumes "v \ fv t" "\ v = t" "\w. v \ w \ \ w = Var w" + shows "subst_domain \ = {v}" "range_vars \ = fv t" +proof - + show "subst_domain \ = {v}" using assms by (fastforce simp add: subst_domain_def) + have "fv t \ range_vars \" by (metis fv_in_subst_img assms(1,2) vars_iff_subterm_or_eq) + moreover have "\v. \ v \ Var v \ \ v = t" using assms by fastforce + ultimately show "range_vars \ = fv t" + unfolding range_vars_alt_def + by (auto simp add: subst_domain_def) +qed + +lemma subst_comp_upd1: + "\(v := t) \\<^sub>s \ = (\ \\<^sub>s \)(v := t \ \)" +unfolding subst_compose_def by auto + +lemma subst_comp_upd2: + assumes "v \ subst_domain s" "v \ range_vars s" + shows "s(v := t) = s \\<^sub>s (Var(v := t))" +unfolding subst_compose_def +proof - + { fix w + have "(s(v := t)) w = s w \ Var(v := t)" + proof (cases "w = v") + case True + hence "s w = Var w" using \v \ subst_domain s\ by (simp add: subst_domain_def) + thus ?thesis using \w = v\ by simp + next + case False + hence "(s(v := t)) w = s w" by simp + moreover have "s w \ Var(v := t) = s w" using \w \ v\ \v \ range_vars s\ + by (metis fv_in_subst_img fun_upd_apply insert_absorb insert_subset + repl_invariance subst_apply_term.simps(1) subst_apply_term_empty) + ultimately show ?thesis .. + qed + } + thus "s(v := t) = (\w. s w \ Var(v := t))" by auto +qed + +lemma ground_subst_dom_iff_img: + "ground (subst_range \) \ x \ subst_domain \ \ \ x \ subst_range \" +by (auto simp add: subst_domain_def) + +lemma finite_dom_subst_exists: + "finite S \ \\::('f,'v) subst. subst_domain \ = S" +proof (induction S rule: finite.induct) + case (insertI A a) + then obtain \::"('f,'v) subst" where "subst_domain \ = A" by blast + fix f::'f + have "subst_domain (\(a := Fun f [])) = insert a A" + using \subst_domain \ = A\ + by (auto simp add: subst_domain_def) + thus ?case by metis +qed (auto simp add: subst_domain_def) + +lemma subst_inj_is_bij_betw_dom_img_if_ground_img: + assumes "ground (subst_range \)" + shows "inj \ \ bij_betw \ (subst_domain \) (subst_range \)" (is "?A \ ?B") +proof + show "?A \ ?B" by (metis bij_betw_def injD inj_onI subst_range.simps) +next + assume ?B + hence "inj_on \ (subst_domain \)" unfolding bij_betw_def by auto + moreover have "\x. x \ UNIV - subst_domain \ \ \ x = Var x" by auto + hence "inj_on \ (UNIV - subst_domain \)" + using inj_onI[of "UNIV - subst_domain \"] + by (metis term.inject(1)) + moreover have "\x y. x \ subst_domain \ \ y \ subst_domain \ \ \ x \ \ y" + using assms by (auto simp add: subst_domain_def) + ultimately show ?A by (metis injI inj_onD subst_domI term.inject(1)) +qed + +lemma bij_finite_ground_subst_exists: + assumes "finite (S::'v set)" "infinite (U::('f,'v) term set)" "ground U" + shows "\\::('f,'v) subst. subst_domain \ = S + \ bij_betw \ (subst_domain \) (subst_range \) + \ subst_range \ \ U" +proof - + obtain T' where "T' \ U" "card T' = card S" "finite T'" + by (meson assms(2) finite_Diff2 infinite_arbitrarily_large) + then obtain f::"'v \ ('f,'v) term" where f_bij: "bij_betw f S T'" + using finite_same_card_bij[OF assms(1)] by metis + hence *: "\v. v \ S \ f v \ Var v" + using \ground U\ \T' \ U\ bij_betwE + by fastforce + + let ?\ = "\v. if v \ S then f v else Var v" + have "subst_domain ?\ = S" + proof + show "subst_domain ?\ \ S" by (auto simp add: subst_domain_def) + + { fix v assume "v \ S" "v \ subst_domain ?\" + hence "f v = Var v" by (simp add: subst_domain_def) + hence False using *[OF \v \ S\] by metis + } + thus "S \ subst_domain ?\" by blast + qed + hence "\v w. \v \ subst_domain ?\; w \ subst_domain ?\\ \ ?\ w \ ?\ v" + using \ground U\ bij_betwE[OF f_bij] set_rev_mp[OF _ \T' \ U\] + by (metis (no_types, lifting) UN_iff empty_iff vars_iff_subterm_or_eq fv\<^sub>s\<^sub>e\<^sub>t.simps) + hence "inj_on ?\ (subst_domain ?\)" + using f_bij \subst_domain ?\ = S\ + unfolding bij_betw_def inj_on_def + by metis + hence "bij_betw ?\ (subst_domain ?\) (subst_range ?\)" + using inj_on_imp_bij_betw[of ?\] by simp + moreover have "subst_range ?\ = T'" + using \bij_betw f S T'\ \subst_domain ?\ = S\ + unfolding bij_betw_def by auto + hence "subst_range ?\ \ U" using \T' \ U\ by auto + ultimately show ?thesis using \subst_domain ?\ = S\ by (metis (lifting)) +qed + +lemma bij_finite_const_subst_exists: + assumes "finite (S::'v set)" "finite (T::'f set)" "infinite (U::'f set)" + shows "\\::('f,'v) subst. subst_domain \ = S + \ bij_betw \ (subst_domain \) (subst_range \) + \ subst_range \ \ (\c. Fun c []) ` (U - T)" +proof - + obtain T' where "T' \ U - T" "card T' = card S" "finite T'" + by (meson assms(2,3) finite_Diff2 infinite_arbitrarily_large) + then obtain f::"'v \ 'f" where f_bij: "bij_betw f S T'" + using finite_same_card_bij[OF assms(1)] by metis + + let ?\ = "\v. if v \ S then Fun (f v) [] else Var v" + have "subst_domain ?\ = S" by (simp add: subst_domain_def) + moreover have "\v w. \v \ subst_domain ?\; w \ subst_domain ?\\ \ ?\ w \ ?\ v" by auto + hence "inj_on ?\ (subst_domain ?\)" + using f_bij unfolding bij_betw_def inj_on_def + by (metis \subst_domain ?\ = S\ term.inject(2)) + hence "bij_betw ?\ (subst_domain ?\) (subst_range ?\)" + using inj_on_imp_bij_betw[of ?\] by simp + moreover have "subst_range ?\ = ((\c. Fun c []) ` T')" + using \bij_betw f S T'\ unfolding bij_betw_def inj_on_def by (auto simp add: subst_domain_def) + hence "subst_range ?\ \ ((\c. Fun c []) ` (U - T))" using \T' \ U - T\ by auto + ultimately show ?thesis by (metis (lifting)) +qed + +lemma bij_finite_const_subst_exists': + assumes "finite (S::'v set)" "finite (T::('f,'v) terms)" "infinite (U::'f set)" + shows "\\::('f,'v) subst. subst_domain \ = S + \ bij_betw \ (subst_domain \) (subst_range \) + \ subst_range \ \ ((\c. Fun c []) ` U) - T" +proof - + have "finite (\(funs_term ` T))" using assms(2) by auto + then obtain \ where \: + "subst_domain \ = S" "bij_betw \ (subst_domain \) (subst_range \)" + "subst_range \ \ (\c. Fun c []) ` (U - (\(funs_term ` T)))" + using bij_finite_const_subst_exists[OF assms(1) _ assms(3)] by blast + moreover have "(\c. Fun c []) ` (U - (\(funs_term ` T))) \ ((\c. Fun c []) ` U) - T" by auto + ultimately show ?thesis by blast +qed + +lemma bij_betw_iteI: + assumes "bij_betw f A B" "bij_betw g C D" "A \ C = {}" "B \ D = {}" + shows "bij_betw (\x. if x \ A then f x else g x) (A \ C) (B \ D)" +proof - + have "bij_betw (\x. if x \ A then f x else g x) A B" + by (metis bij_betw_cong[of A f "\x. if x \ A then f x else g x" B] assms(1)) + moreover have "bij_betw (\x. if x \ A then f x else g x) C D" + using bij_betw_cong[of C g "\x. if x \ A then f x else g x" D] assms(2,3) by force + ultimately show ?thesis using bij_betw_combine[OF _ _ assms(4)] by metis +qed + +lemma subst_comp_split: + assumes "subst_domain \ \ range_vars \ = {}" + shows "\ = (rm_vars (subst_domain \ - V) \) \\<^sub>s (rm_vars V \)" (is ?P) + and "\ = (rm_vars V \) \\<^sub>s (rm_vars (subst_domain \ - V) \)" (is ?Q) +proof - + let ?rm1 = "rm_vars (subst_domain \ - V) \" and ?rm2 = "rm_vars V \" + have "subst_domain ?rm2 \ range_vars ?rm1 = {}" + "subst_domain ?rm1 \ range_vars ?rm2 = {}" + using assms unfolding range_vars_alt_def by (force simp add: subst_domain_def)+ + hence *: "\v. v \ subst_domain ?rm1 \ (?rm1 \\<^sub>s ?rm2) v = \ v" + "\v. v \ subst_domain ?rm2 \ (?rm2 \\<^sub>s ?rm1) v = \ v" + using ident_comp_subst_trm_if_disj[of ?rm2 ?rm1] + ident_comp_subst_trm_if_disj[of ?rm1 ?rm2] + by (auto simp add: subst_domain_def) + hence "\v. v \ subst_domain ?rm1 \ (?rm1 \\<^sub>s ?rm2) v = \ v" + "\v. v \ subst_domain ?rm2 \ (?rm2 \\<^sub>s ?rm1) v = \ v" + unfolding subst_compose_def by (auto simp add: subst_domain_def) + hence "\v. (?rm1 \\<^sub>s ?rm2) v = \ v" "\v. (?rm2 \\<^sub>s ?rm1) v = \ v" using * by blast+ + thus ?P ?Q by auto +qed + +lemma subst_comp_eq_if_disjoint_vars: + assumes "(subst_domain \ \ range_vars \) \ (subst_domain \ \ range_vars \) = {}" + shows "\ \\<^sub>s \ = \ \\<^sub>s \" +proof - + { fix x assume "x \ subst_domain \" + hence "(\ \\<^sub>s \) x = \ x" "(\ \\<^sub>s \) x = \ x" + using assms unfolding range_vars_alt_def by (force simp add: subst_compose)+ + hence "(\ \\<^sub>s \) x = (\ \\<^sub>s \) x" by metis + } moreover + { fix x assume "x \ subst_domain \" + hence "(\ \\<^sub>s \) x = \ x" "(\ \\<^sub>s \) x = \ x" + using assms + unfolding range_vars_alt_def by (auto simp add: subst_compose subst_domain_def) + hence "(\ \\<^sub>s \) x = (\ \\<^sub>s \) x" by metis + } moreover + { fix x assume "x \ subst_domain \" "x \ subst_domain \" + hence "(\ \\<^sub>s \) x = (\ \\<^sub>s \) x" by (simp add: subst_compose subst_domain_def) + } ultimately show ?thesis by auto +qed + +lemma subst_eq_if_disjoint_vars_ground: + fixes \ \::"('f,'v) subst" + assumes "subst_domain \ \ subst_domain \ = {}" "ground (subst_range \)" "ground (subst_range \)" + shows "t \ \ \ \ = t \ \ \ \" +by (metis assms subst_comp_eq_if_disjoint_vars range_vars_alt_def + subst_subst_compose sup_bot.right_neutral) + +lemma subst_img_bound: "subst_domain \ \ range_vars \ \ fv t \ range_vars \ \ fv (t \ \)" +proof - + assume "subst_domain \ \ range_vars \ \ fv t" + hence "subst_domain \ \ fv t" by blast + thus ?thesis + by (metis (no_types) range_vars_alt_def le_iff_sup subst_apply_fv_unfold + subst_apply_fv_union subst_range.simps) +qed + +lemma subst_all_fv_subset: "fv t \ fv\<^sub>s\<^sub>e\<^sub>t M \ fv (t \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \)" +proof - + assume *: "fv t \ fv\<^sub>s\<^sub>e\<^sub>t M" + { fix v assume "v \ fv t" + hence "v \ fv\<^sub>s\<^sub>e\<^sub>t M" using * by auto + then obtain t' where "t' \ M" "v \ fv t'" by auto + hence "fv (\ v) \ fv (t' \ \)" + by (metis subst_apply_term.simps(1) subst_apply_fv_subset subst_apply_fv_unfold + subtermeq_vars_subset vars_iff_subtermeq) + hence "fv (\ v) \ fv\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \)" using \t' \ M\ by auto + } + thus ?thesis using subst_apply_fv_unfold[of t \] by auto +qed + +lemma subst_support_if_mgt_subst_idem: + assumes "\ \\<^sub>\ \" "subst_idem \" + shows "\ supports \" +proof - + from \\ \\<^sub>\ \\ obtain \ where \: "\ = \ \\<^sub>s \" by blast + hence "\v. \ v \ \ = Var v \ (\ \\<^sub>s \ \\<^sub>s \)" by simp + hence "\v. \ v \ \ = Var v \ (\ \\<^sub>s \)" using \subst_idem \ \ unfolding subst_idem_def by simp + hence "\v. \ v \ \ = Var v \ \" using \ by simp + thus "\ supports \" by simp +qed + +lemma subst_support_iff_mgt_if_subst_idem: + assumes "subst_idem \" + shows "\ \\<^sub>\ \ \ \ supports \" +proof + show "\ \\<^sub>\ \ \ \ supports \" by (fact subst_support_if_mgt_subst_idem[OF _ \subst_idem \\]) + show "\ supports \ \ \ \\<^sub>\ \" by (fact subst_supportD) +qed + +lemma subst_support_comp: + fixes \ \ \::"('a,'b) subst" + assumes "\ supports \" "\ supports \" + shows "(\ \\<^sub>s \) supports \" +by (metis (no_types) assms subst_agreement subst_apply_term.simps(1) subst_subst_compose) + +lemma subst_support_comp': + fixes \ \ \::"('a,'b) subst" + assumes "\ supports \" + shows "\ supports (\ \\<^sub>s \)" "\ supports \ \ \ supports (\ \\<^sub>s \)" +using assms unfolding subst_support_def by (metis subst_compose_assoc, metis) + +lemma subst_support_comp_split: + fixes \ \ \::"('a,'b) subst" + assumes "(\ \\<^sub>s \) supports \" + shows "subst_domain \ \ range_vars \ = {} \ \ supports \" + and "subst_domain \ \ subst_domain \ = {} \ \ supports \" +proof - + assume "subst_domain \ \ range_vars \ = {}" + hence "subst_idem \" by (metis subst_idemI) + have "\ \\<^sub>\ \" using assms subst_compose_assoc[of \ \ \] unfolding subst_compose_def by metis + show "\ supports \" using subst_support_if_mgt_subst_idem[OF \\ \\<^sub>\ \\ \subst_idem \\] by auto +next + assume "subst_domain \ \ subst_domain \ = {}" + moreover have "\v \ subst_domain (\ \\<^sub>s \). (\ \\<^sub>s \) v \ \ = \ v" using assms by metis + ultimately have "\v \ subst_domain \. \ v \ \ = \ v" + using var_not_in_subst_dom unfolding subst_compose_def + by (metis IntI empty_iff subst_apply_term.simps(1)) + thus "\ supports \" by force +qed + +lemma subst_idem_support: "subst_idem \ \ \ supports \ \\<^sub>s \" +unfolding subst_idem_def by (metis subst_support_def subst_compose_assoc) + +lemma subst_idem_iff_self_support: "subst_idem \ \ \ supports \" +using subst_support_def[of \ \] unfolding subst_idem_def by auto + +lemma subterm_subst_neq: "t \ t' \ t \ s \ t' \ s" +by (metis subst_mono_neq) + +lemma fv_Fun_subst_neq: "x \ fv (Fun f T) \ \ x \ Fun f T \ \" +using subterm_subst_neq[of "Var x" "Fun f T"] vars_iff_subterm_or_eq[of x "Fun f T"] by auto + +lemma subterm_subst_unfold: + assumes "t \ s \ \" + shows "(\s'. s' \ s \ t = s' \ \) \ (\x \ fv s. t \ \ x)" +using assms +proof (induction s) + case (Fun f T) thus ?case + proof (cases "t = Fun f T \ \") + case True thus ?thesis using Fun by auto + next + case False + then obtain s' where s': "s' \ set T" "t \ s' \ \" using Fun by auto + hence "(\s''. s'' \ s' \ t = s'' \ \) \ (\x \ fv s'. t \ \ x)" by (metis Fun.IH) + thus ?thesis using s'(1) by auto + qed +qed simp + +lemma subterm_subst_img_subterm: + assumes "t \ s \ \" "\s'. s' \ s \ t \ s' \ \" + shows "\w \ fv s. t \ \ w" +using subterm_subst_unfold[OF assms(1)] assms(2) by force + +lemma subterm_subst_not_img_subterm: + assumes "t \ s \ \" "\(\w \ fv s. t \ \ w)" + shows "\f T. Fun f T \ s \ t = Fun f T \ \" +proof (rule ccontr) + assume "\(\f T. Fun f T \ s \ t = Fun f T \ \)" + hence "\f T. Fun f T \ s \ t \ Fun f T \ \" by simp + moreover have "\x. Var x \ s \ t \ Var x \ \" + using assms(2) vars_iff_subtermeq by force + ultimately have "\s'. s' \ s \ t \ s' \ \" by (metis "term.exhaust") + thus False using assms subterm_subst_img_subterm by blast +qed + +lemma subst_apply_img_var: + assumes "v \ fv (t \ \)" "v \ fv t" + obtains w where "w \ fv t" "v \ fv (\ w)" +using assms by (induct t) auto + +lemma subst_apply_img_var': + assumes "x \ fv (t \ \)" "x \ fv t" + shows "\y \ fv t. x \ fv (\ y)" +by (metis assms subst_apply_img_var) + +lemma nth_map_subst: + fixes \::"('f,'v) subst" and T::"('f,'v) term list" and i::nat + shows "i < length T \ (map (\t. t \ \) T) ! i = (T ! i) \ \" +by (fact nth_map) + +lemma subst_subterm: + assumes "Fun f T \ t \ \" + shows "(\S. Fun f S \ t \ Fun f S \ \ = Fun f T) \ + (\s \ subst_range \. Fun f T \ s)" +using assms subterm_subst_not_img_subterm by (cases "\s \ subst_range \. Fun f T \ s") fastforce+ + +lemma subst_subterm': + assumes "Fun f T \ t \ \" + shows "\S. length S = length T \ (Fun f S \ t \ (\s \ subst_range \. Fun f S \ s))" +using subst_subterm[OF assms] by auto + +lemma subst_subterm'': + assumes "s \ subterms (t \ \)" + shows "(\u \ subterms t. s = u \ \) \ s \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \)" +proof (cases s) + case (Var x) + thus ?thesis + using assms subterm_subst_not_img_subterm vars_iff_subtermeq + by (cases "s = t \ \") fastforce+ +next + case (Fun f T) + thus ?thesis + using subst_subterm[of f T t \] assms + by fastforce +qed + + +subsection \More Small Lemmata\ +lemma funs_term_subst: "funs_term (t \ \) = funs_term t \ (\x \ fv t. funs_term (\ x))" +by (induct t) auto + +lemma fv\<^sub>s\<^sub>e\<^sub>t_subst_img_eq: + assumes "X \ (subst_domain \ \ range_vars \) = {}" + shows "fv\<^sub>s\<^sub>e\<^sub>t (\ ` (Y - X)) = fv\<^sub>s\<^sub>e\<^sub>t (\ ` Y) - X" +using assms unfolding range_vars_alt_def by force + +lemma subst_Fun_index_eq: + assumes "i < length T" "Fun f T \ \ = Fun g T' \ \" + shows "T ! i \ \ = T' ! i \ \" +proof - + have "map (\x. x \ \) T = map (\x. x \ \) T'" using assms by simp + thus ?thesis by (metis assms(1) length_map nth_map) +qed + +lemma fv_exists_if_unifiable_and_neq: + fixes t t'::"('a,'b) term" and \ \::"('a,'b) subst" + assumes "t \ t'" "t \ \ = t' \ \" + shows "fv t \ fv t' \ {}" +proof + assume "fv t \ fv t' = {}" + hence "fv t = {}" "fv t' = {}" by auto + hence "t \ \ = t" "t' \ \ = t'" by auto + hence "t = t'" using assms(2) by metis + thus False using assms(1) by auto +qed + +lemma const_subterm_subst: "Fun c [] \ t \ Fun c [] \ t \ \" +by (induct t) auto + +lemma const_subterm_subst_var_obtain: + assumes "Fun c [] \ t \ \" "\Fun c [] \ t" + obtains x where "x \ fv t" "Fun c [] \ \ x" +using assms by (induct t) auto + +lemma const_subterm_subst_cases: + assumes "Fun c [] \ t \ \" + shows "Fun c [] \ t \ (\x \ fv t. x \ subst_domain \ \ Fun c [] \ \ x)" +proof (cases "Fun c [] \ t") + case False + then obtain x where "x \ fv t" "Fun c [] \ \ x" + using const_subterm_subst_var_obtain[OF assms] by moura + thus ?thesis by (cases "x \ subst_domain \") auto +qed simp + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_fv_subset: + assumes "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" + shows "fv (\ x) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using assms +proof (induction F) + case (Cons f F) + then obtain t t' where f: "f = (t,t')" by (metis surj_pair) + show ?case + proof (cases "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F") + case True thus ?thesis + using Cons.IH + unfolding subst_apply_pairs_def + by auto + next + case False + hence "x \ fv t \ fv t'" using Cons.prems f by simp + hence "fv (\ x) \ fv (t \ \) \ fv (t' \ \)" using fv_subst_subset[of x] by force + thus ?thesis using f unfolding subst_apply_pairs_def by auto + qed +qed simp + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_step_subst: "fv\<^sub>s\<^sub>e\<^sub>t (\ ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" +proof (induction F) + case (Cons f F) + obtain t t' where "f = (t,t')" by moura + thus ?case + using Cons + by (simp add: subst_apply_pairs_def subst_apply_fv_unfold) +qed (simp_all add: subst_apply_pairs_def) + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_obtain_var: + fixes \::"('a,'b) subst" + assumes "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + shows "\y \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. x \ fv (\ y)" + using assms +proof (induction F) + case (Cons f F) + then obtain t s where f: "f = (t,s)" by (metis surj_pair) + + from Cons.IH show ?case + proof (cases "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)") + case False + hence "x \ fv (t \ \) \ x \ fv (s \ \)" + using f Cons.prems + by (simp add: subst_apply_pairs_def) + hence "(\y \ fv t. x \ fv (\ y)) \ (\y \ fv s. x \ fv (\ y))" by (metis fv_subst_obtain_var) + thus ?thesis using f by (auto simp add: subst_apply_pairs_def) + qed (auto simp add: Cons.IH) +qed (simp add: subst_apply_pairs_def) + +lemma pair_subst_ident[intro]: "(fv t \ fv t') \ subst_domain \ = {} \ (t,t') \\<^sub>p \ = (t,t')" +by auto + +lemma pairs_substI[intro]: + assumes "subst_domain \ \ (\(s,t) \ M. fv s \ fv t) = {}" + shows "M \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ = M" +proof - + { fix m assume M: "m \ M" + then obtain s t where m: "m = (s,t)" by (metis surj_pair) + hence "(fv s \ fv t) \ subst_domain \ = {}" using assms M by auto + hence "m \\<^sub>p \ = m" using m by auto + } thus ?thesis by (simp add: image_cong) +qed + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) = fv\<^sub>s\<^sub>e\<^sub>t (\ ` (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F))" +proof (induction F) + case (Cons g G) + obtain t t' where "g = (t,t')" by (metis surj_pair) + thus ?case + using Cons.IH + by (simp add: subst_apply_pairs_def subst_apply_fv_unfold) +qed (simp add: subst_apply_pairs_def) + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_subset: + assumes "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \ subst_domain \" + shows "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ subst_domain \ \ subst_domain \" + using assms +proof (induction F) + case (Cons g G) + hence IH: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \ subst_domain \ \ subst_domain \" + by (simp add: subst_apply_pairs_def) + obtain t t' where g: "g = (t,t')" by (metis surj_pair) + hence "fv (t \ \) \ subst_domain \" "fv (t' \ \) \ subst_domain \" + using Cons.prems by (simp_all add: subst_apply_pairs_def) + hence "fv t \ subst_domain \ \ subst_domain \" "fv t' \ subst_domain \ \ subst_domain \" + using subst_apply_fv_unfold[of _ \] by force+ + thus ?case using IH g by (simp add: subst_apply_pairs_def) +qed (simp add: subst_apply_pairs_def) + +lemma pairs_subst_comp: "F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \ \\<^sub>s \ = ((F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" +by (induct F) (auto simp add: subst_apply_pairs_def) + +lemma pairs_substI'[intro]: + "subst_domain \ \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = {} \ F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \ = F" +by (induct F) (force simp add: subst_apply_pairs_def)+ + +lemma subst_pair_compose[simp]: "d \\<^sub>p (\ \\<^sub>s \) = d \\<^sub>p \ \\<^sub>p \" +proof - + obtain t s where "d = (t,s)" by moura + thus ?thesis by auto +qed + +lemma subst_pairs_compose[simp]: "D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t (\ \\<^sub>s \) = D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" +by auto + +lemma subst_apply_pair_pair: "(t, s) \\<^sub>p \ = (t \ \, s \ \)" +by (rule prod.case) + +lemma subst_apply_pairs_nil[simp]: "[] \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \ = []" +unfolding subst_apply_pairs_def by simp + +lemma subst_apply_pairs_singleton[simp]: "[(t,s)] \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \ = [(t \ \,s \ \)]" +unfolding subst_apply_pairs_def by simp + +lemma subst_apply_pairs_Var[iff]: "F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s Var = F" by (simp add: subst_apply_pairs_def) + +lemma subst_apply_pairs_pset_subst: "set (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) = set F \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" +unfolding subst_apply_pairs_def by force + + +subsection \Finite Substitutions\ +inductive_set fsubst::"('a,'b) subst set" where + fvar: "Var \ fsubst" +| FUpdate: "\\ \ fsubst; v \ subst_domain \; t \ Var v\ \ \(v := t) \ fsubst" + +lemma finite_dom_iff_fsubst: + "finite (subst_domain \) \ \ \ fsubst" +proof + assume "finite (subst_domain \)" thus "\ \ fsubst" + proof (induction "subst_domain \" arbitrary: \ rule: finite.induct) + case emptyI + hence "\ = Var" using empty_dom_iff_empty_subst by metis + thus ?case using fvar by simp + next + case (insertI \'\<^sub>d\<^sub>o\<^sub>m v) thus ?case + proof (cases "v \ \'\<^sub>d\<^sub>o\<^sub>m") + case True + hence "\'\<^sub>d\<^sub>o\<^sub>m = subst_domain \" using \insert v \'\<^sub>d\<^sub>o\<^sub>m = subst_domain \\ by auto + thus ?thesis using insertI.hyps(2) by metis + next + case False + let ?\' = "\w. if w \ \'\<^sub>d\<^sub>o\<^sub>m then \ w else Var w" + have "subst_domain ?\' = \'\<^sub>d\<^sub>o\<^sub>m" + using \v \ \'\<^sub>d\<^sub>o\<^sub>m\ \insert v \'\<^sub>d\<^sub>o\<^sub>m = subst_domain \\ + by (auto simp add: subst_domain_def) + hence "?\' \ fsubst" using insertI.hyps(2) by simp + moreover have "?\'(v := \ v) = (\w. if w \ insert v \'\<^sub>d\<^sub>o\<^sub>m then \ w else Var w)" by auto + hence "?\'(v := \ v) = \" + using \insert v \'\<^sub>d\<^sub>o\<^sub>m = subst_domain \\ + by (auto simp add: subst_domain_def) + ultimately show ?thesis + using FUpdate[of ?\' v "\ v"] False insertI.hyps(3) + by (auto simp add: subst_domain_def) + qed + qed +next + assume "\ \ fsubst" thus "finite (subst_domain \)" + by (induct \, simp, metis subst_dom_insert_finite) +qed + +lemma fsubst_induct[case_names fvar FUpdate, induct set: finite]: + assumes "finite (subst_domain \)" "P Var" + and "\\ v t. \finite (subst_domain \); v \ subst_domain \; t \ Var v; P \\ \ P (\(v := t))" + shows "P \" +using assms finite_dom_iff_fsubst fsubst.induct by metis + +lemma fun_upd_fsubst: "s(v := t) \ fsubst \ s \ fsubst" +using subst_dom_insert_finite[of s] finite_dom_iff_fsubst by blast + +lemma finite_img_if_fsubst: "s \ fsubst \ finite (subst_range s)" +using finite_dom_iff_fsubst finite_subst_img_if_finite_dom' by blast + + +subsection \Unifiers and Most General Unifiers (MGUs)\ + +abbreviation Unifier::"('f,'v) subst \ ('f,'v) term \ ('f,'v) term \ bool" where + "Unifier \ t u \ (t \ \ = u \ \)" + +abbreviation MGU::"('f,'v) subst \ ('f,'v) term \ ('f,'v) term \ bool" where + "MGU \ t u \ Unifier \ t u \ (\\. Unifier \ t u \ \ \\<^sub>\ \)" + +lemma MGUI[intro]: + shows "\t \ \ = u \ \; \\::('f,'v) subst. t \ \ = u \ \ \ \ \\<^sub>\ \\ \ MGU \ t u" +by auto + +lemma UnifierD[dest]: + fixes \::"('f,'v) subst" and f g::'f and X Y::"('f,'v) term list" + assumes "Unifier \ (Fun f X) (Fun g Y)" + shows "f = g" "length X = length Y" +proof - + from assms show "f = g" by auto + + from assms have "Fun f X \ \ = Fun g Y \ \" by auto + hence "length (map (\x. x \ \) X) = length (map (\x. x \ \) Y)" by auto + thus "length X = length Y" by auto +qed + +lemma MGUD[dest]: + fixes \::"('f,'v) subst" and f g::'f and X Y::"('f,'v) term list" + assumes "MGU \ (Fun f X) (Fun g Y)" + shows "f = g" "length X = length Y" +using assms by (auto intro!: UnifierD[of f X \ g Y]) + +lemma MGU_sym[sym]: "MGU \ s t \ MGU \ t s" by auto +lemma Unifier_sym[sym]: "Unifier \ s t \ Unifier \ t s" by auto + +lemma MGU_nil: "MGU Var s t \ s = t" by fastforce + +lemma Unifier_comp: "Unifier (\ \\<^sub>s \) t u \ Unifier \ (t \ \) (u \ \)" +by simp + +lemma Unifier_comp': "Unifier \ (t \ \) (u \ \) \ Unifier (\ \\<^sub>s \) t u" +by simp + +lemma Unifier_excludes_subterm: + assumes \: "Unifier \ t u" + shows "\t \ u" +proof + assume "t \ u" + hence "t \ \ \ u \ \" using subst_mono_neq by metis + hence "t \ \ \ u \ \" by simp + moreover from \ have "t \ \ = u \ \" by auto + ultimately show False .. +qed + +lemma MGU_is_Unifier: "MGU \ t u \ Unifier \ t u" by (rule conjunct1) + +lemma MGU_Var1: + assumes "\Var v \ t" + shows "MGU (Var(v := t)) (Var v) t" +proof (intro MGUI exI) + show "Var v \ (Var(v := t)) = t \ (Var(v := t))" using assms subst_no_occs by fastforce +next + fix \::"('a,'b) subst" assume th: "Var v \ \ = t \ \" + show "\ = (Var(v := t)) \\<^sub>s \" + proof + fix s show "s \ \ = s \ ((Var(v := t)) \\<^sub>s \)" using th by (induct s) auto + qed +qed + +lemma MGU_Var2: "v \ fv t \ MGU (Var(v := t)) (Var v) t" +by (metis (no_types) MGU_Var1 vars_iff_subterm_or_eq) + +lemma MGU_Var3: "MGU Var (Var v) (Var w) \ v = w" by fastforce + +lemma MGU_Const1: "MGU Var (Fun c []) (Fun d []) \ c = d" by fastforce + +lemma MGU_Const2: "MGU \ (Fun c []) (Fun d []) \ c = d" by auto + +lemma MGU_Fun: + assumes "MGU \ (Fun f X) (Fun g Y)" + shows "f = g" "length X = length Y" +proof - + let ?F = "\\ X. map (\x. x \ \) X" + from assms have + "\f = g; ?F \ X = ?F \ Y; \\'. f = g \ ?F \' X = ?F \' Y \ \ \\<^sub>\ \'\ \ length X = length Y" + using map_eq_imp_length_eq by auto + thus "f = g" "length X = length Y" using assms by auto +qed + +lemma Unifier_Fun: + assumes "Unifier \ (Fun f (x#X)) (Fun g (y#Y))" + shows "Unifier \ x y" "Unifier \ (Fun f X) (Fun g Y)" +using assms by simp_all + +lemma Unifier_subst_idem_subst: + "subst_idem r \ Unifier s (t \ r) (u \ r) \ Unifier (r \\<^sub>s s) (t \ r) (u \ r)" +by (metis (no_types, lifting) subst_idem_def subst_subst_compose) + +lemma subst_idem_comp: + "subst_idem r \ Unifier s (t \ r) (u \ r) \ + (\q. Unifier q (t \ r) (u \ r) \ s \\<^sub>s q = q) \ + subst_idem (r \\<^sub>s s)" +by (frule Unifier_subst_idem_subst, blast, metis subst_idem_def subst_compose_assoc) + +lemma Unifier_mgt: "\Unifier \ t u; \ \\<^sub>\ \\ \ Unifier \ t u" by auto + +lemma Unifier_support: "\Unifier \ t u; \ supports \\ \ Unifier \ t u" +using subst_supportD Unifier_mgt by metis + +lemma MGU_mgt: "\MGU \ t u; MGU \ t u\ \ \ \\<^sub>\ \" by auto + +lemma Unifier_trm_fv_bound: + "\Unifier s t u; v \ fv t\ \ v \ subst_domain s \ range_vars s \ fv u" +proof (induction t arbitrary: s u) + case (Fun f X) + hence "v \ fv (u \ s) \ v \ subst_domain s" by (metis subst_not_dom_fixed) + thus ?case by (metis (no_types) Un_iff contra_subsetD subst_sends_fv_to_img) +qed (metis (no_types) UnI1 UnI2 subsetCE no_var_subterm subst_sends_dom_to_img + subst_to_var_is_var trm_subst_ident' vars_iff_subterm_or_eq) + +lemma Unifier_rm_var: "\Unifier \ s t; v \ fv s \ fv t\ \ Unifier (rm_var v \) s t" +by (auto simp add: repl_invariance) + +lemma Unifier_ground_rm_vars: + assumes "ground (subst_range s)" "Unifier (rm_vars X s) t t'" + shows "Unifier s t t'" +by (rule Unifier_support[OF assms(2) rm_vars_ground_supports[OF assms(1)]]) + +lemma Unifier_dom_restrict: + assumes "Unifier s t t'" "fv t \ fv t' \ S" + shows "Unifier (rm_vars (UNIV - S) s) t t'" +proof - + let ?s = "rm_vars (UNIV - S) s" + show ?thesis using term_subst_eq_conv[of t s ?s] term_subst_eq_conv[of t' s ?s] assms by auto +qed + + +subsection \Well-formedness of Substitutions and Unifiers\ +inductive_set wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set::"('a,'b) subst set" where + Empty[simp]: "Var \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set" +| Insert[simp]: + "\\ \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set; v \ subst_domain \; + v \ range_vars \; fv t \ (insert v (subst_domain \)) = {}\ + \ \(v := t) \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set" + +definition wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t::"('a,'b) subst \ bool" where + "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ subst_domain \ \ range_vars \ = {} \ finite (subst_domain \)" + +definition wf\<^sub>M\<^sub>G\<^sub>U::"('a,'b) subst \ ('a,'b) term \ ('a,'b) term \ bool" where + "wf\<^sub>M\<^sub>G\<^sub>U \ s t \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ MGU \ s t \ subst_domain \ \ range_vars \ \ fv s \ fv t" + +lemma wf_subst_subst_idem: "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ subst_idem \" using subst_idemI[of \] unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by fast + +lemma wf_subst_properties: "\ \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set = wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" +proof + show "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ \ \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set" unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def + proof - + assume "subst_domain \ \ range_vars \ = {} \ finite (subst_domain \)" + hence "finite (subst_domain \)" "subst_domain \ \ range_vars \ = {}" + by auto + thus "\ \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set" + proof (induction \ rule: fsubst_induct) + case fvar thus ?case by simp + next + case (FUpdate \ v t) + have "subst_domain \ \ subst_domain (\(v := t))" "range_vars \ \ range_vars (\(v := t))" + using FUpdate.hyps(2,3) subst_img_update + unfolding range_vars_alt_def by (fastforce simp add: subst_domain_def)+ + hence "subst_domain \ \ range_vars \ = {}" using FUpdate.prems(1) by blast + hence "\ \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set" using FUpdate.IH by metis + + have *: "range_vars (\(v := t)) = range_vars \ \ fv t" + using FUpdate.hyps(2) subst_img_update[OF _ FUpdate.hyps(3)] + by fastforce + hence "fv t \ insert v (subst_domain \) = {}" + using FUpdate.prems subst_dom_update2[OF FUpdate.hyps(3)] by blast + moreover have "subst_domain (\(v := t)) = insert v (subst_domain \)" + by (meson FUpdate.hyps(3) subst_dom_update2) + hence "v \ range_vars \" using FUpdate.prems * by blast + ultimately show ?case using Insert[OF \\ \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set\ \v \ subst_domain \\] by metis + qed + qed + + show "\ \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def + proof (induction \ rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set.induct) + case Empty thus ?case by simp + next + case (Insert \ v t) + hence 1: "subst_domain \ \ range_vars \ = {}" by simp + hence 2: "subst_domain (\(v := t)) \ range_vars \ = {}" + using Insert.hyps(3) by (auto simp add: subst_domain_def) + have 3: "fv t \ subst_domain (\(v := t)) = {}" + using Insert.hyps(4) by (auto simp add: subst_domain_def) + have 4: "\ v = Var v" using \v \ subst_domain \\ by (simp add: subst_domain_def) + + from Insert.IH have "finite (subst_domain \)" by simp + hence 5: "finite (subst_domain (\(v := t)))" using subst_dom_insert_finite[of \] by simp + + have "subst_domain (\(v := t)) \ range_vars (\(v := t)) = {}" + proof (cases "t = Var v") + case True + hence "range_vars (\(v := t)) = range_vars \" + using 4 fun_upd_triv term.inject(1) + unfolding range_vars_alt_def by (auto simp add: subst_domain_def) + thus "subst_domain (\(v := t)) \ range_vars (\(v := t)) = {}" + using 1 2 3 by auto + next + case False + hence "range_vars (\(v := t)) = fv t \ (range_vars \)" + using 4 subst_img_update[of \ v] by auto + thus "subst_domain (\(v := t)) \ range_vars (\(v := t)) = {}" using 1 2 3 by blast + qed + thus ?case using 5 by blast + qed +qed + +lemma wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct[consumes 1, case_names Empty Insert]: + assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "P Var" + and "\\ v t. \wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \; P \; v \ subst_domain \; v \ range_vars \; + fv t \ insert v (subst_domain \) = {}\ + \ P (\(v := t))" + shows "P \" +proof - + from assms(1,3) wf_subst_properties have + "\ \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set" + "\\ v t. \\ \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set; P \; v \ subst_domain \; v \ range_vars \; + fv t \ insert v (subst_domain \) = {}\ + \ P (\(v := t))" + by blast+ + thus "P \" using wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set.induct assms(2) by blast +qed + +lemma wf_subst_fsubst: "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ \ \ fsubst" +unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def using finite_dom_iff_fsubst by blast + +lemma wf_subst_nil: "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp + +lemma wf_MGU_nil: "MGU Var s t \ wf\<^sub>M\<^sub>G\<^sub>U Var s t" +using wf_subst_nil subst_domain_Var range_vars_Var +unfolding wf\<^sub>M\<^sub>G\<^sub>U_def by fast + +lemma wf_MGU_dom_bound: "wf\<^sub>M\<^sub>G\<^sub>U \ s t \ subst_domain \ \ fv s \ fv t" unfolding wf\<^sub>M\<^sub>G\<^sub>U_def by blast + +lemma wf_subst_single: + assumes "v \ fv t" "\ v = t" "\w. v \ w \ \ w = Var w" + shows "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" +proof - + have *: "subst_domain \ = {v}" by (metis subst_fv_dom_img_single(1)[OF assms]) + + have "subst_domain \ \ range_vars \ = {}" + using * assms subst_fv_dom_img_single(2) + by (metis inf_bot_left insert_disjoint(1)) + moreover have "finite (subst_domain \)" using * by simp + ultimately show ?thesis by (metis wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) +qed + +lemma wf_subst_reduction: + "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t s \ wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (rm_var v s)" +proof - + assume "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t s" + moreover have "subst_domain (rm_var v s) \ subst_domain s" by (auto simp add: subst_domain_def) + moreover have "range_vars (rm_var v s) \ range_vars s" + unfolding range_vars_alt_def by (auto simp add: subst_domain_def) + ultimately have "subst_domain (rm_var v s) \ range_vars (rm_var v s) = {}" + by (meson compl_le_compl_iff disjoint_eq_subset_Compl subset_trans wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + moreover have "finite (subst_domain (rm_var v s))" + using \subst_domain (rm_var v s) \ subst_domain s\ \wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t s\ rev_finite_subset + unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by blast + ultimately show "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (rm_var v s)" by (metis wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) +qed + +lemma wf_subst_compose: + assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \1" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \2" + and "subst_domain \1 \ subst_domain \2 = {}" + and "subst_domain \1 \ range_vars \2 = {}" + shows "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\1 \\<^sub>s \2)" +using assms +proof (induction \1 rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct) + case Empty thus ?case unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp +next + case (Insert \1 v t) + have "t \ Var v" using Insert.hyps(4) by auto + hence dom1v_unfold: "subst_domain (\1(v := t)) = insert v (subst_domain \1)" + using subst_dom_update2 by metis + hence doms_disj: "subst_domain \1 \ subst_domain \2 = {}" + using Insert.prems(2) disjoint_insert(1) by blast + moreover have dom_img_disj: "subst_domain \1 \ range_vars \2 = {}" + using Insert.hyps(2) Insert.prems(3) + by (fastforce simp add: subst_domain_def) + ultimately have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\1 \\<^sub>s \2)" using Insert.IH[OF \wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \2\] by metis + + have dom_comp_is_union: "subst_domain (\1 \\<^sub>s \2) = subst_domain \1 \ subst_domain \2" + using subst_dom_comp_eq[OF dom_img_disj] . + + have "v \ subst_domain \2" + using Insert.prems(2) \t \ Var v\ + by (fastforce simp add: subst_domain_def) + hence "\2 v = Var v" "\1 v = Var v" using Insert.hyps(2) by (simp_all add: subst_domain_def) + hence "(\1 \\<^sub>s \2) v = Var v" "(\1(v := t) \\<^sub>s \2) v = t \ \2" "((\1 \\<^sub>s \2)(v := t)) v = t" + unfolding subst_compose_def by simp_all + + have fv_t2_bound: "fv (t \ \2) \ fv t \ range_vars \2" by (meson subst_sends_fv_to_img) + + have 1: "v \ subst_domain (\1 \\<^sub>s \2)" + using \(\1 \\<^sub>s \2) v = Var v\ + by (auto simp add: subst_domain_def) + + have "insert v (subst_domain \1) \ range_vars \2 = {}" + using Insert.prems(3) dom1v_unfold by blast + hence "v \ range_vars \1 \ range_vars \2" using Insert.hyps(3) by blast + hence 2: "v \ range_vars (\1 \\<^sub>s \2)" by (meson set_rev_mp subst_img_comp_subset) + + have "subst_domain \2 \ range_vars \2 = {}" + using \wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \2\ unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp + hence "fv (t \ \2) \ subst_domain \2 = {}" + using subst_dom_elim unfolding range_vars_alt_def by simp + moreover have "v \ range_vars \2" using Insert.prems(3) dom1v_unfold by blast + hence "v \ fv t \ range_vars \2" using Insert.hyps(4) by blast + hence "v \ fv (t \ \2)" using \fv (t \ \2) \ fv t \ range_vars \2\ by blast + moreover have "fv (t \ \2) \ subst_domain \1 = {}" + using dom_img_disj fv_t2_bound \fv t \ insert v (subst_domain \1) = {}\ by blast + ultimately have 3: "fv (t \ \2) \ insert v (subst_domain (\1 \\<^sub>s \2)) = {}" + using dom_comp_is_union by blast + + have "\1(v := t) \\<^sub>s \2 = (\1 \\<^sub>s \2)(v := t \ \2)" using subst_comp_upd1[of \1 v t \2] . + moreover have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t ((\1 \\<^sub>s \2)(v := t \ \2))" + using "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set.Insert"[OF _ 1 2 3] \wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\1 \\<^sub>s \2)\ wf_subst_properties by metis + ultimately show ?case by presburger +qed + +lemma wf_subst_append: + fixes \1 \2::"('f,'v) subst" + assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \1" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \2" + and "subst_domain \1 \ subst_domain \2 = {}" + and "subst_domain \1 \ range_vars \2 = {}" + and "range_vars \1 \ subst_domain \2 = {}" + shows "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\v. if \1 v = Var v then \2 v else \1 v)" +using assms +proof (induction \1 rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct) + case Empty thus ?case unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp +next + case (Insert \1 v t) + let ?if = "\w. if \1 w = Var w then \2 w else \1 w" + let ?if_upd = "\w. if (\1(v := t)) w = Var w then \2 w else (\1(v := t)) w" + + from Insert.hyps(4) have "?if_upd = ?if(v := t)" by fastforce + + have dom_insert: "subst_domain (\1(v := t)) = insert v (subst_domain \1)" + using Insert.hyps(4) by (auto simp add: subst_domain_def) + + have "\1 v = Var v" "t \ Var v" using Insert.hyps(2,4) by auto + hence img_insert: "range_vars (\1(v := t)) = range_vars \1 \ fv t" + using subst_img_update by metis + + from Insert.prems(2) dom_insert have "subst_domain \1 \ subst_domain \2 = {}" + by (auto simp add: subst_domain_def) + moreover have "subst_domain \1 \ range_vars \2 = {}" + using Insert.prems(3) dom_insert + by (simp add: subst_domain_def) + moreover have "range_vars \1 \ subst_domain \2 = {}" + using Insert.prems(4) img_insert + by blast + ultimately have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t ?if" using Insert.IH[OF Insert.prems(1)] by metis + + have dom_union: "subst_domain ?if = subst_domain \1 \ subst_domain \2" + by (auto simp add: subst_domain_def) + hence "v \ subst_domain ?if" + using Insert.hyps(2) Insert.prems(2) dom_insert + by (auto simp add: subst_domain_def) + moreover have "v \ range_vars ?if" + using Insert.prems(3) Insert.hyps(3) dom_insert + unfolding range_vars_alt_def by (auto simp add: subst_domain_def) + moreover have "fv t \ insert v (subst_domain ?if) = {}" + using Insert.hyps(4) Insert.prems(4) img_insert + unfolding range_vars_alt_def by (fastforce simp add: subst_domain_def) + ultimately show ?case + using wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set.Insert \wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t ?if\ \?if_upd = ?if(v := t)\ wf_subst_properties + by (metis (no_types, lifting)) +qed + +lemma wf_subst_elim_append: + assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "subst_elim \ v" "v \ fv t" + shows "subst_elim (\(w := t)) v" +using assms +proof (induction \ rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct) + case (Insert \ v' t') + hence "\q. v \ fv (Var q \ \(v' := t'))" using subst_elimD by blast + hence "\q. v \ fv (Var q \ \(v' := t', w := t))" using \v \ fv t\ by simp + thus ?case by (metis subst_elimI' subst_apply_term.simps(1)) +qed (simp add: subst_elim_def) + +lemma wf_subst_elim_dom: + assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + shows "\v \ subst_domain \. subst_elim \ v" +using assms +proof (induction \ rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct) + case (Insert \ w t) + have dom_insert: "subst_domain (\(w := t)) \ insert w (subst_domain \)" + by (auto simp add: subst_domain_def) + hence "\v \ subst_domain \. subst_elim (\(w := t)) v" using Insert.IH Insert.hyps(2,4) + by (metis Insert.hyps(1) IntI disjoint_insert(2) empty_iff wf_subst_elim_append) + moreover have "w \ fv t" using Insert.hyps(4) by simp + hence "\q. w \ fv (Var q \ \(w := t))" + by (metis fv_simps(1) fv_in_subst_img Insert.hyps(3) contra_subsetD + fun_upd_def singletonD subst_apply_term.simps(1)) + hence "subst_elim (\(w := t)) w" by (metis subst_elimI') + ultimately show ?case using dom_insert by blast +qed simp + +lemma wf_subst_support_iff_mgt: "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ \ supports \ \ \ \\<^sub>\ \" +using subst_support_def subst_support_if_mgt_subst_idem wf_subst_subst_idem by blast + + +subsection \Interpretations\ +abbreviation interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t::"('a,'b) subst \ bool" where + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ subst_domain \ = UNIV \ ground (subst_range \)" + +lemma interpretation_substI: + "(\v. fv (\ v) = {}) \ interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" +proof - + assume "\v. fv (\ v) = {}" + moreover { fix v assume "fv (\ v) = {}" hence "v \ subst_domain \" by auto } + ultimately show ?thesis by auto +qed + +lemma interpretation_grounds[simp]: + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ fv (t \ \) = {}" +using subst_fv_dom_ground_if_ground_img[of t \] by blast + +lemma interpretation_grounds_all: + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ (\v. fv (\ v) = {})" +by (metis range_vars_alt_def UNIV_I fv_in_subst_img subset_empty subst_dom_vars_in_subst) + +lemma interpretation_grounds_all': + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ ground (M \\<^sub>s\<^sub>e\<^sub>t \)" +using subst_fv_dom_ground_if_ground_img[of _ \] +by simp + +lemma interpretation_comp: + assumes "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + shows "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" +proof - + have \_fv: "fv (\ v) = {}" for v using interpretation_grounds_all[OF assms] by simp + hence \_fv': "fv (t \ \) = {}" for t + by (metis all_not_in_conv subst_elimD subst_elimI' subst_apply_term.simps(1)) + + from assms have "(\ \\<^sub>s \) v \ Var v" for v + unfolding subst_compose_def by (metis fv_simps(1) \_fv' insert_not_empty) + hence "subst_domain (\ \\<^sub>s \) = UNIV" by (simp add: subst_domain_def) + moreover have "fv ((\ \\<^sub>s \) v) = {}" for v unfolding subst_compose_def using \_fv' by simp + hence "ground (subst_range (\ \\<^sub>s \))" by simp + ultimately show "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" .. + + from assms have "(\ \\<^sub>s \) v \ Var v" for v + unfolding subst_compose_def by (metis fv_simps(1) \_fv insert_not_empty subst_to_var_is_var) + hence "subst_domain (\ \\<^sub>s \) = UNIV" by (simp add: subst_domain_def) + moreover have "fv ((\ \\<^sub>s \) v) = {}" for v + unfolding subst_compose_def by (simp add: \_fv trm_subst_ident) + hence "ground (subst_range (\ \\<^sub>s \))" by simp + ultimately show "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" .. +qed + +lemma interpretation_subst_exists: + "\\::('f,'v) subst. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" +proof - + obtain c::"'f" where "c \ UNIV" by simp + then obtain \::"('f,'v) subst" where "\v. \ v = Fun c []" by simp + hence "subst_domain \ = UNIV" "ground (subst_range \)" + by (simp_all add: subst_domain_def) + thus ?thesis by auto +qed + +lemma interpretation_subst_exists': + "\\::('f,'v) subst. subst_domain \ = X \ ground (subst_range \)" +proof - + obtain \::"('f,'v) subst" where \: "subst_domain \ = UNIV" "ground (subst_range \)" + using interpretation_subst_exists by moura + let ?\ = "rm_vars (UNIV - X) \" + have 1: "subst_domain ?\ = X" using \ by (auto simp add: subst_domain_def) + hence 2: "ground (subst_range ?\)" using \ by force + show ?thesis using 1 2 by blast +qed + +lemma interpretation_subst_idem: + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ subst_idem \" +unfolding subst_idem_def +using interpretation_grounds_all[of \] trm_subst_ident subst_eq_if_eq_vars +by fastforce + +lemma subst_idem_comp_upd_eq: + assumes "v \ subst_domain \" "subst_idem \" + shows "\ \\<^sub>s \ = \(v := \ v) \\<^sub>s \" +proof - + from assms(1) have "(\ \\<^sub>s \) v = \ v" unfolding subst_compose_def by auto + moreover have "\w. w \ v \ (\ \\<^sub>s \) w = (\(v := \ v) \\<^sub>s \) w" unfolding subst_compose_def by auto + moreover have "(\(v := \ v) \\<^sub>s \) v = \ v" using assms(2) unfolding subst_idem_def subst_compose_def + by (metis fun_upd_same) + ultimately show ?thesis by (metis fun_upd_same fun_upd_triv subst_comp_upd1) +qed + +lemma interpretation_dom_img_disjoint: + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ subst_domain \ \ range_vars \ = {}" +unfolding range_vars_alt_def by auto + + +subsection \Basic Properties of MGUs\ +lemma MGU_is_mgu_singleton: "MGU \ t u = is_mgu \ {(t,u)}" +unfolding is_mgu_def unifiers_def by auto + +lemma Unifier_in_unifiers_singleton: "Unifier \ s t \ \ \ unifiers {(s,t)}" +unfolding unifiers_def by auto + +lemma subst_list_singleton_fv_subset: + "(\x \ set (subst_list (subst v t) E). fv (fst x) \ fv (snd x)) + \ fv t \ (\x \ set E. fv (fst x) \ fv (snd x))" +proof (induction E) + case (Cons x E) + let ?fvs = "\L. \x \ set L. fv (fst x) \ fv (snd x)" + let ?fvx = "fv (fst x) \ fv (snd x)" + let ?fvxsubst = "fv (fst x \ Var(v := t)) \ fv (snd x \ Var(v := t))" + have "?fvs (subst_list (subst v t) (x#E)) = ?fvxsubst \ ?fvs (subst_list (subst v t) E)" + unfolding subst_list_def subst_def by auto + hence "?fvs (subst_list (subst v t) (x#E)) \ ?fvxsubst \ fv t \ ?fvs E" + using Cons.IH by blast + moreover have "?fvs (x#E) = ?fvx \ ?fvs E" by auto + moreover have "?fvxsubst \ ?fvx \ fv t" using subst_fv_bound_singleton[of _ v t] by blast + ultimately show ?case unfolding range_vars_alt_def by auto +qed (simp add: subst_list_def) + +lemma subst_of_dom_subset: "subst_domain (subst_of L) \ set (map fst L)" +proof (induction L rule: List.rev_induct) + case (snoc x L) + then obtain v t where x: "x = (v,t)" by (metis surj_pair) + hence "subst_of (L@[x]) = Var(v := t) \\<^sub>s subst_of L" + unfolding subst_of_def subst_def by (induct L) auto + hence "subst_domain (subst_of (L@[x])) \ insert v (subst_domain (subst_of L))" + using x subst_domain_compose[of "Var(v := t)" "subst_of L"] + by (auto simp add: subst_domain_def) + thus ?case using snoc.IH x by auto +qed simp + +lemma wf_MGU_is_imgu_singleton: "wf\<^sub>M\<^sub>G\<^sub>U \ s t \ is_imgu \ {(s,t)}" +proof - + assume 1: "wf\<^sub>M\<^sub>G\<^sub>U \ s t" + + have 2: "subst_idem \" by (metis wf_subst_subst_idem 1 wf\<^sub>M\<^sub>G\<^sub>U_def) + + have 3: "\\' \ unifiers {(s,t)}. \ \\<^sub>\ \'" "\ \ unifiers {(s,t)}" + by (metis 1 Unifier_in_unifiers_singleton wf\<^sub>M\<^sub>G\<^sub>U_def)+ + + have "\\ \ unifiers {(s,t)}. \ = \ \\<^sub>s \" by (metis 2 3 subst_idem_def subst_compose_assoc) + thus "is_imgu \ {(s,t)}" by (metis is_imgu_def \\ \ unifiers {(s,t)}\) +qed + +lemma mgu_subst_range_vars: + assumes "mgu s t = Some \" shows "range_vars \ \ vars_term s \ vars_term t" +proof - + obtain xs where *: "Unification.unify [(s, t)] [] = Some xs" and [simp]: "subst_of xs = \" + using assms by (simp split: option.splits) + from unify_Some_UNIF [OF *] obtain ss + where "compose ss = \" and "UNIF ss {#(s, t)#} {#}" by auto + with UNIF_range_vars_subset [of ss "{#(s, t)#}" "{#}"] + show ?thesis by (metis vars_mset_singleton fst_conv snd_conv) +qed + +lemma mgu_subst_domain_range_vars_disjoint: + assumes "mgu s t = Some \" shows "subst_domain \ \ range_vars \ = {}" +proof - + have "is_imgu \ {(s, t)}" using assms mgu_sound by simp + hence "\ = \ \\<^sub>s \" unfolding is_imgu_def by blast + thus ?thesis by (metis subst_idemp_iff) +qed + +lemma mgu_same_empty: "mgu (t::('a,'b) term) t = Some Var" +proof - + { fix E::"('a,'b) equation list" and U::"('b \ ('a,'b) term) list" + assume "\(s,t) \ set E. s = t" + hence "Unification.unify E U = Some U" + proof (induction E U rule: Unification.unify.induct) + case (2 f S g T E U) + hence *: "f = g" "S = T" by auto + moreover have "\(s,t) \ set (zip T T). s = t" by (induct T) auto + hence "\(s,t) \ set (zip T T@E). s = t" using "2.prems"(1) by auto + moreover have "zip_option S T = Some (zip S T)" using \S = T\ by auto + hence **: "decompose (Fun f S) (Fun g T) = Some (zip S T)" + using \f = g\ unfolding decompose_def by auto + ultimately have "Unification.unify (zip S T@E) U = Some U" using "2.IH" * by auto + thus ?case using ** by auto + qed auto + } + hence "Unification.unify [(t,t)] [] = Some []" by auto + thus ?thesis by auto +qed + +lemma mgu_var: assumes "x \ fv t" shows "mgu (Var x) t = Some (Var(x := t))" +proof - + have "unify [(Var x,t)] [] = Some [(x,t)]" using assms by (auto simp add: subst_list_def) + moreover have "subst_of [(x,t)] = Var(x := t)" unfolding subst_of_def subst_def by simp + ultimately show ?thesis by simp +qed + +lemma mgu_gives_wellformed_subst: + assumes "mgu s t = Some \" shows "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" +using mgu_finite_subst_domain[OF assms] mgu_subst_domain_range_vars_disjoint[OF assms] +unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def +by auto + +lemma mgu_gives_wellformed_MGU: + assumes "mgu s t = Some \" shows "wf\<^sub>M\<^sub>G\<^sub>U \ s t" +using mgu_subst_domain[OF assms] mgu_sound[OF assms] mgu_subst_range_vars [OF assms] + MGU_is_mgu_singleton[of s \ t] is_imgu_imp_is_mgu[of \ "{(s,t)}"] + mgu_gives_wellformed_subst[OF assms] +unfolding wf\<^sub>M\<^sub>G\<^sub>U_def by blast + +lemma mgu_vars_bounded[dest?]: + "mgu M N = Some \ \ subst_domain \ \ range_vars \ \ fv M \ fv N" +using mgu_gives_wellformed_MGU unfolding wf\<^sub>M\<^sub>G\<^sub>U_def by blast + +lemma mgu_gives_subst_idem: "mgu s t = Some \ \ subst_idem \" +using mgu_sound[of s t \] unfolding is_imgu_def subst_idem_def by auto + +lemma mgu_always_unifies: "Unifier \ M N \ \\. mgu M N = Some \" +using mgu_complete Unifier_in_unifiers_singleton by blast + +lemma mgu_gives_MGU: "mgu s t = Some \ \ MGU \ s t" +using mgu_sound[of s t \, THEN is_imgu_imp_is_mgu] MGU_is_mgu_singleton by metis + +lemma mgu_eliminates[dest?]: + assumes "mgu M N = Some \" + shows "(\v \ fv M \ fv N. subst_elim \ v) \ \ = Var" + (is "?P M N \") +proof (cases "\ = Var") + case False + then obtain v where v: "v \ subst_domain \" by auto + hence "v \ fv M \ fv N" using mgu_vars_bounded[OF assms] by blast + thus ?thesis using wf_subst_elim_dom[OF mgu_gives_wellformed_subst[OF assms]] v by blast +qed simp + +lemma mgu_eliminates_dom: + assumes "mgu x y = Some \" "v \ subst_domain \" + shows "subst_elim \ v" +using mgu_gives_wellformed_subst[OF assms(1)] +unfolding wf\<^sub>M\<^sub>G\<^sub>U_def wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_elim_def +by (metis disjoint_iff_not_equal subst_dom_elim assms(2)) + +lemma unify_list_distinct: + assumes "Unification.unify E B = Some U" "distinct (map fst B)" + and "(\x \ set E. fv (fst x) \ fv (snd x)) \ set (map fst B) = {}" + shows "distinct (map fst U)" +using assms +proof (induction E B arbitrary: U rule: Unification.unify.induct) + case 1 thus ?case by simp +next + case (2 f X g Y E B U) + let ?fvs = "\L. \x \ set L. fv (fst x) \ fv (snd x)" + from "2.prems"(1) obtain E' where *: "decompose (Fun f X) (Fun g Y) = Some E'" + and [simp]: "f = g" "length X = length Y" "E' = zip X Y" + and **: "Unification.unify (E'@E) B = Some U" + by (auto split: option.splits) + hence "\t t'. (t,t') \ set E' \ fv t \ fv (Fun f X) \ fv t' \ fv (Fun g Y)" + by (metis zip_arg_subterm subtermeq_vars_subset) + hence "?fvs E' \ fv (Fun f X) \ fv (Fun g Y)" by fastforce + moreover have "fv (Fun f X) \ set (map fst B) = {}" "fv (Fun g Y) \ set (map fst B) = {}" + using "2.prems"(3) by auto + ultimately have "?fvs E' \ set (map fst B) = {}" by blast + moreover have "?fvs E \ set (map fst B) = {}" using "2.prems"(3) by auto + ultimately have "?fvs (E'@E) \ set (map fst B) = {}" by auto + thus ?case using "2.IH"[OF * ** "2.prems"(2)] by metis +next + case (3 v t E B) + let ?fvs = "\L. \x \ set L. fv (fst x) \ fv (snd x)" + let ?E' = "subst_list (subst v t) E" + from "3.prems"(3) have "v \ set (map fst B)" "fv t \ set (map fst B) = {}" by force+ + hence *: "distinct (map fst ((v, t)#B))" using "3.prems"(2) by auto + + show ?case + proof (cases "t = Var v") + case True thus ?thesis using "3.prems" "3.IH"(1) by auto + next + case False + hence "v \ fv t" using "3.prems"(1) by auto + hence "Unification.unify (subst_list (subst v t) E) ((v, t)#B) = Some U" + using \t \ Var v\ "3.prems"(1) by auto + moreover have "?fvs ?E' \ set (map fst ((v, t)#B)) = {}" + proof - + have "v \ ?fvs ?E'" + unfolding subst_list_def subst_def + by (simp add: \v \ fv t\ subst_remove_var) + moreover have "?fvs ?E' \ fv t \ ?fvs E" by (metis subst_list_singleton_fv_subset) + hence "?fvs ?E' \ set (map fst B) = {}" using "3.prems"(3) by auto + ultimately show ?thesis by auto + qed + ultimately show ?thesis using "3.IH"(2)[OF \t \ Var v\ \v \ fv t\ _ *] by metis + qed +next + case (4 f X v E B U) + let ?fvs = "\L. \x \ set L. fv (fst x) \ fv (snd x)" + let ?E' = "subst_list (subst v (Fun f X)) E" + have *: "?fvs E \ set (map fst B) = {}" using "4.prems"(3) by auto + from "4.prems"(1) have "v \ fv (Fun f X)" by force + from "4.prems"(3) have **: "v \ set (map fst B)" "fv (Fun f X) \ set (map fst B) = {}" by force+ + hence ***: "distinct (map fst ((v, Fun f X)#B))" using "4.prems"(2) by auto + from "4.prems"(3) have ****: "?fvs ?E' \ set (map fst ((v, Fun f X)#B)) = {}" + proof - + have "v \ ?fvs ?E'" + unfolding subst_list_def subst_def + using \v \ fv (Fun f X)\ subst_remove_var[of v "Fun f X"] by simp + moreover have "?fvs ?E' \ fv (Fun f X) \ ?fvs E" by (metis subst_list_singleton_fv_subset) + hence "?fvs ?E' \ set (map fst B) = {}" using * ** by blast + ultimately show ?thesis by auto + qed + have "Unification.unify (subst_list (subst v (Fun f X)) E) ((v, Fun f X) # B) = Some U" + using \v \ fv (Fun f X)\ "4.prems"(1) by auto + thus ?case using "4.IH"[OF \v \ fv (Fun f X)\ _ *** ****] by metis +qed + +lemma mgu_None_is_subst_neq: + fixes s t::"('a,'b) term" and \::"('a,'b) subst" + assumes "mgu s t = None" + shows "s \ \ \ t \ \" +using assms mgu_always_unifies by force + +lemma mgu_None_if_neq_ground: + assumes "t \ t'" "fv t = {}" "fv t' = {}" + shows "mgu t t' = None" +proof (rule ccontr) + assume "mgu t t' \ None" + then obtain \ where \: "mgu t t' = Some \" by auto + hence "t \ \ = t" "t' \ \ = t'" using assms subst_ground_ident by auto + thus False using assms(1) MGU_is_Unifier[OF mgu_gives_MGU[OF \]] by auto +qed + +lemma mgu_None_commutes: + "mgu s t = None \ mgu t s = None" +using mgu_complete[of s t] + Unifier_in_unifiers_singleton[of s _ t] + Unifier_sym[of t _ s] + Unifier_in_unifiers_singleton[of t _ s] + mgu_sound[of t s] +unfolding is_imgu_def +by fastforce + +lemma mgu_img_subterm_subst: + fixes \::"('f,'v) subst" and s t u::"('f,'v) term" + assumes "mgu s t = Some \" "u \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) - range Var" + shows "u \ ((subterms s \ subterms t) - range Var) \\<^sub>s\<^sub>e\<^sub>t \" +proof - + define subterms_tuples::"('f,'v) equation list \ ('f,'v) terms" where subtt_def: + "subterms_tuples \ \E. subterms\<^sub>s\<^sub>e\<^sub>t (fst ` set E) \ subterms\<^sub>s\<^sub>e\<^sub>t (snd ` set E)" + define subterms_img::"('f,'v) subst \ ('f,'v) terms" where subti_def: + "subterms_img \ \d. subterms\<^sub>s\<^sub>e\<^sub>t (subst_range d)" + + define d where "d \ \v t. subst v t::('f,'v) subst" + define V where "V \ range Var::('f,'v) terms" + define R where "R \ \d::('f,'v) subst. ((subterms s \ subterms t) - V) \\<^sub>s\<^sub>e\<^sub>t d" + define M where "M \ \E d. subterms_tuples E \ subterms_img d" + define Q where "Q \ (\E d. M E d - V \ R d - V)" + define Q' where "Q' \ (\E d d'. (M E d - V) \\<^sub>s\<^sub>e\<^sub>t d' \ (R d - V) \\<^sub>s\<^sub>e\<^sub>t (d'::('f,'v) subst))" + + have Q_subst: "Q (subst_list (subst v t') E) (subst_of ((v, t')#B))" + when v_fv: "v \ fv t'" and Q_assm: "Q ((Var v, t')#E) (subst_of B)" + for v t' E B + proof - + define E' where "E' \ subst_list (subst v t') E" + define B' where "B' \ subst_of ((v, t')#B)" + + have E': "E' = subst_list (d v t') E" + and B': "B' = subst_of B \\<^sub>s d v t'" + using subst_of_simps(3)[of "(v, t')"] + unfolding subst_def E'_def B'_def d_def by simp_all + + have vt_img_subt: "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (d v t')) = subterms t'" + and vt_dom: "subst_domain (d v t') = {v}" + using v_fv by (auto simp add: subst_domain_def d_def subst_def) + + have *: "subterms u1 \ subterms\<^sub>s\<^sub>e\<^sub>t (fst ` set E)" "subterms u2 \ subterms\<^sub>s\<^sub>e\<^sub>t (snd ` set E)" + when "(u1,u2) \ set E" for u1 u2 + using that by auto + + have **: "subterms\<^sub>s\<^sub>e\<^sub>t (d v t' ` (fv u \ subst_domain (d v t'))) \ subterms t'" + for u::"('f,'v) term" + using vt_dom unfolding d_def by force + + have 1: "subterms_tuples E' - V \ (subterms t' - V) \ (subterms_tuples E - V \\<^sub>s\<^sub>e\<^sub>t d v t')" + (is "?A \ ?B") + proof + fix u assume "u \ ?A" + then obtain u1 u2 where u12: + "(u1,u2) \ set E" + "u \ (subterms (u1 \ (d v t')) - V) \ (subterms (u2 \ (d v t')) - V)" + unfolding subtt_def subst_list_def E'_def d_def by moura + hence "u \ (subterms t' - V) \ (((subterms_tuples E) \\<^sub>s\<^sub>e\<^sub>t d v t') - V)" + using subterms_subst[of u1 "d v t'"] subterms_subst[of u2 "d v t'"] + *[OF u12(1)] **[of u1] **[of u2] + unfolding subtt_def subst_list_def by auto + moreover have + "(subterms_tuples E \\<^sub>s\<^sub>e\<^sub>t d v t') - V \ + (subterms_tuples E - V \\<^sub>s\<^sub>e\<^sub>t d v t') \ {t'}" + unfolding subst_def subtt_def V_def d_def by force + ultimately show "u \ ?B" using u12 v_fv by auto + qed + + have 2: "subterms_img B' - V \ + (subterms t' - V) \ (subterms_img (subst_of B) - V \\<^sub>s\<^sub>e\<^sub>t d v t')" + using B' vt_img_subt subst_img_comp_subset'''[of "subst_of B" "d v t'"] + unfolding subti_def subst_def V_def by argo + + have 3: "subterms_tuples ((Var v, t')#E) - V = (subterms t' - V) \ (subterms_tuples E - V)" + by (auto simp add: subst_def subtt_def V_def) + + have "fv\<^sub>s\<^sub>e\<^sub>t (subterms t' - V) \ subst_domain (d v t') = {}" + using v_fv vt_dom fv_subterms[of t'] by fastforce + hence 4: "subterms t' - V \\<^sub>s\<^sub>e\<^sub>t d v t' = subterms t' - V" + using set_subst_ident[of "subterms t' - range Var" "d v t'"] by (simp add: V_def) + + have "M E' B' - V \ M ((Var v, t')#E) (subst_of B) - V \\<^sub>s\<^sub>e\<^sub>t d v t'" + using 1 2 3 4 unfolding M_def by blast + moreover have "Q' ((Var v, t')#E) (subst_of B) (d v t')" + using Q_assm unfolding Q_def Q'_def by auto + moreover have "R (subst_of B) \\<^sub>s\<^sub>e\<^sub>t d v t' = R (subst_of ((v,t')#B))" + unfolding R_def d_def by auto + ultimately have + "M (subst_list (d v t') E) (subst_of ((v, t')#B)) - V \ R (subst_of ((v, t')#B)) - V" + unfolding Q'_def E'_def B'_def d_def by blast + thus ?thesis unfolding Q_def M_def R_def d_def by blast + qed + + have "u \ subterms s \ subterms t - V \\<^sub>s\<^sub>e\<^sub>t subst_of U" + when assms': + "unify E B = Some U" + "u \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (subst_of U)) - V" + "Q E (subst_of B)" + for E B U and T::"('f,'v) term list" + using assms' + proof (induction E B arbitrary: U rule: Unification.unify.induct) + case (1 B) thus ?case by (auto simp add: Q_def M_def R_def subti_def) + next + case (2 g X h Y E B U) + from "2.prems"(1) obtain E' where E': + "decompose (Fun g X) (Fun h Y) = Some E'" + "g = h" "length X = length Y" "E' = zip X Y" + "Unification.unify (E'@E) B = Some U" + by (auto split: option.splits) + moreover have "subterms_tuples (E'@E) \ subterms_tuples ((Fun g X, Fun h Y)#E)" + proof + fix u assume "u \ subterms_tuples (E'@E)" + then obtain u1 u2 where u12: "(u1,u2) \ set (E'@E)" "u \ subterms u1 \ subterms u2" + unfolding subtt_def by fastforce + thus "u \ subterms_tuples ((Fun g X, Fun h Y)#E)" + proof (cases "(u1,u2) \ set E'") + case True + hence "subterms u1 \ subterms (Fun g X)" "subterms u2 \ subterms (Fun h Y)" + using E'(4) subterms_subset params_subterms subsetCE + by (metis set_zip_leftD, metis set_zip_rightD) + thus ?thesis using u12 unfolding subtt_def by auto + next + case False thus ?thesis using u12 unfolding subtt_def by fastforce + qed + qed + hence "Q (E'@E) (subst_of B)" using "2.prems"(3) unfolding Q_def M_def by blast + ultimately show ?case using "2.IH"[of E' U] "2.prems" by meson + next + case (3 v t' E B) + show ?case + proof (cases "t' = Var v") + case True thus ?thesis + using "3.prems" "3.IH"(1) unfolding Q_def M_def V_def subtt_def by auto + next + case False + hence 1: "v \ fv t'" using "3.prems"(1) by auto + hence "unify (subst_list (subst v t') E) ((v, t')#B) = Some U" + using False "3.prems"(1) by auto + thus ?thesis + using Q_subst[OF 1 "3.prems"(3)] + "3.IH"(2)[OF False 1 _ "3.prems"(2)] + by metis + qed + next + case (4 g X v E B U) + have 1: "v \ fv (Fun g X)" using "4.prems"(1) not_None_eq by fastforce + hence 2: "unify (subst_list (subst v (Fun g X)) E) ((v, Fun g X)#B) = Some U" + using "4.prems"(1) by auto + + have 3: "Q ((Var v, Fun g X)#E) (subst_of B)" + using "4.prems"(3) unfolding Q_def M_def subtt_def by auto + + show ?case + using Q_subst[OF 1 3] "4.IH"[OF 1 2 "4.prems"(2)] + by metis + qed + moreover obtain D where "unify [(s, t)] [] = Some D" "\ = subst_of D" + using assms(1) by (auto split: option.splits) + moreover have "Q [(s,t)] (subst_of [])" + unfolding Q_def M_def R_def subtt_def subti_def + by force + ultimately show ?thesis using assms(2) unfolding V_def by auto +qed + +lemma mgu_img_consts: + fixes \::"('f,'v) subst" and s t::"('f,'v) term" and c::'f and z::'v + assumes "mgu s t = Some \" "Fun c [] \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \)" + shows "Fun c [] \ subterms s \ subterms t" +proof - + obtain u where "u \ (subterms s \ subterms t) - range Var" "u \ \ = Fun c []" + using mgu_img_subterm_subst[OF assms(1), of "Fun c []"] assms(2) by force + thus ?thesis by (cases u) auto +qed + +lemma mgu_img_consts': + fixes \::"('f,'v) subst" and s t::"('f,'v) term" and c::'f and z::'v + assumes "mgu s t = Some \" "\ z = Fun c []" + shows "Fun c [] \ s \ Fun c [] \ t" +using mgu_img_consts[OF assms(1)] assms(2) +by (metis Un_iff in_subterms_Union subst_imgI term.distinct(1)) + +lemma mgu_img_composed_var_term: + fixes \::"('f,'v) subst" and s t::"('f,'v) term" and f::'f and Z::"'v list" + assumes "mgu s t = Some \" "Fun f (map Var Z) \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \)" + shows "\Z'. map \ Z' = map Var Z \ Fun f (map Var Z') \ subterms s \ subterms t" +proof - + obtain u where u: "u \ (subterms s \ subterms t) - range Var" "u \ \ = Fun f (map Var Z)" + using mgu_img_subterm_subst[OF assms(1), of "Fun f (map Var Z)"] assms(2) by fastforce + then obtain T where T: "u = Fun f T" "map (\t. t \ \) T = map Var Z" by (cases u) auto + have "\t \ set T. \x. t = Var x" using T(2) by (induct T arbitrary: Z) auto + then obtain Z' where Z': "map Var Z' = T" by (metis ex_map_conv) + hence "map \ Z' = map Var Z" using T(2) by (induct Z' arbitrary: T Z) auto + thus ?thesis using u(1) T(1) Z' by auto +qed + + +subsection \Lemmata: The "Inequality Lemmata"\ +text \Subterm injectivity (a stronger injectivity property)\ +definition subterm_inj_on where + "subterm_inj_on f A \ \x\A. \y\A. (\v. v \ f x \ v \ f y) \ x = y" + +lemma subterm_inj_on_imp_inj_on: "subterm_inj_on f A \ inj_on f A" +unfolding subterm_inj_on_def inj_on_def by fastforce + +lemma subst_inj_on_is_bij_betw: + "inj_on \ (subst_domain \) = bij_betw \ (subst_domain \) (subst_range \)" +unfolding inj_on_def bij_betw_def by auto + +lemma subterm_inj_on_alt_def: + "subterm_inj_on f A \ + (inj_on f A \ (\s \ f`A. \u \ f`A. (\v. v \ s \ v \ u) \ s = u))" + (is "?A \ ?B") +unfolding subterm_inj_on_def inj_on_def by fastforce + +lemma subterm_inj_on_alt_def': + "subterm_inj_on \ (subst_domain \) \ + (inj_on \ (subst_domain \) \ + (\s \ subst_range \. \u \ subst_range \. (\v. v \ s \ v \ u) \ s = u))" + (is "?A \ ?B") +by (metis subterm_inj_on_alt_def subst_range.simps) + +lemma subterm_inj_on_subset: + assumes "subterm_inj_on f A" + and "B \ A" + shows "subterm_inj_on f B" +proof - + have "inj_on f A" "\s\f ` A. \u\f ` A. (\v. v \ s \ v \ u) \ s = u" + using subterm_inj_on_alt_def[of f A] assms(1) by auto + moreover have "f ` B \ f ` A" using assms(2) by auto + ultimately have "inj_on f B" "\s\f ` B. \u\f ` B. (\v. v \ s \ v \ u) \ s = u" + using inj_on_subset[of f A] assms(2) by blast+ + thus ?thesis by (metis subterm_inj_on_alt_def) +qed + +lemma inj_subst_unif_consts: + fixes \ \ \::"('f,'v) subst" and s t::"('f,'v) term" + assumes \: "subterm_inj_on \ (subst_domain \)" "\x \ (fv s \ fv t) - X. \c. \ x = Fun c []" + "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) \ (subterms s \ subterms t) = {}" "ground (subst_range \)" + "subst_domain \ \ X = {}" + and \: "ground (subst_range \)" "subst_domain \ = subst_domain \" + and unif: "Unifier \ (s \ \) (t \ \)" + shows "\\. Unifier \ (s \ \) (t \ \)" +proof - + let ?xs = "subst_domain \" + let ?ys = "(fv s \ fv t) - ?xs" + + have "\\::('f,'v) subst. s \ \ = t \ \" by (metis subst_subst_compose unif) + then obtain \::"('f,'v) subst" where \: "mgu s t = Some \" + using mgu_always_unifies by moura + have 1: "\\::('f,'v) subst. s \ \ \ \ = t \ \ \ \" by (metis unif) + have 2: "\\::('f,'v) subst. s \ \ \ \ = t \ \ \ \ \ \ \\<^sub>\ \ \\<^sub>s \" using mgu_gives_MGU[OF \] by simp + have 3: "\(z::'v) (c::'f). \ z = Fun c [] \ Fun c [] \ s \ Fun c [] \ t" + by (rule mgu_img_consts'[OF \]) + have 4: "subst_domain \ \ range_vars \ = {}" + by (metis mgu_gives_wellformed_subst[OF \] wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + have 5: "subst_domain \ \ range_vars \ \ fv s \ fv t" + by (metis mgu_gives_wellformed_MGU[OF \] wf\<^sub>M\<^sub>G\<^sub>U_def) + + { fix x and \::"('f,'v) subst" assume "x \ subst_domain \" + hence "(\ \\<^sub>s \) x = \ x" + using \(4) ident_comp_subst_trm_if_disj[of \ \] + unfolding range_vars_alt_def by fast + } + then obtain \::"('f,'v) subst" where \: "\x \ subst_domain \. \ x = (\ \\<^sub>s \) x" using 1 2 by moura + + have *: "\x. x \ subst_domain \ \ subst_domain \ \ \y \ ?ys. \ x = Var y" + proof - + fix x assume "x \ subst_domain \ \ ?xs" + hence x: "x \ subst_domain \" "x \ subst_domain \" by auto + then obtain c where c: "\ x = Fun c []" using \(2,5) 5 by moura + hence *: "(\ \\<^sub>s \) x = Fun c []" using \ x by fastforce + hence **: "x \ subst_domain (\ \\<^sub>s \)" "Fun c [] \ subst_range (\ \\<^sub>s \)" + by (auto simp add: subst_domain_def) + have "\ x = Fun c [] \ (\z. \ x = Var z \ \ z = Fun c [])" + by (rule subst_img_comp_subset_const'[OF *]) + moreover have "\ x \ Fun c []" + proof (rule ccontr) + assume "\\ x \ Fun c []" + hence "Fun c [] \ s \ Fun c [] \ t" using 3 by metis + moreover have "\u \ subst_range \. u \ subterms s \ subterms t" + using \(3) by force + hence "Fun c [] \ subterms s \ subterms t" + by (metis c \ground (subst_range \)\x(2) ground_subst_dom_iff_img) + ultimately show False by auto + qed + moreover have "\x' \ subst_domain \. \ x \ Var x'" + proof (rule ccontr) + assume "\(\x' \ subst_domain \. \ x \ Var x')" + then obtain x' where x': "x' \ subst_domain \" "\ x = Var x'" by moura + hence "\ x' = Fun c []" "(\ \\<^sub>s \) x = Fun c []" using * unfolding subst_compose_def by auto + moreover have "x \ x'" + using x(1) x'(2) 4 + by (auto simp add: subst_domain_def) + moreover have "x' \ subst_domain \" + using x'(2) mgu_eliminates_dom[OF \] + by (metis (no_types) subst_elim_def subst_apply_term.simps(1) vars_iff_subterm_or_eq) + moreover have "(\ \\<^sub>s \) x = \ x" "(\ \\<^sub>s \) x' = \ x'" using \ x(2) x'(1) by auto + ultimately show False + using subterm_inj_on_imp_inj_on[OF \(1)] * + by (simp add: inj_on_def subst_compose_def x'(2) subst_domain_def) + qed + ultimately show "\y \ ?ys. \ x = Var y" + by (metis 5 x(2) subtermeqI' vars_iff_subtermeq DiffI Un_iff subst_fv_imgI sup.orderE) + qed + + have **: "inj_on \ (subst_domain \ \ ?xs)" + proof (intro inj_onI) + fix x y assume *: + "x \ subst_domain \ \ subst_domain \" "y \ subst_domain \ \ subst_domain \" "\ x = \ y" + hence "(\ \\<^sub>s \) x = (\ \\<^sub>s \) y" unfolding subst_compose_def by auto + hence "\ x = \ y" using \ * by auto + thus "x = y" using inj_onD[OF subterm_inj_on_imp_inj_on[OF \(1)]] *(1,2) by simp + qed + + define \ where "\ = (\y'. if Var y' \ \ ` (subst_domain \ \ ?xs) + then Var ((inv_into (subst_domain \ \ ?xs) \) (Var y')) + else Var y'::('f,'v) term)" + have a1: "Unifier (\ \\<^sub>s \) s t" using mgu_gives_MGU[OF \] by auto + + define \' where "\' = \ \\<^sub>s \" + have d1: "subst_domain \' \ ?ys" + proof + fix z assume z: "z \ subst_domain \'" + have "z \ ?xs \ z \ subst_domain \'" + proof (cases "z \ subst_domain \") + case True + moreover assume "z \ ?xs" + ultimately have z_in: "z \ subst_domain \ \ ?xs" by simp + then obtain y where y: "\ z = Var y" "y \ ?ys" using * by moura + hence "\ y = Var ((inv_into (subst_domain \ \ ?xs) \) (Var y))" + using \_def z_in by simp + hence "\ y = Var z" by (metis y(1) z_in ** inv_into_f_eq) + hence "\' z = Var z" using \'_def y(1) subst_compose_def[of \ \] by simp + thus ?thesis by (simp add: subst_domain_def) + next + case False + hence "\ z = Var z" by (simp add: subst_domain_def) + moreover assume "z \ ?xs" + hence "\ z = Var z" using \_def * by force + ultimately show ?thesis + using \'_def subst_compose_def[of \ \] + by (simp add: subst_domain_def) + qed + moreover have "subst_domain \ \ range_vars \" + unfolding \'_def \_def range_vars_alt_def + by (auto simp add: subst_domain_def) + hence "subst_domain \' \ subst_domain \ \ range_vars \" + using subst_domain_compose[of \ \] unfolding \'_def by blast + ultimately show "z \ ?ys" using 5 z by auto + qed + have d2: "Unifier (\' \\<^sub>s \) s t" using a1 \'_def by auto + have d3: "\ \\<^sub>s \' \\<^sub>s \ = \' \\<^sub>s \" + proof - + { fix z::'v assume z: "z \ ?xs" + then obtain u where u: "\ z = u" "fv u = {}" using \ by auto + hence "(\ \\<^sub>s \' \\<^sub>s \) z = u" by (simp add: subst_compose subst_ground_ident) + moreover have "z \ subst_domain \'" using d1 z by auto + hence "\' z = Var z" by (simp add: subst_domain_def) + hence "(\' \\<^sub>s \) z = u" using u(1) by (simp add: subst_compose) + ultimately have "(\ \\<^sub>s \' \\<^sub>s \) z = (\' \\<^sub>s \) z" by metis + } moreover { + fix z::'v assume "z \ ?ys" + hence "z \ subst_domain \" using \(2) by auto + hence "(\ \\<^sub>s \' \\<^sub>s \) z = (\' \\<^sub>s \) z" by (simp add: subst_compose subst_domain_def) + } moreover { + fix z::'v assume "z \ ?xs" "z \ ?ys" + hence "\ z = Var z" "\' z = Var z" using \(2) d1 by blast+ + hence "(\ \\<^sub>s \' \\<^sub>s \) z = (\' \\<^sub>s \) z" by (simp add: subst_compose) + } ultimately show ?thesis by auto + qed + + from d2 d3 have "Unifier (\' \\<^sub>s \) (s \ \) (t \ \)" by (metis subst_subst_compose) + thus ?thesis by metis +qed + +lemma inj_subst_unif_comp_terms: + fixes \ \ \::"('f,'v) subst" and s t::"('f,'v) term" + assumes \: "subterm_inj_on \ (subst_domain \)" "ground (subst_range \)" + "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) \ (subterms s \ subterms t) = {}" + "(fv s \ fv t) - subst_domain \ \ X" + and tfr: "\f U. Fun f U \ subterms s \ subterms t \ U = [] \ (\u \ set U. u \ Var ` X)" + and \: "ground (subst_range \)" "subst_domain \ = subst_domain \" + and unif: "Unifier \ (s \ \) (t \ \)" + shows "\\. Unifier \ (s \ \) (t \ \)" +proof - + let ?xs = "subst_domain \" + let ?ys = "(fv s \ fv t) - ?xs" + + have "ground (subst_range \)" using \(2) by auto + + have "\\::('f,'v) subst. s \ \ = t \ \" by (metis subst_subst_compose unif) + then obtain \::"('f,'v) subst" where \: "mgu s t = Some \" + using mgu_always_unifies by moura + have 1: "\\::('f,'v) subst. s \ \ \ \ = t \ \ \ \" by (metis unif) + have 2: "\\::('f,'v) subst. s \ \ \ \ = t \ \ \ \ \ \ \\<^sub>\ \ \\<^sub>s \" using mgu_gives_MGU[OF \] by simp + have 3: "\(z::'v) (c::'f). Fun c [] \ \ z \ Fun c [] \ s \ Fun c [] \ t" + using mgu_img_consts[OF \] by force + have 4: "subst_domain \ \ range_vars \ = {}" + using mgu_gives_wellformed_subst[OF \] + by (metis wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + have 5: "subst_domain \ \ range_vars \ \ fv s \ fv t" + using mgu_gives_wellformed_MGU[OF \] + by (metis wf\<^sub>M\<^sub>G\<^sub>U_def) + + { fix x and \::"('f,'v) subst" assume "x \ subst_domain \" + hence "(\ \\<^sub>s \) x = \ x" + using \ground (subst_range \)\ ident_comp_subst_trm_if_disj[of \ \ x] + unfolding range_vars_alt_def by blast + } + then obtain \::"('f,'v) subst" where \: "\x \ subst_domain \. \ x = (\ \\<^sub>s \) x" using 1 2 by moura + + have ***: "\x. x \ subst_domain \ \ subst_domain \ \ fv (\ x) \ ?ys" + proof - + fix x assume "x \ subst_domain \ \ ?xs" + hence x: "x \ subst_domain \" "x \ subst_domain \" by auto + moreover have "\(\x' \ ?xs. x' \ fv (\ x))" + proof (rule ccontr) + assume "\\(\x' \ ?xs. x' \ fv (\ x))" + then obtain x' where x': "x' \ fv (\ x)" "x' \ ?xs" by metis + have "x \ x'" "x' \ subst_domain \" "\ x' = Var x'" + using 4 x(1) x'(1) unfolding range_vars_alt_def by auto + hence "(\ \\<^sub>s \) x' \ (\ \\<^sub>s \) x" "\ x' = (\ \\<^sub>s \) x'" + using \ x(2) x'(2) + by (metis subst_compose subst_mono vars_iff_subtermeq x'(1), + metis subst_apply_term.simps(1) subst_compose_def) + hence "\ x' \ \ x" using \ x(2) x'(2) by auto + thus False + using \(1) x'(2) x(2) \x \ x'\ + unfolding subterm_inj_on_def + by (meson subtermeqI') + qed + ultimately show "fv (\ x) \ ?ys" + using 5 subst_dom_vars_in_subst[of x \] subst_fv_imgI[of \ x] + by blast + qed + + have **: "inj_on \ (subst_domain \ \ ?xs)" + proof (intro inj_onI) + fix x y assume *: + "x \ subst_domain \ \ subst_domain \" "y \ subst_domain \ \ subst_domain \" "\ x = \ y" + hence "(\ \\<^sub>s \) x = (\ \\<^sub>s \) y" unfolding subst_compose_def by auto + hence "\ x = \ y" using \ * by auto + thus "x = y" using inj_onD[OF subterm_inj_on_imp_inj_on[OF \(1)]] *(1,2) by simp + qed + + have *: "\x. x \ subst_domain \ \ subst_domain \ \ \y \ ?ys. \ x = Var y" + proof (rule ccontr) + fix xi assume xi_assms: "xi \ subst_domain \ \ subst_domain \" "\(\y \ ?ys. \ xi = Var y)" + hence xi_\: "xi \ subst_domain \" and \_xi_comp: "\(\y. \ xi = Var y)" + using ***[of xi] 5 by auto + then obtain f T where f: "\ xi = Fun f T" by (cases "\ xi") moura + + have "\g Y'. Y' \ [] \ Fun g (map Var Y') \ \ xi \ set Y' \ ?ys" + proof - + have "\c. Fun c [] \ \ xi \ Fun c [] \ \ xi" + using \ xi_\ by (metis const_subterm_subst subst_compose) + hence 1: "\c. \(Fun c [] \ \ xi)" + using 3[of _ xi] xi_\ \(3) + by auto + + have "\(\x. \ xi = Var x)" using f by auto + hence "\g S. Fun g S \ \ xi \ (\s \ set S. (\c. s = Fun c []) \ (\x. s = Var x))" + using nonvar_term_has_composed_shallow_term[of "\ xi"] by auto + then obtain g S where gS: "Fun g S \ \ xi" "\s \ set S. (\c. s = Fun c []) \ (\x. s = Var x)" + by moura + + have "\s \ set S. \x. s = Var x" + using 1 term.order_trans gS + by (metis (no_types, lifting) UN_I term.order_refl subsetCE subterms.simps(2) sup_ge2) + then obtain S' where 2: "map Var S' = S" by (metis ex_map_conv) + + have "S \ []" using 1 term.order_trans[OF _ gS(1)] by fastforce + hence 3: "S' \ []" "Fun g (map Var S') \ \ xi" using gS(1) 2 by auto + + have "set S' \ fv (Fun g (map Var S'))" by simp + hence 4: "set S' \ fv (\ xi)" using 3(2) fv_subterms by force + + show ?thesis using ***[OF xi_assms(1)] 2 3 4 by auto + qed + then obtain g Y' where g: "Y' \ []" "Fun g (map Var Y') \ \ xi" "set Y' \ ?ys" by moura + then obtain X where X: "map \ X = map Var Y'" "Fun g (map Var X) \ subterms s \ subterms t" + using mgu_img_composed_var_term[OF \, of g Y'] by force + hence "\(u::('f,'v) term) \ set (map Var X). u \ Var ` ?ys" + using \(4) tfr g(1) by fastforce + then obtain j where j: "j < length X" "X ! j \ ?ys" + by (metis image_iff[of _ Var "fv s \ fv t - subst_domain \"] nth_map[of _ X Var] + in_set_conv_nth[of _ "map Var X"] length_map[of Var X]) + + define yj' where yj': "yj' \ Y' ! j" + define xj where xj: "xj \ X ! j" + + have "xj \ fv s \ fv t" + using j X(1) g(3) 5 xj yj' + by (metis length_map nth_map term.simps(1) in_set_conv_nth le_supE subsetCE subst_domI) + hence xj_\: "xj \ subst_domain \" using j unfolding xj by simp + + have len: "length X = length Y'" by (rule map_eq_imp_length_eq[OF X(1)]) + + have "Var yj' \ \ xi" + using term.order_trans[OF _ g(2)] j(1) len unfolding yj' by auto + hence "\ yj' \ \ xi" + using \ xi_\ by (metis subst_apply_term.simps(1) subst_compose_def subst_mono) + moreover have \_xj_var: "Var yj' = \ xj" + using X(1) len j(1) nth_map + unfolding xj yj' by metis + hence "\ yj' = \ xj" using \ xj_\ by (metis subst_apply_term.simps(1) subst_compose_def) + moreover have "xi \ xj" using \_xi_comp \_xj_var by auto + ultimately show False using \(1) xi_\ xj_\ unfolding subterm_inj_on_def by blast + qed + + define \ where "\ = (\y'. if Var y' \ \ ` (subst_domain \ \ ?xs) + then Var ((inv_into (subst_domain \ \ ?xs) \) (Var y')) + else Var y'::('f,'v) term)" + have a1: "Unifier (\ \\<^sub>s \) s t" using mgu_gives_MGU[OF \] by auto + + define \' where "\' = \ \\<^sub>s \" + have d1: "subst_domain \' \ ?ys" + proof + fix z assume z: "z \ subst_domain \'" + have "z \ ?xs \ z \ subst_domain \'" + proof (cases "z \ subst_domain \") + case True + moreover assume "z \ ?xs" + ultimately have z_in: "z \ subst_domain \ \ ?xs" by simp + then obtain y where y: "\ z = Var y" "y \ ?ys" using * by moura + hence "\ y = Var ((inv_into (subst_domain \ \ ?xs) \) (Var y))" + using \_def z_in by simp + hence "\ y = Var z" by (metis y(1) z_in ** inv_into_f_eq) + hence "\' z = Var z" using \'_def y(1) subst_compose_def[of \ \] by simp + thus ?thesis by (simp add: subst_domain_def) + next + case False + hence "\ z = Var z" by (simp add: subst_domain_def) + moreover assume "z \ ?xs" + hence "\ z = Var z" using \_def * by force + ultimately show ?thesis using \'_def subst_compose_def[of \ \] by (simp add: subst_domain_def) + qed + moreover have "subst_domain \ \ range_vars \" + unfolding \'_def \_def range_vars_alt_def subst_domain_def + by auto + hence "subst_domain \' \ subst_domain \ \ range_vars \" + using subst_domain_compose[of \ \] + unfolding \'_def by blast + ultimately show "z \ ?ys" using 5 z by blast + qed + have d2: "Unifier (\' \\<^sub>s \) s t" using a1 \'_def by auto + have d3: "\ \\<^sub>s \' \\<^sub>s \ = \' \\<^sub>s \" + proof - + { fix z::'v assume z: "z \ ?xs" + then obtain u where u: "\ z = u" "fv u = {}" using \ by auto + hence "(\ \\<^sub>s \' \\<^sub>s \) z = u" by (simp add: subst_compose subst_ground_ident) + moreover have "z \ subst_domain \'" using d1 z by auto + hence "\' z = Var z" by (simp add: subst_domain_def) + hence "(\' \\<^sub>s \) z = u" using u(1) by (simp add: subst_compose) + ultimately have "(\ \\<^sub>s \' \\<^sub>s \) z = (\' \\<^sub>s \) z" by metis + } moreover { + fix z::'v assume "z \ ?ys" + hence "z \ subst_domain \" using \(2) by auto + hence "(\ \\<^sub>s \' \\<^sub>s \) z = (\' \\<^sub>s \) z" by (simp add: subst_compose subst_domain_def) + } moreover { + fix z::'v assume "z \ ?xs" "z \ ?ys" + hence "\ z = Var z" "\' z = Var z" using \(2) d1 by blast+ + hence "(\ \\<^sub>s \' \\<^sub>s \) z = (\' \\<^sub>s \) z" by (simp add: subst_compose) + } ultimately show ?thesis by auto + qed + + from d2 d3 have "Unifier (\' \\<^sub>s \) (s \ \) (t \ \)" by (metis subst_subst_compose) + thus ?thesis by metis +qed + +context +begin +private lemma sat_ineq_subterm_inj_subst_aux: + fixes \::"('f,'v) subst" + assumes "Unifier \ (s \ \) (t \ \)" "ground (subst_range \)" + "(fv s \ fv t) - X \ subst_domain \" "subst_domain \ \ X = {}" + shows "\\::('f,'v) subst. subst_domain \ = X \ ground (subst_range \) \ s \ \ \ \ = t \ \ \ \" +proof - + have "\\. Unifier \ (s \ \) (t \ \) \ interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + proof - + obtain \'::"('f,'v) subst" where *: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \'" + using interpretation_subst_exists by metis + hence "Unifier (\ \\<^sub>s \') (s \ \) (t \ \)" using assms(1) by simp + thus ?thesis using * interpretation_comp by blast + qed + then obtain \' where \': "Unifier \' (s \ \) (t \ \)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \'" by moura + + define \'' where "\'' = rm_vars (UNIV - X) \'" + + have *: "fv (s \ \) \ X" "fv (t \ \) \ X" + using assms(2,3) subst_fv_unfold_ground_img[of \] + unfolding range_vars_alt_def + by (simp_all add: Diff_subset_conv Un_commute) + hence **: "subst_domain \'' = X" "ground (subst_range \'')" + using rm_vars_img_subset[of "UNIV - X" \'] rm_vars_dom[of "UNIV - X" \'] \'(2) + unfolding \''_def by auto + hence "\t. t \ \ \ \'' = t \ \'' \ \" + using subst_eq_if_disjoint_vars_ground[OF _ _ assms(2)] assms(4) by blast + moreover have "Unifier \'' (s \ \) (t \ \)" + using Unifier_dom_restrict[OF \'(1)] \''_def * by blast + ultimately show ?thesis using ** by auto +qed + +text \ + The "inequality lemma": This lemma gives sufficient syntactic conditions for finding substitutions + \\\ under which terms \s\ and \t\ are not unifiable. + + This is useful later when establishing the typing results since we there want to find well-typed + solutions to inequality constraints / "negative checks" constraints, and this lemma gives + conditions for protocols under which such constraints are well-typed satisfiable if satisfiable. +\ +lemma sat_ineq_subterm_inj_subst: + fixes \ \ \::"('f,'v) subst" + assumes \: "subterm_inj_on \ (subst_domain \)" + "ground (subst_range \)" + "subst_domain \ \ X = {}" + "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) \ (subterms s \ subterms t) = {}" + "(fv s \ fv t) - subst_domain \ \ X" + and tfr: "(\x \ (fv s \ fv t) - X. \c. \ x = Fun c []) \ + (\f U. Fun f U \ subterms s \ subterms t \ U = [] \ (\u \ set U. u \ Var ` X))" + and \: "\\::('f,'v) subst. subst_domain \ = X \ ground (subst_range \) \ s \ \ \ \ \ t \ \ \ \" + "(fv s \ fv t) - X \ subst_domain \" "subst_domain \ \ X = {}" "ground (subst_range \)" + "subst_domain \ = subst_domain \" + and \: "subst_domain \ = X" "ground (subst_range \)" + shows "s \ \ \ \ \ t \ \ \ \" +proof - + have "\\. \Unifier \ (s \ \) (t \ \)" + by (metis \(1) sat_ineq_subterm_inj_subst_aux[OF _ \(4,2,3)]) + hence "\Unifier \ (s \ \) (t \ \)" + using inj_subst_unif_consts[OF \(1) _ \(4,2,3) \(4,5)] + inj_subst_unif_comp_terms[OF \(1,2,4,5) _ \(4,5)] + tfr + by metis + moreover have "subst_domain \ \ subst_domain \ = {}" using \(2,3) \(1) by auto + ultimately show ?thesis using \ subst_eq_if_disjoint_vars_ground[OF _ \(2) \(2)] by metis +qed +end + +lemma ineq_subterm_inj_cond_subst: + assumes "X \ range_vars \ = {}" + and "\f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t S \ T = [] \ (\u \ set T. u \ Var`X)" + shows "\f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (S \\<^sub>s\<^sub>e\<^sub>t \) \ T = [] \ (\u \ set T. u \ Var`X)" +proof (intro allI impI) + let ?M = "\S. subterms\<^sub>s\<^sub>e\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \" + let ?N = "\S. subterms\<^sub>s\<^sub>e\<^sub>t (\ ` (fv\<^sub>s\<^sub>e\<^sub>t S \ subst_domain \))" + + fix f T assume "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (S \\<^sub>s\<^sub>e\<^sub>t \)" + hence 1: "Fun f T \ ?M S \ Fun f T \ ?N S" + using subterms_subst[of _ \] by auto + + have 2: "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) \ \u \ set T. u \ Var`X" + using fv_subset_subterms[of "Fun f T" "subst_range \"] assms(1) + unfolding range_vars_alt_def by force + + have 3: "\x \ subst_domain \. \ x \ Var`X" + proof + fix x assume "x \ subst_domain \" + hence "fv (\ x) \ range_vars \" + using subst_dom_vars_in_subst subst_fv_imgI + unfolding range_vars_alt_def by auto + thus "\ x \ Var`X" using assms(1) by auto + qed + + show "T = [] \ (\s \ set T. s \ Var`X)" using 1 + proof + assume "Fun f T \ ?M S" + then obtain u where u: "u \ subterms\<^sub>s\<^sub>e\<^sub>t S" "u \ \ = Fun f T" by fastforce + show ?thesis + proof (cases u) + case (Var x) + hence "Fun f T \ subst_range \" using u(2) by (simp add: subst_domain_def) + hence "\u \ set T. u \ Var`X" using 2 by force + thus ?thesis by auto + next + case (Fun g S) + hence "S = [] \ (\u \ set S. u \ Var`X)" using assms(2) u(1) by metis + thus ?thesis + proof + assume "S = []" thus ?thesis using u(2) Fun by simp + next + assume "\u \ set S. u \ Var`X" + then obtain u' where u': "u' \ set S" "u' \ Var`X" by moura + hence "u' \ \ \ set T" using u(2) Fun by auto + thus ?thesis using u'(2) 3 by (cases u') force+ + qed + qed + next + assume "Fun f T \ ?N S" + thus ?thesis using 2 by force + qed +qed + + +subsection \Lemmata: Sufficient Conditions for Term Matching\ +text \Injective substitutions from variables to variables are invertible\ +definition subst_var_inv where + "subst_var_inv \ X \ (\x. if Var x \ \ ` X then Var ((inv_into X \) (Var x)) else Var x)" + +lemma inj_var_ran_subst_is_invertible: + assumes \_inj_on_t: "inj_on \ (fv t)" + and \_var_on_t: "\ ` fv t \ range Var" + shows "t = t \ \ \\<^sub>s subst_var_inv \ (fv t)" +proof - + have "\ x \ subst_var_inv \ (fv t) = Var x" when x: "x \ fv t" for x + proof - + obtain y where y: "\ x = Var y" using x \_var_on_t by auto + hence "Var y \ \ ` (fv t)" using x by simp + thus ?thesis using y inv_into_f_eq[OF \_inj_on_t x y] unfolding subst_var_inv_def by simp + qed + thus ?thesis by (simp add: subst_compose_def trm_subst_ident'') +qed + +text \Sufficient conditions for matching unifiable terms\ +lemma inj_var_ran_unifiable_has_subst_match: + assumes "t \ \ = s \ \" "inj_on \ (fv t)" "\ ` fv t \ range Var" + shows "t = s \ \ \\<^sub>s subst_var_inv \ (fv t)" +using assms inj_var_ran_subst_is_invertible by fastforce + +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Parallel_Compositionality.thy b/thys/Stateful_Protocol_Composition_and_Typing/Parallel_Compositionality.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Parallel_Compositionality.thy @@ -0,0 +1,1178 @@ +(* +(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: Parallel_Compositionality.thy + Author: Andreas Viktor Hess, DTU + Author: Sebastian A. Mödersheim, DTU + Author: Achim D. Brucker, The University of Sheffield +*) + +section \Parallel Compositionality of Security Protocols\ +theory Parallel_Compositionality +imports Typing_Result Labeled_Strands +begin + + +subsection \Definitions: Labeled Typed Model Locale\ +locale labeled_typed_model = typed_model arity public Ana \ + for arity::"'fun \ nat" + and public::"'fun \ bool" + and Ana::"('fun,'var) term \ (('fun,'var) term list \ ('fun,'var) term list)" + and \::"('fun,'var) term \ ('fun,'atom::finite) term_type" + + + fixes label_witness1 and label_witness2::"'lbl" + assumes at_least_2_labels: "label_witness1 \ label_witness2" +begin + +text \The Ground Sub-Message Patterns (GSMP)\ +definition GSMP::"('fun,'var) terms \ ('fun,'var) terms" where + "GSMP P \ {t \ SMP P. fv t = {}}" + +definition typing_cond where + "typing_cond \ \ + wf\<^sub>s\<^sub>t {} \ \ + fv\<^sub>s\<^sub>t \ \ bvars\<^sub>s\<^sub>t \ = {} \ + tfr\<^sub>s\<^sub>t \ \ + wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t \) \ + Ana_invar_subst (ik\<^sub>s\<^sub>t \ \ assignment_rhs\<^sub>s\<^sub>t \)" + + +subsection \Definitions: GSMP Disjointedness and Parallel Composability\ +definition GSMP_disjoint where + "GSMP_disjoint P1 P2 Secrets \ GSMP P1 \ GSMP P2 \ Secrets \ {m. {} \\<^sub>c m}" + +definition declassified\<^sub>l\<^sub>s\<^sub>t where + "declassified\<^sub>l\<^sub>s\<^sub>t (\::('fun,'var,'lbl) labeled_strand) \ \ {t. (\, Receive t) \ set \} \\<^sub>s\<^sub>e\<^sub>t \" + +definition par_comp where + "par_comp (\::('fun,'var,'lbl) labeled_strand) (Secrets::('fun,'var) terms) \ + (\l1 l2. l1 \ l2 \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) Secrets) \ + (\s \ Secrets. \s' \ subterms s. {} \\<^sub>c s' \ s' \ Secrets) \ + ground Secrets" + +definition strand_leaks\<^sub>l\<^sub>s\<^sub>t where + "strand_leaks\<^sub>l\<^sub>s\<^sub>t \ Sec \ \ (\t \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t \ \. \l. (\ \ \proj_unl l \@[Send t]\))" + +subsection \Definitions: Homogeneous and Numbered Intruder Deduction Variants\ + +definition proj_specific where + "proj_specific n t \ Secrets \ t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n \) - (Secrets \ {m. {} \\<^sub>c m})" + +definition heterogeneous\<^sub>l\<^sub>s\<^sub>t where + "heterogeneous\<^sub>l\<^sub>s\<^sub>t t \ Secrets \ ( + (\l1 l2. \s1 \ subterms t. \s2 \ subterms t. + l1 \ l2 \ proj_specific l1 s1 \ Secrets \ proj_specific l2 s2 \ Secrets))" + +abbreviation homogeneous\<^sub>l\<^sub>s\<^sub>t where + "homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Secrets \ \heterogeneous\<^sub>l\<^sub>s\<^sub>t t \ Secrets" + +definition intruder_deduct_hom:: + "('fun,'var) terms \ ('fun,'var,'lbl) labeled_strand \ ('fun,'var) terms \ ('fun,'var) term + \ bool" ("\_;_;_\ \\<^sub>h\<^sub>o\<^sub>m _" 50) +where + "\M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t \ \M; \t. homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec \ t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)\ \\<^sub>r t" + +lemma intruder_deduct_hom_AxiomH[simp]: + assumes "t \ M" + shows "\M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t" +using intruder_deduct_restricted.AxiomR[of t M] assms +unfolding intruder_deduct_hom_def +by blast + +lemma intruder_deduct_hom_ComposeH[simp]: + assumes "length X = arity f" "public f" "\x. x \ set X \ \M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m x" + and "homogeneous\<^sub>l\<^sub>s\<^sub>t (Fun f X) \ Sec" "Fun f X \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + shows "\M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m Fun f X" +proof - + let ?Q = "\t. homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec \ t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + show ?thesis + using intruder_deduct_restricted.ComposeR[of X f M ?Q] assms + unfolding intruder_deduct_hom_def + by blast +qed + +lemma intruder_deduct_hom_DecomposeH: + assumes "\M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t" "Ana t = (K, T)" "\k. k \ set K \ \M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m k" "t\<^sub>i \ set T" + shows "\M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t\<^sub>i" +proof - + let ?Q = "\t. homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec \ t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + show ?thesis + using intruder_deduct_restricted.DecomposeR[of M ?Q t] assms + unfolding intruder_deduct_hom_def + by blast +qed + +lemma intruder_deduct_hom_induct[consumes 1, case_names AxiomH ComposeH DecomposeH]: + assumes "\M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t" "\t. t \ M \ P M t" + "\X f. \length X = arity f; public f; + \x. x \ set X \ \M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m x; + \x. x \ set X \ P M x; + homogeneous\<^sub>l\<^sub>s\<^sub>t (Fun f X) \ Sec; + Fun f X \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \) + \ \ P M (Fun f X)" + "\t K T t\<^sub>i. \\M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t; P M t; Ana t = (K, T); + \k. k \ set K \ \M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m k; + \k. k \ set K \ P M k; t\<^sub>i \ set T\ \ P M t\<^sub>i" + shows "P M t" +proof - + let ?Q = "\t. homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec \ t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + show ?thesis + using intruder_deduct_restricted_induct[of M ?Q t "\M Q t. P M t"] assms + unfolding intruder_deduct_hom_def + by blast +qed + +lemma ideduct_hom_mono: + "\\M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t; M \ M'\ \ \M'; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t" +using ideduct_restricted_mono[of M _ t M'] +unfolding intruder_deduct_hom_def +by fast + +subsection \Lemmata: GSMP\ +lemma GSMP_disjoint_empty[simp]: + "GSMP_disjoint {} A Sec" "GSMP_disjoint A {} Sec" +unfolding GSMP_disjoint_def GSMP_def by fastforce+ + +lemma GSMP_mono: + assumes "N \ M" + shows "GSMP N \ GSMP M" +using SMP_mono[OF assms] unfolding GSMP_def by fast + +lemma GSMP_SMP_mono: + assumes "SMP N \ SMP M" + shows "GSMP N \ GSMP M" +using assms unfolding GSMP_def by fast + +lemma GSMP_subterm: + assumes "t \ GSMP M" "t' \ t" + shows "t' \ GSMP M" +using SMP.Subterm[of t M t'] ground_subterm[of t t'] assms unfolding GSMP_def by auto + +lemma GSMP_subterms: "subterms\<^sub>s\<^sub>e\<^sub>t (GSMP M) = GSMP M" +using GSMP_subterm[of _ M] by blast + +lemma GSMP_Ana_key: + assumes "t \ GSMP M" "Ana t = (K,T)" "k \ set K" + shows "k \ GSMP M" +using SMP.Ana[of t M K T k] Ana_keys_fv[of t K T] assms unfolding GSMP_def by auto + +lemma GSMP_append[simp]: "GSMP (trms\<^sub>l\<^sub>s\<^sub>t (A@B)) = GSMP (trms\<^sub>l\<^sub>s\<^sub>t A) \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t B)" +using SMP_union[of "trms\<^sub>l\<^sub>s\<^sub>t A" "trms\<^sub>l\<^sub>s\<^sub>t B"] trms\<^sub>l\<^sub>s\<^sub>t_append[of A B] unfolding GSMP_def by auto + +lemma GSMP_union: "GSMP (A \ B) = GSMP A \ GSMP B" +using SMP_union[of A B] unfolding GSMP_def by auto + +lemma GSMP_Union: "GSMP (trms\<^sub>l\<^sub>s\<^sub>t A) = (\l. GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l A))" +proof - + define P where "P \ (\l. trms_proj\<^sub>l\<^sub>s\<^sub>t l A)" + define Q where "Q \ trms\<^sub>l\<^sub>s\<^sub>t A" + have "SMP (\l. P l) = (\l. SMP (P l))" "Q = (\l. P l)" + unfolding P_def Q_def by (metis SMP_Union, metis trms\<^sub>l\<^sub>s\<^sub>t_union) + hence "GSMP Q = (\l. GSMP (P l))" unfolding GSMP_def by auto + thus ?thesis unfolding P_def Q_def by metis +qed + +lemma in_GSMP_in_proj: "t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t A) \ \n. t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n A)" +using GSMP_Union[of A] by blast + +lemma in_proj_in_GSMP: "t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n A) \ t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t A)" +using GSMP_Union[of A] by blast + +lemma GSMP_disjointE: + assumes A: "GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t n A) (trms_proj\<^sub>l\<^sub>s\<^sub>t m A) Sec" + shows "GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n A) \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t m A) \ Sec \ {m. {} \\<^sub>c m}" +using assms unfolding GSMP_disjoint_def by auto + +lemma GSMP_disjoint_term: + assumes "GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \) Sec" + shows "t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) \ t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \) \ t \ Sec \ {} \\<^sub>c t" +using assms unfolding GSMP_disjoint_def by blast + +lemma GSMP_wt_subst_subset: + assumes "t \ GSMP (M \\<^sub>s\<^sub>e\<^sub>t \)" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "t \ GSMP M" +using SMP_wt_subst_subset[OF _ assms(2,3), of t M] assms(1) unfolding GSMP_def by simp + +lemma GSMP_wt_substI: + assumes "t \ M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" + shows "t \ I \ GSMP M" +proof - + have "t \ SMP M" using assms(1) by auto + hence *: "t \ I \ SMP M" using SMP.Substitution assms(2,3) wf_trm_subst_range_iff[of I] by simp + moreover have "fv (t \ I) = {}" + using assms(1) interpretation_grounds_all'[OF assms(4)] + by auto + ultimately show ?thesis unfolding GSMP_def by simp +qed + +lemma GSMP_disjoint_subset: + assumes "GSMP_disjoint L R S" "L' \ L" "R' \ R" + shows "GSMP_disjoint L' R' S" +using assms(1) SMP_mono[OF assms(2)] SMP_mono[OF assms(3)] +by (auto simp add: GSMP_def GSMP_disjoint_def) + +lemma GSMP_disjoint_fst_specific_not_snd_specific: + assumes "GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \) Sec" "l \ l'" + and "proj_specific l m \ Sec" + shows "\proj_specific l' m \ Sec" +using assms by (fastforce simp add: GSMP_disjoint_def proj_specific_def) + +lemma GSMP_disjoint_snd_specific_not_fst_specific: + assumes "GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \) Sec" + and "proj_specific l' m \ Sec" + shows "\proj_specific l m \ Sec" +using assms by (auto simp add: GSMP_disjoint_def proj_specific_def) + +lemma GSMP_disjoint_intersection_not_specific: + assumes "GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \) Sec" + and "t \ Sec \ {} \\<^sub>c t" + shows "\proj_specific l t \ Sec" "\proj_specific l t \ Sec" +using assms by (auto simp add: GSMP_disjoint_def proj_specific_def) + +subsection \Lemmata: Intruder Knowledge and Declassification\ +lemma ik_proj_subst_GSMP_subset: + assumes I: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" + shows "ik\<^sub>s\<^sub>t (proj_unl n A) \\<^sub>s\<^sub>e\<^sub>t I \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n A)" +proof + fix t assume "t \ ik\<^sub>s\<^sub>t (proj_unl n A) \\<^sub>s\<^sub>e\<^sub>t I" + hence *: "t \ trms_proj\<^sub>l\<^sub>s\<^sub>t n A \\<^sub>s\<^sub>e\<^sub>t I" by auto + then obtain s where "s \ trms_proj\<^sub>l\<^sub>s\<^sub>t n A" "t = s \ I" by auto + hence "t \ SMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n A)" using SMP_I I(1,2) wf_trm_subst_range_iff[of I] by simp + moreover have "fv t = {}" + using * interpretation_grounds_all'[OF I(3)] + by auto + ultimately show "t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n A)" unfolding GSMP_def by simp +qed + +lemma declassified_proj_ik_subset: "declassified\<^sub>l\<^sub>s\<^sub>t A I \ ik\<^sub>s\<^sub>t (proj_unl n A) \\<^sub>s\<^sub>e\<^sub>t I" +proof (induction A) + case (Cons a A) thus ?case + using proj_ik_append[of n "[a]" A] by (auto simp add: declassified\<^sub>l\<^sub>s\<^sub>t_def) +qed (simp add: declassified\<^sub>l\<^sub>s\<^sub>t_def) + +lemma declassified_proj_GSMP_subset: + assumes I: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" + shows "declassified\<^sub>l\<^sub>s\<^sub>t A I \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n A)" +by (rule subset_trans[OF declassified_proj_ik_subset ik_proj_subst_GSMP_subset[OF I]]) + +lemma declassified_subterms_proj_GSMP_subset: + assumes I: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" + shows "subterms\<^sub>s\<^sub>e\<^sub>t (declassified\<^sub>l\<^sub>s\<^sub>t A I) \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n A)" +proof + fix t assume t: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (declassified\<^sub>l\<^sub>s\<^sub>t A I)" + then obtain t' where t': "t' \ declassified\<^sub>l\<^sub>s\<^sub>t A I" "t \ t'" by moura + hence "t' \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n A)" using declassified_proj_GSMP_subset[OF assms] by blast + thus "t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n A)" + using SMP.Subterm[of t' "trms_proj\<^sub>l\<^sub>s\<^sub>t n A" t] ground_subterm[OF _ t'(2)] t'(2) + unfolding GSMP_def by fast +qed + +lemma declassified_secrets_subset: + assumes A: "\n m. n \ m \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t n A) (trms_proj\<^sub>l\<^sub>s\<^sub>t m A) Sec" + and I: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" + shows "declassified\<^sub>l\<^sub>s\<^sub>t A I \ Sec \ {m. {} \\<^sub>c m}" +using declassified_proj_GSMP_subset[OF I] A at_least_2_labels +unfolding GSMP_disjoint_def by blast + +lemma declassified_subterms_secrets_subset: + assumes A: "\n m. n \ m \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t n A) (trms_proj\<^sub>l\<^sub>s\<^sub>t m A) Sec" + and I: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range I)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t I" + shows "subterms\<^sub>s\<^sub>e\<^sub>t (declassified\<^sub>l\<^sub>s\<^sub>t A I) \ Sec \ {m. {} \\<^sub>c m}" +using declassified_subterms_proj_GSMP_subset[OF I, of A label_witness1] + declassified_subterms_proj_GSMP_subset[OF I, of A label_witness2] + A at_least_2_labels +unfolding GSMP_disjoint_def by fast + +lemma declassified_proj_eq: "declassified\<^sub>l\<^sub>s\<^sub>t A I = declassified\<^sub>l\<^sub>s\<^sub>t (proj n A) I" +unfolding declassified\<^sub>l\<^sub>s\<^sub>t_def proj_def by auto + +lemma declassified_append: "declassified\<^sub>l\<^sub>s\<^sub>t (A@B) I = declassified\<^sub>l\<^sub>s\<^sub>t A I \ declassified\<^sub>l\<^sub>s\<^sub>t B I" +unfolding declassified\<^sub>l\<^sub>s\<^sub>t_def by auto + +lemma declassified_prefix_subset: "prefix A B \ declassified\<^sub>l\<^sub>s\<^sub>t A I \ declassified\<^sub>l\<^sub>s\<^sub>t B I" +using declassified_append unfolding prefix_def by auto + +subsection \Lemmata: Homogeneous and Heterogeneous Terms\ +lemma proj_specific_secrets_anti_mono: + assumes "proj_specific l t \ Sec" "Sec' \ Sec" + shows "proj_specific l t \ Sec'" +using assms unfolding proj_specific_def by fast + +lemma heterogeneous_secrets_anti_mono: + assumes "heterogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec" "Sec' \ Sec" + shows "heterogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec'" +using assms proj_specific_secrets_anti_mono unfolding heterogeneous\<^sub>l\<^sub>s\<^sub>t_def by metis + +lemma homogeneous_secrets_mono: + assumes "homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec'" "Sec' \ Sec" + shows "homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec" +using assms heterogeneous_secrets_anti_mono by blast + +lemma heterogeneous_supterm: + assumes "heterogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec" "t \ t'" + shows "heterogeneous\<^sub>l\<^sub>s\<^sub>t t' \ Sec" +proof - + obtain l1 l2 s1 s2 where *: + "l1 \ l2" + "s1 \ t" "proj_specific l1 s1 \ Sec" + "s2 \ t" "proj_specific l2 s2 \ Sec" + using assms(1) unfolding heterogeneous\<^sub>l\<^sub>s\<^sub>t_def by moura + thus ?thesis + using term.order_trans[OF *(2) assms(2)] term.order_trans[OF *(4) assms(2)] + by (auto simp add: heterogeneous\<^sub>l\<^sub>s\<^sub>t_def) +qed + +lemma homogeneous_subterm: + assumes "homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec" "t' \ t" + shows "homogeneous\<^sub>l\<^sub>s\<^sub>t t' \ Sec" +by (metis assms heterogeneous_supterm) + +lemma proj_specific_subterm: + assumes "t \ t'" "proj_specific l t' \ Sec" + shows "proj_specific l t \ Sec \ t \ Sec \ {} \\<^sub>c t" +using GSMP_subterm[OF _ assms(1)] assms(2) by (auto simp add: proj_specific_def) + +lemma heterogeneous_term_is_Fun: + assumes "heterogeneous\<^sub>l\<^sub>s\<^sub>t t A S" shows "\f T. t = Fun f T" +using assms by (cases t) (auto simp add: GSMP_def heterogeneous\<^sub>l\<^sub>s\<^sub>t_def proj_specific_def) + +lemma proj_specific_is_homogeneous: + assumes \: "\l l'. l \ l' \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \) Sec" + and t: "proj_specific l m \ Sec" + shows "homogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec" +proof + assume "heterogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec" + then obtain s l' where s: "s \ subterms m" "proj_specific l' s \ Sec" "l \ l'" + unfolding heterogeneous\<^sub>l\<^sub>s\<^sub>t_def by moura + hence "s \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" "s \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \)" + using t by (auto simp add: GSMP_def proj_specific_def) + hence "s \ Sec \ {} \\<^sub>c s" + using \ s(3) by (auto simp add: GSMP_disjoint_def) + thus False using s(2) by (auto simp add: proj_specific_def) +qed + +lemma deduct_synth_homogeneous: + assumes "{} \\<^sub>c t" + shows "homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec" +proof - + have "\s \ subterms t. {} \\<^sub>c s" using deduct_synth_subterm[OF assms] by auto + thus ?thesis unfolding heterogeneous\<^sub>l\<^sub>s\<^sub>t_def proj_specific_def by auto +qed + +lemma GSMP_proj_is_homogeneous: + assumes "\l l'. l \ l' \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l A) (trms_proj\<^sub>l\<^sub>s\<^sub>t l' A) Sec" + and "t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l A)" "t \ Sec" + shows "homogeneous\<^sub>l\<^sub>s\<^sub>t t A Sec" +proof + assume "heterogeneous\<^sub>l\<^sub>s\<^sub>t t A Sec" + then obtain s l' where s: "s \ subterms t" "proj_specific l' s A Sec" "l \ l'" + unfolding heterogeneous\<^sub>l\<^sub>s\<^sub>t_def by moura + hence "s \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l A)" "s \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l' A)" + using assms by (auto simp add: GSMP_def proj_specific_def) + hence "s \ Sec \ {} \\<^sub>c s" using assms(1) s(3) by (auto simp add: GSMP_disjoint_def) + thus False using s(2) by (auto simp add: proj_specific_def) +qed + +lemma homogeneous_is_not_proj_specific: + assumes "homogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec" + shows "\l::'lbl. \proj_specific l m \ Sec" +proof - + let ?P = "\l s. proj_specific l s \ Sec" + have "\l1 l2. \s1\subterms m. \s2\subterms m. (l1 \ l2 \ (\?P l1 s1 \ \?P l2 s2))" + using assms heterogeneous\<^sub>l\<^sub>s\<^sub>t_def by metis + then obtain l1 l2 where "l1 \ l2" "\?P l1 m \ \?P l2 m" + by (metis term.order_refl at_least_2_labels) + thus ?thesis by metis +qed + +lemma secrets_are_homogeneous: + assumes "\s \ Sec. P s \ (\s' \ subterms s. {} \\<^sub>c s' \ s' \ Sec)" "s \ Sec" "P s" + shows "homogeneous\<^sub>l\<^sub>s\<^sub>t s \ Sec" +using assms by (auto simp add: heterogeneous\<^sub>l\<^sub>s\<^sub>t_def proj_specific_def) + +lemma GSMP_is_homogeneous: + assumes \: "\l l'. l \ l' \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \) Sec" + and t: "t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" "t \ Sec" + shows "homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec" +proof - + obtain n where n: "t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n \)" using in_GSMP_in_proj[OF t(1)] by moura + show ?thesis using GSMP_proj_is_homogeneous[OF \ n t(2)] by metis +qed + +lemma GSMP_intersection_is_homogeneous: + assumes \: "\l l'. l \ l' \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \) Sec" + and t: "t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \)" "l \ l'" + shows "homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec" +proof - + define M where "M \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" + define M' where "M' \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \)" + + have t_in: "t \ M \ M'" "t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + using t(1) in_proj_in_GSMP[of t _ \] + unfolding M_def M'_def by blast+ + + have "M \ M' \ Sec \ {m. {} \\<^sub>c m}" + using \ GSMP_disjointE[of l \ l' Sec] t(2) + unfolding M_def M'_def by presburger + moreover have "subterms\<^sub>s\<^sub>e\<^sub>t (M \ M') = M \ M'" + using GSMP_subterms unfolding M_def M'_def by blast + ultimately have *: "subterms\<^sub>s\<^sub>e\<^sub>t (M \ M') \ Sec \ {m. {} \\<^sub>c m}" + by blast + + show ?thesis + proof (cases "t \ Sec") + case True thus ?thesis + using * secrets_are_homogeneous[of Sec "\t. t \ M \ M'", OF _ _ t_in(1)] + by fast + qed (metis GSMP_is_homogeneous[OF \ t_in(2)]) +qed + +lemma GSMP_is_homogeneous': + assumes \: "\l l'. l \ l' \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \) Sec" + and t: "t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + "t \ Sec - \{GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) | l1 l2. l1 \ l2}" + shows "homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec" +using GSMP_is_homogeneous[OF \ t(1)] GSMP_intersection_is_homogeneous[OF \] t(2) +by blast + +lemma declassified_secrets_are_homogeneous: + assumes \: "\l l'. l \ l' \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \) Sec" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and s: "s \ declassified\<^sub>l\<^sub>s\<^sub>t \ \" + shows "homogeneous\<^sub>l\<^sub>s\<^sub>t s \ Sec" +proof - + have s_in: "s \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + using declassified_proj_GSMP_subset[OF \, of \ label_witness1] + in_proj_in_GSMP[of s label_witness1 \] s + by blast + + show ?thesis + proof (cases "s \ Sec") + case True thus ?thesis + using declassified_subterms_secrets_subset[OF \ \] + secrets_are_homogeneous[of Sec "\s. s \ declassified\<^sub>l\<^sub>s\<^sub>t \ \", OF _ _ s] + by fast + qed (metis GSMP_is_homogeneous[OF \ s_in]) +qed + +lemma Ana_keys_homogeneous: + assumes \: "\l l'. l \ l' \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \) Sec" + and t: "t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + and k: "Ana t = (K,T)" "k \ set K" + "k \ Sec - \{GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) | l1 l2. l1 \ l2}" + shows "homogeneous\<^sub>l\<^sub>s\<^sub>t k \ Sec" +proof (cases "k \ \{GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) | l1 l2. l1 \ l2}") + case False + hence "k \ Sec" using k(3) by fast + moreover have "k \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + using t SMP.Ana[OF _ k(1,2)] Ana_keys_fv[OF k(1)] k(2) + unfolding GSMP_def by auto + ultimately show ?thesis using GSMP_is_homogeneous[OF \, of k] by metis +qed (use GSMP_intersection_is_homogeneous[OF \] in blast) + +subsection \Lemmata: Intruder Deduction Equivalences\ +lemma deduct_if_hom_deduct: "\M;A;S\ \\<^sub>h\<^sub>o\<^sub>m m \ M \ m" +using deduct_if_restricted_deduct unfolding intruder_deduct_hom_def by blast + +lemma hom_deduct_if_hom_ik: + assumes "\M;A;Sec\ \\<^sub>h\<^sub>o\<^sub>m m" "\m \ M. homogeneous\<^sub>l\<^sub>s\<^sub>t m A Sec \ m \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t A)" + shows "homogeneous\<^sub>l\<^sub>s\<^sub>t m A Sec \ m \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t A)" +proof - + let ?Q = "\m. homogeneous\<^sub>l\<^sub>s\<^sub>t m A Sec \ m \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t A)" + have "?Q t'" when "?Q t" "t' \ t" for t t' + using homogeneous_subterm[OF _ that(2)] GSMP_subterm[OF _ that(2)] that(1) + by blast + thus ?thesis + using assms(1) restricted_deduct_if_restricted_ik[OF _ assms(2)] + unfolding intruder_deduct_hom_def + by blast +qed + +lemma deduct_hom_if_synth: + assumes hom: "homogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec" "m \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + and m: "M \\<^sub>c m" + shows "\M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m m" +proof - + let ?Q = "\m. homogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec \ m \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + have "?Q t'" when "?Q t" "t' \ t" for t t' + using homogeneous_subterm[OF _ that(2)] GSMP_subterm[OF _ that(2)] that(1) + by blast + thus ?thesis + using assms deduct_restricted_if_synth[of ?Q] + unfolding intruder_deduct_hom_def + by blast +qed + +lemma hom_deduct_if_deduct: + assumes \: "par_comp \ Sec" + and M: "\m\M. homogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec \ m \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + and m: "M \ m" "m \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" +shows "\M; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m m" +proof - + let ?P = "\x. homogeneous\<^sub>l\<^sub>s\<^sub>t x \ Sec \ x \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + + have GSMP_hom: "homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec" when "t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" for t + using \ GSMP_is_homogeneous[of \ Sec t] + secrets_are_homogeneous[of Sec "\x. True" t \] that + unfolding par_comp_def by blast + + have P_Ana: "?P k" when "?P t" "Ana t = (K, T)" "k \ set K" for t K T k + using GSMP_Ana_key[OF _ that(2,3), of "trms\<^sub>l\<^sub>s\<^sub>t \"] \ that GSMP_hom + by presburger + + have P_subterm: "?P t'" when "?P t" "t' \ t" for t t' + using GSMP_subterm[of _ "trms\<^sub>l\<^sub>s\<^sub>t \"] homogeneous_subterm[of _ \ Sec] that + by blast + + have P_m: "?P m" + using GSMP_hom[OF m(2)] m(2) + by metis + + show ?thesis + using restricted_deduct_if_deduct'[OF M _ _ m(1) P_m] P_Ana P_subterm + unfolding intruder_deduct_hom_def + by fast +qed + + +subsection \Lemmata: Deduction Reduction of Parallel Composable Constraints\ +lemma par_comp_hom_deduct: + assumes \: "par_comp \ Sec" + and M: "\l. \m \ M l. homogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec" + "\l. M l \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" + "\l. Discl \ M l" + "Discl \ Sec \ {m. {} \\<^sub>c m}" + and Sec: "\l. \s \ Sec - Discl. \(\M l; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m s)" + and t: "\\l. M l; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t" + shows "t \ Sec - Discl" (is ?A) + "\l. t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) \ \M l; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t" (is ?B) +proof - + have M': "\l. \m \ M l. m \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + proof (intro allI ballI) + fix l m show "m \ M l \ m \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" using M(2) in_proj_in_GSMP[of m l \] by blast + qed + + show ?A ?B using t + proof (induction t rule: intruder_deduct_hom_induct) + case (AxiomH t) + then obtain lt where t_in_proj_ik: "t \ M lt" by moura + show t_not_Sec: "t \ Sec - Discl" + proof + assume "t \ Sec - Discl" + hence "\l. \(\M l;\;Sec\ \\<^sub>h\<^sub>o\<^sub>m t)" using Sec by auto + thus False using intruder_deduct_hom_AxiomH[OF t_in_proj_ik] by metis + qed + + have 1: "\l. t \ M l \ t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" + using M(2,3) AxiomH by auto + + have 3: "\l1 l2. l1 \ l2 \ t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) + \ {} \\<^sub>c t \ t \ Discl" + using \ t_not_Sec by (auto simp add: par_comp_def GSMP_disjoint_def) + + have 4: "homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec" "t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" using M(1) M' t_in_proj_ik by auto + + { fix l assume "t \ Discl" + hence "t \ M l" using M(3) by auto + hence "\M l; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t" by auto + } hence 5: "\l. t \ Discl \ \M l; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t" by metis + + show "\l. t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) \ \M l; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t" + by (metis (lifting) Int_iff empty_subsetI + 1 3 4 5 t_in_proj_ik + intruder_deduct_hom_AxiomH[of t _ \ Sec] + deduct_hom_if_synth[of t \ Sec "{}"] + ideduct_hom_mono[of "{}" \ Sec t]) + next + case (ComposeH T f) + show "\l. Fun f T \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) \ \M l; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m Fun f T" + proof (intro allI impI) + fix l + assume "Fun f T \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" + hence "\t. t \ set T \ t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" + using GSMP_subterm[OF _ subtermeqI''] by auto + thus "\M l; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m Fun f T" + using ComposeH.IH(2) intruder_deduct_hom_ComposeH[OF ComposeH.hyps(1,2) _ ComposeH.hyps(4,5)] + by simp + qed + thus "Fun f T \ Sec - Discl" + using Sec ComposeH.hyps(5) trms\<^sub>l\<^sub>s\<^sub>t_union[of \] GSMP_Union[of \] + by (metis (no_types, lifting) UN_iff) + next + case (DecomposeH t K T t\<^sub>i) + have ti_subt: "t\<^sub>i \ t" using Ana_subterm[OF DecomposeH.hyps(2)] \t\<^sub>i \ set T\ by auto + have t: "homogeneous\<^sub>l\<^sub>s\<^sub>t t \ Sec" "t \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + using DecomposeH.hyps(1) hom_deduct_if_hom_ik M(1) M' + by auto + have ti: "homogeneous\<^sub>l\<^sub>s\<^sub>t t\<^sub>i \ Sec" "t\<^sub>i \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + using intruder_deduct_hom_DecomposeH[OF DecomposeH.hyps] hom_deduct_if_hom_ik M(1) M' by auto + { fix l assume *: "t\<^sub>i \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" "t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" + hence "\k. k \ set K \ \M l;\;Sec\ \\<^sub>h\<^sub>o\<^sub>m k" + using GSMP_Ana_key[OF _ DecomposeH.hyps(2)] DecomposeH.IH(4) by auto + hence "\M l;\;Sec\ \\<^sub>h\<^sub>o\<^sub>m t\<^sub>i" "t\<^sub>i \ Sec - Discl" + using Sec DecomposeH.IH(2) *(2) + intruder_deduct_hom_DecomposeH[OF _ DecomposeH.hyps(2) _ \t\<^sub>i \ set T\] + by force+ + } moreover { + fix l1 l2 assume *: "t\<^sub>i \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \)" "t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \)" "l1 \ l2" + have "GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) Sec" + using *(3) \ by (simp add: par_comp_def) + hence "t\<^sub>i \ Sec \ {m. {} \\<^sub>c m}" + using GSMP_subterm[OF *(2) ti_subt] *(1) by (auto simp add: GSMP_disjoint_def) + moreover have "\k. k \ set K \ \M l2;\;Sec\ \\<^sub>h\<^sub>o\<^sub>m k" + using *(2) GSMP_Ana_key[OF _ DecomposeH.hyps(2)] DecomposeH.IH(4) by auto + ultimately have "t\<^sub>i \ Sec - Discl" "{} \\<^sub>c t\<^sub>i \ t\<^sub>i \ Discl" + using Sec DecomposeH.IH(2) *(2) + intruder_deduct_hom_DecomposeH[OF _ DecomposeH.hyps(2) _ \t\<^sub>i \ set T\] + by (metis (lifting), metis (no_types, lifting) DiffI Un_iff mem_Collect_eq) + hence "\M l1;\;Sec\ \\<^sub>h\<^sub>o\<^sub>m t\<^sub>i" "\M l2;\;Sec\ \\<^sub>h\<^sub>o\<^sub>m t\<^sub>i" "t\<^sub>i \ Sec - Discl" + using M(3,4) deduct_hom_if_synth[THEN ideduct_hom_mono] ti + by (meson intruder_deduct_hom_AxiomH empty_subsetI subsetCE)+ + } moreover have + "\l. t\<^sub>i \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" + "\l. t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" + using in_GSMP_in_proj[of _ \] ti(2) t(2) by presburger+ + ultimately show + "t\<^sub>i \ Sec - Discl" + "\l. t\<^sub>i \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \) \ \M l; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t\<^sub>i" + by (metis (no_types, lifting))+ + qed +qed + +lemma par_comp_deduct_proj: + assumes \: "par_comp \ Sec" + and M: "\l. \m\M l. homogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec" + "\l. M l \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" + "\l. Discl \ M l" + and t: "(\l. M l) \ t" "t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" + and Discl: "Discl \ Sec \ {m. {} \\<^sub>c m}" + shows "M l \ t \ (\s \ Sec - Discl. \l. M l \ s)" +using t +proof (induction t rule: intruder_deduct_induct) + case (Axiom t) + then obtain l' where t_in_ik_proj: "t \ M l'" by moura + show ?case + proof (cases "t \ Sec - Discl \ {} \\<^sub>c t") + case True + note T = True + show ?thesis + proof (cases "t \ Sec - Discl") + case True thus ?thesis using intruder_deduct.Axiom[OF t_in_ik_proj] by metis + next + case False thus ?thesis using T ideduct_mono[of "{}" t] by auto + qed + next + case False + hence "t \ Sec - Discl" "\{} \\<^sub>c t" "t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" using Axiom by auto + hence "(\l'. l \ l' \ t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \)) \ t \ Discl" + using \ unfolding GSMP_disjoint_def par_comp_def by auto + hence "(\l'. l \ l' \ t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l' \)) \ t \ M l \ {} \\<^sub>c t" using M by auto + thus ?thesis using Axiom deduct_if_synth[THEN ideduct_mono] t_in_ik_proj + by (metis (no_types, lifting) False M(2) intruder_deduct.Axiom subsetCE) + qed +next + case (Compose T f) + hence "Fun f T \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" using Compose.prems by auto + hence "\t. t \ set T \ t \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" unfolding GSMP_def by auto + hence IH: "\t. t \ set T \ M l \ t \ (\s \ Sec - Discl. \l. M l \ s)" + using Compose.IH by auto + show ?case + proof (cases "\t \ set T. M l \ t") + case True thus ?thesis by (metis intruder_deduct.Compose[OF Compose.hyps(1,2)]) + qed (metis IH) +next + case (Decompose t K T t\<^sub>i) + have hom_ik: "\l. \m\M l. homogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec \ m \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + proof (intro allI ballI conjI) + fix l m assume m: "m \ M l" + thus "homogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec" using M(1) by simp + show "m \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" using in_proj_in_GSMP[of m l \] M(2) m by blast + qed + + have par_comp_unfold: + "\l1 l2. l1 \ l2 \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) Sec" + using \ by (auto simp add: par_comp_def) + + note ti_GSMP = in_proj_in_GSMP[OF Decompose.prems(1)] + + have "\\l. M l; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t\<^sub>i" + using intruder_deduct.Decompose[OF Decompose.hyps] + hom_deduct_if_deduct[OF \, of "\l. M l"] hom_ik ti_GSMP (* ti_hom *) + by blast + hence "(\M l; \; Sec\ \\<^sub>h\<^sub>o\<^sub>m t\<^sub>i) \ (\s \ Sec-Discl. \l. \M l;\;Sec\ \\<^sub>h\<^sub>o\<^sub>m s)" + using par_comp_hom_deduct(2)[OF \ M Discl(1)] Decompose.prems(1) + by blast + thus ?case using deduct_if_hom_deduct[of _ \ Sec] by auto +qed + + +subsection \Theorem: Parallel Compositionality for Labeled Constraints\ +lemma par_comp_prefix: assumes "par_comp (A@B) M" shows "par_comp A M" +proof - + let ?L = "\l. trms_proj\<^sub>l\<^sub>s\<^sub>t l A \ trms_proj\<^sub>l\<^sub>s\<^sub>t l B" + have "\l1 l2. l1 \ l2 \ GSMP_disjoint (?L l1) (?L l2) M" + using assms unfolding par_comp_def + by (metis trms\<^sub>s\<^sub>t_append proj_append(2) unlabel_append) + hence "\l1 l2. l1 \ l2 \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 A) (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 A) M" + using SMP_union by (auto simp add: GSMP_def GSMP_disjoint_def) + thus ?thesis using assms unfolding par_comp_def by blast +qed + +theorem par_comp_constr_typed: + assumes \: "par_comp \ Sec" + and \: "\ \ \unlabel \\" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "(\l. (\ \ \proj_unl l \\)) \ (\\'. prefix \' \ \ (strand_leaks\<^sub>l\<^sub>s\<^sub>t \' Sec \))" +proof - + let ?L = "\\'. \t \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t \' \. \l. \{}; proj_unl l \'@[Send t]\\<^sub>d \" + have "\{}; unlabel \\\<^sub>d \" using \ by (simp add: constr_sem_d_def) + with \ have "(\l. \{}; proj_unl l \\\<^sub>d \) \ (\\'. prefix \' \ \ ?L \')" + proof (induction "unlabel \" arbitrary: \ rule: List.rev_induct) + case Nil + hence "\ = []" using unlabel_nil_only_if_nil by simp + thus ?case by auto + next + case (snoc b B \) + hence disj: "\l1 l2. l1 \ l2 \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) Sec" + by (auto simp add: par_comp_def) + + obtain a A n where a: "\ = A@[a]" "a = (ln n, b) \ a = (\, b)" + using unlabel_snoc_inv[OF snoc.hyps(2)[symmetric]] by moura + hence A: "\ = A@[(ln n, b)] \ \ = A@[(\, b)]" by metis + + have 1: "B = unlabel A" using a snoc.hyps(2) unlabel_append[of A "[a]"] by auto + have 2: "par_comp A Sec" using par_comp_prefix snoc.prems(1) a by metis + have 3: "\{}; unlabel A\\<^sub>d \" by (metis 1 snoc.prems(2) snoc.hyps(2) strand_sem_split(3)) + have IH: "(\l. \{}; proj_unl l A\\<^sub>d \) \ (\\'. prefix \' A \ ?L \')" + by (rule snoc.hyps(1)[OF 1 2 3]) + + show ?case + proof (cases "\l. \{}; proj_unl l A\\<^sub>d \") + case False + then obtain \' where \': "prefix \' A" "?L \'" by (metis IH) + hence "prefix \' (A@[a])" using a prefix_prefix[of _ A "[a]"] by simp + thus ?thesis using \'(2) a by auto + next + case True + note IH' = True + show ?thesis + proof (cases b) + case (Send t) + hence "ik\<^sub>s\<^sub>t (unlabel A) \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" + using a \\{}; unlabel \\\<^sub>d \\ strand_sem_split(2)[of "{}" "unlabel A" "unlabel [a]" \] + unlabel_append[of A "[a]"] + by auto + hence *: "(\l. (ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t \)) \ t \ \" + using proj_ik_union_is_unlabel_ik image_UN by metis + + have "ik\<^sub>s\<^sub>t (proj_unl l \) = ik\<^sub>s\<^sub>t (proj_unl l A)" for l + using Send A + by (metis append_Nil2 ik\<^sub>s\<^sub>t.simps(3) proj_unl_cons(3) proj_nil(2) + singleton_lst_proj(1,2) proj_ik_append) + hence **: "ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t \ \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" for l + using ik_proj_subst_GSMP_subset[OF \(3,4,2), of _ \] + by auto + + note Discl = + declassified_proj_ik_subset[of A \] + declassified_proj_GSMP_subset[OF \(3,4,2), of A] + declassified_secrets_subset[OF disj \(3,4,2)] + declassified_append[of A "[a]" \] + + have Sec: "ground Sec" + using \ by (auto simp add: par_comp_def) + + have "\m\ik\<^sub>s\<^sub>t (proj_unl l \) \\<^sub>s\<^sub>e\<^sub>t \. homogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec \ m \ Sec-declassified\<^sub>l\<^sub>s\<^sub>t A \" + "\m\ik\<^sub>s\<^sub>t (proj_unl l \) \\<^sub>s\<^sub>e\<^sub>t \. m \ GSMP (trms\<^sub>l\<^sub>s\<^sub>t \)" + "ik\<^sub>s\<^sub>t (proj_unl l \) \\<^sub>s\<^sub>e\<^sub>t \ \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" + for l + using declassified_secrets_are_homogeneous[OF disj \(3,4,2)] + GSMP_proj_is_homogeneous[OF disj] + ik_proj_subst_GSMP_subset[OF \(3,4,2), of _ \] + apply (metis (no_types, lifting) Diff_iff Discl(4) UnCI a(1) subsetCE) + using ik_proj_subst_GSMP_subset[OF \(3,4,2), of _ \] + GSMP_Union[of \] + by auto + moreover have "ik\<^sub>s\<^sub>t (proj_unl l [a]) = {}" for l + using Send proj_ik\<^sub>s\<^sub>t_is_proj_rcv_set[of _ "[a]"] a(2) by auto + ultimately have M: + "\l. \m\ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t \. homogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec \ m \ Sec-declassified\<^sub>l\<^sub>s\<^sub>t A \" + "\l. ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t \ \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" + using a(1) proj_ik_append[of _ A "[a]"] by auto + + have prefix_A: "prefix A \" using A by auto + + have "s \ \ = s" + when "s \ Sec" for s + using that Sec by auto + hence leakage_case: "\{}; proj_unl l A@[Send s]\\<^sub>d \" + when "s \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t A \" "ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t \ \ s" for l s + using that strand_sem_append(2) IH' by auto + + have proj_deduct_case_n: + "\m. m \ n \ \{}; proj_unl m (A@[a])\\<^sub>d \" + "ik\<^sub>s\<^sub>t (proj_unl n A) \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \ \ \{}; proj_unl n (A@[a])\\<^sub>d \" + when "a = (ln n, Send t)" + using that IH' proj_append(2)[of _ A] + by auto + + have proj_deduct_case_star: + "\{}; proj_unl l (A@[a])\\<^sub>d \" + when "a = (\, Send t)" "ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" for l + using that IH' proj_append(2)[of _ A] + by auto + + show ?thesis + proof (cases "\l. \m \ ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t \. m \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t A \") + case True + then obtain l s where ls: "s \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t A \" "ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t \ \ s" + using intruder_deduct.Axiom by metis + thus ?thesis using leakage_case prefix_A by blast + next + case False + hence M': "\l. \m\ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t \. homogeneous\<^sub>l\<^sub>s\<^sub>t m \ Sec" using M(1) by blast + + note deduct_proj_lemma = + par_comp_deduct_proj[OF snoc.prems(1) M' M(2) _ *, of "declassified\<^sub>l\<^sub>s\<^sub>t A \" n] + + from a(2) show ?thesis + proof + assume "a = (ln n, b)" + hence "a = (ln n, Send t)" "t \ \ \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n \)" + using Send a(1) trms_proj\<^sub>l\<^sub>s\<^sub>t_append[of n A "[a]"] + GSMP_wt_substI[OF _ \(3,4,2)] + by (metis, force) + hence + "a = (ln n, Send t)" + "\m. m \ n \ \{}; proj_unl m (A@[a])\\<^sub>d \" + "ik\<^sub>s\<^sub>t (proj_unl n A) \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \ \ \{}; proj_unl n (A@[a])\\<^sub>d \" + "t \ \ \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t n \)" + using proj_deduct_case_n + by auto + hence "(\l. \{}; proj_unl l \\\<^sub>d \) \ + (\s \ Sec-declassified\<^sub>l\<^sub>s\<^sub>t A \. \l. ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t \ \ s)" + using deduct_proj_lemma A a Discl + by fast + thus ?thesis using leakage_case prefix_A by metis + next + assume "a = (\, b)" + hence ***: "a = (\, Send t)" "t \ \ \ GSMP (trms_proj\<^sub>l\<^sub>s\<^sub>t l \)" for l + using Send a(1) GSMP_wt_substI[OF _ \(3,4,2)] + by (metis, force) + hence "t \ \ \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t A \ \ + t \ \ \ declassified\<^sub>l\<^sub>s\<^sub>t A \ \ + t \ \ \ {m. {} \\<^sub>c m}" + using snoc.prems(1) a(1) at_least_2_labels + unfolding par_comp_def GSMP_disjoint_def + by blast + thus ?thesis + proof (elim disjE) + assume "t \ \ \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t A \" + hence "\s \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t A \. \l. ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t \ \ s" + using deduct_proj_lemma ***(2) A a Discl + by blast + thus ?thesis using prefix_A leakage_case by blast + next + assume "t \ \ \ declassified\<^sub>l\<^sub>s\<^sub>t A \" + hence "ik\<^sub>s\<^sub>t (proj_unl l A) \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" for l + using intruder_deduct.Axiom Discl(1) by blast + thus ?thesis using proj_deduct_case_star[OF ***(1)] a(1) by fast + next + assume "t \ \ \ {m. {} \\<^sub>c m}" + hence "M \ t \ \" for M using ideduct_mono[OF deduct_if_synth] by blast + thus ?thesis using IH' a(1) ***(1) by fastforce + qed + qed + qed + next + case (Receive t) + hence "\{}; proj_unl l \\\<^sub>d \" for l + using IH' a proj_append(2)[of l A "[a]"] + unfolding unlabel_def proj_def by auto + thus ?thesis by metis + next + case (Equality ac t t') + hence *: "\M; [Equality ac t t']\\<^sub>d \" for M + using a \\{}; unlabel \\\<^sub>d \\ unlabel_append[of A "[a]"] + by auto + show ?thesis + using a proj_append(2)[of _ A "[a]"] Equality + strand_sem_append(2)[OF _ *] IH' + unfolding unlabel_def proj_def by auto + next + case (Inequality X F) + hence *: "\M; [Inequality X F]\\<^sub>d \" for M + using a \\{}; unlabel \\\<^sub>d \\ unlabel_append[of A "[a]"] + by auto + show ?thesis + using a proj_append(2)[of _ A "[a]"] Inequality + strand_sem_append(2)[OF _ *] IH' + unfolding unlabel_def proj_def by auto + qed + qed + qed + thus ?thesis using \(1) unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>t_def by (simp add: constr_sem_d_def) +qed + +theorem par_comp_constr: + assumes \: "par_comp \ Sec" "typing_cond (unlabel \)" + and \: "\ \ \unlabel \\" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + shows "\\\<^sub>\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\) \ (\\<^sub>\ \ \unlabel \\) \ + ((\l. (\\<^sub>\ \ \proj_unl l \\)) \ (\\'. prefix \' \ \ (strand_leaks\<^sub>l\<^sub>s\<^sub>t \' Sec \\<^sub>\)))" +proof - + from \(2) have *: + "wf\<^sub>s\<^sub>t {} (unlabel \)" + "fv\<^sub>s\<^sub>t (unlabel \) \ bvars\<^sub>s\<^sub>t (unlabel \) = {}" + "tfr\<^sub>s\<^sub>t (unlabel \)" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t (unlabel \))" + "Ana_invar_subst (ik\<^sub>s\<^sub>t (unlabel \) \ assignment_rhs\<^sub>s\<^sub>t (unlabel \))" + unfolding typing_cond_def tfr\<^sub>s\<^sub>t_def by metis+ + + obtain \\<^sub>\ where \\<^sub>\: "\\<^sub>\ \ \unlabel \\" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)" + using wt_attack_if_tfr_attack_d[OF * \(2,1)] by metis + + show ?thesis using par_comp_constr_typed[OF \(1) \\<^sub>\] \\<^sub>\ by auto +qed + + +subsection \Theorem: Parallel Compositionality for Labeled Protocols\ +subsubsection \Definitions: Labeled Protocols\ +text \ + We state our result on the level of protocol traces (i.e., the constraints reachable in a + symbolic execution of the actual protocol). Hence, we do not need to convert protocol strands + to intruder constraints in the following well-formedness definitions. +\ +definition wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s::"('fun,'var,'lbl) labeled_strand set \ bool" where + "wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s \ \ (\\ \ \. wf\<^sub>l\<^sub>s\<^sub>t {} \) \ (\\ \ \. \\' \ \. fv\<^sub>l\<^sub>s\<^sub>t \ \ bvars\<^sub>l\<^sub>s\<^sub>t \' = {})" + +definition wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s'::"('fun,'var,'lbl) labeled_strand set \ ('fun,'var,'lbl) labeled_strand \ bool" +where + "wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s' \ \ \ (\\' \ \. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t \) (unlabel \')) \ + (\\' \ \. \\'' \ \. fv\<^sub>l\<^sub>s\<^sub>t \' \ bvars\<^sub>l\<^sub>s\<^sub>t \'' = {}) \ + (\\' \ \. fv\<^sub>l\<^sub>s\<^sub>t \' \ bvars\<^sub>l\<^sub>s\<^sub>t \ = {}) \ + (\\' \ \. fv\<^sub>l\<^sub>s\<^sub>t \ \ bvars\<^sub>l\<^sub>s\<^sub>t \' = {})" + +definition typing_cond_prot where + "typing_cond_prot \

\ + wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s \

\ + tfr\<^sub>s\<^sub>e\<^sub>t (\(trms\<^sub>l\<^sub>s\<^sub>t ` \

)) \ + wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\(trms\<^sub>l\<^sub>s\<^sub>t ` \

)) \ + (\\ \ \

. list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel \)) \ + Ana_invar_subst (\(ik\<^sub>s\<^sub>t ` unlabel ` \

) \ \(assignment_rhs\<^sub>s\<^sub>t ` unlabel ` \

))" + +definition par_comp_prot where + "par_comp_prot \

Sec \ + (\l1 l2. l1 \ l2 \ + GSMP_disjoint (\\ \ \

. trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) (\\ \ \

. trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) Sec) \ + ground Sec \ (\s \ Sec. \s' \ subterms s. {} \\<^sub>c s' \ s' \ Sec) \ + typing_cond_prot \

" + + +subsubsection \Lemmata: Labeled Protocols\ +lemma wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s_eqs_wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s'[simp]: "wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s S = wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s' S []" +unfolding wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s_def wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s'_def unlabel_def by auto + +lemma par_comp_prot_impl_par_comp: + assumes "par_comp_prot \

Sec" "\ \ \

" + shows "par_comp \ Sec" +proof - + have *: "\l1 l2. l1 \ l2 \ + GSMP_disjoint (\\ \ \

. trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) (\\ \ \

. trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) Sec" + using assms(1) unfolding par_comp_prot_def by metis + { fix l1 l2::'lbl assume **: "l1 \ l2" + hence ***: "GSMP_disjoint (\\ \ \

. trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) (\\ \ \

. trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) Sec" + using * by auto + have "GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) Sec" + using GSMP_disjoint_subset[OF ***] assms(2) by auto + } hence "\l1 l2. l1 \ l2 \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 \) (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 \) Sec" by metis + thus ?thesis using assms unfolding par_comp_prot_def par_comp_def by metis +qed + +lemma typing_cond_prot_impl_typing_cond: + assumes "typing_cond_prot \

" "\ \ \

" + shows "typing_cond (unlabel \)" +proof - + have 1: "wf\<^sub>s\<^sub>t {} (unlabel \)" "fv\<^sub>l\<^sub>s\<^sub>t \ \ bvars\<^sub>l\<^sub>s\<^sub>t \ = {}" + using assms unfolding typing_cond_prot_def wf\<^sub>l\<^sub>s\<^sub>t\<^sub>s_def by auto + + have "tfr\<^sub>s\<^sub>e\<^sub>t (\(trms\<^sub>l\<^sub>s\<^sub>t ` \

))" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\(trms\<^sub>l\<^sub>s\<^sub>t ` \

))" + "trms\<^sub>l\<^sub>s\<^sub>t \ \ \(trms\<^sub>l\<^sub>s\<^sub>t ` \

)" + "SMP (trms\<^sub>l\<^sub>s\<^sub>t \) - Var`\ \ SMP (\(trms\<^sub>l\<^sub>s\<^sub>t ` \

)) - Var`\" + using assms SMP_mono[of "trms\<^sub>l\<^sub>s\<^sub>t \" "\(trms\<^sub>l\<^sub>s\<^sub>t ` \

)"] + unfolding typing_cond_prot_def + by (metis, metis, auto) + hence 2: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>t \)" and 3: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>t \)" + unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (meson subsetD)+ + + have 4: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel \)" using assms unfolding typing_cond_prot_def by auto + + have "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t (unlabel \) \ assignment_rhs\<^sub>s\<^sub>t (unlabel \)) \ + subterms\<^sub>s\<^sub>e\<^sub>t (\(ik\<^sub>s\<^sub>t ` unlabel ` \

) \ \(assignment_rhs\<^sub>s\<^sub>t ` unlabel ` \

))" + using assms(2) by auto + hence 5: "Ana_invar_subst (ik\<^sub>s\<^sub>t (unlabel \) \ assignment_rhs\<^sub>s\<^sub>t (unlabel \))" + using assms SMP_mono unfolding typing_cond_prot_def Ana_invar_subst_def by (meson subsetD) + + show ?thesis using 1 2 3 4 5 unfolding typing_cond_def tfr\<^sub>s\<^sub>t_def by blast +qed + + +subsubsection \Theorem: Parallel Compositionality for Labeled Protocols\ +definition component_prot where + "component_prot n P \ (\l \ P. \s \ set l. is_LabelN n s \ is_LabelS s)" + +definition composed_prot where + "composed_prot \

\<^sub>i \ {\. \n. proj n \ \ \

\<^sub>i n}" + +definition component_secure_prot where + "component_secure_prot n P Sec attack \ (\\ \ P. suffix [(ln n, Send (Fun attack []))] \ \ + (\\\<^sub>\. (interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)) \ + \(\\<^sub>\ \ \proj_unl n \\) \ + (\\'. prefix \' \ \ + (\t \ Sec-declassified\<^sub>l\<^sub>s\<^sub>t \' \\<^sub>\. \(\\<^sub>\ \ \proj_unl n \'@[Send t]\)))))" + +definition component_leaks where + "component_leaks n \ Sec \ (\\' \\<^sub>\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\) \ + prefix \' \ \ (\t \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t \' \\<^sub>\. (\\<^sub>\ \ \proj_unl n \'@[Send t]\)))" + +definition unsat where + "unsat \ \ (\\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ \(\ \ \unlabel \\))" + +theorem par_comp_constr_prot: + assumes P: "P = composed_prot Pi" "par_comp_prot P Sec" "\n. component_prot n (Pi n)" + and left_secure: "component_secure_prot n (Pi n) Sec attack" + shows "\\ \ P. suffix [(ln n, Send (Fun attack []))] \ \ + unsat \ \ (\m. n \ m \ component_leaks m \ Sec)" +proof - + { fix \ \' assume \: "\ = \'@[(ln n, Send (Fun attack []))]" "\ \ P" + let ?P = "\\' \\<^sub>\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\) \ prefix \' \ \ + (\t \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t \' \\<^sub>\. \m. n \ m \ (\\<^sub>\ \ \proj_unl m \'@[Send t]\))" + have tcp: "typing_cond_prot P" using P(2) unfolding par_comp_prot_def by simp + have par_comp: "par_comp \ Sec" "typing_cond (unlabel \)" + using par_comp_prot_impl_par_comp[OF P(2) \(2)] + typing_cond_prot_impl_typing_cond[OF tcp \(2)] + by metis+ + + have "unlabel (proj n \) = proj_unl n \" "proj_unl n \ = proj_unl n (proj n \)" + "\A. A \ Pi n \ proj n A = A" + "proj n \ = (proj n \')@[(ln n, Send (Fun attack []))]" + using P(1,3) \ by (auto simp add: proj_def unlabel_def component_prot_def composed_prot_def) + moreover have "proj n \ \ Pi n" + using P(1) \ unfolding composed_prot_def by blast + moreover { + fix A assume "prefix A \" + hence *: "prefix (proj n A) (proj n \)" unfolding proj_def prefix_def by force + hence "proj_unl n A = proj_unl n (proj n A)" + "\I. declassified\<^sub>l\<^sub>s\<^sub>t A I = declassified\<^sub>l\<^sub>s\<^sub>t (proj n A) I" + unfolding proj_def declassified\<^sub>l\<^sub>s\<^sub>t_def by auto + hence "\B. prefix B (proj n \) \ proj_unl n A = proj_unl n B \ + (\I. declassified\<^sub>l\<^sub>s\<^sub>t A I = declassified\<^sub>l\<^sub>s\<^sub>t B I)" + using * by metis + + } + ultimately have *: + "\\\<^sub>\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\) \ + \(\\<^sub>\ \ \proj_unl n \\) \ (\\'. prefix \' \ \ + (\t \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t \' \\<^sub>\. \(\\<^sub>\ \ \proj_unl n \'@[Send t]\)))" + using left_secure unfolding component_secure_prot_def composed_prot_def suffix_def by metis + { fix \ assume \: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "\ \ \unlabel \\" + obtain \\<^sub>\ where \\<^sub>\: + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)" + "\\'. prefix \' \ \ (strand_leaks\<^sub>l\<^sub>s\<^sub>t \' Sec \\<^sub>\)" + using par_comp_constr[OF par_comp \(2,1)] * by moura + hence "\\'. prefix \' \ \ (\t \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t \' \\<^sub>\. \m. + n \ m \ (\\<^sub>\ \ \proj_unl m \'@[Send t]\))" + using \\<^sub>\(4) * unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>t_def by metis + hence ?P using \\<^sub>\(1,2,3) by auto + } hence "unsat \ \ (\m. n \ m \ component_leaks m \ Sec)" + by (metis unsat_def component_leaks_def) + } thus ?thesis unfolding suffix_def by metis +qed + +end + + +subsection \Automated GSMP Disjointness\ +locale labeled_typed_model' = typed_model' arity public Ana \ + + labeled_typed_model arity public Ana \ label_witness1 label_witness2 + for arity::"'fun \ nat" + and public::"'fun \ bool" + and Ana::"('fun,(('fun,'atom::finite) term_type \ nat)) term + \ (('fun,(('fun,'atom) term_type \ nat)) term list + \ ('fun,(('fun,'atom) term_type \ nat)) term list)" + and \::"('fun,(('fun,'atom) term_type \ nat)) term \ ('fun,'atom) term_type" + and label_witness1 label_witness2::'lbl +begin + +lemma GSMP_disjointI: + fixes A' A B B'::"('fun, ('fun, 'atom) term \ nat) term list" + defines "f \ \M. {t \ \ | t \. t \ M \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}}" + and "\ \ var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t (set A)))" + assumes A'_wf: "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) A'" + and B'_wf: "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) B'" + and A_inst: "has_all_wt_instances_of \ (set A') (set A)" + and B_inst: "has_all_wt_instances_of \ (set B') (set (B \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \))" + and A_SMP_repr: "finite_SMP_representation arity Ana \ A" + and B_SMP_repr: "finite_SMP_representation arity Ana \ (B \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" + and AB_trms_disj: + "\t \ set A. \s \ set (B \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \). \ t = \ s \ mgu t s \ None \ + (intruder_synth' public arity {} t \ intruder_synth' public arity {} s) \ + ((\u \ Sec. is_wt_instance_of_cond \ t u) \ (\u \ Sec. is_wt_instance_of_cond \ s u))" + and Sec_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s Sec" + shows "GSMP_disjoint (set A') (set B') ((f Sec) - {m. {} \\<^sub>c m})" +proof - + have A_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set A)" and B_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set (B \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \))" + and A'_wf': "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set A')" and B'_wf': "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set B')" + using finite_SMP_representationD[OF A_SMP_repr] + finite_SMP_representationD[OF B_SMP_repr] + A'_wf B'_wf + unfolding wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[symmetric] wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric] list_all_iff by blast+ + + have AB_fv_disj: "fv\<^sub>s\<^sub>e\<^sub>t (set A) \ fv\<^sub>s\<^sub>e\<^sub>t (set (B \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)) = {}" + using var_rename_fv_set_disjoint'[of "set A" "set B", unfolded \_def[symmetric]] by simp + + have "GSMP_disjoint (set A) (set (B \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)) ((f Sec) - {m. {} \\<^sub>c m})" + using ground_SMP_disjointI[OF AB_fv_disj A_SMP_repr B_SMP_repr Sec_wf AB_trms_disj] + unfolding GSMP_def GSMP_disjoint_def f_def by blast + moreover have "SMP (set A') \ SMP (set A)" "SMP (set B') \ SMP (set (B \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \))" + using SMP_I'[OF A'_wf' A_wf A_inst] SMP_SMP_subset[of "set A'" "set A"] + SMP_I'[OF B'_wf' B_wf B_inst] SMP_SMP_subset[of "set B'" "set (B \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)"] + by blast+ + ultimately show ?thesis unfolding GSMP_def GSMP_disjoint_def by auto +qed + +end + +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/ROOT b/thys/Stateful_Protocol_Composition_and_Typing/ROOT new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/ROOT @@ -0,0 +1,13 @@ +chapter AFP + +session "Stateful_Protocol_Composition_and_Typing" (AFP) = "First_Order_Terms" + + options [timeout = 2400] + directories + "examples" + theories + "Stateful_Compositionality" + "Examples" + document_files + "root.tex" + "root.bib" + diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Compositionality.thy b/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Compositionality.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Compositionality.thy @@ -0,0 +1,3086 @@ +(* +(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: Stateful_Compositionality.thy + Author: Andreas Viktor Hess, DTU +*) + + +section \Stateful Protocol Compositionality\ + +theory Stateful_Compositionality +imports Stateful_Typing Parallel_Compositionality Labeled_Stateful_Strands +begin + +subsection \Small Lemmata\ +lemma (in typed_model) wt_subst_sstp_vars_type_subset: + fixes a::"('fun,'var) stateful_strand_step" + assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and "\t \ subst_range \. fv t = {} \ (\x. t = Var x)" + shows "\ ` Var ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \ \ ` Var ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" (is ?A) + and "\ ` Var ` set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)) = \ ` Var ` set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a)" (is ?B) + and "\ ` Var ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \ \ ` Var ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" (is ?C) +proof - + show ?A + proof + fix \ assume \: "\ \ \ ` Var ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + then obtain x where x: "x \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" "\ (Var x) = \" by moura + + show "\ \ \ ` Var ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" + proof (cases "x \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a") + case False + hence "\y \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. \ y = Var x" + proof (cases a) + case (NegChecks X F G) + hence *: "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)" + "x \ set X" + using fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck(1)[of X "F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \" "G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \"] + fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck(1)[of X F G] False x(1) + by fastforce+ + + obtain y where y: "y \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" "x \ fv (rm_vars (set X) \ y)" + using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_obtain_var[of _ _ "rm_vars (set X) \"] + fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_obtain_var[of _ _ "rm_vars (set X) \"] + *(1) + by blast + + have "fv (rm_vars (set X) \ z) = {} \ (\u. rm_vars (set X) \ z = Var u)" for z + using assms(2) rm_vars_img_subset[of "set X" \] by blast + hence "rm_vars (set X) \ y = Var x" using y(2) by fastforce + hence "\y \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. rm_vars (set X) \ y = Var x" + using y fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck(1)[of X F G] NegChecks *(2) by fastforce + thus ?thesis by (metis (full_types) *(2) term.inject(1)) + qed (use assms(2) x(1) subst_apply_img_var'[of x _ \] in fastforce)+ + then obtain y where y: "y \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" "\ y = Var x" by moura + hence "\ (Var y) = \" using x(2) assms(1) by (simp add: wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + thus ?thesis using y(1) by auto + qed (use x in auto) + qed + + show ?B by (metis bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst) + + show ?C + proof + fix \ assume \: "\ \ \ ` Var ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + then obtain x where x: "x \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" "\ (Var x) = \" by moura + + show "\ \ \ ` Var ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" + proof (cases "x \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a") + case False + hence "\y \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. \ y = Var x" + proof (cases a) + case (NegChecks X F G) + hence *: "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)" + "x \ set X" + using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck[of X "F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \" "G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \"] + vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck[of X F G] False x(1) + by (fastforce, blast) + + obtain y where y: "y \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" "x \ fv (rm_vars (set X) \ y)" + using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_obtain_var[of _ _ "rm_vars (set X) \"] + fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_obtain_var[of _ _ "rm_vars (set X) \"] + *(1) + by blast + + have "fv (rm_vars (set X) \ z) = {} \ (\u. rm_vars (set X) \ z = Var u)" for z + using assms(2) rm_vars_img_subset[of "set X" \] by blast + hence "rm_vars (set X) \ y = Var x" using y(2) by fastforce + hence "\y \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. rm_vars (set X) \ y = Var x" + using y vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck[of X F G] NegChecks by blast + thus ?thesis by (metis (full_types) *(2) term.inject(1)) + qed (use assms(2) x(1) subst_apply_img_var'[of x _ \] in fastforce)+ + then obtain y where y: "y \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" "\ y = Var x" by moura + hence "\ (Var y) = \" using x(2) assms(1) by (simp add: wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + thus ?thesis using y(1) by auto + qed (use x in auto) + qed +qed + +lemma (in typed_model) wt_subst_lsst_vars_type_subset: + fixes A::"('fun,'var,'a) labeled_stateful_strand" + assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and "\t \ subst_range \. fv t = {} \ (\x. t = Var x)" + shows "\ ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ \ ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" (is ?A) + and "\ ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = \ ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" (is ?B) + and "\ ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) \ \ ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" (is ?C) +proof - + have "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \ vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \ fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)) \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b) \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + when "a = (l,b)" for a l b and A::"('fun,'var,'a) labeled_stateful_strand" + using that unlabel_Cons(1)[of l b A] unlabel_subst[of "a#A" \] + subst_lsst_cons[of a A \] subst_sst_cons[of b "unlabel A" \] + subst_apply_labeled_stateful_strand_step.simps(1)[of l b \] + vars\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons[of l b A] vars\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons[of l "b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" "A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \"] + fv\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons[of l b A] fv\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons[of l "b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" "A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \"] + bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons[of l b A] bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons[of l "b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" "A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \"] + by simp_all + hence *: "\ ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = + \ ` Var ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \ \ ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + "\ ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = \ ` Var ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \ \ ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + "\ ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = + \ ` Var ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \ \ ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + "\ ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = \ ` Var ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \ \ ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + "\ ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = + \ ` Var ` set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)) \ \ ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + "\ ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = \ ` Var ` set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b) \ \ ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + when "a = (l,b)" for a l b and A::"('fun,'var,'a) labeled_stateful_strand" + using that by fast+ + + have "?A \ ?B \ ?C" + proof (induction A) + case (Cons a A) + obtain l b where a: "a = (l,b)" by (metis surj_pair) + + show ?case + using Cons.IH wt_subst_sstp_vars_type_subset[OF assms, of b] *[OF a, of A] + by (metis Un_mono) + qed simp + thus ?A ?B ?C by metis+ +qed + +lemma (in stateful_typed_model) fv_pair_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subset: + assumes "d \ set D" + shows "fv (pair (snd d)) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" +using assms unfolding pair_def by (induct D) (auto simp add: unlabel_def) + +lemma (in stateful_typed_model) labeled_sat_ineq_lift: + assumes "\M; map (\d. \X\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t) [d\dbproj i D. d \ set Di]\\<^sub>d \" + (is "?R1 D") + and "\(j,p) \ {(i,t,s)} \ set D \ set Di. \(k,q) \ {(i,t,s)} \ set D \ set Di. + (\\. Unifier \ (pair p) (pair q)) \ j = k" (is "?R2 D") + shows "\M; map (\d. \X\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t) [d\D. d \ set Di]\\<^sub>d \" +using assms +proof (induction D) + case (Cons dl D) + obtain d l where dl: "dl = (l,d)" by (metis surj_pair) + + have 1: "?R1 D" + proof (cases "i = l") + case True thus ?thesis using Cons.prems(1) dl by (cases "dl \ set Di") auto + next + case False thus ?thesis using Cons.prems(1) dl by auto + qed + + have "set D \ set (dl#D)" by auto + hence 2: "?R2 D" using Cons.prems(2) by blast + + have "i \ l \ dl \ set Di \ \M; [\X\\\: [(pair (t,s), pair (snd dl))]\\<^sub>s\<^sub>t]\\<^sub>d \" + using Cons.prems(1) dl by (auto simp add: ineq_model_def) + moreover have "\\. Unifier \ (pair (t,s)) (pair d) \ i = l" + using Cons.prems(2) dl by force + ultimately have 3: "dl \ set Di \ \M; [\X\\\: [(pair (t,s), pair (snd dl))]\\<^sub>s\<^sub>t]\\<^sub>d \" + using strand_sem_not_unif_is_sat_ineq[of "pair (t,s)" "pair d"] dl by fastforce + + show ?case using Cons.IH[OF 1 2] 3 dl by auto +qed simp + +lemma (in stateful_typed_model) labeled_sat_ineq_dbproj: + assumes "\M; map (\d. \X\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t) [d\D. d \ set Di]\\<^sub>d \" + (is "?P D") + shows "\M; map (\d. \X\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t) [d\dbproj i D. d \ set Di]\\<^sub>d \" + (is "?Q D") +using assms +proof (induction D) + case (Cons di D) + obtain d j where di: "di = (j,d)" by (metis surj_pair) + + have "?P D" using Cons.prems by (cases "di \ set Di") auto + hence IH: "?Q D" by (metis Cons.IH) + + show ?case using di IH + proof (cases "i = j \ di \ set Di") + case True + have 1: "\M; [\X\\\: [(pair (t,s), pair (snd di))]\\<^sub>s\<^sub>t]\\<^sub>d \" + using Cons.prems True by auto + have 2: "dbproj i (di#D) = di#dbproj i D" using True dbproj_Cons(1) di by auto + show ?thesis using 1 2 IH by auto + qed auto +qed simp + +lemma (in stateful_typed_model) labeled_sat_ineq_dbproj_sem_equiv: + assumes "\(j,p) \ ((\(t, s). (i, t, s)) ` set F') \ set D. + \(k,q) \ ((\(t, s). (i, t, s)) ` set F') \ set D. + (\\. Unifier \ (pair p) (pair q)) \ j = k" + and "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (map snd D) \ set X = {}" + shows "\M; map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D))\\<^sub>d \ \ + \M; map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))\\<^sub>d \" +proof - + let ?A = "set (map snd D) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + let ?B = "set (map snd (dbproj i D)) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + let ?C = "set (map snd D) - set (map snd (dbproj i D))" + let ?F = "(\(t, s). (i, t, s)) ` set F'" + let ?P = "\\. subst_domain \ = set X \ ground (subst_range \)" + + have 1: "\(t, t') \ set (map snd D). (fv t \ fv t') \ set X = {}" + "\(t, t') \ set (map snd (dbproj i D)). (fv t \ fv t') \ set X = {}" + using assms(2) dbproj_subset[of i D] unfolding unlabel_def by force+ + + have 2: "?B \ ?A" by auto + + have 3: "\Unifier \ (pair f) (pair d)" + when f: "f \ set F'" and d: "d \ set (map snd D) - set (map snd (dbproj i D))" + for f d and \::"('fun,'var) subst" + proof - + obtain k where k: "(k,d) \ set D - set (dbproj i D)" + using d by force + + have "(i,f) \ ((\(t, s). (i, t, s)) ` set F') \ set D" + "(k,d) \ ((\(t, s). (i, t, s)) ` set F') \ set D" + using f k by auto + hence "i = k" when "Unifier \ (pair f) (pair d)" for \ + using assms(1) that by blast + moreover have "k \ i" using k d by simp + ultimately show ?thesis by metis + qed + + have "f \\<^sub>p \ \ d \\<^sub>p \" + when "f \ set F'" "d \ ?C" for f d and \::"('fun,'var) subst" + by (metis fun_pair_eq_subst 3[OF that]) + hence "f \\<^sub>p (\ \\<^sub>s \) \ ?C \\<^sub>p\<^sub>s\<^sub>e\<^sub>t (\ \\<^sub>s \)" + when "f \ set F'" for f and \::"('fun,'var) subst" + using that by blast + moreover have "?C \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ = ?C \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + when "?P \" for \ + using assms(2) that pairs_substI[of \ "(set (map snd D) - set (map snd (dbproj i D)))"] + by blast + ultimately have 4: "f \\<^sub>p (\ \\<^sub>s \) \ ?C \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + when "f \ set F'" "?P \" for f and \::"('fun,'var) subst" + by (metis that subst_pairs_compose) + + { fix f and \::"('fun,'var) subst" + assume "f \ set F'" "?P \" + hence "f \\<^sub>p (\ \\<^sub>s \) \ ?C \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" by (metis 4) + hence "f \\<^sub>p (\ \\<^sub>s \) \ ?A - ?B" by force + } hence 5: "\f\set F'. \\. ?P \ \ f \\<^sub>p (\ \\<^sub>s \) \ ?A - ?B" by metis + + show ?thesis + using negchecks_model_db_subset[OF 2] + negchecks_model_db_supset[OF 2 5] + tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_sem_equiv[OF 1(1)] + tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_sem_equiv[OF 1(2)] + tr_NegChecks_constr_iff(1) + strand_sem_eq_defs(2) + by (metis (no_types, lifting)) +qed + +lemma (in stateful_typed_model) labeled_sat_eqs_list_all: + assumes "\(j, p) \ {(i,t,s)} \ set D. \(k,q) \ {(i,t,s)} \ set D. + (\\. Unifier \ (pair p) (pair q)) \ j = k" (is "?P D") + and "\M; map (\d. \ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t) D\\<^sub>d \" (is "?Q D") + shows "list_all (\d. fst d = i) D" +using assms +proof (induction D rule: List.rev_induct) + case (snoc di D) + obtain d j where di: "di = (j,d)" by (metis surj_pair) + have "pair (t,s) \ \ = pair d \ \" using di snoc.prems(2) by auto + hence "\\. Unifier \ (pair (t,s)) (pair d)" by auto + hence 1: "i = j" using snoc.prems(1) di by fastforce + + have "set D \ set (D@[di])" by auto + hence 2: "?P D" using snoc.prems(1) by blast + + have 3: "?Q D" using snoc.prems(2) by auto + + show ?case using di 1 snoc.IH[OF 2 3] by simp +qed simp + +lemma (in stateful_typed_model) labeled_sat_eqs_subseqs: + assumes "Di \ set (subseqs D)" + and "\(j, p) \ {(i,t,s)} \ set D. \(k, q) \ {(i,t,s)} \ set D. + (\\. Unifier \ (pair p) (pair q)) \ j = k" (is "?P D") + and "\M; map (\d. \ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t) Di\\<^sub>d \" + shows "Di \ set (subseqs (dbproj i D))" +proof - + have "set Di \ set D" by (rule subseqs_subset[OF assms(1)]) + hence "?P Di" using assms(2) by blast + thus ?thesis using labeled_sat_eqs_list_all[OF _ assms(3)] subseqs_mem_dbproj[OF assms(1)] by simp +qed + +lemma (in stateful_typed_model) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p: + assumes "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel S)" + shows "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S))" +using assms +proof (induction S) + case (Cons a S) + have prems: "tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a)" "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel S)" + using Cons.prems unlabel_Cons(2)[of a S] by simp_all + hence IH: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S))" by (metis Cons.IH) + + obtain l b where a: "a = (l,b)" by (metis surj_pair) + with Cons show ?case + proof (cases b) + case (Equality c t t') + hence "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#S) = a#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S" by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_Cons(3) a) + thus ?thesis using a IH prems by fastforce + next + case (NegChecks X F G) + hence "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#S) = a#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S" by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_Cons(7) a) + thus ?thesis using a IH prems by fastforce + qed auto +qed simp + +lemma (in stateful_typed_model) setops\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq: + "setops\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)) = setops\<^sub>s\<^sub>s\<^sub>t (unlabel 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_all add: setops\<^sub>s\<^sub>s\<^sub>t_def) +qed simp + + +subsection \Locale Setup and Definitions\ +locale labeled_stateful_typed_model = + stateful_typed_model arity public Ana \ Pair ++ labeled_typed_model arity public Ana \ label_witness1 label_witness2 + for arity::"'fun \ nat" + and public::"'fun \ bool" + and Ana::"('fun,'var) term \ (('fun,'var) term list \ ('fun,'var) term list)" + and \::"('fun,'var) term \ ('fun,'atom::finite) term_type" + and Pair::"'fun" + and label_witness1::"'lbl" + and label_witness2::"'lbl" +begin + +definition lpair where + "lpair lp \ case lp of (i,p) \ (i,pair p)" + +lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_pair_image[simp]: + "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,send\t\)) = {}" + "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,receive\t\)) = {}" + "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,\ac: t \ t'\)) = {}" + "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,insert\t,s\)) = {(i, pair (t,s))}" + "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,delete\t,s\)) = {(i, pair (t,s))}" + "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,\ac: t \ s\)) = {(i, pair (t,s))}" + "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,\X\\\: F \\: F'\)) = ((\(t,s). (i, pair (t,s))) ` set F')" +unfolding lpair_def by force+ + +definition par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t where + "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\::('fun,'var,'lbl) labeled_stateful_strand) (Secrets::('fun,'var) terms) \ + (\l1 l2. l1 \ l2 \ + GSMP_disjoint (trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \)) + (trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \)) Secrets) \ + ground Secrets \ (\s \ Secrets. \s' \ subterms s. {} \\<^sub>c s' \ s' \ Secrets) \ + (\(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t \. \(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t \. + (\\. Unifier \ (pair p) (pair q)) \ i = j)" + +definition declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t where + "declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ \ {t. \\, receive\t\\ \ set \} \\<^sub>s\<^sub>e\<^sub>t \" + +definition strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t ("_ leaks _ under _") where + "(\::('fun,'var,'lbl) labeled_stateful_strand) leaks Secrets under \ \ + (\t \ Secrets - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \. \n. \ \\<^sub>s (proj_unl n \@[send\t\]))" + +definition typing_cond\<^sub>s\<^sub>s\<^sub>t where + "typing_cond\<^sub>s\<^sub>s\<^sub>t \ \ wf\<^sub>s\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t \) \ tfr\<^sub>s\<^sub>s\<^sub>t \" + +type_synonym ('a,'b,'c) labeleddbstate = "('c strand_label \ (('a,'b) term \ ('a,'b) term)) set" +type_synonym ('a,'b,'c) labeleddbstatelist = "('c strand_label \ (('a,'b) term \ ('a,'b) term)) list" + +text \ + For proving the compositionality theorem for stateful constraints the idea is to first define a + variant of the reduction technique that was used to establish the stateful typing result. This + variant performs database-state projections, and it allows us to reduce the compositionality + problem for stateful constraints to ordinary constraints. +\ +fun tr\<^sub>p\<^sub>c:: + "('fun,'var,'lbl) labeled_stateful_strand \ ('fun,'var,'lbl) labeleddbstatelist + \ ('fun,'var,'lbl) labeled_strand list" +where + "tr\<^sub>p\<^sub>c [] D = [[]]" +| "tr\<^sub>p\<^sub>c ((i,send\t\)#A) D = map ((#) (i,send\t\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>c A D)" +| "tr\<^sub>p\<^sub>c ((i,receive\t\)#A) D = map ((#) (i,receive\t\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>c A D)" +| "tr\<^sub>p\<^sub>c ((i,\ac: t \ t'\)#A) D = map ((#) (i,\ac: t \ t'\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>c A D)" +| "tr\<^sub>p\<^sub>c ((i,insert\t,s\)#A) D = tr\<^sub>p\<^sub>c A (List.insert (i,(t,s)) D)" +| "tr\<^sub>p\<^sub>c ((i,delete\t,s\)#A) D = ( + concat (map (\Di. map (\B. (map (\d. (i,\check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di)@ + (map (\d. (i,\[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) + [d\dbproj i D. d \ set Di])@B) + (tr\<^sub>p\<^sub>c A [d\D. d \ set Di])) + (subseqs (dbproj i D))))" +| "tr\<^sub>p\<^sub>c ((i,\ac: t \ s\)#A) D = + concat (map (\B. map (\d. (i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)#B) (dbproj i D)) (tr\<^sub>p\<^sub>c A D))" +| "tr\<^sub>p\<^sub>c ((i,\X\\\: F \\: F' \)#A) D = + map ((@) (map (\G. (i,\X\\\: (F@G)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D))))) (tr\<^sub>p\<^sub>c A D)" + + +subsection \Small Lemmata\ +lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_nil: + assumes "ground Sec" "\s \ Sec. \s'\subterms s. {} \\<^sub>c s' \ s' \ Sec" + shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] Sec" +using assms unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by simp + +lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subset: + assumes A: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A Sec" + and BA: "set B \ set A" + shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t B Sec" +proof - + let ?L = "\n A. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n A)" + + have "?L n B \ ?L n A" for n + using trms\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_set_mono(2)[OF BA]] setops\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_set_mono(2)[OF BA]] + by blast + hence "GSMP_disjoint (?L m B) (?L n B) Sec" when nm: "m \ n" for n m::'lbl + using GSMP_disjoint_subset[of "?L m A" "?L n A" Sec "?L m B" "?L n B"] A nm + unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by simp + thus "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t B Sec" + using A setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_mono[OF BA] + unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by blast +qed + +lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_split: + assumes "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) Sec" + shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A Sec" "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t B Sec" +using par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subset[OF assms] by simp_all + +lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj: + assumes "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A Sec" + shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) Sec" +using par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subset[OF assms] by simp + +lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t: + assumes A: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A S" + shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) S" +proof (unfold par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def case_prod_unfold; intro conjI) + show "ground S" "\s \ S. \s' \ subterms s. {} \\<^sub>c s' \ s' \ S" + using A unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by fast+ + + let ?M = "\l B. (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l B) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l B))" + let ?P = "\B. \l1 l2. l1 \ l2 \ GSMP_disjoint (?M l1 B) (?M l2 B) S" + let ?Q = "\B. \p \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. \q \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. + (\\. Unifier \ (pair (snd p)) (pair (snd q))) \ fst p = fst q" + + have "?P A" "?Q A" using A unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def case_prod_unfold by blast+ + thus "?P (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" "?Q (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + by (metis setops\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq proj_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t, + metis setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq) +qed + +lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst: + assumes A: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A S" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "subst_domain \ \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = {}" + shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) S" +proof (unfold par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def case_prod_unfold; intro conjI) + show "ground S" "\s \ S. \s' \ subterms s. {} \\<^sub>c s' \ s' \ S" + using A unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by fast+ + + let ?N = "\l B. trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l B) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l B)" + define M where "M \ \l (B::('fun,'var,'lbl) labeled_stateful_strand). ?N l B" + let ?P = "\p q. \\. Unifier \ (pair (snd p)) (pair (snd q))" + let ?Q = "\B. \p \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. \q \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. ?P p q \ fst p = fst q" + let ?R = "\B. \l1 l2. l1 \ l2 \ GSMP_disjoint (?N l1 B) (?N l2 B) S" + + have d: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l A) \ subst_domain \ = {}" for l + using \(3) unfolding proj_def bvars\<^sub>s\<^sub>s\<^sub>t_def unlabel_def by auto + + have "GSMP_disjoint (M l1 A) (M l2 A) S" when l: "l1 \ l2" for l1 l2 + using l A unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def M_def by presburger + moreover have "M l (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) = (M l A) \\<^sub>s\<^sub>e\<^sub>t \" for l + using fun_pair_subst_set[of \ "setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l A)", symmetric] + trms\<^sub>s\<^sub>s\<^sub>t_subst[OF d[of l]] setops\<^sub>s\<^sub>s\<^sub>t_subst[OF d[of l]] proj_subst[of l A \] + unfolding M_def unlabel_subst by auto + ultimately have "GSMP_disjoint (M l1 (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) (M l2 (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)) S" when l: "l1 \ l2" for l1 l2 + using l GSMP_wt_subst_subset[OF _ \(1,2), of _ "M l1 A"] + GSMP_wt_subst_subset[OF _ \(1,2), of _ "M l2 A"] + unfolding GSMP_disjoint_def by fastforce + thus "?R (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" unfolding M_def by blast + + have "?Q A" using A unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by force + thus "?Q (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" using \(3) + proof (induction A) + case (Cons a A) + obtain l b where a: "a = (l,b)" by (metis surj_pair) + + have 0: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a)) \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def unlabel_def by simp + + have "?Q A" "subst_domain \ \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = {}" + using Cons.prems 0 unfolding setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto + hence IH: "?Q (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" using Cons.IH unfolding setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by blast + + have 1: "fst p = fst q" + when p: "p \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + and q: "q \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + and pq: "?P p q" + for p q + using a p q pq by (cases b) auto + + have 2: "fst p = fst q" + when p: "p \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + and q: "q \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + and pq: "?P p q" + for p q + proof - + obtain p' X where p': + "p' \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "fst p = fst p'" + "X \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A)" "snd p = snd p' \\<^sub>p rm_vars X \" + using setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_subst[OF p] 0 by blast + + obtain q' Y where q': + "q' \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" "fst q = fst q'" + "Y \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A)" "snd q = snd q' \\<^sub>p rm_vars Y \" + using setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_in_subst[OF q] 0 by blast + + have "pair (snd p) = pair (snd p') \ \" + "pair (snd q) = pair (snd q') \ \" + using fun_pair_subst[of "snd p'" "rm_vars X \"] fun_pair_subst[of "snd q'" "rm_vars Y \"] + p'(3,4) q'(3,4) Cons.prems(2) rm_vars_apply'[of \ X] rm_vars_apply'[of \ Y] + by fastforce+ + hence "\\. Unifier \ (pair (snd p')) (pair (snd q'))" + using pq Unifier_comp' by metis + thus ?thesis using Cons.prems p'(1,2) q'(1,2) by simp + qed + + show ?case by (metis 1 2 IH Un_iff setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_cons subst_lsst_cons) + qed simp +qed + +lemma wf_pair_negchecks_map': + assumes "wf\<^sub>s\<^sub>t X (unlabel A)" + shows "wf\<^sub>s\<^sub>t X (unlabel (map (\G. (i,\Y\\\: (F@G)\\<^sub>s\<^sub>t)) M@A))" +using assms by (induct M) auto + +lemma wf_pair_eqs_ineqs_map': + fixes A::"('fun,'var,'lbl) labeled_strand" + assumes "wf\<^sub>s\<^sub>t X (unlabel A)" + "Di \ set (subseqs (dbproj i D))" + "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ X" + shows "wf\<^sub>s\<^sub>t X (unlabel ( + (map (\d. (i,\check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di)@ + (map (\d. (i,\[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) [d\dbproj i D. d \ set Di])@A))" +proof - + let ?f = "[d\dbproj i D. d \ set Di]" + define c1 where c1: "c1 = map (\d. (i,\check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di" + define c2 where c2: "c2 = map (\d. (i,\[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) ?f" + define c3 where c3: "c3 = map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) (unlabel Di)" + define c4 where c4: "c4 = map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) (unlabel ?f)" + have ci_eqs: "c3 = unlabel c1" "c4 = unlabel c2" unfolding c1 c2 c3 c4 unlabel_def by auto + have 1: "wf\<^sub>s\<^sub>t X (unlabel (c2@A))" + using wf_fun_pair_ineqs_map[OF assms(1)] ci_eqs(2) unlabel_append[of c2 A] c4 + by metis + have 2: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel Di) \ X" + using assms(3) subseqs_set_subset(1)[OF assms(2)] + unfolding unlabel_def + by fastforce + { fix B::"('fun,'var) strand" assume "wf\<^sub>s\<^sub>t X B" + hence "wf\<^sub>s\<^sub>t X (unlabel c1@B)" using 2 unfolding c1 unlabel_def by (induct Di) auto + } thus ?thesis using 1 unfolding c1 c2 unlabel_def by simp +qed + +lemma trms\<^sub>s\<^sub>s\<^sub>t_setops\<^sub>s\<^sub>s\<^sub>t_wt_instance_ex: + defines "M \ \A. trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + assumes B: "\b \ set B. \a \ set A. \\. b = a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "\t \ M B. \s \ M A. \\. t = s \ \ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +proof + let ?P = "\\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + + fix t assume "t \ M B" + then obtain b where b: "b \ set B" "t \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd b) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd b)" + unfolding M_def unfolding unlabel_def trms\<^sub>s\<^sub>s\<^sub>t_def setops\<^sub>s\<^sub>s\<^sub>t_def by auto + then obtain a \ where a: "a \ set A" "b = a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using B by meson + + note \' = wt_subst_rm_vars[OF \(1)] wf_trms_subst_rm_vars'[OF \(2)] + + have "t \ M (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using b(2) a + unfolding M_def subst_apply_labeled_stateful_strand_def unlabel_def trms\<^sub>s\<^sub>s\<^sub>t_def setops\<^sub>s\<^sub>s\<^sub>t_def + by auto + moreover have "\s \ M A. \\. t = s \ \ \ ?P \" when "t \ trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst'[OF that] \' unfolding M_def by blast + moreover have "\s \ M A. \\. t = s \ \ \ ?P \" when t: "t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A \\<^sub>s\<^sub>s\<^sub>t \)" + proof - + obtain p where p: "p \ setops\<^sub>s\<^sub>s\<^sub>t (unlabel A \\<^sub>s\<^sub>s\<^sub>t \)" "t = pair p" using t by blast + then obtain q X where q: "q \ setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "p = q \\<^sub>p rm_vars (set X) \" + using setops\<^sub>s\<^sub>s\<^sub>t_subst'[OF p(1)] by blast + hence "t = pair q \ rm_vars (set X) \" + using fun_pair_subst[of q "rm_vars (set X) \"] p(2) by presburger + thus ?thesis using \'[of "set X"] q(1) unfolding M_def by blast + qed + ultimately show "\s \ M A. \\. t = s \ \ \ ?P \" unfolding M_def unlabel_subst by fast +qed + +lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_wt_instance_ex: + assumes B: "\b \ set B. \a \ set A. \\. b = a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "\p \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. \q \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \\. + fst p = fst q \ snd p = snd q \\<^sub>p \ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +proof + let ?P = "\\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + + fix p assume "p \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B" + then obtain b where b: "b \ set B" "p \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p b" unfolding setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by blast + then obtain a \ where a: "a \ set A" "b = a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using B by meson + hence p: "p \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + using b(2) unfolding setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def by auto + + obtain X q where q: + "q \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "fst p = fst q" "snd p = snd q \\<^sub>p rm_vars X \" + using setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_subst[OF p] by blast + + show "\q \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \\. fst p = fst q \ snd p = snd q \\<^sub>p \ \ ?P \" + using q wt_subst_rm_vars[OF \(1)] wf_trms_subst_rm_vars'[OF \(2)] by blast +qed + + +subsection \Lemmata: Properties of the Constraint Translation Function\ +lemma tr_par_labeled_rcv_iff: + "B \ set (tr\<^sub>p\<^sub>c A D) \ (i, receive\t\\<^sub>s\<^sub>t) \ set B \ (i, receive\t\) \ set A" +by (induct A D arbitrary: B rule: tr\<^sub>p\<^sub>c.induct) auto + +lemma tr_par_declassified_eq: + "B \ set (tr\<^sub>p\<^sub>c A D) \ declassified\<^sub>l\<^sub>s\<^sub>t B I = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I" +using tr_par_labeled_rcv_iff unfolding declassified\<^sub>l\<^sub>s\<^sub>t_def declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by simp + +lemma tr_par_ik_eq: + assumes "B \ set (tr\<^sub>p\<^sub>c A D)" + shows "ik\<^sub>s\<^sub>t (unlabel B) = ik\<^sub>s\<^sub>s\<^sub>t (unlabel A)" +proof - + have "{t. \i. (i, receive\t\\<^sub>s\<^sub>t) \ set B} = {t. \i. (i, receive\t\) \ set A}" + using tr_par_labeled_rcv_iff[OF assms] by simp + moreover have + "\C. {t. \i. (i, receive\t\\<^sub>s\<^sub>t) \ set C} = {t. receive\t\\<^sub>s\<^sub>t \ set (unlabel C)}" + "\C. {t. \i. (i, receive\t\) \ set C} = {t. receive\t\ \ set (unlabel C)}" + unfolding unlabel_def by force+ + ultimately show ?thesis by (metis ik\<^sub>s\<^sub>s\<^sub>t_def ik\<^sub>s\<^sub>t_is_rcv_set) +qed + +lemma tr_par_deduct_iff: + assumes "B \ set (tr\<^sub>p\<^sub>c A D)" + shows "ik\<^sub>s\<^sub>t (unlabel B) \\<^sub>s\<^sub>e\<^sub>t I \ t \ ik\<^sub>s\<^sub>s\<^sub>t (unlabel A) \\<^sub>s\<^sub>e\<^sub>t I \ t" +using tr_par_ik_eq[OF assms] by metis + +lemma tr_par_vars_subset: + assumes "A' \ set (tr\<^sub>p\<^sub>c A D)" + shows "fv\<^sub>l\<^sub>s\<^sub>t A' \ fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" (is ?P) + and "bvars\<^sub>l\<^sub>s\<^sub>t A' \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A)" (is ?Q) +proof - + show ?P using assms + proof (induction "unlabel A" arbitrary: A A' D rule: strand_sem_stateful_induct) + case (ConsIn A' D ac t s AA A A') + then obtain i B where iB: "A = (i,\ac: t \ s\)#B" "AA = unlabel B" + unfolding unlabel_def by moura + then obtain A'' d where *: + "d \ set (dbproj i D)" + "A' = (i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)#A''" + "A'' \ set (tr\<^sub>p\<^sub>c B D)" + using ConsIn.prems(1) by moura + hence "fv\<^sub>l\<^sub>s\<^sub>t A'' \ fv\<^sub>s\<^sub>s\<^sub>t (unlabel B) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" + "fv (pair (snd d)) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" + apply (metis ConsIn.hyps(1)[OF iB(2)]) + using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_mono[OF dbproj_subset[of i D]] + fv_pair_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subset[OF *(1)] + by blast + thus ?case using * iB unfolding pair_def by auto + next + case (ConsDel A' D t s AA A A') + then obtain i B where iB: "A = (i,delete\t,s\)#B" "AA = unlabel B" + unfolding unlabel_def by moura + + define fltD1 where "fltD1 = (\Di. filter (\d. d \ set Di) D)" + define fltD2 where "fltD2 = (\Di. filter (\d. d \ set Di) (dbproj i D))" + define constr where "constr = + (\Di. (map (\d. (i, \check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di)@ + (map (\d. (i, \[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) (fltD2 Di)))" + + from iB obtain A'' Di where *: + "Di \ set (subseqs (dbproj i D))" "A' = (constr Di)@A''" "A'' \ set (tr\<^sub>p\<^sub>c B (fltD1 Di))" + using ConsDel.prems(1) unfolding constr_def fltD1_def fltD2_def by moura + hence "fv\<^sub>l\<^sub>s\<^sub>t A'' \ fv\<^sub>s\<^sub>s\<^sub>t AA \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel (fltD1 Di))" + unfolding constr_def fltD1_def by (metis ConsDel.hyps(1) iB(2)) + hence 1: "fv\<^sub>l\<^sub>s\<^sub>t A'' \ fv\<^sub>s\<^sub>s\<^sub>t AA \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" + using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_mono[of "unlabel (fltD1 Di)" "unlabel D"] + unfolding unlabel_def fltD1_def by force + + have 2: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel Di) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel (fltD1 Di)) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" + using subseqs_set_subset(1)[OF *(1)] + unfolding fltD1_def unlabel_def + by auto + + have 5: "fv\<^sub>l\<^sub>s\<^sub>t A' = fv\<^sub>l\<^sub>s\<^sub>t (constr Di) \ fv\<^sub>l\<^sub>s\<^sub>t A''" using * unfolding unlabel_def by force + + have "fv\<^sub>l\<^sub>s\<^sub>t (constr Di) \ fv t \ fv s \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel Di) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel (fltD1 Di))" + unfolding unlabel_def constr_def fltD1_def fltD2_def pair_def by auto + hence 3: "fv\<^sub>l\<^sub>s\<^sub>t (constr Di) \ fv t \ fv s \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" using 2 by blast + + have 4: "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) = fv t \ fv s \ fv\<^sub>s\<^sub>s\<^sub>t AA" using iB by auto + + have "fv\<^sub>s\<^sub>t (unlabel A') \ fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" using 1 3 4 5 by blast + thus ?case by metis + next + case (ConsNegChecks A' D X F F' AA A A') + then obtain i B where iB: "A = (i,NegChecks X F F')#B" "AA = unlabel B" + unfolding unlabel_def by moura + + define D' where "D' \ \(fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ` set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (unlabel (dbproj i D))))" + define constr where "constr = map (\G. (i,\X\\\: (F@G)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))" + + from iB obtain A'' where *: "A'' \ set (tr\<^sub>p\<^sub>c B D)" "A' = constr@A''" + using ConsNegChecks.prems(1) unfolding constr_def by moura + hence "fv\<^sub>l\<^sub>s\<^sub>t A'' \ fv\<^sub>s\<^sub>s\<^sub>t AA \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" + by (metis ConsNegChecks.hyps(1) iB(2)) + hence **: "fv\<^sub>l\<^sub>s\<^sub>t A'' \ fv\<^sub>s\<^sub>s\<^sub>t AA \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" by auto + + have 1: "fv\<^sub>l\<^sub>s\<^sub>t constr \ (D' \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X" + unfolding D'_def constr_def unlabel_def by auto + + have "set (unlabel (dbproj i D)) \ set (unlabel D)" unfolding unlabel_def by auto + hence 2: "D' \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" + using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_vars_subset'[of F' "unlabel (dbproj i D)"] fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_mono + unfolding D'_def by blast + + have 3: "fv\<^sub>l\<^sub>s\<^sub>t A' \ ((fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ fv\<^sub>l\<^sub>s\<^sub>t A''" + using 1 2 *(2) unfolding unlabel_def by fastforce + + have 4: "fv\<^sub>s\<^sub>s\<^sub>t AA \ fv\<^sub>s\<^sub>s\<^sub>t (unlabel A)" by (metis ConsNegChecks.hyps(2) fv\<^sub>s\<^sub>s\<^sub>t_cons_subset) + + have 5: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \ fv\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + using ConsNegChecks.hyps(2) unfolding unlabel_def by force + + show ?case using ** 3 4 5 by blast + qed (fastforce simp add: unlabel_def)+ + + show ?Q using assms + apply (induct "unlabel A" arbitrary: A A' D rule: strand_sem_stateful_induct) + by (fastforce simp add: unlabel_def)+ +qed + +lemma tr_par_vars_disj: + assumes "A' \ set (tr\<^sub>p\<^sub>c A D)" "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" + and "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" + shows "fv\<^sub>l\<^sub>s\<^sub>t A' \ bvars\<^sub>l\<^sub>s\<^sub>t A' = {}" +using assms tr_par_vars_subset by fast + +lemma tr_par_trms_subset: + assumes "A' \ set (tr\<^sub>p\<^sub>c A D)" + shows "trms\<^sub>l\<^sub>s\<^sub>t A' \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` snd ` set D" +using assms +proof (induction A D arbitrary: A' rule: tr\<^sub>p\<^sub>c.induct) + case 1 thus ?case by simp +next + case (2 i t A D) + then obtain A'' where A'': "A' = (i,send\t\\<^sub>s\<^sub>t)#A''" "A'' \ set (tr\<^sub>p\<^sub>c A D)" by moura + hence "trms\<^sub>l\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` snd ` set D" + by (metis "2.IH") + thus ?case using A'' by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +next + case (3 i t A D) + then obtain A'' where A'': "A' = (i,receive\t\\<^sub>s\<^sub>t)#A''" "A'' \ set (tr\<^sub>p\<^sub>c A D)" + by moura + hence "trms\<^sub>l\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` snd ` set D" + by (metis "3.IH") + thus ?case using A'' by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +next + case (4 i ac t t' A D) + then obtain A'' where A'': "A' = (i,\ac: t \ t'\\<^sub>s\<^sub>t)#A''" "A'' \ set (tr\<^sub>p\<^sub>c A D)" + by moura + hence "trms\<^sub>l\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` snd ` set D" + by (metis "4.IH") + thus ?case using A'' by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +next + case (5 i t s A D) + hence "A' \ set (tr\<^sub>p\<^sub>c A (List.insert (i,t,s) D))" by simp + hence "trms\<^sub>l\<^sub>s\<^sub>t A' \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ + pair ` snd ` set (List.insert (i,t,s) D)" + by (metis "5.IH") + thus ?case by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +next + case (6 i t s A D) + from 6 obtain Di A'' B C where A'': + "Di \ set (subseqs (dbproj i D))" "A'' \ set (tr\<^sub>p\<^sub>c A [d\D. d \ set Di])" "A' = (B@C)@A''" + "B = map (\d. (i,\check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di" + "C = map (\d. (i,\[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) [d\dbproj i D. d \ set Di]" + by moura + hence "trms\<^sub>l\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ + pair ` snd ` set [d\D. d \ set Di]" + by (metis "6.IH") + moreover have "set [d\D. d \ set Di] \ set D" using set_filter by auto + ultimately have + "trms\<^sub>l\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` snd ` set D" + by blast + hence "trms\<^sub>l\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel ((i,delete\t,s\)#A)) \ + pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ((i,delete\t,s\)#A)) \ + pair ` snd ` set D" + using setops\<^sub>s\<^sub>s\<^sub>t_cons_subset trms\<^sub>s\<^sub>s\<^sub>t_cons + by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + moreover have "set Di \ set D" "set [d\dbproj i D . d \ set Di] \ set D" + using subseqs_set_subset[OF A''(1)] by auto + hence "trms\<^sub>s\<^sub>t (unlabel B) \ insert (pair (t, s)) (pair ` snd ` set D)" + "trms\<^sub>s\<^sub>t (unlabel C) \ insert (pair (t, s)) (pair ` snd ` set D)" + using A''(4,5) unfolding unlabel_def by auto + hence "trms\<^sub>s\<^sub>t (unlabel (B@C)) \ insert (pair (t,s)) (pair ` snd ` set D)" + using unlabel_append[of B C] by auto + moreover have "pair (t,s) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (delete\t,s\#unlabel A)" by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + ultimately show ?case + using A''(3) trms\<^sub>s\<^sub>t_append[of "unlabel (B@C)" "unlabel A'"] unlabel_append[of "B@C" A''] + by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +next + case (7 i ac t s A D) + from 7 obtain d A'' where A'': + "d \ set (dbproj i D)" "A'' \ set (tr\<^sub>p\<^sub>c A D)" + "A' = (i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)#A''" + by moura + hence "trms\<^sub>l\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ + pair ` snd ` set D" + by (metis "7.IH") + moreover have "trms\<^sub>s\<^sub>t (unlabel A') = {pair (t,s), pair (snd d)} \ trms\<^sub>s\<^sub>t (unlabel A'')" + using A''(1,3) by auto + ultimately show ?case using A''(1) by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +next + case (8 i X F F' A D) + define constr where "constr = map (\G. (i,\X\\\: (F@G)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))" + define B where "B \ \(trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ` set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D))))" + + from 8 obtain A'' where A'': + "A'' \ set (tr\<^sub>p\<^sub>c A D)" "A' = constr@A''" + unfolding constr_def by moura + + have "trms\<^sub>s\<^sub>t (unlabel A'') \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair`snd`set D" + by (metis A''(1) "8.IH") + moreover have "trms\<^sub>s\<^sub>t (unlabel constr) \ B \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` snd ` set D" + unfolding unlabel_def constr_def B_def by auto + ultimately have "trms\<^sub>s\<^sub>t (unlabel A') \ B \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ + pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` snd ` set D" + using A'' unlabel_append[of constr A''] by auto + moreover have "set (dbproj i D) \ set D" by auto + hence "B \ pair ` set F' \ pair ` snd ` set D" + using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_trms_subset'[of F' "map snd (dbproj i D)"] + unfolding B_def by force + moreover have + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ((i, \X\\\: F \\: F'\)#A)) = + pair ` set F' \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + by auto + ultimately show ?case by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +qed + +lemma tr_par_wf_trms: + assumes "A' \ set (tr\<^sub>p\<^sub>c A [])" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t (unlabel A))" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>t A')" +using tr_par_trms_subset[OF assms(1)] setops\<^sub>s\<^sub>s\<^sub>t_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s(2)[OF assms(2)] +by auto + +lemma tr_par_wf': + assumes "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" + and "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ X" + and "wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)" "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" + and "A' \ set (tr\<^sub>p\<^sub>c A D)" + shows "wf\<^sub>l\<^sub>s\<^sub>t X A'" +proof - + define P where + "P = (\(D::('fun,'var,'lbl) labeleddbstatelist) (A::('fun,'var,'lbl) labeled_stateful_strand). + (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}) \ + fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {})" + + have "P D A" using assms(1,4) by (simp add: P_def) + with assms(5,3,2) show ?thesis + proof (induction A arbitrary: X A' D) + case Nil thus ?case by simp + next + case (Cons a A) + obtain i s where i: "a = (i,s)" by (metis surj_pair) + note prems = Cons.prems + note IH = Cons.IH + show ?case + proof (cases s) + case (Receive t) + note si = Receive i + then obtain A'' where A'': "A' = (i,receive\t\\<^sub>s\<^sub>t)#A''" "A'' \ set (tr\<^sub>p\<^sub>c A D)" "fv t \ X" + using prems unlabel_Cons(1)[of i s A] by moura + have *: "wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)" + "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ X" + "P D A" + using prems si apply (force, force) + using prems(4) si unfolding P_def by fastforce + show ?thesis using IH[OF A''(2) *] A''(1,3) by simp + next + case (Send t) + note si = Send i + then obtain A'' where A'': "A' = (i,send\t\\<^sub>s\<^sub>t)#A''" "A'' \ set (tr\<^sub>p\<^sub>c A D)" + using prems by moura + have *: "wf'\<^sub>s\<^sub>s\<^sub>t (X \ fv t) (unlabel A)" + "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ X \ fv t" + "P D A" + using prems si apply (force, force) + using prems(4) si unfolding P_def by fastforce + show ?thesis using IH[OF A''(2) *] A''(1) by simp + next + case (Equality ac t t') + note si = Equality i + then obtain A'' where A'': + "A' = (i,\ac: t \ t'\\<^sub>s\<^sub>t)#A''" "A'' \ set (tr\<^sub>p\<^sub>c A D)" + "ac = Assign \ fv t' \ X" + using prems unlabel_Cons(1)[of i s] by moura + have *: "ac = Assign \ wf'\<^sub>s\<^sub>s\<^sub>t (X \ fv t) (unlabel A)" + "ac = Check \ wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)" + "ac = Assign \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ X \ fv t" + "ac = Check \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ X" + "P D A" + using prems si apply (force, force, force, force) + using prems(4) si unfolding P_def by fastforce + show ?thesis + using IH[OF A''(2) *(1,3,5)] IH[OF A''(2) *(2,4,5)] A''(1,3) + by (cases ac) simp_all + next + case (Insert t t') + note si = Insert i + hence A': "A' \ set (tr\<^sub>p\<^sub>c A (List.insert (i,t,t') D))" "fv t \ X" "fv t' \ X" + using prems by auto + have *: "wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)" "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel (List.insert (i,t,t') D)) \ X" + using prems si by (auto simp add: unlabel_def) + have **: "P (List.insert (i,t,t') D) A" + using prems(4) si + unfolding P_def unlabel_def + by fastforce + show ?thesis using IH[OF A'(1) * **] A'(2,3) by simp + next + case (Delete t t') + note si = Delete i + define constr where "constr = (\Di. + (map (\d. (i,\check: (pair (t,t')) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di)@ + (map (\d. (i,\[]\\\: [(pair (t,t'), pair (snd d))]\\<^sub>s\<^sub>t)) [d\dbproj i D. d \ set Di]))" + from prems si obtain Di A'' where A'': + "A' = constr Di@A''" "A'' \ set (tr\<^sub>p\<^sub>c A [d\D. d \ set Di])" + "Di \ set (subseqs (dbproj i D))" + unfolding constr_def by auto + have *: "wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)" + "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel (filter (\d. d \ set Di) D)) \ X" + using prems si apply simp + using prems si by (fastforce simp add: unlabel_def) + + have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel (filter (\d. d \ set Di) D)) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" + by (auto simp add: unlabel_def) + hence **: "P [d\D. d \ set Di] A" + using prems si unfolding P_def + by fastforce + + have ***: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ X" using prems si by auto + show ?thesis + using IH[OF A''(2) * **] A''(1) wf_pair_eqs_ineqs_map'[OF _ A''(3) ***] + unfolding constr_def by simp + next + case (InSet ac t t') + note si = InSet i + then obtain d A'' where A'': + "A' = (i,\ac: (pair (t,t')) \ (pair (snd d))\\<^sub>s\<^sub>t)#A''" + "A'' \ set (tr\<^sub>p\<^sub>c A D)" + "d \ set D" + using prems by moura + have *: + "ac = Assign \ wf'\<^sub>s\<^sub>s\<^sub>t (X \ fv t \ fv t') (unlabel A)" + "ac = Check \ wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)" + "ac = Assign \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ X \ fv t \ fv t'" + "ac = Check \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ X" + "P D A" + using prems si apply (force, force, force, force) + using prems(4) si unfolding P_def by fastforce + have **: "fv (pair (snd d)) \ X" + using A''(3) prems(3) fv_pair_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subset + by fast + have ***: "fv (pair (t,t')) = fv t \ fv t'" unfolding pair_def by auto + show ?thesis + using IH[OF A''(2) *(1,3,5)] IH[OF A''(2) *(2,4,5)] A''(1) ** *** + by (cases ac) (simp_all add: Un_assoc) + next + case (NegChecks Y F F') + note si = NegChecks i + then obtain A'' where A'': + "A' = (map (\G. (i,\Y\\\: (F@G)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D))))@A''" + "A'' \ set (tr\<^sub>p\<^sub>c A D)" + using prems by moura + + have *: "wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)" "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ X" using prems si by auto + + have "bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel ((i,\Y\\\: F \\: F'\)#A))" + "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ fv\<^sub>s\<^sub>s\<^sub>t (unlabel ((i,\Y\\\: F \\: F'\)#A))" + by auto + hence **: "P D A" using prems si unfolding P_def by blast + + show ?thesis using IH[OF A''(2) * **] A''(1) wf_pair_negchecks_map' by simp + qed + qed +qed + +lemma tr_par_wf: + assumes "A' \ set (tr\<^sub>p\<^sub>c A [])" + and "wf\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" + shows "wf\<^sub>l\<^sub>s\<^sub>t {} A'" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>t A')" + and "fv\<^sub>l\<^sub>s\<^sub>t A' \ bvars\<^sub>l\<^sub>s\<^sub>t A' = {}" +using tr_par_wf'[OF _ _ _ _ assms(1)] + tr_par_wf_trms[OF assms(1,3)] + tr_par_vars_disj[OF assms(1)] + assms(2) +by fastforce+ + +lemma tr_par_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p: + assumes "A' \ set (tr\<^sub>p\<^sub>c A D)" "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel A)" + and "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" (is "?P0 A D") + and "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" (is "?P1 A D") + and "\t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` snd ` set D. + \t' \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` snd ` set D. + (\\. Unifier \ t t') \ \ t = \ t'" (is "?P3 A D") + shows "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A')" +proof - + have sublmm: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel A)" "?P0 A D" "?P1 A D" "?P3 A D" + when p: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (a#A))" "?P0 (a#A) D" "?P1 (a#A) D" "?P3 (a#A) D" + for a A D + proof - + show "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel A)" using p(1) by (simp add: unlabel_def tfr\<^sub>s\<^sub>s\<^sub>t_def) + show "?P0 A D" using p(2) fv\<^sub>s\<^sub>s\<^sub>t_cons_subset unfolding unlabel_def by fastforce + show "?P1 A D" using p(3) bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset unfolding unlabel_def by fastforce + have "setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ setops\<^sub>s\<^sub>s\<^sub>t (unlabel (a#A))" + using setops\<^sub>s\<^sub>s\<^sub>t_cons_subset unfolding unlabel_def by auto + thus "?P3 A D" using p(4) by blast + qed + + show ?thesis using assms + proof (induction A D arbitrary: A' rule: tr\<^sub>p\<^sub>c.induct) + case 1 thus ?case by simp + next + case (2 i t A D) + note prems = "2.prems" + note IH = "2.IH" + from prems(1) obtain A'' where A'': "A' = (i,send\t\\<^sub>s\<^sub>t)#A''" "A'' \ set (tr\<^sub>p\<^sub>c A D)" by moura + have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A'')" + using IH[OF A''(2)] prems(5) sublmm[OF prems(2,3,4,5)] + by meson + thus ?case using A''(1) by simp + next + case (3 i t A D) + note prems = "3.prems" + note IH = "3.IH" + from prems(1) obtain A'' where A'': "A' = (i,receive\t\\<^sub>s\<^sub>t)#A''" "A'' \ set (tr\<^sub>p\<^sub>c A D)" by moura + have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A'')" + using IH[OF A''(2)] prems(5) sublmm[OF prems(2,3,4,5)] + by meson + thus ?case using A''(1) by simp + next + case (4 i ac t t' A D) + note prems = "4.prems" + note IH = "4.IH" + from prems(1) obtain A'' where A'': "A' = (i,\ac: t \ t'\\<^sub>s\<^sub>t)#A''" "A'' \ set (tr\<^sub>p\<^sub>c A D)" by moura + have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A'')" + using IH[OF A''(2)] prems(5) sublmm[OF prems(2,3,4,5)] + by meson + thus ?case using A''(1) prems(2) by simp + next + case (5 i t s A D) + note prems = "5.prems" + note IH = "5.IH" + from prems(1) have A': "A' \ set (tr\<^sub>p\<^sub>c A (List.insert (i,t,s) D))" by simp + + have 1: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel A)" using sublmm[OF prems(2,3,4,5)] by simp + + have "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ((i,insert\t,s\)#A)) \ pair`snd`set D = + pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair`snd`set (List.insert (i,t,s) D)" + by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + hence 3: "?P3 A (List.insert (i,t,s) D)" using prems(5) by metis + moreover have "?P1 A (List.insert (i,t,s) D)" + using prems(3,4) bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset[of "unlabel A" "insert\t,s\"] + unfolding unlabel_def + by fastforce + ultimately have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A')" + using IH[OF A' sublmm(1,2)[OF prems(2,3,4,5)] _ 3] by metis + thus ?case using A'(1) by auto + next + case (6 i t s A D) + note prems = "6.prems" + note IH = "6.IH" + + define constr where constr: "constr \ (\Di. + (map (\d. (i,\check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di)@ + (map (\d. (i,\[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) (filter (\d. d \ set Di) (dbproj i D))))" + + from prems(1) obtain Di A'' where A'': + "A' = constr Di@A''" "A'' \ set (tr\<^sub>p\<^sub>c A (filter (\d. d \ set Di) D))" + "Di \ set (subseqs (dbproj i D))" + unfolding constr by fastforce + + define Q1 where "Q1 \ (\(F::(('fun,'var) term \ ('fun,'var) term) list) X. + \x \ (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X. \a. \ (Var x) = TAtom a)" + define Q2 where "Q2 \ (\(F::(('fun,'var) term \ ('fun,'var) term) list) X. + \f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ T = [] \ (\s \ set T. s \ Var ` set X))" + + have "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair`snd`set [d\D. d \ set Di] + \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ((i,delete\t,s\)#A)) \ pair`snd`set D" + using subseqs_set_subset[OF A''(3)] by (force simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + moreover have "\a\M. \b\M. P a b" + when "M \ N" "\a\N. \b\N. P a b" + for M N::"('fun, 'var) terms" and P + using that by blast + ultimately have *: "?P3 A (filter (\d. d \ set Di) D)" + using prems(5) by presburger + + have **: "?P1 A (filter (\d. d \ set Di) D)" + using prems(4) bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset[of "unlabel A" "delete\t,s\"] + unfolding unlabel_def by fastforce + + have 1: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A'')" + using IH[OF A''(3,2) sublmm(1,2)[OF prems(2,3,4,5)] ** *] + by metis + + have 2: "\ac: u \ u'\\<^sub>s\<^sub>t \ set (unlabel A'') \ + (\d \ set Di. u = pair (t,s) \ u' = pair (snd d))" + when "\ac: u \ u'\\<^sub>s\<^sub>t \ set (unlabel A')" for ac u u' + using that A''(1) unfolding constr unlabel_def by force + have 3: + "\X\\\: u\\<^sub>s\<^sub>t \ set (unlabel A'') \ + (\d \ set (filter (\d. d \ set Di) D). u = [(pair (t,s), pair (snd d))] \ Q2 u X)" + when "\X\\\: u\\<^sub>s\<^sub>t \ set (unlabel A')" for X u + using that A''(1) unfolding Q2_def constr unlabel_def by force + have 4: "\d\set D. (\\. Unifier \ (pair (t,s)) (pair (snd d))) + \ \ (pair (t,s)) = \ (pair (snd d))" + using prems(5) by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + + { fix ac u u' + assume a: "\ac: u \ u'\\<^sub>s\<^sub>t \ set (unlabel A')" "\\. Unifier \ u u'" + hence "\ac: u \ u'\\<^sub>s\<^sub>t \ set (unlabel A'') \ (\d \ set Di. u = pair (t,s) \ u' = pair (snd d))" + using 2 by metis + moreover { + assume "\ac: u \ u'\\<^sub>s\<^sub>t \ set (unlabel A'')" + hence "tfr\<^sub>s\<^sub>t\<^sub>p (\ac: u \ u'\\<^sub>s\<^sub>t)" + using 1 Ball_set_list_all[of "unlabel A''" tfr\<^sub>s\<^sub>t\<^sub>p] + by fast + } moreover { + fix d assume "d \ set Di" "u = pair (t,s)" "u' = pair (snd d)" + hence "\\. Unifier \ u u' \ \ u = \ u'" + using 4 dbproj_subseq_subset A''(3) + by fast + hence "tfr\<^sub>s\<^sub>t\<^sub>p (\ac: u \ u'\\<^sub>s\<^sub>t)" + using Ball_set_list_all[of "unlabel A''" tfr\<^sub>s\<^sub>t\<^sub>p] + by simp + hence "\ u = \ u'" using tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of "unlabel A''"] + using a(2) unfolding unlabel_def by auto + } ultimately have "\ u = \ u'" + using tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of "unlabel A''"] a(2) + unfolding unlabel_def by auto + } moreover { + fix u U + assume "\U\\\: u\\<^sub>s\<^sub>t \ set (unlabel A')" + hence "\U\\\: u\\<^sub>s\<^sub>t \ set (unlabel A'') \ + (\d \ set (filter (\d. d \ set Di) D). u = [(pair (t,s), pair (snd d))] \ Q2 u U)" + using 3 by metis + hence "Q1 u U \ Q2 u U" + using 1 4 subseqs_set_subset[OF A''(3)] tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of "unlabel A''"] + unfolding Q1_def Q2_def + by blast + } ultimately show ?case + using tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of "unlabel A'"] unfolding Q1_def Q2_def unlabel_def by blast + next + case (7 i ac t s A D) + note prems = "7.prems" + note IH = "7.IH" + + from prems(1) obtain d A'' where A'': + "A' = (i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)#A''" + "A'' \ set (tr\<^sub>p\<^sub>c A D)" + "d \ set (dbproj i D)" + by moura + + have 1: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A'')" + using IH[OF A''(2) sublmm(1,2,3)[OF prems(2,3,4,5)] sublmm(4)[OF prems(2,3,4,5)]] + by metis + + have 2: "\ (pair (t,s)) = \ (pair (snd d))" + when "\\. Unifier \ (pair (t,s)) (pair (snd d))" + using that prems(2,5) A''(3) unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + + show ?case using A''(1) 1 2 by fastforce + next + case (8 i X F F' A D) + note prems = "8.prems" + note IH = "8.IH" + + define constr where + "constr = map (\G. (i,\X\\\: (F@G)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))" + + define Q1 where "Q1 \ (\(F::(('fun,'var) term \ ('fun,'var) term) list) X. + \x \ (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X. \a. \ (Var x) = TAtom a)" + + define Q2 where "Q2 \ (\(M::('fun,'var) terms) X. + \f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t M \ T = [] \ (\s \ set T. s \ Var ` set X))" + + have Q2_subset: "Q2 M' X" when "M' \ M" "Q2 M X" for X M M' + using that unfolding Q2_def by auto + + have Q2_supset: "Q2 (M \ M') X" when "Q2 M X" "Q2 M' X" for X M M' + using that unfolding Q2_def by auto + + from prems obtain A'' where A'': "A' = constr@A''" "A'' \ set (tr\<^sub>p\<^sub>c A D)" + using constr_def by moura + + have 0: "constr = [(i,\X\\\: F\\<^sub>s\<^sub>t)]" when "F' = []" using that unfolding constr_def by simp + + have 1: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A'')" + using IH[OF A''(2) sublmm(1,2,3)[OF prems(2,3,4,5)] sublmm(4)[OF prems(2,3,4,5)]] + by metis + + have 2: "(F' = [] \ Q1 F X) \ Q2 (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` set F') X" + using prems(2) unfolding Q1_def Q2_def by simp + + have 3: "F' = [] \ Q1 F X \ list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel constr)" + using 0 2 tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of "unlabel constr"] unfolding Q1_def by auto + + { fix c assume "c \ set (unlabel constr)" + hence "\G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D))). c = \X\\\: (F@G)\\<^sub>s\<^sub>t" + unfolding constr_def unlabel_def by force + } moreover { + fix G + assume G: "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))" + and c: "\X\\\: (F@G)\\<^sub>s\<^sub>t \ set (unlabel constr)" + and e: "Q2 (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` set F') X" + + have d_Q2: "Q2 (pair ` set (map snd D)) X" unfolding Q2_def + proof (intro allI impI) + fix f T assume "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (pair ` set (map snd D))" + then obtain d where d: "d \ set (map snd D)" "Fun f T \ subterms (pair d)" by force + hence "fv (pair d) \ set X = {}" + using prems(4) unfolding pair_def by (force simp add: unlabel_def) + thus "T = [] \ (\s \ set T. s \ Var ` set X)" + by (metis fv_disj_Fun_subterm_param_cases d(2)) + qed + + have "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F@G) \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` set F' \ pair ` set (map snd D)" + using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_trms_subset[OF G] by force + hence "Q2 (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F@G)) X" using Q2_subset[OF _ Q2_supset[OF e d_Q2]] by metis + hence "tfr\<^sub>s\<^sub>t\<^sub>p (\X\\\: (F@G)\\<^sub>s\<^sub>t)" by (metis Q2_def tfr\<^sub>s\<^sub>t\<^sub>p.simps(2)) + } ultimately have 4: + "Q2 (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` set F') X \ list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel constr)" + using Ball_set by blast + + have 5: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel constr)" using 2 3 4 by metis + + show ?case using 1 5 A''(1) by (simp add: unlabel_def) + qed +qed + +lemma tr_par_tfr: + assumes "A' \ set (tr\<^sub>p\<^sub>c A [])" and "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + and "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" + shows "tfr\<^sub>s\<^sub>t (unlabel A')" +proof - + have *: "trms\<^sub>l\<^sub>s\<^sub>t A' \ trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + using tr_par_trms_subset[OF assms(1)] by simp + hence "SMP (trms\<^sub>l\<^sub>s\<^sub>t A') \ SMP (trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A))" + using SMP_mono by simp + moreover have "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A))" + using assms(2) unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by fast + ultimately have 1: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>t A')" by (metis tfr_subset(2)[OF _ *]) + + have **: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel A)" using assms(2) unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by fast + have "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ + SMP (trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)) - Var`\" + using setops\<^sub>s\<^sub>s\<^sub>t_are_pairs unfolding pair_def by auto + hence "\ t = \ t'" + when "\\. Unifier \ t t'" "t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "t' \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" + for t t' + using that assms(2) unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def tfr\<^sub>s\<^sub>e\<^sub>t_def by blast + moreover have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel []) = {}" "pair ` snd ` set [] = {}" by auto + ultimately have 2: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A')" + using tr_par_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p[OF assms(1) ** assms(3)] by simp + + show ?thesis by (metis 1 2 tfr\<^sub>s\<^sub>t_def) +qed + +lemma tr_par_proj: + assumes "B \ set (tr\<^sub>p\<^sub>c A D)" + shows "proj n B \ set (tr\<^sub>p\<^sub>c (proj n A) (proj n D))" +using assms +proof (induction A D arbitrary: B rule: tr\<^sub>p\<^sub>c.induct) + case (5 i t s S D) + note prems = "5.prems" + note IH = "5.IH" + have IH': "proj n B \ set (tr\<^sub>p\<^sub>c (proj n S) (proj n (List.insert (i,t,s) D)))" + using prems IH by auto + show ?case + proof (cases "(i = ln n) \ (i = \)") + case True thus ?thesis + using IH' proj_list_insert(1,2)[of n "(t,s)" D] proj_list_Cons(1,2)[of n _ S] + by auto + next + case False + then obtain m where "i = ln m" "n \ m" by (cases i) simp_all + thus ?thesis + using IH' proj_list_insert(3)[of n _ "(t,s)" D] proj_list_Cons(3)[of n _ "insert\t,s\" S] + by auto + qed +next + case (6 i t s S D) + note prems = "6.prems" + note IH = "6.IH" + define constr where "constr = (\Di D. + (map (\d. (i,\check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di)@ + (map (\d. (i,\[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) [d\dbproj i D. d \ set Di]))" + + obtain Di B' where B': + "B = constr Di D@B'" + "Di \ set (subseqs (dbproj i D))" + "B' \ set (tr\<^sub>p\<^sub>c S [d\D. d \ set Di])" + using prems constr_def by fastforce + hence "proj n B' \ set (tr\<^sub>p\<^sub>c (proj n S) (proj n [d\D. d \ set Di]))" using IH by simp + hence IH': "proj n B' \ set (tr\<^sub>p\<^sub>c (proj n S) [d\proj n D. d \ set Di])" by (metis proj_filter) + show ?case + proof (cases "(i = ln n) \ (i = \)") + case True + hence "proj n B = constr Di D@proj n B'" "Di \ set (subseqs (dbproj i (proj n D)))" + using B'(1,2) proj_dbproj(1,2)[of n D] unfolding proj_def constr_def by auto + moreover have "constr Di (proj n D) = constr Di D" + using True proj_dbproj(1,2)[of n D] unfolding constr_def by presburger + ultimately have "proj n B \ set (tr\<^sub>p\<^sub>c ((i, delete\t,s\)#proj n S) (proj n D))" + using IH' unfolding constr_def by force + thus ?thesis by (metis proj_list_Cons(1,2) True) + next + case False + then obtain m where m: "i = ln m" "n \ m" by (cases i) simp_all + hence *: "(ln n) \ i" by simp + have "proj n B = proj n B'" using B'(1) False unfolding constr_def proj_def by auto + moreover have "[d\proj n D. d \ set Di] = proj n D" + using proj_subseq[OF _ m(2)[symmetric]] m(1) B'(2) by simp + ultimately show ?thesis using m(1) IH' proj_list_Cons(3)[OF m(2), of _ S] by auto + qed +next + case (7 i ac t s S D) + note prems = "7.prems" + note IH = "7.IH" + define constr where "constr = ( + \d::'lbl strand_label \ ('fun,'var) term \ ('fun,'var) term. + (i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t))" + + obtain d B' where B': + "B = constr d#B'" + "d \ set (dbproj i D)" + "B' \ set (tr\<^sub>p\<^sub>c S D)" + using prems constr_def by fastforce + hence IH': "proj n B' \ set (tr\<^sub>p\<^sub>c (proj n S) (proj n D))" using IH by auto + + show ?case + proof (cases "(i = ln n) \ (i = \)") + case True + hence "proj n B = constr d#proj n B'" "d \ set (dbproj i (proj n D))" + using B' proj_list_Cons(1,2)[of n _ B'] + unfolding constr_def + by (force, metis proj_dbproj(1,2)) + hence "proj n B \ set (tr\<^sub>p\<^sub>c ((i, InSet ac t s)#proj n S) (proj n D))" + using IH' unfolding constr_def by auto + thus ?thesis using proj_list_Cons(1,2)[of n _ S] True by metis + next + case False + then obtain m where m: "i = ln m" "n \ m" by (cases i) simp_all + hence "proj n B = proj n B'" using B'(1) proj_list_Cons(3) unfolding constr_def by auto + thus ?thesis + using IH' m proj_list_Cons(3)[OF m(2), of "InSet ac t s" S] + unfolding constr_def + by auto + qed +next + case (8 i X F F' S D) + note prems = "8.prems" + note IH = "8.IH" + + define constr where + "constr = (\D. map (\G. (i,\X\\\: (F@G)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D))))" + + obtain B' where B': + "B = constr D@B'" + "B' \ set (tr\<^sub>p\<^sub>c S D)" + using prems constr_def by fastforce + hence IH': "proj n B' \ set (tr\<^sub>p\<^sub>c (proj n S) (proj n D))" using IH by auto + + show ?case + proof (cases "(i = ln n) \ (i = \)") + case True + hence "proj n B = constr (proj n D)@proj n B'" + using B'(1,2) proj_dbproj(1,2)[of n D] unfolding proj_def constr_def by auto + hence "proj n B \ set (tr\<^sub>p\<^sub>c ((i, NegChecks X F F')#proj n S) (proj n D))" + using IH' unfolding constr_def by auto + thus ?thesis using proj_list_Cons(1,2)[of n _ S] True by metis + next + case False + then obtain m where m: "i = ln m" "n \ m" by (cases i) simp_all + hence "proj n B = proj n B'" using B'(1) unfolding constr_def proj_def by auto + thus ?thesis + using IH' m proj_list_Cons(3)[OF m(2), of "NegChecks X F F'" S] + unfolding constr_def + by auto + qed +qed (force simp add: proj_def)+ + +lemma tr_par_preserves_typing_cond: + assumes "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A Sec" "typing_cond\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "A' \ set (tr\<^sub>p\<^sub>c A [])" + shows "typing_cond (unlabel A')" +proof - + have "wf'\<^sub>s\<^sub>s\<^sub>t {} (unlabel A)" + "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t (unlabel A))" + using assms(2) unfolding typing_cond\<^sub>s\<^sub>s\<^sub>t_def by simp_all + hence 1: "wf\<^sub>s\<^sub>t {} (unlabel A')" + "fv\<^sub>s\<^sub>t (unlabel A') \ bvars\<^sub>s\<^sub>t (unlabel A') = {}" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t (unlabel A'))" + "Ana_invar_subst (ik\<^sub>s\<^sub>t (unlabel A') \ assignment_rhs\<^sub>s\<^sub>t (unlabel A'))" + using tr_par_wf[OF assms(3)] Ana_invar_subst' by metis+ + + have 2: "tfr\<^sub>s\<^sub>t (unlabel A')" by (metis tr_par_tfr assms(2,3) typing_cond\<^sub>s\<^sub>s\<^sub>t_def) + + show ?thesis by (metis 1 2 typing_cond_def) +qed + +lemma tr_par_preserves_par_comp: + assumes "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A Sec" "A' \ set (tr\<^sub>p\<^sub>c A [])" + shows "par_comp A' Sec" +proof - + let ?M = "\l. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l A)" + let ?N = "\l. trms_proj\<^sub>l\<^sub>s\<^sub>t l A'" + + have 0: "\l1 l2. l1 \ l2 \ GSMP_disjoint (?M l1) (?M l2) Sec" + using assms(1) unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by simp_all + + { fix l1 l2::'lbl assume *: "l1 \ l2" + hence "GSMP_disjoint (?M l1) (?M l2) Sec" using 0(1) by metis + moreover have "pair ` snd ` set (proj n []) = {}" for n::'lbl unfolding proj_def by simp + hence "?N l1 \ ?M l1" "?N l2 \ ?M l2" + using tr_par_trms_subset[OF tr_par_proj[OF assms(2)]] by (metis Un_empty_right)+ + ultimately have "GSMP_disjoint (?N l1) (?N l2) Sec" + using GSMP_disjoint_subset by presburger + } hence 1: "\l1 l2. l1 \ l2 \ GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 A') (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 A') Sec" + using 0(1) by metis + + have 2: "ground Sec" "\s \ Sec. \s' \ subterms s. {} \\<^sub>c s' \ s' \ Sec" + using assms(1) unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by metis+ + + show ?thesis using 1 2 unfolding par_comp_def by metis +qed + +lemma tr_leaking_prefix_exists: + assumes "A' \ set (tr\<^sub>p\<^sub>c A [])" "prefix B A'" "ik\<^sub>s\<^sub>t (proj_unl n B) \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" + shows "\C D. prefix C B \ prefix D A \ C \ set (tr\<^sub>p\<^sub>c D []) \ (ik\<^sub>s\<^sub>t (proj_unl n C) \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \)" +proof - + let ?P = "\B C C'. B = C@C' \ (\n t. (n, receive\t\\<^sub>s\<^sub>t) \ set C') \ + (C = [] \ (\n t. suffix [(n,receive\t\\<^sub>s\<^sub>t)] C))" + have "\C C'. ?P B C C'" + proof (induction B) + case (Cons b B) + then obtain C C' n s where *: "?P B C C'" "b = (n,s)" by moura + show ?case + proof (cases "C = []") + case True + note T = True + show ?thesis + proof (cases "\t. s = receive\t\\<^sub>s\<^sub>t") + case True + hence "?P (b#B) [b] C'" using * T by auto + thus ?thesis by metis + next + case False + hence "?P (b#B) [] (b#C')" using * T by auto + thus ?thesis by metis + qed + next + case False + hence "?P (b#B) (b#C) C'" using * unfolding suffix_def by auto + thus ?thesis by metis + qed + qed simp + then obtain C C' where C: + "B = C@C'" "\n t. (n, receive\t\\<^sub>s\<^sub>t) \ set C'" + "C = [] \ (\n t. suffix [(n,receive\t\\<^sub>s\<^sub>t)] C)" + by moura + hence 1: "prefix C B" by simp + hence 2: "prefix C A'" using assms(2) by simp + + have "\m t. (m,receive\t\\<^sub>s\<^sub>t) \ set B \ (m,receive\t\\<^sub>s\<^sub>t) \ set C" using C by auto + hence "\t. receive\t\\<^sub>s\<^sub>t \ set (proj_unl n B) \ receive\t\\<^sub>s\<^sub>t \ set (proj_unl n C)" + unfolding unlabel_def proj_def by force + hence "ik\<^sub>s\<^sub>t (proj_unl n B) \ ik\<^sub>s\<^sub>t (proj_unl n C)" using ik\<^sub>s\<^sub>t_is_rcv_set by auto + hence 3: "ik\<^sub>s\<^sub>t (proj_unl n C) \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" by (metis ideduct_mono[OF assms(3)] subst_all_mono) + + { fix D E m t assume "suffix [(m, receive\t\\<^sub>s\<^sub>t)] E" "prefix E A'" "A' \ set (tr\<^sub>p\<^sub>c A D)" + hence "\F. prefix F A \ E \ set (tr\<^sub>p\<^sub>c F D)" + proof (induction A D arbitrary: A' E rule: tr\<^sub>p\<^sub>c.induct) + case (1 D) thus ?case by simp + next + case (2 i t' S D) + note prems = "2.prems" + note IH = "2.IH" + obtain A'' where *: "A' = (i,send\t'\\<^sub>s\<^sub>t)#A''" "A'' \ set (tr\<^sub>p\<^sub>c S D)" + using prems(3) by auto + have "E \ []" using prems(1) by auto + then obtain E' where **: "E = (i,send\t'\\<^sub>s\<^sub>t)#E'" + using *(1) prems(2) by (cases E) auto + hence "suffix [(m, receive\t\\<^sub>s\<^sub>t)] E'" "prefix E' A''" + using *(1) prems(1,2) suffix_Cons[of _ _ E'] by auto + then obtain F where "prefix F S" "E' \ set (tr\<^sub>p\<^sub>c F D)" + using *(2) ** IH by metis + hence "prefix ((i,Send t')#F) ((i,Send t')#S)" "E \ set (tr\<^sub>p\<^sub>c ((i,Send t')#F) D)" + using ** by auto + thus ?case by metis + next + case (3 i t' S D) + note prems = "3.prems" + note IH = "3.IH" + obtain A'' where *: "A' = (i,receive\t'\\<^sub>s\<^sub>t)#A''" "A'' \ set (tr\<^sub>p\<^sub>c S D)" + using prems(3) by auto + have "E \ []" using prems(1) by auto + then obtain E' where **: "E = (i,receive\t'\\<^sub>s\<^sub>t)#E'" + using *(1) prems(2) by (cases E) auto + show ?case + proof (cases "(m, receive\t\\<^sub>s\<^sub>t) = (i, receive\t'\\<^sub>s\<^sub>t)") + case True + note T = True + show ?thesis + proof (cases "suffix [(m, receive\t\\<^sub>s\<^sub>t)] E'") + case True + hence "suffix [(m, receive\t\\<^sub>s\<^sub>t)] E'" "prefix E' A''" + using ** *(1) prems(1,2) by auto + then obtain F where "prefix F S" "E' \ set (tr\<^sub>p\<^sub>c F D)" + using *(2) ** IH by metis + hence "prefix ((i,receive\t'\)#F) ((i,receive\t'\)#S)" + "E \ set (tr\<^sub>p\<^sub>c ((i,receive\t'\)#F) D)" + using ** by auto + thus ?thesis by metis + next + case False + hence "E' = []" + using **(1) T prems(1) + suffix_Cons[of "[(m, receive\t\\<^sub>s\<^sub>t)]" "(m, receive\t\\<^sub>s\<^sub>t)" E'] + by auto + hence "prefix [(i,receive\t'\)] ((i,receive\t'\) # S) \ E \ set (tr\<^sub>p\<^sub>c [(i,receive\t'\)] D)" + using * ** prems by auto + thus ?thesis by metis + qed + next + case False + hence "suffix [(m, receive\t\\<^sub>s\<^sub>t)] E'" "prefix E' A''" + using ** *(1) prems(1,2) suffix_Cons[of _ _ E'] by auto + then obtain F where "prefix F S" "E' \ set (tr\<^sub>p\<^sub>c F D)" using *(2) ** IH by metis + hence "prefix ((i,receive\t'\)#F) ((i,receive\t'\)#S)" "E \ set (tr\<^sub>p\<^sub>c ((i,receive\t'\)#F) D)" + using ** by auto + thus ?thesis by metis + qed + next + case (4 i ac t' t'' S D) + note prems = "4.prems" + note IH = "4.IH" + obtain A'' where *: "A' = (i,\ac: t' \ t''\\<^sub>s\<^sub>t)#A''" "A'' \ set (tr\<^sub>p\<^sub>c S D)" + using prems(3) by auto + have "E \ []" using prems(1) by auto + then obtain E' where **: "E = (i,\ac: t' \ t''\\<^sub>s\<^sub>t)#E'" + using *(1) prems(2) by (cases E) auto + hence "suffix [(m, receive\t\\<^sub>s\<^sub>t)] E'" "prefix E' A''" + using *(1) prems(1,2) suffix_Cons[of _ _ E'] by auto + then obtain F where "prefix F S" "E' \ set (tr\<^sub>p\<^sub>c F D)" + using *(2) ** IH by metis + hence "prefix ((i,Equality ac t' t'')#F) ((i,Equality ac t' t'')#S)" + "E \ set (tr\<^sub>p\<^sub>c ((i,Equality ac t' t'')#F) D)" + using ** by auto + thus ?case by metis + next + case (5 i t' s S D) + note prems = "5.prems" + note IH = "5.IH" + have *: "A' \ set (tr\<^sub>p\<^sub>c S (List.insert (i,t',s) D))" using prems(3) by auto + have "E \ []" using prems(1) by auto + hence "suffix [(m, receive\t\\<^sub>s\<^sub>t)] E" "prefix E A'" + using *(1) prems(1,2) suffix_Cons[of _ _ E] by auto + then obtain F where "prefix F S" "E \ set (tr\<^sub>p\<^sub>c F (List.insert (i,t',s) D))" + using * IH by metis + hence "prefix ((i,insert\t',s\)#F) ((i,insert\t',s\)#S)" + "E \ set (tr\<^sub>p\<^sub>c ((i,insert\t',s\)#F) D)" + by auto + thus ?case by metis + next + case (6 i t' s S D) + note prems = "6.prems" + note IH = "6.IH" + + define constr where "constr = (\Di. + (map (\d. (i,\check: (pair (t',s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di)@ + (map (\d. (i,\[]\\\: [(pair (t',s), pair (snd d))]\\<^sub>s\<^sub>t)) + (filter (\d. d \ set Di) (dbproj i D))))" + + obtain A'' Di where *: + "A' = constr Di@A''" "A'' \ set (tr\<^sub>p\<^sub>c S (filter (\d. d \ set Di) D))" + "Di \ set (subseqs (dbproj i D))" + using prems(3) constr_def by auto + have ***: "(m, receive\t\\<^sub>s\<^sub>t) \ set (constr Di)" using constr_def by auto + have "E \ []" using prems(1) by auto + then obtain E' where **: "E = constr Di@E'" + using *(1) prems(1,2) *** + by (metis (mono_tags, lifting) Un_iff list.set_intros(1) prefixI prefix_def + prefix_same_cases set_append suffix_def) + hence "suffix [(m, receive\t\\<^sub>s\<^sub>t)] E'" "prefix E' A''" + using *(1) prems(1,2) suffix_append[of "[(m,receive\t\\<^sub>s\<^sub>t)]" "constr Di" E'] *** + by (metis (no_types, hide_lams) Nil_suffix append_Nil2 in_set_conv_decomp rev_exhaust + snoc_suffix_snoc suffix_appendD, + auto) + then obtain F where "prefix F S" "E' \ set (tr\<^sub>p\<^sub>c F (filter (\d. d \ set Di) D))" + using *(2,3) ** IH by metis + hence "prefix ((i,delete\t',s\)#F) ((i,delete\t',s\)#S)" + "E \ set (tr\<^sub>p\<^sub>c ((i,delete\t',s\)#F) D)" + using *(3) ** constr_def by auto + thus ?case by metis + next + case (7 i ac t' s S D) + note prems = "7.prems" + note IH = "7.IH" + + define constr where "constr = ( + \d::(('lbl strand_label \ ('fun,'var) term \ ('fun,'var) term)). + (i,\ac: (pair (t',s)) \ (pair (snd d))\\<^sub>s\<^sub>t))" + + obtain A'' d where *: "A' = constr d#A''" "A'' \ set (tr\<^sub>p\<^sub>c S D)" "d \ set (dbproj i D)" + using prems(3) constr_def by auto + have "E \ []" using prems(1) by auto + then obtain E' where **: "E = constr d#E'" using *(1) prems(2) by (cases E) auto + hence "suffix [(m, receive\t\\<^sub>s\<^sub>t)] E'" "prefix E' A''" + using *(1) prems(1,2) suffix_Cons[of _ _ E'] using constr_def by auto + then obtain F where "prefix F S" "E' \ set (tr\<^sub>p\<^sub>c F D)" using *(2) ** IH by metis + hence "prefix ((i,InSet ac t' s)#F) ((i,InSet ac t' s)#S)" + "E \ set (tr\<^sub>p\<^sub>c ((i,InSet ac t' s)#F) D)" + using *(3) ** unfolding constr_def by auto + thus ?case by metis + next + case (8 i X G G' S D) + note prems = "8.prems" + note IH = "8.IH" + + define constr where + "constr = map (\H. (i,\X\\\: (G@H)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G' (map snd (dbproj i D)))" + + obtain A'' where *: "A' = constr@A''" "A'' \ set (tr\<^sub>p\<^sub>c S D)" + using prems(3) constr_def by auto + have ***: "(m, receive\t\\<^sub>s\<^sub>t) \ set constr" using constr_def by auto + have "E \ []" using prems(1) by auto + then obtain E' where **: "E = constr@E'" + using *(1) prems(1,2) *** + by (metis (mono_tags, lifting) Un_iff list.set_intros(1) prefixI prefix_def + prefix_same_cases set_append suffix_def) + hence "suffix [(m, receive\t\\<^sub>s\<^sub>t)] E'" "prefix E' A''" + using *(1) prems(1,2) suffix_append[of "[(m,receive\t\\<^sub>s\<^sub>t)]" constr E'] *** + by (metis (no_types, hide_lams) Nil_suffix append_Nil2 in_set_conv_decomp rev_exhaust + snoc_suffix_snoc suffix_appendD, + auto) + then obtain F where "prefix F S" "E' \ set (tr\<^sub>p\<^sub>c F D)" using *(2) ** IH by metis + hence "prefix ((i,NegChecks X G G')#F) ((i,NegChecks X G G')#S)" + "E \ set (tr\<^sub>p\<^sub>c ((i,NegChecks X G G')#F) D)" + using ** constr_def by auto + thus ?case by metis + qed + } + moreover have "prefix [] A" "[] \ set (tr\<^sub>p\<^sub>c [] [])" by auto + ultimately have 4: "\D. prefix D A \ C \ set (tr\<^sub>p\<^sub>c D [])" using C(3) assms(1) 2 by blast + + show ?thesis by (metis 1 3 4) +qed + + +subsection \Theorem: Semantic Equivalence of Translation\ +context +begin + +text \ + An alternative version of the translation that does not perform database-state projections. + It is used as an intermediate step in the proof of semantic equivalence. +\ +private fun tr'\<^sub>p\<^sub>c:: + "('fun,'var,'lbl) labeled_stateful_strand \ ('fun,'var,'lbl) labeleddbstatelist + \ ('fun,'var,'lbl) labeled_strand list" +where + "tr'\<^sub>p\<^sub>c [] D = [[]]" +| "tr'\<^sub>p\<^sub>c ((i,send\t\)#A) D = map ((#) (i,send\t\\<^sub>s\<^sub>t)) (tr'\<^sub>p\<^sub>c A D)" +| "tr'\<^sub>p\<^sub>c ((i,receive\t\)#A) D = map ((#) (i,receive\t\\<^sub>s\<^sub>t)) (tr'\<^sub>p\<^sub>c A D)" +| "tr'\<^sub>p\<^sub>c ((i,\ac: t \ t'\)#A) D = map ((#) (i,\ac: t \ t'\\<^sub>s\<^sub>t)) (tr'\<^sub>p\<^sub>c A D)" +| "tr'\<^sub>p\<^sub>c ((i,insert\t,s\)#A) D = tr'\<^sub>p\<^sub>c A (List.insert (i,(t,s)) D)" +| "tr'\<^sub>p\<^sub>c ((i,delete\t,s\)#A) D = ( + concat (map (\Di. map (\B. (map (\d. (i,\check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di)@ + (map (\d. (i,\[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) + [d\D. d \ set Di])@B) + (tr'\<^sub>p\<^sub>c A [d\D. d \ set Di])) + (subseqs D)))" +| "tr'\<^sub>p\<^sub>c ((i,\ac: t \ s\)#A) D = + concat (map (\B. map (\d. (i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)#B) D) (tr'\<^sub>p\<^sub>c A D))" +| "tr'\<^sub>p\<^sub>c ((i,\X\\\: F \\: F'\)#A) D = + map ((@) (map (\G. (i,\X\\\: (F@G)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D)))) (tr'\<^sub>p\<^sub>c A D)" + +subsubsection \Part 1\ +private lemma tr'_par_iff_unlabel_tr: + assumes "\(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set D. + \(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set D. + p = q \ i = j" + shows "(\C \ set (tr'\<^sub>p\<^sub>c A D). B = unlabel C) \ B \ set (tr (unlabel A) (unlabel D))" + (is "?A \ ?B") +proof + { fix C have "C \ set (tr'\<^sub>p\<^sub>c A D) \ unlabel C \ set (tr (unlabel A) (unlabel D))" using assms + proof (induction A D arbitrary: C rule: tr'\<^sub>p\<^sub>c.induct) + case (5 i t s S D) + hence "unlabel C \ set (tr (unlabel S) (unlabel (List.insert (i, t, s) D)))" + by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + moreover have + "insert (i,t,s) (set D) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i,insert\t,s\)#S) \ set D" + by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "\(j,p) \ insert (i,t,s) (set D). \(k,q) \ insert (i,t,s) (set D). p = q \ j = k" + using "5.prems"(2) by blast + hence "unlabel (List.insert (i, t, s) D) = (List.insert (t, s) (unlabel D))" + using map_snd_list_insert_distrib[of "(i,t,s)" D] unfolding unlabel_def by simp + ultimately show ?case by auto + next + case (6 i t s S D) + let ?f1 = "\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t" + let ?g1 = "\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t" + let ?f2 = "\d. (i, ?f1 (snd d))" + let ?g2 = "\d. (i, ?g1 (snd d))" + + define constr1 where "constr1 = (\Di. (map ?f1 Di)@(map ?g1 [d\unlabel D. d \ set Di]))" + define constr2 where "constr2 = (\Di. (map ?f2 Di)@(map ?g2 [d\D. d \ set Di]))" + + obtain C' Di where C': + "Di \ set (subseqs D)" + "C = constr2 Di@C'" + "C' \ set (tr'\<^sub>p\<^sub>c S [d\D. d \ set Di])" + using "6.prems"(1) unfolding constr2_def by moura + + have 0: "set [d\D. d \ set Di] \ set D" + "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\t,s\)#S)" + by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence 1: + "\(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set [d\D. d \ set Di]. + \(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set [d\D. d \ set Di]. + p = q \ j = k" + using "6.prems"(2) by blast + + have "\(i,p) \ set D \ set Di. \(j,q) \ set D \ set Di. p = q \ i = j" + using "6.prems"(2) subseqs_set_subset(1)[OF C'(1)] by blast + hence 2: "unlabel [d\D. d \ set Di] = [d\unlabel D. d \ set (unlabel Di)]" + using unlabel_filter_eq[of D "set Di"] unfolding unlabel_def by simp + + have 3: + "\f g::('a \ 'a \ 'c). \A B::(('b \ 'a \ 'a) list). + map snd ((map (\d. (i, f (snd d))) A)@(map (\d. (i, g (snd d))) B)) = + map f (map snd A)@map g (map snd B)" + by simp + have "unlabel (constr2 Di) = constr1 (unlabel Di)" + using 2 3[of ?f1 Di ?g1 "[d\D. d \ set Di]"] + by (simp add: constr1_def constr2_def unlabel_def) + hence 4: "unlabel C = constr1 (unlabel Di)@unlabel C'" + using C'(2) unlabel_append by metis + + have "unlabel Di \ set (map unlabel (subseqs D))" + using C'(1) unfolding unlabel_def by simp + hence 5: "unlabel Di \ set (subseqs (unlabel D))" + using map_subseqs[of snd D] unfolding unlabel_def by simp + + show ?case using "6.IH"[OF C'(1,3) 1] 2 4 5 unfolding constr1_def by auto + next + case (7 i ac t s S D) + obtain C' d where C': + "C = (i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)#C'" + "C' \ set (tr'\<^sub>p\<^sub>c S D)" "d \ set D" + using "7.prems"(1) by moura + + have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set D \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i,InSet ac t s)#S) \ set D" + by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "\(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set D. + \(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set D. + p = q \ j = k" + using "7.prems"(2) by blast + hence "unlabel C' \ set (tr (unlabel S) (unlabel D))" using "7.IH"[OF C'(2)] by auto + thus ?case using C' unfolding unlabel_def by force + next + case (8 i X F F' S D) + obtain C' where C': + "C = map (\G. (i,\X\\\: (F@G)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D))@C'" + "C' \ set (tr'\<^sub>p\<^sub>c S D)" + using "8.prems"(1) by moura + + have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set D \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i,NegChecks X F F')#S) \ set D" + by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "\(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set D. + \(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set D. + p = q \ j = k" + using "8.prems"(2) by blast + hence "unlabel C' \ set (tr (unlabel S) (unlabel D))" using "8.IH"[OF C'(2)] by auto + thus ?case using C' unfolding unlabel_def by auto + qed (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + } thus "?A \ ?B" by blast + + show "?B \ ?A" using assms + proof (induction A arbitrary: B D) + case (Cons a A) + obtain ia sa where a: "a = (ia,sa)" by moura + + have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A)" using a by (cases sa) (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence 1: "\(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set D. + \(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set D. + p = q \ j = k" + using Cons.prems(2) by blast + + show ?case + proof (cases sa) + case (Send t) + then obtain B' where B': + "B = send\t\\<^sub>s\<^sub>t#B'" + "B' \ set (tr (unlabel A) (unlabel D))" + using Cons.prems(1) a by auto + thus ?thesis using Cons.IH[OF B'(2) 1] a B'(1) Send by auto + next + case (Receive t) + then obtain B' where B': + "B = receive\t\\<^sub>s\<^sub>t#B'" + "B' \ set (tr (unlabel A) (unlabel D))" + using Cons.prems(1) a by auto + thus ?thesis using Cons.IH[OF B'(2) 1] a B'(1) Receive by auto + next + case (Equality ac t t') + then obtain B' where B': + "B = \ac: t \ t'\\<^sub>s\<^sub>t#B'" + "B' \ set (tr (unlabel A) (unlabel D))" + using Cons.prems(1) a by auto + thus ?thesis using Cons.IH[OF B'(2) 1] a B'(1) Equality by auto + next + case (Insert t s) + hence B: "B \ set (tr (unlabel A) (List.insert (t,s) (unlabel D)))" + using Cons.prems(1) a by auto + + let ?P = "\i. List.insert (t,s) (unlabel D) = unlabel (List.insert (i,t,s) D)" + + { obtain j where j: "?P j" "j = ia \ (j,t,s) \ set D" + using labeled_list_insert_eq_ex_cases[of "(t,s)" D ia] by moura + hence "j = ia" using Cons.prems(2) a Insert by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "?P ia" using j(1) by metis + } hence j: "?P ia" by metis + + have 2: "\(k1, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set (List.insert (ia,t,s) D). + \(k2, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set (List.insert (ia,t,s) D). + p = q \ k1 = k2" + using Cons.prems(2) a Insert by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + + show ?thesis using Cons.IH[OF _ 2] j(1) B Insert a by auto + next + case (Delete t s) + define c where "c \ (\(i::'lbl strand_label) Di. + map (\d. (i,\check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di@ + map (\d. (i,\[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) [d\D. d \ set Di])" + + define d where "d \ (\Di. + map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di@ + map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\unlabel D. d \ set Di])" + + obtain B' Di where B': + "B = d Di@B'" "Di \ set (subseqs (unlabel D))" + "B' \ set (tr (unlabel A) [d\unlabel D. d \ set Di])" + using Cons.prems(1) a Delete unfolding d_def by auto + + obtain Di' where Di': "Di' \ set (subseqs D)" "unlabel Di' = Di" + using unlabel_subseqsD[OF B'(2)] by moura + + have 2: "\(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set [d\D. d \ set Di']. + \(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set [d\D. d \ set Di']. + p = q \ j = k" + using 1 subseqs_subset[OF Di'(1)] + filter_is_subset[of "\d. d \ set Di'"] + by blast + + have "set Di' \ set D" by (rule subseqs_subset[OF Di'(1)]) + hence "\(j, p)\set D \ set Di'. \(k, q)\set D \ set Di'. p = q \ j = k" + using Cons.prems(2) by blast + hence 3: "[d\unlabel D. d \ set Di] = unlabel [d\D. d \ set Di']" + using Di'(2) unlabel_filter_eq[of D "set Di'"] unfolding unlabel_def by auto + + obtain C where C: "C \ set (tr'\<^sub>p\<^sub>c A [d\D. d \ set Di'])" "B' = unlabel C" + using 3 Cons.IH[OF _ 2] B'(3) by auto + hence 4: "c ia Di'@C \ set (tr'\<^sub>p\<^sub>c (a#A) D)" using Di'(1) a Delete unfolding c_def by auto + + have "unlabel (c ia Di') = d Di" using Di' 3 unfolding c_def d_def unlabel_def by auto + hence 5: "B = unlabel (c ia Di'@C)" using B'(1) C(2) unlabel_append[of "c ia Di'" C] by simp + + show ?thesis using 4 5 by blast + next + case (InSet ac t s) + then obtain B' d where B': + "B = \ac: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t#B'" + "B' \ set (tr (unlabel A) (unlabel D))" + "d \ set (unlabel D)" + using Cons.prems(1) a by auto + thus ?thesis using Cons.IH[OF _ 1] a InSet unfolding unlabel_def by auto + next + case (NegChecks X F F') + then obtain B' where B': + "B = map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (unlabel D))@B'" + "B' \ set (tr (unlabel A) (unlabel D))" + using Cons.prems(1) a by auto + thus ?thesis using Cons.IH[OF _ 1] a NegChecks unfolding unlabel_def by auto + qed + qed simp +qed + +subsubsection \Part 2\ +private lemma tr_par_iff_tr'_par: + assumes "\(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set D. \(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set D. + (\\. Unifier \ (pair p) (pair q)) \ i = j" + (is "?R3 A D") + and "\(l,t,s) \ set D. (fv t \ fv s) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" (is "?R4 A D") + and "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" (is "?R5 A D") + shows "(\B \ set (tr\<^sub>p\<^sub>c A D). \M; unlabel B\\<^sub>d \) \ (\C \ set (tr'\<^sub>p\<^sub>c A D). \M; unlabel C\\<^sub>d \)" + (is "?P \ ?Q") +proof + { fix B assume "B \ set (tr\<^sub>p\<^sub>c A D)" "\M; unlabel B\\<^sub>d \" + hence ?Q using assms + proof (induction A D arbitrary: B M rule: tr\<^sub>p\<^sub>c.induct) + case (1 D) thus ?case by simp + next + case (2 i t S D) + note prems = "2.prems" + note IH = "2.IH" + + obtain B' where B': "B = (i,send\t\\<^sub>s\<^sub>t)#B'" "B' \ set (tr\<^sub>p\<^sub>c S D)" + using prems(1) by moura + + have 1: "\M; unlabel B'\\<^sub>d \" using prems(2) B'(1) by simp + have 4: "?R3 S D" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + have 5: "?R4 S D" using prems(4) by force + have 6: "?R5 S D" using prems(5) by force + + have 7: "M \ t \ \" using prems(2) B'(1) by simp + + obtain C where C: "C \ set (tr'\<^sub>p\<^sub>c S D)" "\M; unlabel C\\<^sub>d \" + using IH[OF B'(2) 1 4 5 6] by moura + hence "((i,send\t\\<^sub>s\<^sub>t)#C) \ set (tr'\<^sub>p\<^sub>c ((i,Send t)#S) D)" "\M; unlabel ((i,send\t\\<^sub>s\<^sub>t)#C)\\<^sub>d \" + using 7 by auto + thus ?case by metis + next + case (3 i t S D) + note prems = "3.prems" + note IH = "3.IH" + + obtain B' where B': "B = (i,receive\t\\<^sub>s\<^sub>t)#B'" "B' \ set (tr\<^sub>p\<^sub>c S D)" using prems(1) by moura + + have 1: "\insert (t \ \) M; unlabel B'\\<^sub>d \ " using prems(2) B'(1) by simp + have 4: "?R3 S D" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + have 5: "?R4 S D" using prems(4) by force + have 6: "?R5 S D" using prems(5) by force + + obtain C where C: "C \ set (tr'\<^sub>p\<^sub>c S D)" "\insert (t \ \) M; unlabel C\\<^sub>d \" + using IH[OF B'(2) 1 4 5 6] by moura + hence "((i,receive\t\\<^sub>s\<^sub>t)#C) \ set (tr'\<^sub>p\<^sub>c ((i,receive\t\)#S) D)" + "\insert (t \ \) M; unlabel ((i,receive\t\\<^sub>s\<^sub>t)#C)\\<^sub>d \" + by auto + thus ?case by auto + next + case (4 i ac t t' S D) + note prems = "4.prems" + note IH = "4.IH" + + obtain B' where B': "B = (i,\ac: t \ t'\\<^sub>s\<^sub>t)#B'" "B' \ set (tr\<^sub>p\<^sub>c S D)" + using prems(1) by moura + + have 1: "\M; unlabel B'\\<^sub>d \ " using prems(2) B'(1) by simp + have 4: "?R3 S D" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + have 5: "?R4 S D" using prems(4) by force + have 6: "?R5 S D" using prems(5) by force + + have 7: "t \ \ = t' \ \" using prems(2) B'(1) by simp + + obtain C where C: "C \ set (tr'\<^sub>p\<^sub>c S D)" "\M; unlabel C\\<^sub>d \" + using IH[OF B'(2) 1 4 5 6] by moura + hence "((i,\ac: t \ t'\\<^sub>s\<^sub>t)#C) \ set (tr'\<^sub>p\<^sub>c ((i,Equality ac t t')#S) D)" + "\M; unlabel ((i,\ac: t \ t'\\<^sub>s\<^sub>t)#C)\\<^sub>d \" + using 7 by auto + thus ?case by metis + next + case (5 i t s S D) + note prems = "5.prems" + note IH = "5.IH" + + have B: "B \ set (tr\<^sub>p\<^sub>c S (List.insert (i,t,s) D))" using prems(1) by simp + + have 1: "\M; unlabel B\\<^sub>d \ " using prems(2) B(1) by simp + have 4: "?R3 S (List.insert (i,t,s) D)" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + have 5: "?R4 S (List.insert (i,t,s) D)" using prems(4,5) by force + have 6: "?R5 S D" using prems(5) by force + + show ?case using IH[OF B(1) 1 4 5 6] by simp + next + case (6 i t s S D) + note prems = "6.prems" + note IH = "6.IH" + + let ?cl1 = "\Di. map (\d. (i,\check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di" + let ?cu1 = "\Di. map (\d. \check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t) Di" + let ?cl2 = "\Di. map (\d. (i,\[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) [d\dbproj i D. d\set Di]" + let ?cu2 = "\Di. map (\d. \[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t) [d\dbproj i D. d\set Di]" + + let ?dl1 = "\Di. map (\d. (i,\check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di" + let ?du1 = "\Di. map (\d. \check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t) Di" + let ?dl2 = "\Di. map (\d. (i,\[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) [d\D. d\set Di]" + let ?du2 = "\Di. map (\d. \[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t) [d\D. d\set Di]" + + define c where c: "c = (\Di. ?cl1 Di@?cl2 Di)" + define d where d: "d = (\Di. ?dl1 Di@?dl2 Di)" + + obtain B' Di where B': + "Di \ set (subseqs (dbproj i D))" "B = c Di@B'" "B' \ set (tr\<^sub>p\<^sub>c S [d\D. d \ set Di])" + using prems(1) c by moura + + have 0: "ik\<^sub>s\<^sub>t (unlabel (c Di)) = {}" "ik\<^sub>s\<^sub>t (unlabel (d Di)) = {}" + "unlabel (?cl1 Di) = ?cu1 Di" "unlabel (?cl2 Di) = ?cu2 Di" + "unlabel (?dl1 Di) = ?du1 Di" "unlabel (?dl2 Di) = ?du2 Di" + unfolding c d unlabel_def by force+ + + have 1: "\M; unlabel B'\\<^sub>d \ " using prems(2) B'(2) 0(1) unfolding unlabel_def by auto + + { fix j p k q + assume "(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set [d\D. d \ set Di]" + "(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set [d\D. d \ set Di]" + hence "(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\t,s\)#S) \ set D" + "(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\t,s\)#S) \ set D" + using dbproj_subseq_subset[OF B'(1)] by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "(\\. Unifier \ (pair p) (pair q)) \ j = k" using prems(3) by blast + } hence 4: "?R3 S [d\D. d \ set Di]" by blast + + have 5: "?R4 S (filter (\d. d \ set Di) D)" using prems(4) by force + have 6: "?R5 S D" using prems(5) by force + + obtain C where C: "C \ set (tr'\<^sub>p\<^sub>c S [d\D . d \ set Di])" "\M; unlabel C\\<^sub>d \" + using IH[OF B'(1,3) 1 4 5 6] by moura + + have 7: "\M; unlabel (c Di)\\<^sub>d \" "\M; unlabel B'\\<^sub>d \" + using prems(2) B'(2) 0(1) strand_sem_split(3,4)[of M "unlabel (c Di)" "unlabel B'"] + unfolding c unlabel_def by auto + + have "\M; unlabel (?cl2 Di)\\<^sub>d \" using 7(1) 0(1) unfolding c unlabel_def by auto + hence "\M; ?cu2 Di\\<^sub>d \" by (metis 0(4)) + moreover { + fix j p k q + assume "(j, p) \ {(i, t, s)} \ set D \ set Di" + "(k, q) \ {(i, t, s)} \ set D \ set Di" + hence "(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\t,s\)#S) \ set D" + "(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\t,s\)#S) \ set D" + using dbproj_subseq_subset[OF B'(1)] by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "(\\. Unifier \ (pair p) (pair q)) \ j = k" using prems(3) by blast + } hence "\(j, p) \ {(i, t, s)} \ set D \ set Di. + \(k, q) \ {(i, t, s)} \ set D \ set Di. + (\\. Unifier \ (pair p) (pair q)) \ j = k" + by blast + ultimately have "\M; ?du2 Di\\<^sub>d \" using labeled_sat_ineq_lift by simp + hence "\M; unlabel (?dl2 Di)\\<^sub>d \" by (metis 0(6)) + moreover have "\M; unlabel (?cl1 Di)\\<^sub>d \" using 7(1) unfolding c unlabel_def by auto + hence "\M; unlabel (?dl1 Di)\\<^sub>d \" by (metis 0(3,5)) + ultimately have "\M; unlabel (d Di)\\<^sub>d \" using 0(2) unfolding c d unlabel_def by force + hence 8: "\M; unlabel (d Di@C)\\<^sub>d \" using 0(2) C(2) unfolding unlabel_def by auto + + have 9: "d Di@C \ set (tr'\<^sub>p\<^sub>c ((i,delete\t,s\)#S) D)" + using C(1) dbproj_subseq_in_subseqs[OF B'(1)] + unfolding d unlabel_def by auto + + show ?case by (metis 8 9) + next + case (7 i ac t s S D) + note prems = "7.prems" + note IH = "7.IH" + + obtain B' d where B': + "B = (i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)#B'" + "B' \ set (tr\<^sub>p\<^sub>c S D)" "d \ set (dbproj i D)" + using prems(1) by moura + + have 1: "\M; unlabel B'\\<^sub>d \ " using prems(2) B'(1) by simp + + { fix j p k q + assume "(j,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set D" + "(k,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set D" + hence "(j,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, InSet ac t s)#S) \ set D" + "(k,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, InSet ac t s)#S) \ set D" + by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "(\\. Unifier \ (pair p) (pair q)) \ j = k" using prems(3) by blast + } hence 4: "?R3 S D" by blast + + have 5: "?R4 S D" using prems(4) by force + have 6: "?R5 S D" using prems(5) by force + have 7: "pair (t,s) \ \ = pair (snd d) \ \" using prems(2) B'(1) by simp + + obtain C where C: "C \ set (tr'\<^sub>p\<^sub>c S D)" "\M; unlabel C\\<^sub>d \" + using IH[OF B'(2) 1 4 5 6] by moura + hence "((i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)#C) \ set (tr'\<^sub>p\<^sub>c ((i,InSet ac t s)#S) D)" + "\M; unlabel ((i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)#C)\\<^sub>d \" + using 7 B'(3) by auto + thus ?case by metis + next + case (8 i X F F' S D) + note prems = "8.prems" + note IH = "8.IH" + + let ?cl = "map (\G. (i,\X\\\: (F@G)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))" + let ?cu = "map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))" + + let ?dl = "map (\G. (i,\X\\\: (F@G)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D))" + let ?du = "map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D))" + + define c where c: "c = ?cl" + define d where d: "d = ?dl" + + obtain B' where B': "B = c@B'" "B' \ set (tr\<^sub>p\<^sub>c S D)" using prems(1) c by moura + + have 0: "ik\<^sub>s\<^sub>t (unlabel c) = {}" "ik\<^sub>s\<^sub>t (unlabel d) = {}" + "unlabel ?cl = ?cu" "unlabel ?dl = ?du" + unfolding c d unlabel_def by force+ + + have "ik\<^sub>s\<^sub>t (unlabel c) = {}" unfolding c unlabel_def by force + hence 1: "\M; unlabel B'\\<^sub>d \ " using prems(2) B'(1) unfolding unlabel_def by auto + + have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, NegChecks X F F')#S)" by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence 4: "?R3 S D" using prems(3) by blast + + have 5: "?R4 S D" using prems(4) by force + have 6: "?R5 S D" using prems(5) by force + + obtain C where C: "C \ set (tr'\<^sub>p\<^sub>c S D)" "\M; unlabel C\\<^sub>d \" + using IH[OF B'(2) 1 4 5 6] by moura + + have 7: "\M; unlabel c\\<^sub>d \" "\M; unlabel B'\\<^sub>d \" + using prems(2) B'(1) 0(1) strand_sem_split(3,4)[of M "unlabel c" "unlabel B'"] + unfolding c unlabel_def by auto + + have 8: "d@C \ set (tr'\<^sub>p\<^sub>c ((i,NegChecks X F F')#S) D)" + using C(1) unfolding d unlabel_def by auto + + have "\M; unlabel ?cl\\<^sub>d \" using 7(1) unfolding c unlabel_def by auto + hence "\M; ?cu\\<^sub>d \" by (metis 0(3)) + moreover { + fix j p k q + assume "(j, p) \ ((\(t,s). (i,t,s)) ` set F') \ set D" + "(k, q) \ ((\(t,s). (i,t,s)) ` set F') \ set D" + hence "(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, NegChecks X F F')#S) \ set D" + "(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, NegChecks X F F')#S) \ set D" + by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "(\\. Unifier \ (pair p) (pair q)) \ j = k" using prems(3) by blast + } hence "\(j, p) \ ((\(t,s). (i,t,s)) ` set F') \ set D. + \(k, q) \ ((\(t,s). (i,t,s)) ` set F') \ set D. + (\\. Unifier \ (pair p) (pair q)) \ j = k" + by blast + moreover have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (map snd D) \ set X = {}" + using prems(4) by fastforce + ultimately have "\M; ?du\\<^sub>d \" using labeled_sat_ineq_dbproj_sem_equiv[of i] by simp + hence "\M; unlabel ?dl\\<^sub>d \" by (metis 0(4)) + hence "\M; unlabel d\\<^sub>d \" using 0(2) unfolding c d unlabel_def by force + hence 9: "\M; unlabel (d@C)\\<^sub>d \" using 0(2) C(2) unfolding unlabel_def by auto + + show ?case by (metis 8 9) + qed + } thus "?P \ ?Q" by metis + + { fix C assume "C \ set (tr'\<^sub>p\<^sub>c A D)" "\M; unlabel C\\<^sub>d \" + hence ?P using assms + proof (induction A D arbitrary: C M rule: tr'\<^sub>p\<^sub>c.induct) + case (1 D) thus ?case by simp + next + case (2 i t S D) + note prems = "2.prems" + note IH = "2.IH" + + obtain C' where C': "C = (i,send\t\\<^sub>s\<^sub>t)#C'" "C' \ set (tr'\<^sub>p\<^sub>c S D)" + using prems(1) by moura + + have 1: "\M; unlabel C'\\<^sub>d \ " using prems(2) C'(1) by simp + have 4: "?R3 S D" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + have 5: "?R4 S D" using prems(4) by force + have 6: "?R5 S D" using prems(5) by force + + have 7: "M \ t \ \" using prems(2) C'(1) by simp + + obtain B where B: "B \ set (tr\<^sub>p\<^sub>c S D)" "\M; unlabel B\\<^sub>d \" + using IH[OF C'(2) 1 4 5 6] by moura + hence "((i,send\t\\<^sub>s\<^sub>t)#B) \ set (tr\<^sub>p\<^sub>c ((i,Send t)#S) D)" + "\M; unlabel ((i,send\t\\<^sub>s\<^sub>t)#B)\\<^sub>d \" + using 7 by auto + thus ?case by metis + next + case (3 i t S D) + note prems = "3.prems" + note IH = "3.IH" + + obtain C' where C': "C = (i,receive\t\\<^sub>s\<^sub>t)#C'" "C' \ set (tr'\<^sub>p\<^sub>c S D)" + using prems(1) by moura + + have 1: "\insert (t \ \) M; unlabel C'\\<^sub>d \ " using prems(2) C'(1) by simp + have 4: "?R3 S D" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + have 5: "?R4 S D" using prems(4) by force + have 6: "?R5 S D" using prems(5) by force + + obtain B where B: "B \ set (tr\<^sub>p\<^sub>c S D)" "\insert (t \ \) M; unlabel B\\<^sub>d \" + using IH[OF C'(2) 1 4 5 6] by moura + hence "((i,receive\t\\<^sub>s\<^sub>t)#B) \ set (tr\<^sub>p\<^sub>c ((i,receive\t\)#S) D)" + "\insert (t \ \) M; unlabel ((i,receive\t\\<^sub>s\<^sub>t)#B)\\<^sub>d \" + by auto + thus ?case by auto + next + case (4 i ac t t' S D) + note prems = "4.prems" + note IH = "4.IH" + + obtain C' where C': "C = (i,\ac: t \ t'\\<^sub>s\<^sub>t)#C'" "C' \ set (tr'\<^sub>p\<^sub>c S D)" + using prems(1) by moura + + have 1: "\M; unlabel C'\\<^sub>d \ " using prems(2) C'(1) by simp + have 4: "?R3 S D" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + have 5: "?R4 S D" using prems(4) by force + have 6: "?R5 S D" using prems(5) by force + + have 7: "t \ \ = t' \ \" using prems(2) C'(1) by simp + + obtain B where B: "B \ set (tr\<^sub>p\<^sub>c S D)" "\M; unlabel B\\<^sub>d \" + using IH[OF C'(2) 1 4 5 6] by moura + hence "((i,\ac: t \ t'\\<^sub>s\<^sub>t)#B) \ set (tr\<^sub>p\<^sub>c ((i,Equality ac t t')#S) D)" + "\M; unlabel ((i,\ac: t \ t'\\<^sub>s\<^sub>t)#B)\\<^sub>d \" + using 7 by auto + thus ?case by metis + next + case (5 i t s S D) + note prems = "5.prems" + note IH = "5.IH" + + have C: "C \ set (tr'\<^sub>p\<^sub>c S (List.insert (i,t,s) D))" using prems(1) by simp + + have 1: "\M; unlabel C\\<^sub>d \ " using prems(2) C(1) by simp + have 4: "?R3 S (List.insert (i,t,s) D)" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + have 5: "?R4 S (List.insert (i,t,s) D)" using prems(4,5) by force + have 6: "?R5 S (List.insert (i,t,s) D)" using prems(5) by force + + show ?case using IH[OF C(1) 1 4 5 6] by simp + next + case (6 i t s S D) + note prems = "6.prems" + note IH = "6.IH" + + let ?dl1 = "\Di. map (\d. (i,\check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di" + let ?du1 = "\Di. map (\d. \check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t) Di" + let ?dl2 = "\Di. map (\d. (i,\[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) [d\dbproj i D. d\set Di]" + let ?du2 = "\Di. map (\d. \[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t) [d\dbproj i D. d\set Di]" + + let ?cl1 = "\Di. map (\d. (i,\check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)) Di" + let ?cu1 = "\Di. map (\d. \check: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t) Di" + let ?cl2 = "\Di. map (\d. (i,\[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t)) [d\D. d\set Di]" + let ?cu2 = "\Di. map (\d. \[]\\\: [(pair (t,s), pair (snd d))]\\<^sub>s\<^sub>t) [d\D. d\set Di]" + + define c where c: "c = (\Di. ?cl1 Di@?cl2 Di)" + define d where d: "d = (\Di. ?dl1 Di@?dl2 Di)" + + obtain C' Di where C': + "Di \ set (subseqs D)" "C = c Di@C'" "C' \ set (tr'\<^sub>p\<^sub>c S [d\D. d \ set Di])" + using prems(1) c by moura + + have 0: "ik\<^sub>s\<^sub>t (unlabel (c Di)) = {}" "ik\<^sub>s\<^sub>t (unlabel (d Di)) = {}" + "unlabel (?cl1 Di) = ?cu1 Di" "unlabel (?cl2 Di) = ?cu2 Di" + "unlabel (?dl1 Di) = ?du1 Di" "unlabel (?dl2 Di) = ?du2 Di" + unfolding c d unlabel_def by force+ + + have 1: "\M; unlabel C'\\<^sub>d \ " using prems(2) C'(2) 0(1) unfolding unlabel_def by auto + + { fix j p k q + assume "(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set [d\D. d \ set Di]" + "(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set [d\D. d \ set Di]" + hence "(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\t,s\)#S) \ set D" + "(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\t,s\)#S) \ set D" + by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "(\\. Unifier \ (pair p) (pair q)) \ j = k" using prems(3) by blast + } hence 4: "?R3 S [d\D. d \ set Di]" by blast + + have 5: "?R4 S (filter (\d. d \ set Di) D)" using prems(4) by force + have 6: "?R5 S D" using prems(5) by force + + obtain B where B: "B \ set (tr\<^sub>p\<^sub>c S [d\D. d \ set Di])" "\M; unlabel B\\<^sub>d \" + using IH[OF C'(1,3) 1 4 5 6] by moura + + have 7: "\M; unlabel (c Di)\\<^sub>d \" "\M; unlabel C'\\<^sub>d \" + using prems(2) C'(2) 0(1) strand_sem_split(3,4)[of M "unlabel (c Di)" "unlabel C'"] + unfolding c unlabel_def by auto + + { fix j p k q + assume "(j, p) \ {(i, t, s)} \ set D" + "(k, q) \ {(i, t, s)} \ set D" + hence "(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\t,s\)#S) \ set D" + "(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\t,s\)#S) \ set D" + by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "(\\. Unifier \ (pair p) (pair q)) \ j = k" using prems(3) by blast + } hence "\(j, p) \ {(i, t, s)} \ set D. + \(k, q) \ {(i, t, s)} \ set D. + (\\. Unifier \ (pair p) (pair q)) \ j = k" + by blast + moreover have "\M; unlabel (?cl1 Di)\\<^sub>d \" using 7(1) unfolding c unlabel_append by auto + hence "\M; ?cu1 Di\\<^sub>d \" by (metis 0(3)) + ultimately have *: "Di \ set (subseqs (dbproj i D))" + using labeled_sat_eqs_subseqs[OF C'(1)] by simp + hence 8: "d Di@B \ set (tr\<^sub>p\<^sub>c ((i,delete\t,s\)#S) D)" + using B(1) unfolding d unlabel_def by auto + + have "\M; unlabel (?cl2 Di)\\<^sub>d \" using 7(1) 0(1) unfolding c unlabel_def by auto + hence "\M; ?cu2 Di\\<^sub>d \" by (metis 0(4)) + hence "\M; ?du2 Di\\<^sub>d \" by (metis labeled_sat_ineq_dbproj) + hence "\M; unlabel (?dl2 Di)\\<^sub>d \" by (metis 0(6)) + moreover have "\M; unlabel (?cl1 Di)\\<^sub>d \" using 7(1) unfolding c unlabel_def by auto + hence "\M; unlabel (?dl1 Di)\\<^sub>d \" by (metis 0(3,5)) + ultimately have "\M; unlabel (d Di)\\<^sub>d \" using 0(2) unfolding c d unlabel_def by force + hence 9: "\M; unlabel (d Di@B)\\<^sub>d \" using 0(2) B(2) unfolding unlabel_def by auto + + show ?case by (metis 8 9) + next + case (7 i ac t s S D) + note prems = "7.prems" + note IH = "7.IH" + + obtain C' d where C': + "C = (i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)#C'" + "C' \ set (tr'\<^sub>p\<^sub>c S D)" "d \ set D" + using prems(1) by moura + + have 1: "\M; unlabel C'\\<^sub>d \ " using prems(2) C'(1) by simp + + { fix j p k q + assume "(j,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set D" + "(k,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ set D" + hence "(j,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, InSet ac t s)#S) \ set D" + "(k,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, InSet ac t s)#S) \ set D" + by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "(\\. Unifier \ (pair p) (pair q)) \ j = k" using prems(3) by blast + } hence 4: "?R3 S D" by blast + + have 5: "?R4 S D" using prems(4) by force + have 6: "?R5 S D" using prems(5) by force + + obtain B where B: "B \ set (tr\<^sub>p\<^sub>c S D)" "\M; unlabel B\\<^sub>d \" + using IH[OF C'(2) 1 4 5 6] by moura + + have 7: "pair (t,s) \ \ = pair (snd d) \ \" using prems(2) C'(1) by simp + + have "(i,t,s) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, InSet ac t s)#S) \ set D" + "(fst d, snd d) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, InSet ac t s)#S) \ set D" + using C'(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "\\. Unifier \ (pair (t,s)) (pair (snd d)) \ i = fst d" + using prems(3) by blast + hence "fst d = i" using 7 by auto + hence 8: "d \ set (dbproj i D)" using C'(3) by auto + + have 9: "((i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)#B) \ set (tr\<^sub>p\<^sub>c ((i,InSet ac t s)#S) D)" + using B 8 by auto + have 10: "\M; unlabel ((i,\ac: (pair (t,s)) \ (pair (snd d))\\<^sub>s\<^sub>t)#B)\\<^sub>d \" + using B 7 8 by auto + + show ?case by (metis 9 10) + next + case (8 i X F F' S D) + note prems = "8.prems" + note IH = "8.IH" + + let ?dl = "map (\G. (i,\X\\\: (F@G)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))" + let ?du = "map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))" + + let ?cl = "map (\G. (i,\X\\\: (F@G)\\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D))" + let ?cu = "map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D))" + + define c where c: "c = ?cl" + define d where d: "d = ?dl" + + obtain C' where C': "C = c@C'" "C' \ set (tr'\<^sub>p\<^sub>c S D)" using prems(1) c by moura + + have 0: "ik\<^sub>s\<^sub>t (unlabel c) = {}" "ik\<^sub>s\<^sub>t (unlabel d) = {}" + "unlabel ?cl = ?cu" "unlabel ?dl = ?du" + unfolding c d unlabel_def by force+ + + have "ik\<^sub>s\<^sub>t (unlabel c) = {}" unfolding c unlabel_def by force + hence 1: "\M; unlabel C'\\<^sub>d \ " using prems(2) C'(1) unfolding unlabel_def by auto + + have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, NegChecks X F F')#S)" by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence 4: "?R3 S D" using prems(3) by blast + + have 5: "?R4 S D" using prems(4) by force + have 6: "?R5 S D" using prems(5) by force + + obtain B where B: "B \ set (tr\<^sub>p\<^sub>c S D)" "\M; unlabel B\\<^sub>d \" + using IH[OF C'(2) 1 4 5 6] by moura + + have 7: "\M; unlabel c\\<^sub>d \" "\M; unlabel C'\\<^sub>d \" + using prems(2) C'(1) 0(1) strand_sem_split(3,4)[of M "unlabel c" "unlabel C'"] + unfolding c unlabel_def by auto + + have 8: "d@B \ set (tr\<^sub>p\<^sub>c ((i,NegChecks X F F')#S) D)" + using B(1) unfolding d unlabel_def by auto + + have "\M; unlabel ?cl\\<^sub>d \" using 7(1) unfolding c unlabel_def by auto + hence "\M; ?cu\\<^sub>d \" by (metis 0(3)) + moreover { + fix j p k q + assume "(j, p) \ ((\(t,s). (i,t,s)) ` set F') \ set D" + "(k, q) \ ((\(t,s). (i,t,s)) ` set F') \ set D" + hence "(j, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, NegChecks X F F')#S) \ set D" + "(k, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, NegChecks X F F')#S) \ set D" + by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def) + hence "(\\. Unifier \ (pair p) (pair q)) \ j = k" using prems(3) by blast + } hence "\(j, p) \ ((\(t,s). (i,t,s)) ` set F') \ set D. + \(k, q) \ ((\(t,s). (i,t,s)) ` set F') \ set D. + (\\. Unifier \ (pair p) (pair q)) \ j = k" + by blast + moreover have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (map snd D) \ set X = {}" + using prems(4) by fastforce + ultimately have "\M; ?du\\<^sub>d \" using labeled_sat_ineq_dbproj_sem_equiv[of i] by simp + hence "\M; unlabel ?dl\\<^sub>d \" by (metis 0(4)) + hence "\M; unlabel d\\<^sub>d \" using 0(2) unfolding c d unlabel_def by force + hence 9: "\M; unlabel (d@B)\\<^sub>d \" using 0(2) B(2) unfolding unlabel_def by auto + + show ?case by (metis 8 9) + qed + } thus "?Q \ ?P" by metis +qed + + +subsubsection \Part 3\ +private lemma tr'_par_sem_equiv: + assumes "\(l,t,s) \ set D. (fv t \ fv s) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" + and "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" "ground M" + and "\(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set D. \(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set D. + (\\. Unifier \ (pair p) (pair q)) \ i = j" (is "?R A D") + and \: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + shows "\M; set (unlabel D) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; unlabel A\\<^sub>s \ \ (\B \ set (tr'\<^sub>p\<^sub>c A D). \M; unlabel B\\<^sub>d \)" + (is "?P \ ?Q") +proof - + have 1: "\(t,s) \ set (unlabel D). (fv t \ fv s) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" + using assms(1) unfolding unlabel_def by force + + have 2: "\(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set D. \(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set D. p = q \ i = j" + using assms(4) subst_apply_term_empty by blast + + show ?thesis by (metis tr_sem_equiv'[OF 1 assms(2,3) \] tr'_par_iff_unlabel_tr[OF 2]) +qed + + +subsubsection \Part 4\ +lemma tr_par_sem_equiv: + assumes "\(l,t,s) \ set D. (fv t \ fv s) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" + and "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" "ground M" + and "\(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set D. \(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ set D. + (\\. Unifier \ (pair p) (pair q)) \ i = j" + and \: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + shows "\M; set (unlabel D) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; unlabel A\\<^sub>s \ \ (\B \ set (tr\<^sub>p\<^sub>c A D). \M; unlabel B\\<^sub>d \)" + (is "?P \ ?Q") +using tr_par_iff_tr'_par[OF assms(4,1,2), of M \] tr'_par_sem_equiv[OF assms] by metis + +end + + +subsection \Theorem: The Stateful Compositionality Result, on the Constraint Level\ +theorem par_comp_constr_stateful: + assumes \: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ Sec" "typing_cond\<^sub>s\<^sub>s\<^sub>t (unlabel \)" + and \: "\ \\<^sub>s unlabel \" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + shows "\\\<^sub>\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\) \ (\\<^sub>\ \\<^sub>s unlabel \) \ + ((\n. \\<^sub>\ \\<^sub>s proj_unl n \) \ (\\'. prefix \' \ \ (\' leaks Sec under \\<^sub>\)))" +proof - + let ?P = "\n A D. + \(i, p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) \ set D. + \(j, q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) \ set D. + (\\. Unifier \ (pair p) (pair q)) \ i = j" + + have 1: "\(l, t, t')\set []. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel \) = {}" + "fv\<^sub>s\<^sub>s\<^sub>t (unlabel \) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel \) = {}" "ground {}" + using \(2) unfolding typing_cond\<^sub>s\<^sub>s\<^sub>t_def by simp_all + + have 2: "\n. \(l, t, t')\set []. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n \) = {}" + "\n. fv\<^sub>s\<^sub>s\<^sub>t (proj_unl n \) \ bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n \) = {}" + using 1(1,2) sst_vars_proj_subset[of _ \] by fast+ + + have 3: "\n. par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n \) Sec" + using par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj[OF \(1)] by metis + + have 4: + "\{}; set (unlabel []) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \'; unlabel \\\<^sub>s \' \ + (\B\set (tr\<^sub>p\<^sub>c \ []). \{}; unlabel B\\<^sub>d \')" + when \': "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \'" for \' + using tr_par_sem_equiv[OF 1 _ \'] \(1) + unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def constr_sem_d_def by auto + + obtain \' where \': "\' \ set (tr\<^sub>p\<^sub>c \ [])" "\ \ \unlabel \'\" + using 4[OF \(2)] \(1) unfolding constr_sem_d_def by moura + + obtain \\<^sub>\ where \\<^sub>\: + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)" "\\<^sub>\ \ \unlabel \'\" + "(\n. (\\<^sub>\ \ \proj_unl n \'\)) \ (\\''. prefix \'' \' \ (strand_leaks\<^sub>l\<^sub>s\<^sub>t \'' Sec \\<^sub>\))" + using par_comp_constr[OF tr_par_preserves_par_comp[OF \(1) \'(1)] + tr_par_preserves_typing_cond[OF \ \'(1)] + \'(2) \(2)] + by moura + + have \\<^sub>\': "\\<^sub>\ \\<^sub>s unlabel \" using 4[OF \\<^sub>\(1)] \'(1) \\<^sub>\(4) unfolding constr_sem_d_def by auto + + show ?thesis + proof (cases "\n. (\\<^sub>\ \ \proj_unl n \'\)") + case True + { fix n assume "\\<^sub>\ \ \proj_unl n \'\" + hence "\{}; {}; unlabel (proj n \)\\<^sub>s \\<^sub>\" + using tr_par_proj[OF \'(1), of n] + tr_par_sem_equiv[OF 2(1,2) 1(3) _ \\<^sub>\(1), of n] 3(1) + unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def proj_def constr_sem_d_def by force + } thus ?thesis using True \\<^sub>\(1,2,3) \\<^sub>\' by metis + next + case False + then obtain \''::"('fun,'var,'lbl) labeled_strand" where \'': + "prefix \'' \'" "strand_leaks\<^sub>l\<^sub>s\<^sub>t \'' Sec \\<^sub>\" + using \\<^sub>\ by blast + moreover { + fix t l assume *: "\{}; unlabel (proj l \'')@[send\t\\<^sub>s\<^sub>t]\\<^sub>d \\<^sub>\" + have "\\<^sub>\ \ \unlabel (proj l \'')\" "ik\<^sub>s\<^sub>t (unlabel (proj l \'')) \\<^sub>s\<^sub>e\<^sub>t \\<^sub>\ \ t \ \\<^sub>\" + using strand_sem_split(3,4)[OF *] unfolding constr_sem_d_def by auto + } ultimately have "\t \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t \'' \\<^sub>\. \l. + (\\<^sub>\ \ \unlabel (proj l \'')\) \ ik\<^sub>s\<^sub>t (unlabel (proj l \'')) \\<^sub>s\<^sub>e\<^sub>t \\<^sub>\ \ t \ \\<^sub>\" + unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>t_def constr_sem_d_def by metis + then obtain s m where sm: + "s \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t \'' \\<^sub>\" + "\\<^sub>\ \ \unlabel (proj m \'')\" + "ik\<^sub>s\<^sub>t (unlabel (proj m \'')) \\<^sub>s\<^sub>e\<^sub>t \\<^sub>\ \ s \ \\<^sub>\" + by moura + + \ \ + We now need to show that there is some prefix \B\ of \\''\ that also leaks + and where \B \ set (tr C D)\ for some prefix \C\ of \\\ + \ + obtain B::"('fun,'var,'lbl) labeled_strand" + and C::"('fun,'var,'lbl) labeled_stateful_strand" + where BC: + "prefix B \'" "prefix C \" "B \ set (tr\<^sub>p\<^sub>c C [])" + "ik\<^sub>s\<^sub>t (unlabel (proj m B)) \\<^sub>s\<^sub>e\<^sub>t \\<^sub>\ \ s \ \\<^sub>\" + "prefix B \''" + using tr_leaking_prefix_exists[OF \'(1) \''(1) sm(3)] prefix_order.order_trans[OF _ \''(1)] + by auto + have "\{}; unlabel (proj m B)\\<^sub>d \\<^sub>\" + using sm(2) BC(5) unfolding prefix_def unlabel_def proj_def constr_sem_d_def by auto + hence BC': "\\<^sub>\ \ \proj_unl m B@[send\s\\<^sub>s\<^sub>t]\" + using BC(4) unfolding constr_sem_d_def by auto + have BC'': "s \ Sec - declassified\<^sub>l\<^sub>s\<^sub>t B \\<^sub>\" + using BC(5) sm(1) unfolding prefix_def declassified\<^sub>l\<^sub>s\<^sub>t_def by auto + have 5: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n C) Sec" for n + using \(1) BC(2) par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_split(1)[THEN par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj] + unfolding prefix_def by auto + have "fv\<^sub>s\<^sub>s\<^sub>t (unlabel \) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel \) = {}" + "fv\<^sub>s\<^sub>s\<^sub>t (unlabel C) \ fv\<^sub>s\<^sub>s\<^sub>t (unlabel \)" + "bvars\<^sub>s\<^sub>s\<^sub>t (unlabel C) \ bvars\<^sub>s\<^sub>s\<^sub>t (unlabel \)" + using \(2) BC(2) sst_vars_append_subset(1,2)[of "unlabel C"] + unfolding typing_cond\<^sub>s\<^sub>s\<^sub>t_def prefix_def unlabel_def by auto + hence "fv\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) \ bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) = {}" for n + using sst_vars_proj_subset[of _ C] sst_vars_proj_subset[of _ \] + by blast + hence 6: + "\(l, t, t')\set []. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) = {}" + "fv\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) \ bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) = {}" + "ground {}" + for n + using 2 by auto + have 7: "?P n C []" for n using 5 unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by simp + have "s \ \\<^sub>\ = s" using \\<^sub>\(1) BC'' \(1) unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto + hence "\n. (\\<^sub>\ \\<^sub>s proj_unl n C) \ ik\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) \\<^sub>s\<^sub>e\<^sub>t \\<^sub>\ \ s \ \\<^sub>\" + using tr_par_proj[OF BC(3), of m] BC'(1) + tr_par_sem_equiv[OF 6 7 \\<^sub>\(1), of m] + tr_par_deduct_iff[OF tr_par_proj(1)[OF BC(3)], of \\<^sub>\ m s] + unfolding proj_def constr_sem_d_def by auto + hence "\n. \\<^sub>\ \\<^sub>s (proj_unl n C@[Send s])" using strand_sem_append_stateful by simp + moreover have "s \ Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t C \\<^sub>\" by (metis tr_par_declassified_eq BC(3) BC'') + ultimately show ?thesis using \\<^sub>\(1,2,3) \\<^sub>\' BC(2) unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by metis + qed +qed + + +subsection \Theorem: The Stateful Compositionality Result, on the Protocol Level\ +abbreviation wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t where + "wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t V \ \ wf'\<^sub>s\<^sub>s\<^sub>t V (unlabel \)" + +text \ + We state our result on the level of protocol traces (i.e., the constraints reachable in a + symbolic execution of the actual protocol). Hence, we do not need to convert protocol strands + to intruder constraints in the following well-formedness definitions. +\ +definition wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s::"('fun,'var,'lbl) labeled_stateful_strand set \ bool" where + "wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s \ \ (\\ \ \. wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t {} \) \ (\\ \ \. \\' \ \. fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \' = {})" + +definition wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s':: + "('fun,'var,'lbl) labeled_stateful_strand set \ ('fun,'var,'lbl) labeled_stateful_strand \ bool" +where + "wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s' \ \ \ (\\' \ \. wf'\<^sub>s\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \) (unlabel \')) \ + (\\' \ \. \\'' \ \. fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \' \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \'' = {}) \ + (\\' \ \. fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \' \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = {}) \ + (\\' \ \. fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \' = {})" + +definition typing_cond_prot_stateful where + "typing_cond_prot_stateful \

\ + wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s \

\ + tfr\<^sub>s\<^sub>e\<^sub>t (\(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \

) \ pair ` \(setops\<^sub>s\<^sub>s\<^sub>t ` unlabel ` \

)) \ + wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \

)) \ + (\S \ \

. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel S))" + +definition par_comp_prot_stateful where + "par_comp_prot_stateful \

Sec \ + (\l1 l2. l1 \ l2 \ + GSMP_disjoint (\\ \ \

. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \)) + (\\ \ \

. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \)) Sec) \ + ground Sec \ (\s \ Sec. \s' \ subterms s. {} \\<^sub>c s' \ s' \ Sec) \ + (\(i,p) \ \\ \ \

. setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t \. \(j,q) \ \\ \ \

. setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t \. + (\\. Unifier \ (pair p) (pair q)) \ i = j) \ + typing_cond_prot_stateful \

" + +definition component_secure_prot_stateful where + "component_secure_prot_stateful n P Sec attack \ + (\\ \ P. suffix [(ln n, Send (Fun attack []))] \ \ + (\\\<^sub>\. (interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)) \ + \(\\<^sub>\ \\<^sub>s (proj_unl n \)) \ + (\\'. prefix \' \ \ + (\t \ Sec-declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \' \\<^sub>\. \(\\<^sub>\ \\<^sub>s (proj_unl n \'@[Send t]))))))" + +definition component_leaks_stateful where + "component_leaks_stateful n \ Sec \ + (\\' \\<^sub>\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\) \ prefix \' \ \ + (\t \ Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \' \\<^sub>\. (\\<^sub>\ \\<^sub>s (proj_unl n \'@[Send t]))))" + +definition unsat_stateful where + "unsat_stateful \ \ (\\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ \(\ \\<^sub>s unlabel \))" + +lemma wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s_eqs_wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s'[simp]: "wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s S = wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s' S []" +unfolding wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s_def wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s'_def unlabel_def wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by simp + +lemma par_comp_prot_impl_par_comp_stateful: + assumes "par_comp_prot_stateful \

Sec" "\ \ \

" + shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ Sec" +proof - + have *: + "\l1 l2. l1 \ l2 \ + GSMP_disjoint (\\ \ \

. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \)) + (\\ \ \

. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \)) Sec" + using assms(1) unfolding par_comp_prot_stateful_def by argo + { fix l1 l2::'lbl assume **: "l1 \ l2" + hence ***: + "GSMP_disjoint (\\ \ \

. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \)) + (\\ \ \

. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \)) Sec" + using * by auto + have "GSMP_disjoint (trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \)) + (trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \)) Sec" + using GSMP_disjoint_subset[OF ***] assms(2) by auto + } hence "\l1 l2. l1 \ l2 \ + GSMP_disjoint (trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \)) + (trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \)) Sec" + by metis + moreover have "\(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t \. \(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t \. + (\\. Unifier \ (pair p) (pair q)) \ i = j" + using assms(1,2) unfolding par_comp_prot_stateful_def by blast + ultimately show ?thesis + using assms + unfolding par_comp_prot_stateful_def par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def + by fast +qed + +lemma typing_cond_prot_impl_typing_cond_stateful: + assumes "typing_cond_prot_stateful \

" "\ \ \

" + shows "typing_cond\<^sub>s\<^sub>s\<^sub>t (unlabel \)" +proof - + have 1: "wf'\<^sub>s\<^sub>s\<^sub>t {} (unlabel \)" "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ = {}" + using assms unfolding typing_cond_prot_stateful_def wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s_def by auto + + have "tfr\<^sub>s\<^sub>e\<^sub>t (\(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \

) \ pair ` \(setops\<^sub>s\<^sub>s\<^sub>t ` unlabel ` \

))" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \

))" + "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ \(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \

)" + "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel \)) - Var`\ \ + SMP (\(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \

) \ pair ` \(setops\<^sub>s\<^sub>s\<^sub>t ` unlabel ` \

)) - Var`\" + using assms SMP_mono[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel \)" + "\(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \

) \ pair ` \(setops\<^sub>s\<^sub>s\<^sub>t ` unlabel ` \

)"] + unfolding typing_cond_prot_stateful_def + by (metis, metis, auto) + hence 2: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel \))" and 3: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \)" + unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (meson subsetD)+ + + have 4: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel \)" using assms unfolding typing_cond_prot_stateful_def by auto + + show ?thesis using 1 2 3 4 unfolding typing_cond\<^sub>s\<^sub>s\<^sub>t_def tfr\<^sub>s\<^sub>s\<^sub>t_def by blast +qed + +theorem par_comp_constr_prot_stateful: + assumes P: "P = composed_prot Pi" "par_comp_prot_stateful P Sec" "\n. component_prot n (Pi n)" + and left_secure: "component_secure_prot_stateful n (Pi n) Sec attack" + shows "\\ \ P. suffix [(ln n, Send (Fun attack []))] \ \ + unsat_stateful \ \ (\m. n \ m \ component_leaks_stateful m \ Sec)" +proof - + { fix \ \' assume \: "\ = \'@[(ln n, Send (Fun attack []))]" "\ \ P" + let ?P = "\\' \\<^sub>\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\) \ prefix \' \ \ + (\t \ Sec-declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \' \\<^sub>\. \m. n \ m \ (\\<^sub>\ \\<^sub>s (proj_unl m \'@[Send t])))" + have tcp: "typing_cond_prot_stateful P" using P(2) unfolding par_comp_prot_stateful_def by simp + have par_comp: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t \ Sec" "typing_cond\<^sub>s\<^sub>s\<^sub>t (unlabel \)" + using par_comp_prot_impl_par_comp_stateful[OF P(2) \(2)] + typing_cond_prot_impl_typing_cond_stateful[OF tcp \(2)] + by metis+ + + have "unlabel (proj n \) = proj_unl n \" "proj_unl n \ = proj_unl n (proj n \)" + "\A. A \ Pi n \ proj n A = A" + "proj n \ = (proj n \')@[(ln n, Send (Fun attack []))]" + using P(1,3) \ by (auto simp add: proj_def unlabel_def component_prot_def composed_prot_def) + moreover have "proj n \ \ Pi n" + using P(1) \ unfolding composed_prot_def by blast + moreover { + fix A assume "prefix A \" + hence *: "prefix (proj n A) (proj n \)" unfolding proj_def prefix_def by force + hence "proj_unl n A = proj_unl n (proj n A)" + "\I. declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) I" + unfolding proj_def declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto + hence "\B. prefix B (proj n \) \ proj_unl n A = proj_unl n B \ + (\I. declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t B I)" + using * by metis + } + ultimately have *: + "\\\<^sub>\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\) \ + \(\\<^sub>\ \\<^sub>s (proj_unl n \)) \ (\\'. prefix \' \ \ + (\t \ Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \' \\<^sub>\. \(\\<^sub>\ \\<^sub>s (proj_unl n \'@[Send t]))))" + using left_secure + unfolding component_secure_prot_stateful_def composed_prot_def suffix_def + by metis + { fix \ assume \: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "\ \\<^sub>s unlabel \" + obtain \\<^sub>\ where \\<^sub>\: + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)" + "\\'. prefix \' \ \ (\' leaks Sec under \\<^sub>\)" + using par_comp_constr_stateful[OF par_comp \(2,1)] * by moura + hence "\\'. prefix \' \ \ (\t \ Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \' \\<^sub>\. \m. + n \ m \ (\\<^sub>\ \\<^sub>s (proj_unl m \'@[Send t])))" + using \\<^sub>\(4) * unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by metis + hence ?P using \\<^sub>\(1,2,3) by auto + } hence "unsat_stateful \ \ (\m. n \ m \ component_leaks_stateful m \ Sec)" + by (metis unsat_stateful_def component_leaks_stateful_def) + } thus ?thesis unfolding suffix_def by metis +qed + +end + +subsection \Automated Compositionality Conditions\ +definition comp_GSMP_disjoint where + "comp_GSMP_disjoint public arity Ana \ A' B' A B C \ + let B\ = B \\<^sub>l\<^sub>i\<^sub>s\<^sub>t var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t (set A))) + in has_all_wt_instances_of \ (set A') (set A) \ + has_all_wt_instances_of \ (set B') (set B\) \ + finite_SMP_representation arity Ana \ A \ + finite_SMP_representation arity Ana \ B\ \ + (\t \ set A. \s \ set B\. \ t = \ s \ mgu t s \ None \ + (intruder_synth' public arity {} t \ intruder_synth' public arity {} s) \ + (\u \ set C. is_wt_instance_of_cond \ t u) \ (\u \ set C. is_wt_instance_of_cond \ s u))" + +definition comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t where + "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \ pair_fun A M C \ + let L = remdups (map (the_LabelN \ fst) (filter (Not \ is_LabelS) A)); + MP0 = \B. remdups (trms_list\<^sub>s\<^sub>s\<^sub>t B@map (pair' pair_fun) (setops_list\<^sub>s\<^sub>s\<^sub>t B)); + pr = \l. MP0 (proj_unl l A) + in length L > 1 \ + list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (MP0 (unlabel A)) \ + list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) C \ + has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set C)) (set C) \ + is_TComp_var_instance_closed \ C \ + (\i \ set L. \j \ set L. i \ j \ + comp_GSMP_disjoint public arity Ana \ (pr i) (pr j) (M i) (M j) C) \ + (\(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. i \ j \ + (let s = pair' pair_fun p; t = pair' pair_fun q + in mgu s (t \ var_rename (max_var s)) = None))" + +locale labeled_stateful_typed_model' = + stateful_typed_model' arity public Ana \ Pair ++ labeled_typed_model' arity public Ana \ label_witness1 label_witness2 + for arity::"'fun \ nat" + and public::"'fun \ bool" + and Ana::"('fun,(('fun,'atom::finite) term_type \ nat)) term + \ (('fun,(('fun,'atom) term_type \ nat)) term list + \ ('fun,(('fun,'atom) term_type \ nat)) term list)" + and \::"('fun,(('fun,'atom) term_type \ nat)) term \ ('fun,'atom) term_type" + and Pair::"'fun" + and label_witness1::"'lbl" + and label_witness2::"'lbl" +begin + +sublocale labeled_stateful_typed_model +by unfold_locales + +lemma GSMP_disjoint_if_comp_GSMP_disjoint: + defines "f \ \M. {t \ \ | t \. t \ M \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}}" + assumes AB'_wf: "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) A'" "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) B'" + and C_wf: "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) C" + and AB'_disj: "comp_GSMP_disjoint public arity Ana \ A' B' A B C" + shows "GSMP_disjoint (set A') (set B') ((f (set C)) - {m. {} \\<^sub>c m})" +using GSMP_disjointI[of A' B' A B] AB'_wf AB'_disj C_wf +unfolding comp_GSMP_disjoint_def f_def wf\<^sub>t\<^sub>r\<^sub>m_code list_all_iff Let_def by fast + +lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_if_comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t: + defines "f \ \M. {t \ \ | t \. t \ M \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}}" + assumes A: "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \ Pair A M C" + shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A ((f (set C)) - {m. {} \\<^sub>c m})" +proof (unfold par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def; intro conjI) + let ?Sec = "(f (set C)) - {m. {} \\<^sub>c m}" + let ?L = "remdups (map (the_LabelN \ fst) (filter (Not \ is_LabelS) A))" + let ?N1 = "\B. remdups (trms_list\<^sub>s\<^sub>s\<^sub>t B@map (pair' Pair) (setops_list\<^sub>s\<^sub>s\<^sub>t B))" + let ?N2 = "\B. trms\<^sub>s\<^sub>s\<^sub>t B \ pair ` setops\<^sub>s\<^sub>s\<^sub>t B" + let ?pr = "\l. ?N1 (proj_unl l A)" + let ?\ = "\p. var_rename (max_var (pair p))" + + have 0: + "length ?L > 1" + "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (?N1 (unlabel A))" + "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) C" + "has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set C)) (set C)" + "is_TComp_var_instance_closed \ C" + "\i \ set ?L. \j \ set ?L. i \ j \ + comp_GSMP_disjoint public arity Ana \ (?pr i) (?pr j) (M i) (M j) C" + "\(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. i \ j \ mgu (pair p) (pair q \ ?\ p) = None" + using A unfolding comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def pair_code by meson+ + + have L_in_iff: "l \ set ?L \ (\a \ set A. is_LabelN l a)" for l by force + + have A_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A))" + using 0(2) + unfolding pair_code wf\<^sub>t\<^sub>r\<^sub>m_code list_all_iff trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t setops_list\<^sub>s\<^sub>s\<^sub>t_is_setops\<^sub>s\<^sub>s\<^sub>t + by auto + hence A_proj_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l A))" for l + using trms\<^sub>s\<^sub>s\<^sub>t_proj_subset(1)[of l A] setops\<^sub>s\<^sub>s\<^sub>t_proj_subset(1)[of l A] by blast + hence A_proj_wf_trms': "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (?N1 (proj_unl l A))" for l + unfolding pair_code wf\<^sub>t\<^sub>r\<^sub>m_code list_all_iff trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t setops_list\<^sub>s\<^sub>s\<^sub>t_is_setops\<^sub>s\<^sub>s\<^sub>t + by auto + + note C_wf_trms = 0(3)[unfolded list_all_iff wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric]] + + note 1 = has_all_wt_instances_ofD'[OF wf_trms_subterms[OF C_wf_trms] C_wf_trms 0(4)] + + have 2: "GSMP (?N2 (proj_unl l A)) \ GSMP (?N2 (proj_unl l' A))" when "l \ set ?L" for l l' + using that L_in_iff GSMP_mono[of "?N2 (proj_unl l A)" "?N2 (proj_unl l' A)"] + trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subset_if_no_label[of l A] + setops\<^sub>s\<^sub>s\<^sub>t_unlabel_subset_if_no_label[of l A] + unfolding list_ex_iff by fast + + have 3: "GSMP_disjoint (?N2 (proj_unl l1 A)) (?N2 (proj_unl l2 A)) ?Sec" + when "l1 \ set ?L" "l2 \ set ?L" "l1 \ l2" for l1 l2 + proof - + have "GSMP_disjoint (set (?N1 (proj_unl l1 A))) (set (?N1 (proj_unl l2 A))) ?Sec" + using 0(6) that + GSMP_disjoint_if_comp_GSMP_disjoint[ + OF A_proj_wf_trms'[of l1] A_proj_wf_trms'[of l2] 0(3), + of "M l1" "M l2"] + unfolding f_def by blast + thus ?thesis + unfolding pair_code trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t setops_list\<^sub>s\<^sub>s\<^sub>t_is_setops\<^sub>s\<^sub>s\<^sub>t + by simp + qed + + obtain a1 a2 where a: "a1 \ set ?L" "a2 \ set ?L" "a1 \ a2" + using remdups_ex2[OF 0(1)] by moura + + show "ground ?Sec" unfolding f_def by fastforce + + { fix i p j q + assume p: "(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" and q: "(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" + and pq: "\\. Unifier \ (pair p) (pair q)" + + have "\\. Unifier \ (pair p) (pair q \ ?\ p)" + using pq vars_term_disjoint_imp_unifier[OF var_rename_fv_disjoint[of "pair p"], of _ "pair q"] + by (metis (no_types, lifting) subst_subst_compose var_rename_inv_comp) + hence "i = j" using 0(7) mgu_None_is_subst_neq[of "pair p" "pair q \ ?\ p"] p q by fast + } thus "\(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. (\\. Unifier \ (pair p) (pair q)) \ i = j" + by blast + + show "\l1 l2. l1 \ l2 \ GSMP_disjoint (?N2 (proj_unl l1 A)) (?N2 (proj_unl l2 A)) ?Sec" + using 2 3 3[OF a] unfolding GSMP_disjoint_def by blast + + show "\s \ ?Sec. \s' \ subterms s. {} \\<^sub>c s' \ s' \ ?Sec" + proof (intro ballI) + fix s s' + assume s: "s \ ?Sec" and s': "s' \ s" + then obtain t \ where t: "t \ set C" "s = t \ \" "fv s = {}" "\{} \\<^sub>c s" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + unfolding f_def by blast + + obtain m \ where m: "m \ set C" "s' = m \ \" and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using TComp_var_and_subterm_instance_closed_has_subterms_instances[ + OF 0(5,4) C_wf_trms in_subterms_Union[OF t(1)] s'[unfolded t(2)] \] + by blast + thus "{} \\<^sub>c s' \ s' \ ?Sec" + using ground_subterm[OF t(3) s'] + unfolding f_def by blast + qed +qed + +lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_if_comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t': + defines "f \ \M. {t \ \ | t \. t \ M \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}}" + assumes a: "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \ Pair A M C" + and B: "\b \ set B. \a \ set A. \\. b = a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + (is "\b \ set B. \a \ set A. \\. b = a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \ ?D \") + shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t B ((f (set C)) - {m. {} \\<^sub>c m})" +proof (unfold par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def; intro conjI) + define N1 where "N1 \ \B::('fun, ('fun,'atom) term_type \ nat) stateful_strand. + remdups (trms_list\<^sub>s\<^sub>s\<^sub>t B@map (pair' Pair) (setops_list\<^sub>s\<^sub>s\<^sub>t B))" + + define N2 where "N2 \ \B::('fun, ('fun,'atom) term_type \ nat) stateful_strand. + trms\<^sub>s\<^sub>s\<^sub>t B \ pair ` setops\<^sub>s\<^sub>s\<^sub>t B" + + define L where "L \ \A::('fun, ('fun,'atom) term_type \ nat, 'lbl) labeled_stateful_strand. + remdups (map (the_LabelN \ fst) (filter (Not \ is_LabelS) A))" + + define \ where "\ \ \p. var_rename (max_var (pair p::('fun, ('fun,'atom) term_type \ nat) term)) + ::('fun, ('fun,'atom) term_type \ nat) subst" + + let ?Sec = "(f (set C)) - {m. {} \\<^sub>c m}" + + have 0: + "length (L A) > 1" + "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (N1 (unlabel A))" + "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) C" + "has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set C)) (set C)" + "is_TComp_var_instance_closed \ C" + "\i \ set (L A). \j \ set (L A). i \ j \ + comp_GSMP_disjoint public arity Ana \ (N1 (proj_unl i A)) (N1 (proj_unl j A)) (M i) (M j) C" + "\(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. i \ j \ mgu (pair p) (pair q \ \ p) = None" + using a unfolding comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def pair_code L_def N1_def \_def by meson+ + + note 1 = trms\<^sub>s\<^sub>s\<^sub>t_proj_subset(1) setops\<^sub>s\<^sub>s\<^sub>t_proj_subset(1) + + have N1_iff_N2: "set (N1 A) = N2 A" for A + unfolding pair_code trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t setops_list\<^sub>s\<^sub>s\<^sub>t_is_setops\<^sub>s\<^sub>s\<^sub>t N1_def N2_def by simp + + have N2_proj_subset: "N2 (proj_unl l A) \ N2 (unlabel A)" + for l::'lbl and A::"('fun, ('fun,'atom) term_type \ nat, 'lbl) labeled_stateful_strand" + using 1(1)[of l A] image_mono[OF 1(2)[of l A], of pair] unfolding N2_def by blast + + have L_in_iff: "l \ set (L A) \ (\a \ set A. is_LabelN l a)" for l A + unfolding L_def by force + + have L_B_subset_A: "l \ set (L A)" when l: "l \ set (L B)" for l + using L_in_iff[of l B] L_in_iff[of l A] B l by fastforce + + note B_setops = setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_wt_instance_ex[OF B] + + have B_proj: "\b \ set (proj l B). \a \ set (proj l A). \\. b = a \\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \ ?D \" for l + using proj_instance_ex[OF B] by fast + + have B': "\t \ N2 (unlabel B). \s \ N2 (unlabel A). \\. t = s \ \ \ ?D \" + using trms\<^sub>s\<^sub>s\<^sub>t_setops\<^sub>s\<^sub>s\<^sub>t_wt_instance_ex[OF B] unfolding N2_def by blast + + have B'_proj: "\t \ N2 (proj_unl l B). \s \ N2 (proj_unl l A). \\. t = s \ \ \ ?D \" for l + using trms\<^sub>s\<^sub>s\<^sub>t_setops\<^sub>s\<^sub>s\<^sub>t_wt_instance_ex[OF B_proj] unfolding N2_def by presburger + + have A_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (N2 (unlabel A))" + using N1_iff_N2[of "unlabel A"] 0(2) unfolding wf\<^sub>t\<^sub>r\<^sub>m_code list_all_iff by auto + hence A_proj_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (N2 (proj_unl l A))" for l + using 1[of l] unfolding N2_def by blast + hence A_proj_wf_trms': "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (N1 (proj_unl l A))" for l + using N1_iff_N2[of "proj_unl l A"] unfolding wf\<^sub>t\<^sub>r\<^sub>m_code list_all_iff by presburger + + note C_wf_trms = 0(3)[unfolded list_all_iff wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric]] + + have 2: "GSMP (N2 (proj_unl l A)) \ GSMP (N2 (proj_unl l' A))" + when "l \ set (L A)" for l l' + and A::"('fun, ('fun,'atom) term_type \ nat, 'lbl) labeled_stateful_strand" + using that L_in_iff[of _ A] GSMP_mono[of "N2 (proj_unl l A)" "N2 (proj_unl l' A)"] + trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subset_if_no_label[of l A] + setops\<^sub>s\<^sub>s\<^sub>t_unlabel_subset_if_no_label[of l A] + unfolding list_ex_iff N2_def by fast + + have 3: "GSMP (N2 (proj_unl l B)) \ GSMP (N2 (proj_unl l A))" (is "?X \ ?Y") for l + proof + fix t assume "t \ ?X" + hence t: "t \ SMP (N2 (proj_unl l B))" "fv t = {}" unfolding GSMP_def by simp_all + have "t \ SMP (N2 (proj_unl l A))" + using t(1) B'_proj[of l] SMP_wt_instances_subset[of "N2 (proj_unl l B)" "N2 (proj_unl l A)"] + by metis + thus "t \ ?Y" using t(2) unfolding GSMP_def by fast + qed + + have "GSMP_disjoint (N2 (proj_unl l1 A)) (N2 (proj_unl l2 A)) ?Sec" + when "l1 \ set (L A)" "l2 \ set (L A)" "l1 \ l2" for l1 l2 + proof - + have "GSMP_disjoint (set (N1 (proj_unl l1 A))) (set (N1 (proj_unl l2 A))) ?Sec" + using 0(6) that + GSMP_disjoint_if_comp_GSMP_disjoint[ + OF A_proj_wf_trms'[of l1] A_proj_wf_trms'[of l2] 0(3), + of "M l1" "M l2"] + unfolding f_def by blast + thus ?thesis using N1_iff_N2 by simp + qed + hence 4: "GSMP_disjoint (N2 (proj_unl l1 B)) (N2 (proj_unl l2 B)) ?Sec" + when "l1 \ set (L A)" "l2 \ set (L A)" "l1 \ l2" for l1 l2 + using that 3 unfolding GSMP_disjoint_def by blast + + { fix i p j q + assume p: "(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B" and q: "(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B" + and pq: "\\. Unifier \ (pair p) (pair q)" + + obtain p' \p where p': "(i,p') \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "p = p' \\<^sub>p \p" "pair p = pair p' \ \p" + using p B_setops unfolding pair_def by auto + + obtain q' \q where q': "(j,q') \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "q = q' \\<^sub>p \q" "pair q = pair q' \ \q" + using q B_setops unfolding pair_def by auto + + obtain \ where "Unifier \ (pair p) (pair q)" using pq by blast + hence "\\. Unifier \ (pair p') (pair q' \ \ p')" + using p'(3) q'(3) var_rename_inv_comp[of "pair q'"] subst_subst_compose + vars_term_disjoint_imp_unifier[ + OF var_rename_fv_disjoint[of "pair p'"], + of "\p \\<^sub>s \" "pair q'" "var_rename_inv (max_var_set (fv (pair p'))) \\<^sub>s \q \\<^sub>s \"] + unfolding \_def by fastforce + hence "i = j" + using mgu_None_is_subst_neq[of "pair p'" "pair q' \ \ p'"] p'(1) q'(1) 0(7) + unfolding \_def by fast + } thus "\(i,p) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. \(j,q) \ setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. (\\. Unifier \ (pair p) (pair q)) \ i = j" + by blast + + obtain a1 a2 where a: "a1 \ set (L A)" "a2 \ set (L A)" "a1 \ a2" + using remdups_ex2[OF 0(1)[unfolded L_def]] unfolding L_def by moura + + show "\l1 l2. l1 \ l2 \ GSMP_disjoint (N2 (proj_unl l1 B)) (N2 (proj_unl l2 B)) ?Sec" + using 2[of _ B] 4 4[OF a] L_B_subset_A unfolding GSMP_disjoint_def by blast + + show "ground ?Sec" unfolding f_def by fastforce + + show "\s \ ?Sec. \s' \ subterms s. {} \\<^sub>c s' \ s' \ ?Sec" + proof (intro ballI) + fix s s' + assume s: "s \ ?Sec" and s': "s' \ s" + then obtain t \ where t: "t \ set C" "s = t \ \" "fv s = {}" "\{} \\<^sub>c s" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + unfolding f_def by blast + + obtain m \ where m: "m \ set C" "s' = m \ \" and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using TComp_var_and_subterm_instance_closed_has_subterms_instances[ + OF 0(5,4) C_wf_trms in_subterms_Union[OF t(1)] s'[unfolded t(2)] \] + by blast + thus "{} \\<^sub>c s' \ s' \ ?Sec" + using ground_subterm[OF t(3) s'] + unfolding f_def by blast + qed +qed + +end + +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Strands.thy b/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Strands.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Strands.thy @@ -0,0 +1,1756 @@ +(* +(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: Stateful_Strands.thy + Author: Andreas Viktor Hess, DTU +*) + + +section \Stateful Strands\ +theory Stateful_Strands +imports Strands_and_Constraints +begin + +subsection \Stateful Constraints\ +datatype (funs\<^sub>s\<^sub>s\<^sub>t\<^sub>p: 'a, vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p: 'b) stateful_strand_step = + Send (the_msg: "('a,'b) term") ("send\_\" 80) +| Receive (the_msg: "('a,'b) term") ("receive\_\" 80) +| Equality (the_check: poscheckvariant) (the_lhs: "('a,'b) term") (the_rhs: "('a,'b) term") + ("\_: _ \ _\" [80,80]) +| Insert (the_elem_term: "('a,'b) term") (the_set_term: "('a,'b) term") ("insert\_,_\" 80) +| Delete (the_elem_term: "('a,'b) term") (the_set_term: "('a,'b) term") ("delete\_,_\" 80) +| InSet (the_check: poscheckvariant) (the_elem_term: "('a,'b) term") (the_set_term: "('a,'b) term") + ("\_: _ \ _\" [80,80]) +| NegChecks (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p: "'b list") + (the_eqs: "(('a,'b) term \ ('a,'b) term) list") + (the_ins: "(('a,'b) term \ ('a,'b) term) list") + ("\_\\\: _ \\: _\" [80,80]) +where + "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Send _) = []" +| "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Receive _) = []" +| "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Equality _ _ _) = []" +| "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Insert _ _) = []" +| "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Delete _ _) = []" +| "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (InSet _ _ _) = []" + +type_synonym ('a,'b) stateful_strand = "('a,'b) stateful_strand_step list" +type_synonym ('a,'b) dbstatelist = "(('a,'b) term \ ('a,'b) term) list" +type_synonym ('a,'b) dbstate = "(('a,'b) term \ ('a,'b) term) set" + +abbreviation + "is_Assignment x \ (is_Equality x \ is_InSet x) \ the_check x = Assign" + +abbreviation + "is_Check x \ ((is_Equality x \ is_InSet x) \ the_check x = Check) \ is_NegChecks x" + +abbreviation + "is_Update x \ is_Insert x \ is_Delete x" + +abbreviation InSet_select ("select\_,_\") where "select\t,s\ \ InSet Assign t s" +abbreviation InSet_check ("\_ in _\") where "\t in s\ \ InSet Check t s" +abbreviation Equality_assign ("\_ := _\") where "\t := s\ \ Equality Assign t s" +abbreviation Equality_check ("\_ == _\") where "\t == s\ \ Equality Check t s" + +abbreviation NegChecks_Inequality1 ("\_ != _\") where + "\t != s\ \ NegChecks [] [(t,s)] []" + +abbreviation NegChecks_Inequality2 ("\_\_ != _\") where + "\x\t != s\ \ NegChecks [x] [(t,s)] []" + +abbreviation NegChecks_Inequality3 ("\_,_\_ != _\") where + "\x,y\t != s\ \ NegChecks [x,y] [(t,s)] []" + +abbreviation NegChecks_Inequality4 ("\_,_,_\_ != _\") where + "\x,y,z\t != s\ \ NegChecks [x,y,z] [(t,s)] []" + +abbreviation NegChecks_NotInSet1 ("\_ not in _\") where + "\t not in s\ \ NegChecks [] [] [(t,s)]" + +abbreviation NegChecks_NotInSet2 ("\_\_ not in _\") where + "\x\t not in s\ \ NegChecks [x] [] [(t,s)]" + +abbreviation NegChecks_NotInSet3 ("\_,_\_ not in _\") where + "\x,y\t not in s\ \ NegChecks [x,y] [] [(t,s)]" + +abbreviation NegChecks_NotInSet4 ("\_,_,_\_ not in _\") where + "\x,y,z\t not in s\ \ NegChecks [x,y,z] [] [(t,s)]" + +fun trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p where + "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Send t) = {t}" +| "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Receive t) = {t}" +| "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = {t,t'}" +| "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Insert t t') = {t,t'}" +| "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Delete t t') = {t,t'}" +| "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (InSet _ t t') = {t,t'}" +| "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (NegChecks _ F F') = trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F'" + +definition trms\<^sub>s\<^sub>s\<^sub>t where "trms\<^sub>s\<^sub>s\<^sub>t S \ \(trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p ` set S)" +declare trms\<^sub>s\<^sub>s\<^sub>t_def[simp] + +fun trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p where + "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Send t) = [t]" +| "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Receive t) = [t]" +| "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = [t,t']" +| "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Insert t t') = [t,t']" +| "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Delete t t') = [t,t']" +| "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (InSet _ t t') = [t,t']" +| "trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (NegChecks _ F F') = concat (map (\(t,t'). [t,t']) (F@F'))" + +definition trms_list\<^sub>s\<^sub>s\<^sub>t where "trms_list\<^sub>s\<^sub>s\<^sub>t S \ remdups (concat (map trms_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))" + +definition ik\<^sub>s\<^sub>s\<^sub>t where "ik\<^sub>s\<^sub>s\<^sub>t A \ {t. Receive t \ set A}" + +definition bvars\<^sub>s\<^sub>s\<^sub>t::"('a,'b) stateful_strand \ 'b set" where + "bvars\<^sub>s\<^sub>s\<^sub>t S \ \(set (map (set \ bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p) S))" + +fun fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p::"('a,'b) stateful_strand_step \ 'b set" where + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Send t) = fv t" +| "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Receive t) = fv t" +| "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = fv t \ fv t'" +| "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Insert t t') = fv t \ fv t'" +| "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Delete t t') = fv t \ fv t'" +| "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (InSet _ t t') = fv t \ fv t'" +| "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (NegChecks X F F') = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' - set X" + +definition fv\<^sub>s\<^sub>s\<^sub>t::"('a,'b) stateful_strand \ 'b set" where + "fv\<^sub>s\<^sub>s\<^sub>t S \ \(set (map fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))" + +fun fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p where + "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\t\) = fv_list t" +| "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (receive\t\) = fv_list t" +| "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\_: t \ s\) = fv_list t@fv_list s" +| "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\t,s\) = fv_list t@fv_list s" +| "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (delete\t,s\) = fv_list t@fv_list s" +| "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\_: t \ s\) = fv_list t@fv_list s" +| "fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: F \\: F'\) = filter (\x. x \ set X) (fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F@F'))" + +definition fv_list\<^sub>s\<^sub>s\<^sub>t where + "fv_list\<^sub>s\<^sub>s\<^sub>t S \ remdups (concat (map fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))" + +declare bvars\<^sub>s\<^sub>s\<^sub>t_def[simp] +declare fv\<^sub>s\<^sub>s\<^sub>t_def[simp] + +definition vars\<^sub>s\<^sub>s\<^sub>t::"('a,'b) stateful_strand \ 'b set" where + "vars\<^sub>s\<^sub>s\<^sub>t S \ \(set (map vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))" + +abbreviation wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p::"('a,'b) stateful_strand_step \ 'b set" where + "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \ + case x of + NegChecks _ _ _ \ {} + | Equality Check _ _ \ {} + | InSet Check _ _ \ {} + | Delete _ _ \ {} + | _ \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x" + +definition wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t::"('a,'b) stateful_strand \ 'b set" where + "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \ \(set (map wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))" + +abbreviation wfvarsoccs\<^sub>s\<^sub>s\<^sub>t\<^sub>p where + "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \ + case x of + Send t \ fv t + | Equality Assign s t \ fv s + | InSet Assign s t \ fv s \ fv t + | _ \ {}" + +definition wfvarsoccs\<^sub>s\<^sub>s\<^sub>t where + "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S \ \(set (map wfvarsoccs\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))" + +fun wf'\<^sub>s\<^sub>s\<^sub>t::"'b set \ ('a,'b) stateful_strand \ bool" where + "wf'\<^sub>s\<^sub>s\<^sub>t V [] = True" +| "wf'\<^sub>s\<^sub>s\<^sub>t V (Receive t#S) = (fv t \ V \ wf'\<^sub>s\<^sub>s\<^sub>t V S)" +| "wf'\<^sub>s\<^sub>s\<^sub>t V (Send t#S) = wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t) S" +| "wf'\<^sub>s\<^sub>s\<^sub>t V (Equality Assign t t'#S) = (fv t' \ V \ wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t) S)" +| "wf'\<^sub>s\<^sub>s\<^sub>t V (Equality Check _ _#S) = wf'\<^sub>s\<^sub>s\<^sub>t V S" +| "wf'\<^sub>s\<^sub>s\<^sub>t V (Insert t s#S) = (fv t \ V \ fv s \ V \ wf'\<^sub>s\<^sub>s\<^sub>t V S)" +| "wf'\<^sub>s\<^sub>s\<^sub>t V (Delete _ _#S) = wf'\<^sub>s\<^sub>s\<^sub>t V S" +| "wf'\<^sub>s\<^sub>s\<^sub>t V (InSet Assign t s#S) = wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t \ fv s) S" +| "wf'\<^sub>s\<^sub>s\<^sub>t V (InSet Check _ _#S) = wf'\<^sub>s\<^sub>s\<^sub>t V S" +| "wf'\<^sub>s\<^sub>s\<^sub>t V (NegChecks _ _ _#S) = wf'\<^sub>s\<^sub>s\<^sub>t V S" + +abbreviation "wf\<^sub>s\<^sub>s\<^sub>t S \ wf'\<^sub>s\<^sub>s\<^sub>t {} S \ fv\<^sub>s\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>s\<^sub>t S = {}" + +fun subst_apply_stateful_strand_step:: + "('a,'b) stateful_strand_step \ ('a,'b) subst \ ('a,'b) stateful_strand_step" + (infix "\\<^sub>s\<^sub>s\<^sub>t\<^sub>p" 51) where + "send\t\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = send\t \ \\" +| "receive\t\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = receive\t \ \\" +| "\a: t \ s\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = \a: (t \ \) \ (s \ \)\" +| "\a: t \ s\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = \a: (t \ \) \ (s \ \)\" +| "insert\t,s\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = insert\t \ \, s \ \\" +| "delete\t,s\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = delete\t \ \, s \ \\" +| "\X\\\: F \\: G\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = \X\\\: (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \\: (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)\" + +definition subst_apply_stateful_strand:: + "('a,'b) stateful_strand \ ('a,'b) subst \ ('a,'b) stateful_strand" + (infix "\\<^sub>s\<^sub>s\<^sub>t" 51) where + "S \\<^sub>s\<^sub>s\<^sub>t \ \ map (\x. x \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) S" + +fun dbupd\<^sub>s\<^sub>s\<^sub>t::"('f,'v) stateful_strand \ ('f,'v) subst \ ('f,'v) dbstate \ ('f,'v) dbstate" +where + "dbupd\<^sub>s\<^sub>s\<^sub>t [] I D = D" +| "dbupd\<^sub>s\<^sub>s\<^sub>t (Insert t s#A) I D = dbupd\<^sub>s\<^sub>s\<^sub>t A I (insert ((t,s) \\<^sub>p I) D)" +| "dbupd\<^sub>s\<^sub>s\<^sub>t (Delete t s#A) I D = dbupd\<^sub>s\<^sub>s\<^sub>t A I (D - {((t,s) \\<^sub>p I)})" +| "dbupd\<^sub>s\<^sub>s\<^sub>t (_#A) I D = dbupd\<^sub>s\<^sub>s\<^sub>t A I D" + +fun db'\<^sub>s\<^sub>s\<^sub>t::"('f,'v) stateful_strand \ ('f,'v) subst \ ('f,'v) dbstatelist \ ('f,'v) dbstatelist" +where + "db'\<^sub>s\<^sub>s\<^sub>t [] I D = D" +| "db'\<^sub>s\<^sub>s\<^sub>t (Insert t s#A) I D = db'\<^sub>s\<^sub>s\<^sub>t A I (List.insert ((t,s) \\<^sub>p I) D)" +| "db'\<^sub>s\<^sub>s\<^sub>t (Delete t s#A) I D = db'\<^sub>s\<^sub>s\<^sub>t A I (List.removeAll ((t,s) \\<^sub>p I) D)" +| "db'\<^sub>s\<^sub>s\<^sub>t (_#A) I D = db'\<^sub>s\<^sub>s\<^sub>t A I D" + +definition db\<^sub>s\<^sub>s\<^sub>t where + "db\<^sub>s\<^sub>s\<^sub>t S I \ db'\<^sub>s\<^sub>s\<^sub>t S I []" + +fun setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p where + "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Insert t s) = {(t,s)}" +| "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Delete t s) = {(t,s)}" +| "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (InSet _ t s) = {(t,s)}" +| "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (NegChecks _ _ F') = set F'" +| "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p _ = {}" + +text \The set-operations of a stateful strand\ +definition setops\<^sub>s\<^sub>s\<^sub>t where + "setops\<^sub>s\<^sub>s\<^sub>t S \ \(setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p ` set S)" + +fun setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p where + "setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Insert t s) = [(t,s)]" +| "setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Delete t s) = [(t,s)]" +| "setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (InSet _ t s) = [(t,s)]" +| "setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p (NegChecks _ _ F') = F'" +| "setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p _ = []" + +text \The set-operations of a stateful strand (list variant)\ +definition setops_list\<^sub>s\<^sub>s\<^sub>t where + "setops_list\<^sub>s\<^sub>s\<^sub>t S \ remdups (concat (map setops_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p S))" + + +subsection \Small Lemmata\ +lemma trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t: "trms\<^sub>s\<^sub>s\<^sub>t S = set (trms_list\<^sub>s\<^sub>s\<^sub>t S)" +unfolding trms\<^sub>s\<^sub>t_def trms_list\<^sub>s\<^sub>s\<^sub>t_def +proof (induction S) + case (Cons x S) thus ?case by (cases x) auto +qed simp + +lemma setops_list\<^sub>s\<^sub>s\<^sub>t_is_setops\<^sub>s\<^sub>s\<^sub>t: "setops\<^sub>s\<^sub>s\<^sub>t S = set (setops_list\<^sub>s\<^sub>s\<^sub>t S)" +unfolding setops\<^sub>s\<^sub>s\<^sub>t_def setops_list\<^sub>s\<^sub>s\<^sub>t_def +proof (induction S) + case (Cons x S) thus ?case by (cases x) auto +qed simp + +lemma fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p: "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = set (fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p a)" +proof (cases a) + case (NegChecks X F G) thus ?thesis + using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_append[of F G] fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_append[of F G] + fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of "F@G"] + by auto +qed (simp_all add: fv_list\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s fv_list_is_fv) + +lemma fv_list\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t: "fv\<^sub>s\<^sub>s\<^sub>t S = set (fv_list\<^sub>s\<^sub>s\<^sub>t S)" +unfolding fv\<^sub>s\<^sub>s\<^sub>t_def fv_list\<^sub>s\<^sub>s\<^sub>t_def by (induct S) (simp_all add: fv_list\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p) + +lemma trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite[simp]: "finite (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p x)" +by (cases x) auto + +lemma trms\<^sub>s\<^sub>s\<^sub>t_finite[simp]: "finite (trms\<^sub>s\<^sub>s\<^sub>t S)" +using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by (induct S) auto + +lemma vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite[simp]: "finite (vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x)" +by (cases x) auto + +lemma vars\<^sub>s\<^sub>s\<^sub>t_finite[simp]: "finite (vars\<^sub>s\<^sub>s\<^sub>t S)" +using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite unfolding vars\<^sub>s\<^sub>s\<^sub>t_def by (induct S) auto + +lemma fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite[simp]: "finite (fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p x)" +by (cases x) auto + +lemma fv\<^sub>s\<^sub>s\<^sub>t_finite[simp]: "finite (fv\<^sub>s\<^sub>s\<^sub>t S)" +using fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite unfolding fv\<^sub>s\<^sub>s\<^sub>t_def by (induct S) auto + +lemma bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite[simp]: "finite (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x))" +by (rule finite_set) + +lemma bvars\<^sub>s\<^sub>s\<^sub>t_finite[simp]: "finite (bvars\<^sub>s\<^sub>s\<^sub>t S)" +using bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_finite unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def by (induct S) auto + +lemma subst_sst_nil[simp]: "[] \\<^sub>s\<^sub>s\<^sub>t \ = []" +by (simp add: subst_apply_stateful_strand_def) + +lemma db\<^sub>s\<^sub>s\<^sub>t_nil[simp]: "db\<^sub>s\<^sub>s\<^sub>t [] \ = []" +by (simp add: db\<^sub>s\<^sub>s\<^sub>t_def) + +lemma ik\<^sub>s\<^sub>s\<^sub>t_nil[simp]: "ik\<^sub>s\<^sub>s\<^sub>t [] = {}" +by (simp add: ik\<^sub>s\<^sub>s\<^sub>t_def) + +lemma ik\<^sub>s\<^sub>s\<^sub>t_append[simp]: "ik\<^sub>s\<^sub>s\<^sub>t (A@B) = ik\<^sub>s\<^sub>s\<^sub>t A \ ik\<^sub>s\<^sub>s\<^sub>t B" + by (auto simp add: ik\<^sub>s\<^sub>s\<^sub>t_def) + +lemma ik\<^sub>s\<^sub>s\<^sub>t_subst: "ik\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>s\<^sub>s\<^sub>t \) = ik\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \" +proof (induction A) + case (Cons a A) thus ?case + by (cases a) (auto simp add: ik\<^sub>s\<^sub>s\<^sub>t_def subst_apply_stateful_strand_def) +qed simp + +lemma db\<^sub>s\<^sub>s\<^sub>t_set_is_dbupd\<^sub>s\<^sub>s\<^sub>t: "set (db'\<^sub>s\<^sub>s\<^sub>t A I D) = dbupd\<^sub>s\<^sub>s\<^sub>t A I (set D)" (is "?A = ?B") +proof + show "?A \ ?B" + proof + fix t s show "(t,s) \ ?A \ (t,s) \ ?B" by (induct rule: db'\<^sub>s\<^sub>s\<^sub>t.induct) auto + qed + + show "?B \ ?A" + proof + fix t s show "(t,s) \ ?B \ (t,s) \ ?A" by (induct arbitrary: D rule: dbupd\<^sub>s\<^sub>s\<^sub>t.induct) auto + qed +qed + +lemma dbupd\<^sub>s\<^sub>s\<^sub>t_no_upd: + assumes "\a \ set A. \is_Insert a \ \is_Delete a" + shows "dbupd\<^sub>s\<^sub>s\<^sub>t A I D = D" +using assms +proof (induction A) + case (Cons a A) thus ?case by (cases a) auto +qed simp + +lemma db\<^sub>s\<^sub>s\<^sub>t_no_upd: + assumes "\a \ set A. \is_Insert a \ \is_Delete a" + shows "db'\<^sub>s\<^sub>s\<^sub>t A I D = D" +using assms +proof (induction A) + case (Cons a A) thus ?case by (cases a) auto +qed simp + +lemma db\<^sub>s\<^sub>s\<^sub>t_no_upd_append: + assumes "\b \ set B. \is_Insert b \ \is_Delete b" + shows "db'\<^sub>s\<^sub>s\<^sub>t A = db'\<^sub>s\<^sub>s\<^sub>t (A@B)" + using assms +proof (induction A) + case Nil thus ?case by (simp add: db\<^sub>s\<^sub>s\<^sub>t_no_upd) +next + case (Cons a A) thus ?case by (cases a) simp_all +qed + +lemma db\<^sub>s\<^sub>s\<^sub>t_append: + "db'\<^sub>s\<^sub>s\<^sub>t (A@B) I D = db'\<^sub>s\<^sub>s\<^sub>t B I (db'\<^sub>s\<^sub>s\<^sub>t A I D)" +proof (induction A arbitrary: D) + case (Cons a A) thus ?case by (cases a) auto +qed simp + +lemma db\<^sub>s\<^sub>s\<^sub>t_in_cases: + assumes "(t,s) \ set (db'\<^sub>s\<^sub>s\<^sub>t A I D)" + shows "(t,s) \ set D \ (\t' s'. insert\t',s'\ \ set A \ t = t' \ I \ s = s' \ I)" + using assms +proof (induction A arbitrary: D) + case (Cons a A) thus ?case by (cases a) fastforce+ +qed simp + +lemma db\<^sub>s\<^sub>s\<^sub>t_in_cases': + assumes "(t,s) \ set (db'\<^sub>s\<^sub>s\<^sub>t A I D)" + and "(t,s) \ set D" + shows "\B C t' s'. A = B@insert\t',s'\#C \ t = t' \ I \ s = s' \ I \ + (\t'' s''. delete\t'',s''\ \ set C \ t \ t'' \ I \ s \ s'' \ I)" + using assms(1) +proof (induction A rule: List.rev_induct) + case (snoc a A) + note * = snoc db\<^sub>s\<^sub>s\<^sub>t_append[of A "[a]" I D] + thus ?case + proof (cases a) + case (Insert t' s') + thus ?thesis using * by (cases "(t,s) \ set (db'\<^sub>s\<^sub>s\<^sub>t A I D)") force+ + next + case (Delete t' s') + hence **: "t \ t' \ I \ s \ s' \ I" using * by simp + + have "(t,s) \ set (db'\<^sub>s\<^sub>s\<^sub>t A I D)" using * Delete by force + then obtain B C u v where B: + "A = B@insert\u,v\#C" "t = u \ I" "s = v \ I" + "\t' s'. delete\t',s'\ \ set C \ t \ t' \ I \ s \ s' \ I" + using snoc.IH by moura + + have "A@[a] = B@insert\u,v\#(C@[a])" + "\t' s'. delete\t',s'\ \ set (C@[a]) \ t \ t' \ I \ s \ s' \ I" + using B(1,4) Delete ** by auto + thus ?thesis using B(2,3) by blast + qed force+ +qed (simp add: assms(2)) + +lemma db\<^sub>s\<^sub>s\<^sub>t_filter: + "db'\<^sub>s\<^sub>s\<^sub>t A I D = db'\<^sub>s\<^sub>s\<^sub>t (filter is_Update A) I D" +by (induct A I D rule: db'\<^sub>s\<^sub>s\<^sub>t.induct) simp_all + +lemma subst_sst_cons: "a#A \\<^sub>s\<^sub>s\<^sub>t \ = (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)#(A \\<^sub>s\<^sub>s\<^sub>t \)" +by (simp add: subst_apply_stateful_strand_def) + +lemma subst_sst_snoc: "A@[a] \\<^sub>s\<^sub>s\<^sub>t \ = (A \\<^sub>s\<^sub>s\<^sub>t \)@[a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \]" +by (simp add: subst_apply_stateful_strand_def) + +lemma subst_sst_append[simp]: "A@B \\<^sub>s\<^sub>s\<^sub>t \ = (A \\<^sub>s\<^sub>s\<^sub>t \)@(B \\<^sub>s\<^sub>s\<^sub>t \)" +by (simp add: subst_apply_stateful_strand_def) + +lemma sst_vars_append_subset: + "fv\<^sub>s\<^sub>s\<^sub>t A \ fv\<^sub>s\<^sub>s\<^sub>t (A@B)" "bvars\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t (A@B)" + "fv\<^sub>s\<^sub>s\<^sub>t B \ fv\<^sub>s\<^sub>s\<^sub>t (A@B)" "bvars\<^sub>s\<^sub>s\<^sub>t B \ bvars\<^sub>s\<^sub>s\<^sub>t (A@B)" +by auto + +lemma sst_vars_disj_cons[simp]: "fv\<^sub>s\<^sub>s\<^sub>t (a#A) \ bvars\<^sub>s\<^sub>s\<^sub>t (a#A) = {} \ fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" +unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by auto + +lemma fv\<^sub>s\<^sub>s\<^sub>t_cons_subset[simp]: "fv\<^sub>s\<^sub>s\<^sub>t A \ fv\<^sub>s\<^sub>s\<^sub>t (a#A)" +by auto + +lemma fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases[simp]: + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\t\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (receive\t\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\c: t \ s\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (s \ \)" + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\t,s\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (s \ \)" + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (delete\t,s\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (s \ \)" + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\c: t \ s\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (s \ \)" + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: F \\: G\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = + fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) - set X" +by simp_all + +lemma vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_cases[simp]: + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\t\) = fv t" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (receive\t\) = fv t" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\c: t \ s\) = fv t \ fv s" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\t,s\) = fv t \ fv s" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (delete\t,s\) = fv t \ fv s" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\c: t \ s\) = fv t \ fv s" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: F \\: G\) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \ set X" (is ?A) + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: [(t,s)] \\: []\) = fv t \ fv s \ set X" (is ?B) + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: [] \\: [(t,s)]\) = fv t \ fv s \ set X" (is ?C) +proof + show ?A ?B ?C by auto +qed simp_all + +lemma vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases[simp]: + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\t\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (receive\t\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\c: t \ s\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (s \ \)" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\t,s\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (s \ \)" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (delete\t,s\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (s \ \)" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\c: t \ s\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (s \ \)" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: F \\: G\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = + fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \ set X" (is ?A) + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: [(t,s)] \\: []\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = + fv (t \ rm_vars (set X) \) \ fv (s \ rm_vars (set X) \) \ set X" (is ?B) + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: [] \\: [(t,s)]\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = + fv (t \ rm_vars (set X) \) \ fv (s \ rm_vars (set X) \) \ set X" (is ?C) +proof + show ?A ?B ?C by auto +qed simp_all + +lemma bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset: "bvars\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t (a#A)" +by auto + +lemma bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst: "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" +by (cases a) auto + +lemma bvars\<^sub>s\<^sub>s\<^sub>t_subst: "bvars\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>s\<^sub>s\<^sub>t \) = bvars\<^sub>s\<^sub>s\<^sub>t A" +using bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[of _ \] +by (induct A) (simp_all add: subst_apply_stateful_strand_def) + +lemma bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_set_cases[simp]: + "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\t\)) = {}" + "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (receive\t\)) = {}" + "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\c: t \ s\)) = {}" + "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\t,s\)) = {}" + "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (delete\t,s\)) = {}" + "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\c: t \ s\)) = {}" + "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: F \\: G\)) = set X" +by simp_all + +lemma bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegChecks: "\is_NegChecks a \ bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = []" +by (cases a) simp_all + +lemma bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks: "bvars\<^sub>s\<^sub>s\<^sub>t A = bvars\<^sub>s\<^sub>s\<^sub>t (filter is_NegChecks A)" +proof (induction A) + case (Cons a A) thus ?case by (cases a) fastforce+ +qed simp + +lemma vars\<^sub>s\<^sub>s\<^sub>t_append[simp]: "vars\<^sub>s\<^sub>s\<^sub>t (A@B) = vars\<^sub>s\<^sub>s\<^sub>t A \ vars\<^sub>s\<^sub>s\<^sub>t B" +by (simp add: vars\<^sub>s\<^sub>s\<^sub>t_def) + +lemma vars\<^sub>s\<^sub>s\<^sub>t_Nil[simp]: "vars\<^sub>s\<^sub>s\<^sub>t [] = {}" +by (simp add: vars\<^sub>s\<^sub>s\<^sub>t_def) + +lemma vars\<^sub>s\<^sub>s\<^sub>t_Cons: "vars\<^sub>s\<^sub>s\<^sub>t (a#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \ vars\<^sub>s\<^sub>s\<^sub>t A" +by (simp add: vars\<^sub>s\<^sub>s\<^sub>t_def) + +lemma fv\<^sub>s\<^sub>s\<^sub>t_Cons: "fv\<^sub>s\<^sub>s\<^sub>t (a#A) = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \ fv\<^sub>s\<^sub>s\<^sub>t A" +unfolding fv\<^sub>s\<^sub>s\<^sub>t_def by simp + +lemma bvars\<^sub>s\<^sub>s\<^sub>t_Cons: "bvars\<^sub>s\<^sub>s\<^sub>t (a#A) = set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) \ bvars\<^sub>s\<^sub>s\<^sub>t A" +unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def by auto + +lemma vars\<^sub>s\<^sub>s\<^sub>t_Cons'[simp]: + "vars\<^sub>s\<^sub>s\<^sub>t (send\t\#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (send\t\) \ vars\<^sub>s\<^sub>s\<^sub>t A" + "vars\<^sub>s\<^sub>s\<^sub>t (receive\t\#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (receive\t\) \ vars\<^sub>s\<^sub>s\<^sub>t A" + "vars\<^sub>s\<^sub>s\<^sub>t (\a: t \ s\#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\a: t \ s\) \ vars\<^sub>s\<^sub>s\<^sub>t A" + "vars\<^sub>s\<^sub>s\<^sub>t (insert\t,s\#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\t,s\) \ vars\<^sub>s\<^sub>s\<^sub>t A" + "vars\<^sub>s\<^sub>s\<^sub>t (delete\t,s\#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (delete\t,s\) \ vars\<^sub>s\<^sub>s\<^sub>t A" + "vars\<^sub>s\<^sub>s\<^sub>t (\a: t \ s\#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\a: t \ s\) \ vars\<^sub>s\<^sub>s\<^sub>t A" + "vars\<^sub>s\<^sub>s\<^sub>t (\X\\\: F \\: G\#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: F \\: G\) \ vars\<^sub>s\<^sub>s\<^sub>t A" +by (simp_all add: vars\<^sub>s\<^sub>s\<^sub>t_def) + +lemma vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p: + fixes x::"('a,'b) stateful_strand_step" + shows "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \ set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x)" +proof (cases x) + case (NegChecks X F G) thus ?thesis by (induct F) force+ +qed simp_all + +lemma vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t: + fixes S::"('a,'b) stateful_strand" + shows "vars\<^sub>s\<^sub>s\<^sub>t S = fv\<^sub>s\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>s\<^sub>t S" +proof (induction S) + case (Cons x S) thus ?case + using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p[of x] + by (auto simp add: vars\<^sub>s\<^sub>s\<^sub>t_def) +qed simp + +lemma vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck[simp]: + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: F \\: G\) = set X \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" +by (simp_all add: sup_commute sup_left_commute vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p) + +lemma bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck[simp]: + "bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: F \\: G\) = X" + "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\[]\\\: F \\: G\)) = {}" +by simp_all + +lemma fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck[simp]: + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\X\\\: F \\: G\) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G - set X" + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\[]\\\: F \\: G\) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\t != s\) = fv t \ fv s" + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\t not in s\) = fv t \ fv s" +by simp_all + +lemma fv\<^sub>s\<^sub>s\<^sub>t_append[simp]: "fv\<^sub>s\<^sub>s\<^sub>t (A@B) = fv\<^sub>s\<^sub>s\<^sub>t A \ fv\<^sub>s\<^sub>s\<^sub>t B" +by simp + +lemma bvars\<^sub>s\<^sub>s\<^sub>t_append[simp]: "bvars\<^sub>s\<^sub>s\<^sub>t (A@B) = bvars\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t B" +by auto + +lemma fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p: + assumes "x \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" + shows "Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a)" +using assms var_is_subterm +proof (cases a) + case (NegChecks X F F') + hence "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' - set X" using assms by simp + thus ?thesis using NegChecks var_is_subterm by fastforce +qed force+ + +lemma fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t: "x \ fv\<^sub>s\<^sub>s\<^sub>t A \ Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t A)" +proof (induction A) + case (Cons a A) thus ?case using fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p by (cases "x \ fv\<^sub>s\<^sub>s\<^sub>t A") auto +qed simp + +lemma var_subterm_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p: + assumes "Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a)" + shows "x \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" +using assms vars_iff_subtermeq +proof (cases a) + case (NegChecks X F F') + hence "Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F')" using assms by simp + thus ?thesis using NegChecks vars_iff_subtermeq by force +qed force+ + +lemma var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t: "Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t A) \ x \ vars\<^sub>s\<^sub>s\<^sub>t A" +proof (induction A) + case (Cons a A) + show ?case + proof (cases "Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t A)") + case True thus ?thesis using Cons.IH by (simp add: vars\<^sub>s\<^sub>s\<^sub>t_def) + next + case False thus ?thesis + using Cons.prems var_subterm_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p + by (fastforce simp add: vars\<^sub>s\<^sub>s\<^sub>t_def) + qed +qed simp + +lemma var_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t: "Var x \ trms\<^sub>s\<^sub>s\<^sub>t A \ x \ vars\<^sub>s\<^sub>s\<^sub>t A" +by (meson var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t UN_I term.order_refl) + +lemma ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset: "ik\<^sub>s\<^sub>s\<^sub>t A \ trms\<^sub>s\<^sub>s\<^sub>t A" +by (force simp add: ik\<^sub>s\<^sub>s\<^sub>t_def) + +lemma var_subterm_ik\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t: "Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t A) \ x \ vars\<^sub>s\<^sub>s\<^sub>t A" +using var_subterm_trms\<^sub>s\<^sub>s\<^sub>t_is_vars\<^sub>s\<^sub>s\<^sub>t ik\<^sub>s\<^sub>s\<^sub>t_trms\<^sub>s\<^sub>s\<^sub>t_subset by fast + +lemma var_subterm_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t: + assumes "Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t A)" + shows "x \ fv\<^sub>s\<^sub>s\<^sub>t A" +proof - + obtain t where t: "Receive t \ set A" "Var x \ t" using assms unfolding ik\<^sub>s\<^sub>s\<^sub>t_def by moura + hence "fv t \ fv\<^sub>s\<^sub>s\<^sub>t A" unfolding fv\<^sub>s\<^sub>s\<^sub>t_def by force + thus ?thesis using t(2) by (meson contra_subsetD subterm_is_var) +qed + +lemma fv_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t: + assumes "x \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t A)" + shows "x \ fv\<^sub>s\<^sub>s\<^sub>t A" +using var_subterm_ik\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t assms var_is_subterm by fastforce + +lemma fv_trms\<^sub>s\<^sub>s\<^sub>t_subset: + "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S) \ vars\<^sub>s\<^sub>s\<^sub>t S" + "fv\<^sub>s\<^sub>s\<^sub>t S \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)" +proof (induction S) + case (Cons x S) + have *: "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t (x#S)) = fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p x) \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)" + "fv\<^sub>s\<^sub>s\<^sub>t (x#S) = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \ fv\<^sub>s\<^sub>s\<^sub>t S" "vars\<^sub>s\<^sub>s\<^sub>t (x#S) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \ vars\<^sub>s\<^sub>s\<^sub>t S" + unfolding trms\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def vars\<^sub>s\<^sub>s\<^sub>t_def + by auto + + { case 1 + show ?case using Cons.IH(1) + proof (cases x) + case (NegChecks X F G) + hence "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" + "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \ set X" + by (simp, meson vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_cases(7)) + hence "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p x) \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x" + using fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of F] fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of G] + by auto + thus ?thesis + using Cons.IH(1) *(1,3) + by blast + qed auto + } + + { case 2 + show ?case using Cons.IH(2) + proof (cases x) + case (NegChecks X F G) + hence "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" + "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p x = (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G) - set X" + by auto + hence "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p x)" + using fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of F] fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of G] + by auto + thus ?thesis + using Cons.IH(2) *(1,2) + by blast + qed auto + } +qed simp_all + +lemma fv_ik_subset_fv_sst'[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t S) \ fv\<^sub>s\<^sub>s\<^sub>t S" +unfolding ik\<^sub>s\<^sub>s\<^sub>t_def by (induct S) auto + +lemma fv_ik_subset_vars_sst'[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t S) \ vars\<^sub>s\<^sub>s\<^sub>t S" +using fv_ik_subset_fv_sst' fv_trms\<^sub>s\<^sub>s\<^sub>t_subset by fast + +lemma ik\<^sub>s\<^sub>s\<^sub>t_var_is_fv: "Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>s\<^sub>t A) \ x \ fv\<^sub>s\<^sub>s\<^sub>t A" +by (meson fv_ik_subset_fv_sst'[of A] fv_subset_subterms subsetCE term.set_intros(3)) + +lemma vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases': + assumes x: "x \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + shows "x \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s \ x \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s)" +using x vars_term_subst[of _ \] vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_cases(1,2,3,4,5,6) vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(1,2)[of _ \] + vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(3,6)[of _ _ _ \] vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(4,5)[of _ _ \] +proof (cases s) + case (NegChecks X F G) + let ?\' = "rm_vars (set X) \" + have "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\') \ x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\') \ x \ set X" + using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(7)[of X F G \] x NegChecks by simp + hence "x \ fv\<^sub>s\<^sub>e\<^sub>t (?\' ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ x \ fv\<^sub>s\<^sub>e\<^sub>t (?\' ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G) \ x \ set X" + using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst[of _ ?\'] by blast + hence "x \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ x \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G) \ x \ set X" + using rm_vars_fv\<^sub>s\<^sub>e\<^sub>t_subst by fast + thus ?thesis + using NegChecks vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_cases(7)[of X F G] + by auto +qed simp_all + +lemma vars\<^sub>s\<^sub>s\<^sub>t_subst_cases: + assumes "x \ vars\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + shows "x \ vars\<^sub>s\<^sub>s\<^sub>t S \ x \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` vars\<^sub>s\<^sub>s\<^sub>t S)" + using assms +proof (induction S) + case (Cons s S) thus ?case + proof (cases "x \ vars\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)") + case False + note * = subst_sst_cons[of s S \] vars\<^sub>s\<^sub>s\<^sub>t_Cons[of "s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" "S \\<^sub>s\<^sub>s\<^sub>t \"] vars\<^sub>s\<^sub>s\<^sub>t_Cons[of s S] + have **: "x \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" using Cons.prems False * by simp + show ?thesis using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases'[OF **] * by auto + qed (auto simp add: vars\<^sub>s\<^sub>s\<^sub>t_def) +qed simp + +lemma subset_subst_pairs_diff_exists: + fixes \::"('a,'b) subst" and D D'::"('a,'b) dbstate" + shows "\Di. Di \ D \ Di \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ = (D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) - D'" +by (metis (no_types, lifting) Diff_subset subset_image_iff) + +lemma subset_subst_pairs_diff_exists': + fixes \::"('a,'b) subst" and D::"('a,'b) dbstate" + assumes "finite D" + shows "\Di. Di \ D \ Di \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \ {d \\<^sub>p \} \ d \\<^sub>p \ \ (D - Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" +using assms +proof (induction D rule: finite_induct) + case (insert d' D) + then obtain Di where IH: "Di \ D" "Di \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \ {d \\<^sub>p \}" "d \\<^sub>p \ \ (D - Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" by moura + show ?case + proof (cases "d' \\<^sub>p \ = d \\<^sub>p \") + case True + hence "insert d' Di \ insert d' D" "insert d' Di \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \ {d \\<^sub>p \}" + "d \\<^sub>p \ \ (insert d' D - insert d' Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + using IH by auto + thus ?thesis by metis + next + case False + hence "Di \ insert d' D" "Di \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \ {d \\<^sub>p \}" + "d \\<^sub>p \ \ (insert d' D - Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + using IH by auto + thus ?thesis by metis + qed +qed simp + +lemma stateful_strand_step_subst_inI[intro]: + "send\t\ \ set A \ send\t \ \\ \ set (A \\<^sub>s\<^sub>s\<^sub>t \)" + "receive\t\ \ set A \ receive\t \ \\ \ set (A \\<^sub>s\<^sub>s\<^sub>t \)" + "\c: t \ s\ \ set A \ \c: (t \ \) \ (s \ \)\ \ set (A \\<^sub>s\<^sub>s\<^sub>t \)" + "insert\t, s\ \ set A \ insert\t \ \, s \ \\ \ set (A \\<^sub>s\<^sub>s\<^sub>t \)" + "delete\t, s\ \ set A \ delete\t \ \, s \ \\ \ set (A \\<^sub>s\<^sub>s\<^sub>t \)" + "\c: t \ s\ \ set A \ \c: (t \ \) \ (s \ \)\ \ set (A \\<^sub>s\<^sub>s\<^sub>t \)" + "\X\\\: F \\: G\ \ set A + \ \X\\\: (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \\: (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)\ \ set (A \\<^sub>s\<^sub>s\<^sub>t \)" + "\t != s\ \ set A \ \t \ \ != s \ \\ \ set (A \\<^sub>s\<^sub>s\<^sub>t \)" + "\t not in s\ \ set A \ \t \ \ not in s \ \\ \ set (A \\<^sub>s\<^sub>s\<^sub>t \)" +proof (induction A) + case (Cons a A) + note * = subst_sst_cons[of a A \] + { case 1 thus ?case using Cons.IH(1) * by (cases a) auto } + { case 2 thus ?case using Cons.IH(2) * by (cases a) auto } + { case 3 thus ?case using Cons.IH(3) * by (cases a) auto } + { case 4 thus ?case using Cons.IH(4) * by (cases a) auto } + { case 5 thus ?case using Cons.IH(5) * by (cases a) auto } + { case 6 thus ?case using Cons.IH(6) * by (cases a) auto } + { case 7 thus ?case using Cons.IH(7) * by (cases a) auto } + { case 8 thus ?case using Cons.IH(8) * by (cases a) auto } + { case 9 thus ?case using Cons.IH(9) * by (cases a) auto } +qed simp_all + +lemma stateful_strand_step_cases_subst: + "is_Send a = is_Send (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "is_Receive a = is_Receive (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "is_Equality a = is_Equality (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "is_Insert a = is_Insert (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "is_Delete a = is_Delete (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "is_InSet a = is_InSet (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "is_NegChecks a = is_NegChecks (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "is_Assignment a = is_Assignment (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "is_Check a = is_Check (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + "is_Update a = is_Update (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" +by (cases a; simp_all)+ + +lemma stateful_strand_step_subst_inv_cases: + "send\t\ \ set (S \\<^sub>s\<^sub>s\<^sub>t \) \ \t'. t = t' \ \ \ send\t'\ \ set S" + "receive\t\ \ set (S \\<^sub>s\<^sub>s\<^sub>t \) \ \t'. t = t' \ \ \ receive\t'\ \ set S" + "\c: t \ s\ \ set (S \\<^sub>s\<^sub>s\<^sub>t \) \ \t' s'. t = t' \ \ \ s = s' \ \ \ \c: t' \ s'\ \ set S" + "insert\t,s\ \ set (S \\<^sub>s\<^sub>s\<^sub>t \) \ \t' s'. t = t' \ \ \ s = s' \ \ \ insert\t',s'\ \ set S" + "delete\t,s\ \ set (S \\<^sub>s\<^sub>s\<^sub>t \) \ \t' s'. t = t' \ \ \ s = s' \ \ \ delete\t',s'\ \ set S" + "\c: t \ s\ \ set (S \\<^sub>s\<^sub>s\<^sub>t \) \ \t' s'. t = t' \ \ \ s = s' \ \ \ \c: t' \ s'\ \ set S" + "\X\\\: F \\: G\ \ set (S \\<^sub>s\<^sub>s\<^sub>t \) \ + \F' G'. F = F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \ \ G = G' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \ \ + \X\\\: F' \\: G'\ \ set S" +proof (induction S) + case (Cons a S) + have *: "x \ set (S \\<^sub>s\<^sub>s\<^sub>t \)" + when "x \ set (a#S \\<^sub>s\<^sub>s\<^sub>t \)" "x \ a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" for x + using that by (simp add: subst_apply_stateful_strand_def) + + { case 1 thus ?case using Cons.IH(1)[OF *] by (cases a) auto } + { case 2 thus ?case using Cons.IH(2)[OF *] by (cases a) auto } + { case 3 thus ?case using Cons.IH(3)[OF *] by (cases a) auto } + { case 4 thus ?case using Cons.IH(4)[OF *] by (cases a) auto } + { case 5 thus ?case using Cons.IH(5)[OF *] by (cases a) auto } + { case 6 thus ?case using Cons.IH(6)[OF *] by (cases a) auto } + { case 7 thus ?case using Cons.IH(7)[OF *] by (cases a) auto } +qed simp_all + +lemma stateful_strand_step_fv_subset_cases: + "send\t\ \ set S \ fv t \ fv\<^sub>s\<^sub>s\<^sub>t S" + "receive\t\ \ set S \ fv t \ fv\<^sub>s\<^sub>s\<^sub>t S" + "\c: t \ s\ \ set S \ fv t \ fv s \ fv\<^sub>s\<^sub>s\<^sub>t S" + "insert\t,s\ \ set S \ fv t \ fv s \ fv\<^sub>s\<^sub>s\<^sub>t S" + "delete\t,s\ \ set S \ fv t \ fv s \ fv\<^sub>s\<^sub>s\<^sub>t S" + "\c: t \ s\ \ set S \ fv t \ fv s \ fv\<^sub>s\<^sub>s\<^sub>t S" + "\X\\\: F \\: G\ \ set S \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G - set X \ fv\<^sub>s\<^sub>s\<^sub>t S" +proof (induction S) + case (Cons a S) + { case 1 thus ?case using Cons.IH(1) by auto } + { case 2 thus ?case using Cons.IH(2) by auto } + { case 3 thus ?case using Cons.IH(3) by auto } + { case 4 thus ?case using Cons.IH(4) by auto } + { case 5 thus ?case using Cons.IH(5) by auto } + { case 6 thus ?case using Cons.IH(6) by auto } + { case 7 thus ?case using Cons.IH(7) by fastforce } +qed simp_all + +lemma trms\<^sub>s\<^sub>s\<^sub>t_nil[simp]: + "trms\<^sub>s\<^sub>s\<^sub>t [] = {}" +unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by simp + +lemma trms\<^sub>s\<^sub>s\<^sub>t_mono: + "set M \ set N \ trms\<^sub>s\<^sub>s\<^sub>t M \ trms\<^sub>s\<^sub>s\<^sub>t N" +by auto + +lemma trms\<^sub>s\<^sub>s\<^sub>t_in: + assumes "t \ trms\<^sub>s\<^sub>s\<^sub>t S" + shows "\a \ set S. t \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" +using assms unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by simp + +lemma trms\<^sub>s\<^sub>s\<^sub>t_cons: "trms\<^sub>s\<^sub>s\<^sub>t (a#A) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \ trms\<^sub>s\<^sub>s\<^sub>t A" +unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by force + +lemma trms\<^sub>s\<^sub>s\<^sub>t_append[simp]: "trms\<^sub>s\<^sub>s\<^sub>t (A@B) = trms\<^sub>s\<^sub>s\<^sub>t A \ trms\<^sub>s\<^sub>s\<^sub>t B" +unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by force + +lemma trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst: + assumes "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) \ subst_domain \ = {}" + shows "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>s\<^sub>e\<^sub>t \" +proof (cases a) + case (NegChecks X F G) + hence "rm_vars (set X) \ = \" using assms rm_vars_apply'[of \ "set X"] by auto + hence "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>s\<^sub>e\<^sub>t \ = (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \\<^sub>s\<^sub>e\<^sub>t \) \ (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \\<^sub>s\<^sub>e\<^sub>t \)" + using NegChecks image_Un by simp_all + thus ?thesis by (metis trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst) +qed simp_all + +lemma trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst': + assumes "\is_NegChecks a" + shows "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>s\<^sub>e\<^sub>t \" +using assms by (cases a) simp_all + +lemma trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst'': + fixes t::"('a,'b) term" and \::"('a,'b) subst" + assumes "t \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + shows "\s \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p b. t = s \ rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b)) \" +proof (cases "is_NegChecks b") + case True + then obtain X F G where *: "b = NegChecks X F G" by (cases b) moura+ + thus ?thesis using assms trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst[of _ "rm_vars (set X) \"] by auto +next + case False + hence "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \\<^sub>s\<^sub>e\<^sub>t rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b)) \" + using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst' bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegChecks + by fastforce + thus ?thesis using assms by fast +qed + +lemma trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst''': + fixes t::"('a,'b) term" and \ \::"('a,'b) subst" + assumes "t \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \\<^sub>s\<^sub>e\<^sub>t \" + shows "\s \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p b. t = s \ rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b)) \ \\<^sub>s \" +proof - + obtain s where s: "s \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" "t = s \ \" using assms by moura + show ?thesis using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst''[OF s(1)] s(2) by auto +qed + +lemma trms\<^sub>s\<^sub>s\<^sub>t_subst: + assumes "bvars\<^sub>s\<^sub>s\<^sub>t S \ subst_domain \ = {}" + shows "trms\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \) = trms\<^sub>s\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \" +using assms +proof (induction S) + case (Cons a S) + hence IH: "trms\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \) = trms\<^sub>s\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \" and *: "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) \ subst_domain \ = {}" + by auto + show ?case using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[OF *] IH by (auto simp add: subst_apply_stateful_strand_def) +qed simp + +lemma trms\<^sub>s\<^sub>s\<^sub>t_subst_cons: + "trms\<^sub>s\<^sub>s\<^sub>t (a#A \\<^sub>s\<^sub>s\<^sub>t \) = trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \ trms\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>s\<^sub>s\<^sub>t \)" +using subst_sst_cons[of a A \] trms\<^sub>s\<^sub>s\<^sub>t_cons[of a A] trms\<^sub>s\<^sub>s\<^sub>t_append by simp + +lemma (in intruder_model) wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst: + assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>s\<^sub>e\<^sub>t \)" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \))" + using assms +proof (cases a) + case (NegChecks X F G) + hence *: "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = + (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)) \ (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \))" + by simp + + have "trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>s\<^sub>e\<^sub>t \ = (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \\<^sub>s\<^sub>e\<^sub>t \) \ (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \\<^sub>s\<^sub>e\<^sub>t \)" + using NegChecks image_Un by simp + hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \\<^sub>s\<^sub>e\<^sub>t \)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \\<^sub>s\<^sub>e\<^sub>t \)" using * assms by auto + hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \)" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \)" + using wf_trms_subst_rm_vars[of \ "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" "set X"] + wf_trms_subst_rm_vars[of \ "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" "set X"] + by fast+ + thus ?thesis + using * trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst[of _ "rm_vars (set X) \"] + by auto +qed auto + +lemma trms\<^sub>s\<^sub>s\<^sub>t_fv_vars\<^sub>s\<^sub>s\<^sub>t_subset: "t \ trms\<^sub>s\<^sub>s\<^sub>t A \ fv t \ vars\<^sub>s\<^sub>s\<^sub>t A" +proof (induction A) + case (Cons a A) thus ?case by (cases a) auto +qed simp + +lemma trms\<^sub>s\<^sub>s\<^sub>t_fv_subst_subset: + assumes "t \ trms\<^sub>s\<^sub>s\<^sub>t S" "subst_domain \ \ bvars\<^sub>s\<^sub>s\<^sub>t S = {}" + shows "fv (t \ \) \ vars\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" +using assms +proof (induction S) + case (Cons s S) show ?case + proof (cases "t \ trms\<^sub>s\<^sub>s\<^sub>t S") + case True + hence "fv (t \ \) \ vars\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" using Cons.IH Cons.prems by auto + thus ?thesis using subst_sst_cons[of s S \] unfolding vars\<^sub>s\<^sub>s\<^sub>t_def by auto + next + case False + hence *: "t \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" "subst_domain \ \ set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s) = {}" using Cons.prems by auto + hence "fv (t \ \) \ vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + proof (cases s) + case (NegChecks X F G) + hence **: "t \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ t \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" using *(1) by auto + have ***: "rm_vars (set X) \ = \" using *(2) NegChecks rm_vars_apply' by auto + have "fv (t \ \) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)" + using ** *** trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fv_subst_subset[of t _ \] by auto + thus ?thesis using *(2) using NegChecks vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(7)[of X F G \] by blast + qed auto + thus ?thesis using subst_sst_cons[of s S \] unfolding vars\<^sub>s\<^sub>s\<^sub>t_def by auto + qed +qed simp + +lemma trms\<^sub>s\<^sub>s\<^sub>t_fv_subst_subset': + assumes "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)" "fv t \ bvars\<^sub>s\<^sub>s\<^sub>t S = {}" "fv (t \ \) \ bvars\<^sub>s\<^sub>s\<^sub>t S = {}" + shows "fv (t \ \) \ fv\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" +using assms +proof (induction S) + case (Cons s S) show ?case + proof (cases "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)") + case True + hence "fv (t \ \) \ fv\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" using Cons.IH Cons.prems by auto + thus ?thesis using subst_sst_cons[of s S \] unfolding vars\<^sub>s\<^sub>s\<^sub>t_def by auto + next + case False + hence 0: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p s)" "fv t \ set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s) = {}" + "fv (t \ \) \ set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s) = {}" + using Cons.prems by auto + + note 1 = UN_Un UN_insert fv\<^sub>s\<^sub>e\<^sub>t.simps subst_apply_fv_subset subst_apply_fv_unfold + subst_apply_term_empty sup_bot.comm_neutral fv_subterms_set fv_subset[OF 0(1)] + + note 2 = subst_apply_fv_union + + have "fv (t \ \) \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + proof (cases s) + case (NegChecks X F G) + hence 3: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G)" using 0(1) by auto + have "t \ rm_vars (set X) \ = t \ \" using 0(2) NegChecks rm_vars_ident[of t] by auto + hence "fv (t \ \) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)" + using 3 trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fv_subst_subset'[of t _ "rm_vars (set X) \"] by fastforce + thus ?thesis using 0(2,3) NegChecks fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(7)[of X F G \] by auto + qed (metis (no_types, lifting) 1 trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(1) fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(1), + metis (no_types, lifting) 1 trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(2) fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(2), + metis (no_types, lifting) 1 2 trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(3) fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(3), + metis (no_types, lifting) 1 2 trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(4) fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(4), + metis (no_types, lifting) 1 2 trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(5) fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(5), + metis (no_types, lifting) 1 2 trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(6) fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases(6)) + thus ?thesis using subst_sst_cons[of s S \] unfolding fv\<^sub>s\<^sub>s\<^sub>t_def by auto + qed +qed simp + +lemma trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_funs_term_cases: + assumes "t \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" "f \ funs_term t" + shows "(\u \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p s. f \ funs_term u) \ (\x \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s. f \ funs_term (\ x))" + using assms +proof (cases s) + case (NegChecks X F G) + hence "t \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \ t \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)" + using assms(1) by auto + hence "(\u\trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. f \ funs_term u) \ (\x\fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. f \ funs_term (rm_vars (set X) \ x)) \ + (\u\trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G. f \ funs_term u) \ (\x\fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G. f \ funs_term (rm_vars (set X) \ x))" + using trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_funs_term_cases[OF _ assms(2), of _ "rm_vars (set X) \"] by meson + hence "(\u \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G. f \ funs_term u) \ + (\x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G. f \ funs_term (rm_vars (set X) \ x))" + by blast + thus ?thesis + proof + assume "\x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G. f \ funs_term (rm_vars (set X) \ x)" + then obtain x where x: "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" "f \ funs_term (rm_vars (set X) \ x)" + by auto + hence "x \ set X" "rm_vars (set X) \ x = \ x" by auto + thus ?thesis using x by (auto simp add: assms NegChecks) + qed (auto simp add: assms NegChecks) +qed (use assms funs_term_subst[of _ \] in auto) + +lemma trms\<^sub>s\<^sub>s\<^sub>t_funs_term_cases: + assumes "t \ trms\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" "f \ funs_term t" + shows "(\u \ trms\<^sub>s\<^sub>s\<^sub>t S. f \ funs_term u) \ (\x \ fv\<^sub>s\<^sub>s\<^sub>t S. f \ funs_term (\ x))" +using assms(1) +proof (induction S) + case (Cons s S) thus ?case + proof (cases "t \ trms\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)") + case False + hence "t \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" using Cons.prems(1) subst_sst_cons[of s S \] trms\<^sub>s\<^sub>s\<^sub>t_cons by auto + thus ?thesis using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_funs_term_cases[OF _ assms(2)] by fastforce + qed auto +qed simp + +lemma fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t_subst: + assumes "x \ fv\<^sub>s\<^sub>s\<^sub>t T" + and "bvars\<^sub>s\<^sub>s\<^sub>t T \ subst_domain \ = {}" + shows "\ x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t (T \\<^sub>s\<^sub>s\<^sub>t \))" +using trms\<^sub>s\<^sub>s\<^sub>t_subst[OF assms(2)] subterms_subst_subset'[of \ "trms\<^sub>s\<^sub>s\<^sub>t T"] + fv\<^sub>s\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>s\<^sub>t[OF assms(1)] +by (metis (no_types, lifting) image_iff subset_iff subst_apply_term.simps(1)) + +lemma fv\<^sub>s\<^sub>s\<^sub>t_subst_fv_subset: + assumes "x \ fv\<^sub>s\<^sub>s\<^sub>t S" "x \ bvars\<^sub>s\<^sub>s\<^sub>t S" "fv (\ x) \ bvars\<^sub>s\<^sub>s\<^sub>t S = {}" + shows "fv (\ x) \ fv\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" +using assms +proof (induction S) + case (Cons a S) + note 1 = fv_subst_subset[of _ _ \] + note 2 = subst_apply_fv_union subst_apply_fv_unfold[of _ \] fv_subset image_eqI + note 3 = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst_cases + note 4 = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps + from Cons show ?case + proof (cases "x \ fv\<^sub>s\<^sub>s\<^sub>t S") + case False + hence 5: "x \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" " fv (\ x) \ set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) = {}" "x \ set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a)" + using Cons.prems by auto + hence "fv (\ x) \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + proof (cases a) + case (NegChecks X F G) + let ?\ = "rm_vars (set X) \" + have *: "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" using NegChecks 5(1) by auto + have **: "fv (\ x) \ set X = {}" using NegChecks 5(2) by simp + have ***: "\ x = ?\ x" using NegChecks 5(3) by auto + have "fv (\ x) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\)" + using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_fv_subset[of x _ ?\] * *** by auto + thus ?thesis using NegChecks ** by auto + qed (metis (full_types) 1 5(1) 3(1) 4(1), metis (full_types) 1 5(1) 3(2) 4(2), + metis (full_types) 2 5(1) 3(3) 4(3), metis (full_types) 2 5(1) 3(4) 4(4), + metis (full_types) 2 5(1) 3(5) 4(5), metis (full_types) 2 5(1) 3(6) 4(6)) + thus ?thesis by (auto simp add: subst_sst_cons[of a S \]) + qed (auto simp add: subst_sst_cons[of a S \]) +qed simp + +lemma (in intruder_model) wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_trms\<^sub>s\<^sub>s\<^sub>t_subst: + assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \)" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>s\<^sub>s\<^sub>t \))" + using assms +proof (induction A) + case (Cons a A) + hence IH: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t (A \\<^sub>s\<^sub>s\<^sub>t \))" and *: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>s\<^sub>e\<^sub>t \)" by auto + have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \))" by (rule wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[OF *]) + thus ?case using IH trms\<^sub>s\<^sub>s\<^sub>t_subst_cons[of a A \] by blast +qed simp + +lemma fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var: + assumes "x \ fv\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + shows "\y \ fv\<^sub>s\<^sub>s\<^sub>t S. x \ fv (\ y)" + using assms +proof (induction S) + case (Cons s S) + hence "x \ fv\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \) \ \y \ fv\<^sub>s\<^sub>s\<^sub>t S. x \ fv (\ y)" + using bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset[of S s] + by blast + thus ?case + proof (cases "x \ fv\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)") + case False + hence *: "x \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + using Cons.prems(1) subst_sst_cons[of s S \] + by fastforce + + have "\y \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s. x \ fv (\ y)" + proof (cases s) + case (NegChecks X F G) + hence "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \ x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)" + and **: "x \ set X" + using * by simp_all + then obtain y where y: "y \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ y \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" "x \ fv ((rm_vars (set X) \) y)" + using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_obtain_var[of _ _ "rm_vars (set X) \"] + by blast + have "y \ set X" + proof + assume y_in: "y \ set X" + hence "(rm_vars (set X) \) y = Var y" by auto + hence "x = y" using y(2) by simp + thus False using ** y_in by metis + qed + thus ?thesis using NegChecks y by auto + qed (use * fv_subst_obtain_var in force)+ + thus ?thesis by auto + qed auto +qed simp + +lemma fv\<^sub>s\<^sub>s\<^sub>t_subst_subset_range_vars_if_subset_domain: + assumes "fv\<^sub>s\<^sub>s\<^sub>t S \ subst_domain \" + shows "fv\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \) \ range_vars \" +using assms fv\<^sub>s\<^sub>s\<^sub>t_subst_obtain_var[of _ S \] subst_dom_vars_in_subst[of _ \] subst_fv_imgI[of \] +by (metis (no_types) in_mono subsetI) + +lemma fv\<^sub>s\<^sub>s\<^sub>t_in_fv_trms\<^sub>s\<^sub>s\<^sub>t: "x \ fv\<^sub>s\<^sub>s\<^sub>t S \ x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)" +proof (induction S) + case (Cons s S) thus ?case + proof (cases "x \ fv\<^sub>s\<^sub>s\<^sub>t S") + case False + hence *: "x \ fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" using Cons.prems by simp + hence "x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p s)" + proof (cases s) + case (NegChecks X F G) + hence "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" using * by simp_all + thus ?thesis using * fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_in_fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of x] NegChecks by auto + qed auto + thus ?thesis by simp + qed simp +qed simp + +lemma stateful_strand_step_subst_comp: + assumes "range_vars \ \ set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p x) = {}" + shows "x \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \\<^sub>s \ = (x \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" +proof (cases x) + case (NegChecks X F G) + hence *: "range_vars \ \ set X = {}" using assms by simp + have "H \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) (\ \\<^sub>s \) = (H \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \" for H + using pairs_subst_comp rm_vars_comp[OF *] by (induct H) (auto simp add: subst_apply_pairs_def) + thus ?thesis using NegChecks by simp +qed simp_all + +lemma stateful_strand_subst_comp: + assumes "range_vars \ \ bvars\<^sub>s\<^sub>s\<^sub>t S = {}" + shows "S \\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \ = (S \\<^sub>s\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>s\<^sub>t \" +using assms +proof (induction S) + case (Cons s S) + hence IH: "S \\<^sub>s\<^sub>s\<^sub>t \ \\<^sub>s \ = (S \\<^sub>s\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>s\<^sub>t \" using Cons by auto + + have "s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ \\<^sub>s \ = (s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" + using Cons.prems stateful_strand_step_subst_comp[of \ s \] + unfolding range_vars_alt_def by auto + thus ?case using IH by (simp add: subst_apply_stateful_strand_def) +qed simp + +lemma subst_apply_bvars_disj_NegChecks: + assumes "set X \ subst_domain \ = {}" + shows "NegChecks X F G \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = NegChecks X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" +proof - + have "rm_vars (set X) \ = \" using assms rm_vars_apply'[of \ "set X"] by auto + thus ?thesis by simp +qed + +lemma subst_apply_NegChecks_no_bvars[simp]: + "\[]\\\: F \\: F'\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = \[]\\\: (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \\: (F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)\" + "\[]\\\: [] \\: F'\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = \[]\\\: [] \\: (F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)\" + "\[]\\\: F \\: []\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = \[]\\\: (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \\: []\" + "\[]\\\: [] \\: [(t,s)]\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = \[]\\\: [] \\: ([(t \ \,s \ \)])\" (is ?A) + "\[]\\\: [(t,s)] \\: []\ \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ = \[]\\\: ([(t \ \,s \ \)]) \\: []\" (is ?B) +by simp_all + +lemma setops\<^sub>s\<^sub>s\<^sub>t_mono: + "set M \ set N \ setops\<^sub>s\<^sub>s\<^sub>t M \ setops\<^sub>s\<^sub>s\<^sub>t N" +by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + +lemma setops\<^sub>s\<^sub>s\<^sub>t_nil[simp]: "setops\<^sub>s\<^sub>s\<^sub>t [] = {}" +by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + +lemma setops\<^sub>s\<^sub>s\<^sub>t_cons[simp]: "setops\<^sub>s\<^sub>s\<^sub>t (a#A) = setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \ setops\<^sub>s\<^sub>s\<^sub>t A" +by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + +lemma setops\<^sub>s\<^sub>s\<^sub>t_cons_subset[simp]: "setops\<^sub>s\<^sub>s\<^sub>t A \ setops\<^sub>s\<^sub>s\<^sub>t (a#A)" +using setops\<^sub>s\<^sub>s\<^sub>t_cons[of a A] by blast + +lemma setops\<^sub>s\<^sub>s\<^sub>t_append: "setops\<^sub>s\<^sub>s\<^sub>t (A@B) = setops\<^sub>s\<^sub>s\<^sub>t A \ setops\<^sub>s\<^sub>s\<^sub>t B" +proof (induction A) + case (Cons a A) thus ?case by (cases a) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + +lemma setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_member_iff: + "(t,s) \ setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \ + (x = Insert t s \ x = Delete t s \ (\ac. x = InSet ac t s) \ + (\X F F'. x = NegChecks X F F' \ (t,s) \ set F'))" +by (cases x) auto + +lemma setops\<^sub>s\<^sub>s\<^sub>t_member_iff: + "(t,s) \ setops\<^sub>s\<^sub>s\<^sub>t A \ + (Insert t s \ set A \ Delete t s \ set A \ (\ac. InSet ac t s \ set A) \ + (\X F F'. NegChecks X F F' \ set A \ (t,s) \ set F'))" + (is "?P \ ?Q") +proof (induction A) + case (Cons a A) thus ?case + proof (cases "(t, s) \ setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p a") + case True thus ?thesis using setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_member_iff[of t s a] by auto + qed auto +qed simp + +lemma setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst: + assumes "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) \ subst_domain \ = {}" + shows "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" +proof (cases a) + case (NegChecks X F G) + hence "rm_vars (set X) \ = \" using assms rm_vars_apply'[of \ "set X"] by auto + hence "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = set (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ = set G \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + using NegChecks image_Un by simp_all + thus ?thesis by (simp add: subst_apply_pairs_def) +qed simp_all + +lemma setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst': + assumes "\is_NegChecks a" + shows "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p a \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" +using assms by (cases a) auto + +lemma setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst'': + fixes t::"('a,'b) term \ ('a,'b) term" and \::"('a,'b) subst" + assumes t: "t \ setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + shows "\s \ setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p b. t = s \\<^sub>p rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b)) \" +proof (cases "is_NegChecks b") + case True + then obtain X F G where b: "b = NegChecks X F G" by (cases b) moura+ + hence "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p b = set G" "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = set (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b)) \)" + by simp_all + thus ?thesis using t subst_apply_pairs_pset_subst[of G] by blast +next + case False + hence "setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) = setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \\<^sub>p\<^sub>s\<^sub>e\<^sub>t rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b)) \" + using setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst' bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegChecks by fastforce + thus ?thesis using t by blast +qed + +lemma setops\<^sub>s\<^sub>s\<^sub>t_subst: + assumes "bvars\<^sub>s\<^sub>s\<^sub>t S \ subst_domain \ = {}" + shows "setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \) = setops\<^sub>s\<^sub>s\<^sub>t S \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" +using assms +proof (induction S) + case (Cons a S) + have "bvars\<^sub>s\<^sub>s\<^sub>t S \ subst_domain \ = {}" and *: "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a) \ subst_domain \ = {}" + using Cons.prems by auto + hence IH: "setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \) = setops\<^sub>s\<^sub>s\<^sub>t S \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + using Cons.IH by auto + show ?case + using setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[OF *] IH unfolding setops\<^sub>s\<^sub>s\<^sub>t_def + by (auto simp add: subst_apply_stateful_strand_def) +qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + +lemma setops\<^sub>s\<^sub>s\<^sub>t_subst': + fixes p::"('a,'b) term \ ('a,'b) term" and \::"('a,'b) subst" + assumes "p \ setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + shows "\s \ setops\<^sub>s\<^sub>s\<^sub>t S. \X. set X \ bvars\<^sub>s\<^sub>s\<^sub>t S \ p = s \\<^sub>p rm_vars (set X) \" +using assms +proof (induction S) + case (Cons a S) + note 0 = setops\<^sub>s\<^sub>s\<^sub>t_cons[of a S] bvars\<^sub>s\<^sub>s\<^sub>t_Cons[of a S] + note 1 = setops\<^sub>s\<^sub>s\<^sub>t_cons[of "a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \" "S \\<^sub>s\<^sub>s\<^sub>t \"] subst_sst_cons[of a S \] + have "p \ setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \) \ p \ setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" using Cons.prems 1 by auto + thus ?case + proof + assume *: "p \ setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + show ?thesis using setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst''[OF *] 0 by blast + next + assume *: "p \ setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + show ?thesis using Cons.IH[OF *] 0 by blast + qed +qed simp + + +subsection \Stateful Constraint Semantics\ +context intruder_model +begin + +definition negchecks_model where + "negchecks_model (\::('a,'b) subst) (D::('a,'b) dbstate) X F G \ + (\\. subst_domain \ = set X \ ground (subst_range \) \ + (list_ex (\f. fst f \ (\ \\<^sub>s \) \ snd f \ (\ \\<^sub>s \)) F \ + list_ex (\f. f \\<^sub>p (\ \\<^sub>s \) \ D) G))" + +fun strand_sem_stateful:: + "('fun,'var) terms \ ('fun,'var) dbstate \ ('fun,'var) stateful_strand \ ('fun,'var) subst \ bool" + ("\_; _; _\\<^sub>s") +where + "\M; D; []\\<^sub>s = (\\. True)" +| "\M; D; Send t#S\\<^sub>s = (\\. M \ t \ \ \ \M; D; S\\<^sub>s \)" +| "\M; D; Receive t#S\\<^sub>s = (\\. \insert (t \ \) M; D; S\\<^sub>s \)" +| "\M; D; Equality _ t t'#S\\<^sub>s = (\\. t \ \ = t' \ \ \ \M; D; S\\<^sub>s \)" +| "\M; D; Insert t s#S\\<^sub>s = (\\. \M; insert ((t,s) \\<^sub>p \) D; S\\<^sub>s \)" +| "\M; D; Delete t s#S\\<^sub>s = (\\. \M; D - {(t,s) \\<^sub>p \}; S\\<^sub>s \)" +| "\M; D; InSet _ t s#S\\<^sub>s = (\\. (t,s) \\<^sub>p \ \ D \ \M; D; S\\<^sub>s \)" +| "\M; D; NegChecks X F F'#S\\<^sub>s = (\\. negchecks_model \ D X F F' \ \M; D; S\\<^sub>s \)" + + +lemmas strand_sem_stateful_induct = + strand_sem_stateful.induct[case_names Nil ConsSnd ConsRcv ConsEq + ConsIns ConsDel ConsIn ConsNegChecks] + +abbreviation constr_sem_stateful (infix "\\<^sub>s" 91) where "\ \\<^sub>s A \ \{}; {}; A\\<^sub>s \" + +lemma stateful_strand_sem_NegChecks_no_bvars: + "\M; D; [\t not in s\]\\<^sub>s \ \ (t \ \, s \ \) \ D" + "\M; D; [\t != s\]\\<^sub>s \ \ t \ \ \ s \ \" +by (simp_all add: negchecks_model_def empty_dom_iff_empty_subst) + +lemma strand_sem_ik_mono_stateful: + "\M; D; A\\<^sub>s \ \ \M \ M'; D; A\\<^sub>s \" +using ideduct_mono by (induct A arbitrary: M M' D rule: strand_sem_stateful.induct) force+ + +lemma strand_sem_append_stateful: + "\M; D; A@B\\<^sub>s \ \ \M; D; A\\<^sub>s \ \ \M \ (ik\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \); dbupd\<^sub>s\<^sub>s\<^sub>t A \ D; B\\<^sub>s \" + (is "?P \ ?Q \ ?R") +proof - + have 1: "?P \ ?Q" by (induct A rule: strand_sem_stateful.induct) auto + + have 2: "?P \ ?R" + proof (induction A arbitrary: M D B) + case (Cons a A) thus ?case + proof (cases a) + case (Receive t) + have "insert (t \ \) (M \ (ik\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \)) = M \ (ik\<^sub>s\<^sub>s\<^sub>t (a#A) \\<^sub>s\<^sub>e\<^sub>t \)" + "dbupd\<^sub>s\<^sub>s\<^sub>t A \ D = dbupd\<^sub>s\<^sub>s\<^sub>t (a#A) \ D" + using Receive by (auto simp add: ik\<^sub>s\<^sub>s\<^sub>t_def) + thus ?thesis using Cons Receive by force + qed (auto simp add: ik\<^sub>s\<^sub>s\<^sub>t_def) + qed (simp add: ik\<^sub>s\<^sub>s\<^sub>t_def) + + have 3: "?Q \ ?R \ ?P" + proof (induction A arbitrary: M D) + case (Cons a A) thus ?case + proof (cases a) + case (Receive t) + have "insert (t \ \) (M \ (ik\<^sub>s\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \)) = M \ (ik\<^sub>s\<^sub>s\<^sub>t (a#A) \\<^sub>s\<^sub>e\<^sub>t \)" + "dbupd\<^sub>s\<^sub>s\<^sub>t A \ D = dbupd\<^sub>s\<^sub>s\<^sub>t (a#A) \ D" + using Receive by (auto simp add: ik\<^sub>s\<^sub>s\<^sub>t_def) + thus ?thesis using Cons Receive by simp + qed (auto simp add: ik\<^sub>s\<^sub>s\<^sub>t_def) + qed (simp add: ik\<^sub>s\<^sub>s\<^sub>t_def) + + show ?thesis by (metis 1 2 3) +qed + +lemma negchecks_model_db_subset: + fixes F F'::"(('a,'b) term \ ('a,'b) term) list" + assumes "D' \ D" + and "negchecks_model \ D X F F'" + shows "negchecks_model \ D' X F F'" +proof - + have "list_ex (\f. f \\<^sub>p \ \\<^sub>s \ \ D') F'" + when "list_ex (\f. f \\<^sub>p \ \\<^sub>s \ \ D) F'" + for \::"('a,'b) subst" + using Bex_set[of F' "\f. f \\<^sub>p \ \\<^sub>s \ \ D'"] + Bex_set[of F' "\f. f \\<^sub>p \ \\<^sub>s \ \ D"] + that assms(1) + by blast + thus ?thesis using assms(2) by (auto simp add: negchecks_model_def) +qed + +lemma negchecks_model_db_supset: + fixes F F'::"(('a,'b) term \ ('a,'b) term) list" + assumes "D' \ D" + and "\f \ set F'. \\. subst_domain \ = set X \ ground (subst_range \) \ f \\<^sub>p (\ \\<^sub>s \) \ D - D'" + and "negchecks_model \ D' X F F'" + shows "negchecks_model \ D X F F'" +proof - + have "list_ex (\f. f \\<^sub>p \ \\<^sub>s \ \ D) F'" + when "list_ex (\f. f \\<^sub>p \ \\<^sub>s \ \ D') F'" "subst_domain \ = set X \ ground (subst_range \)" + for \::"('a,'b) subst" + using Bex_set[of F' "\f. f \\<^sub>p \ \\<^sub>s \ \ D'"] + Bex_set[of F' "\f. f \\<^sub>p \ \\<^sub>s \ \ D"] + that assms(1,2) + by blast + thus ?thesis using assms(3) by (auto simp add: negchecks_model_def) +qed + +lemma negchecks_model_subst: + fixes F F'::"(('a,'b) term \ ('a,'b) term) list" + assumes "(subst_domain \ \ range_vars \) \ set X = {}" + shows "negchecks_model (\ \\<^sub>s \) D X F F' \ negchecks_model \ D X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) (F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" +proof - + have 0: "\ \\<^sub>s (\ \\<^sub>s \) = \ \\<^sub>s (\ \\<^sub>s \)" + when \: "subst_domain \ = set X" "ground (subst_range \)" for \ + by (metis (no_types, lifting) \ subst_compose_assoc assms(1) inf_sup_aci(1) + subst_comp_eq_if_disjoint_vars sup_inf_absorb range_vars_alt_def) + + { fix \::"('a,'b) subst" and t t' + assume \: "subst_domain \ = set X" "ground (subst_range \)" + and *: "list_ex (\f. fst f \ (\ \\<^sub>s (\ \\<^sub>s \)) \ snd f \ (\ \\<^sub>s (\ \\<^sub>s \))) F" + obtain f where f: "f \ set F" "fst f \ \ \\<^sub>s (\ \\<^sub>s \) \ snd f \ \ \\<^sub>s (\ \\<^sub>s \)" + using * by (induct F) auto + hence "(fst f \ \) \ \ \\<^sub>s \ \ (snd f \ \) \ \ \\<^sub>s \" using 0[OF \] by simp + moreover have "(fst f \ \, snd f \ \) \ set (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using f(1) by (auto simp add: subst_apply_pairs_def) + ultimately have "list_ex (\f. fst f \ (\ \\<^sub>s \) \ snd f \ (\ \\<^sub>s \)) (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using f(1) Bex_set by fastforce + } moreover { + fix \::"('a,'b) subst" and t t' + assume \: "subst_domain \ = set X" "ground (subst_range \)" + and *: "list_ex (\f. f \\<^sub>p \ \\<^sub>s (\ \\<^sub>s \) \ D) F'" + obtain f where f: "f \ set F'" "f \\<^sub>p \ \\<^sub>s (\ \\<^sub>s \) \ D" + using * by (induct F') auto + hence "f \\<^sub>p \ \\<^sub>p \ \\<^sub>s \ \ D" using 0[OF \] by (metis subst_pair_compose) + moreover have "f \\<^sub>p \ \ set (F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using f(1) by (auto simp add: subst_apply_pairs_def) + ultimately have "list_ex (\f. f \\<^sub>p \ \\<^sub>s \ \ D) (F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using f(1) Bex_set by fastforce + } moreover { + fix \::"('a,'b) subst" and t t' + assume \: "subst_domain \ = set X" "ground (subst_range \)" + and *: "list_ex (\f. fst f \ (\ \\<^sub>s \) \ snd f \ (\ \\<^sub>s \)) (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + obtain f where f: "f \ set (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" "fst f \ \ \\<^sub>s \ \ snd f \ \ \\<^sub>s \" + using * by (induct F) (auto simp add: subst_apply_pairs_def) + then obtain g where g: "g \ set F" "f = g \\<^sub>p \" by (auto simp add: subst_apply_pairs_def) + have "fst g \ \ \\<^sub>s (\ \\<^sub>s \) \ snd g \ \ \\<^sub>s (\ \\<^sub>s \)" + using f(2) g 0[OF \] by (simp add: prod.case_eq_if) + hence "list_ex (\f. fst f \ (\ \\<^sub>s (\ \\<^sub>s \)) \ snd f \ (\ \\<^sub>s (\ \\<^sub>s \))) F" + using g Bex_set by fastforce + } moreover { + fix \::"('a,'b) subst" and t t' + assume \: "subst_domain \ = set X" "ground (subst_range \)" + and *: "list_ex (\f. f \\<^sub>p (\ \\<^sub>s \) \ D) (F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + obtain f where f: "f \ set (F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" "f \\<^sub>p \ \\<^sub>s \ \ D" + using * by (induct F') (auto simp add: subst_apply_pairs_def) + then obtain g where g: "g \ set F'" "f = g \\<^sub>p \" by (auto simp add: subst_apply_pairs_def) + have "g \\<^sub>p \ \\<^sub>s (\ \\<^sub>s \) \ D" + using f(2) g 0[OF \] by (simp add: prod.case_eq_if) + hence "list_ex (\f. f \\<^sub>p (\ \\<^sub>s (\ \\<^sub>s \)) \ D) F'" + using g Bex_set by fastforce + } ultimately show ?thesis using assms unfolding negchecks_model_def by blast +qed + +lemma strand_sem_subst_stateful: + fixes \::"('fun,'var) subst" + assumes "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>s\<^sub>t S = {}" + shows "\M; D; S\\<^sub>s (\ \\<^sub>s \) \ \M; D; S \\<^sub>s\<^sub>s\<^sub>t \\\<^sub>s \" +proof + note [simp] = subst_sst_cons[of _ _ \] subst_subst_compose[of _ \ \] + + have "(subst_domain \ \ range_vars \) \ (subst_domain \ \ range_vars \) = {}" + when \: "(subst_domain \ \ range_vars \) \ set X = {}" + and \: "subst_domain \ = set X" "ground (subst_range \)" + for X and \::"('fun,'var) subst" + using \ \ unfolding range_vars_alt_def by auto + hence 0: "\ \\<^sub>s \ = \ \\<^sub>s \" + when \: "(subst_domain \ \ range_vars \) \ set X = {}" + and \: "subst_domain \ = set X" "ground (subst_range \)" + for \ X + by (metis \ \ subst_comp_eq_if_disjoint_vars) + + show "\M; D; S\\<^sub>s (\ \\<^sub>s \) \ \M; D; S \\<^sub>s\<^sub>s\<^sub>t \\\<^sub>s \" using assms + proof (induction S arbitrary: M D rule: strand_sem_stateful_induct) + case (ConsNegChecks M D X F F' S) + hence *: "\M; D; S \\<^sub>s\<^sub>s\<^sub>t \\\<^sub>s \" and **: "(subst_domain \ \ range_vars \) \ set X = {}" + unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def negchecks_model_def by (force, auto) + have "negchecks_model (\ \\<^sub>s \) D X F F'" using ConsNegChecks by auto + hence "negchecks_model \ D X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) (F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using 0[OF **] negchecks_model_subst[OF **] by blast + moreover have "rm_vars (set X) \ = \" using ConsNegChecks.prems(2) by force + ultimately show ?case using * by auto + qed simp_all + + show "\M; D; S \\<^sub>s\<^sub>s\<^sub>t \\\<^sub>s \ \ \M; D; S\\<^sub>s (\ \\<^sub>s \)" using assms + proof (induction S arbitrary: M D rule: strand_sem_stateful_induct) + case (ConsNegChecks M D X F F' S) + have \: "rm_vars (set X) \ = \" using ConsNegChecks.prems(2) by force + hence *: "\M; D; S\\<^sub>s (\ \\<^sub>s \)" and **: "(subst_domain \ \ range_vars \) \ set X = {}" + using ConsNegChecks unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def negchecks_model_def by auto + have "negchecks_model \ D X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) (F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using ConsNegChecks.prems(1) \ by (auto simp add: subst_compose_assoc negchecks_model_def) + hence "negchecks_model (\ \\<^sub>s \) D X F F'" + using 0[OF **] negchecks_model_subst[OF **] by blast + thus ?case using * by auto + qed simp_all +qed + +end + + +subsection \Well-Formedness Lemmata\ +lemma wfvarsocc\<^sub>s\<^sub>s\<^sub>t_subset_wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t[simp]: + "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S \ wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S" +by (induction S) + (auto simp add: wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def + split: stateful_strand_step.split poscheckvariant.split) + +lemma wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_append: "wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (S@S') = wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S'" +by (simp add: wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def) + +lemma wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_union[simp]: + "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t (S@T) = wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \ wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t T" +by (simp add: wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def) + +lemma wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_singleton: + "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t [s] = wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" +by (simp add: wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def) + +lemma wf\<^sub>s\<^sub>s\<^sub>t_prefix[dest]: "wf'\<^sub>s\<^sub>s\<^sub>t V (S@S') \ wf'\<^sub>s\<^sub>s\<^sub>t V S" +by (induct S rule: wf'\<^sub>s\<^sub>s\<^sub>t.induct) auto + +lemma wf\<^sub>s\<^sub>s\<^sub>t_vars_mono: "wf'\<^sub>s\<^sub>s\<^sub>t V S \ wf'\<^sub>s\<^sub>s\<^sub>t (V \ W) S" +proof (induction S arbitrary: V) + case (Cons x S) thus ?case + proof (cases x) + case (Send t) + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t \ W) S" using Cons.prems(1) Cons.IH by simp + thus ?thesis using Send by (simp add: sup_commute sup_left_commute) + next + case (Equality a t t') + show ?thesis + proof (cases a) + case Assign + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t \ W) S" "fv t' \ V \ W" using Equality Cons.prems(1) Cons.IH by auto + thus ?thesis using Equality Assign by (simp add: sup_commute sup_left_commute) + next + case Check thus ?thesis using Equality Cons by auto + qed + next + case (InSet a t t') + show ?thesis + proof (cases a) + case Assign + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t \ fv t' \ W) S" using InSet Cons.prems(1) Cons.IH by auto + thus ?thesis using InSet Assign by (simp add: sup_commute sup_left_commute) + next + case Check thus ?thesis using InSet Cons by auto + qed + qed auto +qed simp + +lemma wf\<^sub>s\<^sub>s\<^sub>tI[intro]: "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \ V \ wf'\<^sub>s\<^sub>s\<^sub>t V S" +proof (induction S) + case (Cons x S) thus ?case + proof (cases x) + case (Send t) + hence "wf'\<^sub>s\<^sub>s\<^sub>t V S" "V \ fv t = V" + using Cons + unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def + by auto + thus ?thesis using Send by simp + next + case (Equality a t t') + show ?thesis + proof (cases a) + case Assign + hence "wf'\<^sub>s\<^sub>s\<^sub>t V S" "fv t' \ V" + using Equality Cons + unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def + by auto + thus ?thesis using wf\<^sub>s\<^sub>s\<^sub>t_vars_mono Equality Assign by simp + next + case Check + thus ?thesis + using Equality Cons + unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def + by auto + qed + next + case (InSet a t t') + show ?thesis + proof (cases a) + case Assign + hence "wf'\<^sub>s\<^sub>s\<^sub>t V S" "fv t \ fv t' \ V" + using InSet Cons + unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def + by auto + thus ?thesis using wf\<^sub>s\<^sub>s\<^sub>t_vars_mono InSet Assign by (simp add: Un_assoc) + next + case Check + thus ?thesis + using InSet Cons + unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def + by auto + qed + qed (simp_all add: wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def) +qed (simp add: wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def) + +lemma wf\<^sub>s\<^sub>s\<^sub>tI'[intro]: + assumes "\((\x. case x of + Receive t \ fv t + | Equality Assign _ t' \ fv t' + | Insert t t' \ fv t \ fv t' + | _ \ {}) ` set S) \ V" + shows "wf'\<^sub>s\<^sub>s\<^sub>t V S" +using assms +proof (induction S) + case (Cons x S) thus ?case + proof (cases x) + case (Equality a t t') + thus ?thesis using Cons by (cases a) (auto simp add: wf\<^sub>s\<^sub>s\<^sub>t_vars_mono) + next + case (InSet a t t') + thus ?thesis using Cons by (cases a) (auto simp add: wf\<^sub>s\<^sub>s\<^sub>t_vars_mono Un_assoc) + qed (simp_all add: wf\<^sub>s\<^sub>s\<^sub>t_vars_mono) +qed simp + +lemma wf\<^sub>s\<^sub>s\<^sub>t_append_exec: "wf'\<^sub>s\<^sub>s\<^sub>t V (S@S') \ wf'\<^sub>s\<^sub>s\<^sub>t (V \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) S'" +proof (induction S arbitrary: V) + case (Cons x S V) thus ?case + proof (cases x) + case (Send t) + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) S'" using Cons.prems Cons.IH by simp + thus ?thesis using Send unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def by (auto simp add: sup_assoc) + next + case (Equality a t t') show ?thesis + proof (cases a) + case Assign + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) S'" using Equality Cons.prems Cons.IH by auto + thus ?thesis using Equality Assign unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def by (auto simp add: sup_assoc) + next + case Check + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) S'" using Equality Cons.prems Cons.IH by auto + thus ?thesis using Equality Check unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def by (auto simp add: sup_assoc) + qed + next + case (InSet a t t') show ?thesis + proof (cases a) + case Assign + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t \ fv t' \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) S'" using InSet Cons.prems Cons.IH by auto + thus ?thesis using InSet Assign unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def by (auto simp add: sup_assoc) + next + case Check + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S) S'" using InSet Cons.prems Cons.IH by auto + thus ?thesis using InSet Check unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def by (auto simp add: sup_assoc) + qed + qed (auto simp add: wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def) +qed (simp add: wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def) + +lemma wf\<^sub>s\<^sub>s\<^sub>t_append: + "wf'\<^sub>s\<^sub>s\<^sub>t X S \ wf'\<^sub>s\<^sub>s\<^sub>t Y T \ wf'\<^sub>s\<^sub>s\<^sub>t (X \ Y) (S@T)" +proof (induction X S rule: wf'\<^sub>s\<^sub>s\<^sub>t.induct) + case 1 thus ?case by (metis wf\<^sub>s\<^sub>s\<^sub>t_vars_mono Un_commute append_Nil) +next + case 3 thus ?case by (metis append_Cons Un_commute Un_assoc wf'\<^sub>s\<^sub>s\<^sub>t.simps(3)) +next + case (4 V t t' S) + hence *: "fv t' \ V" and "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t \ Y) (S @ T)" by simp_all + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ Y \ fv t) (S @ T)" by (metis Un_commute Un_assoc) + thus ?case using * by auto +next + case (8 V t t' S) + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t \ fv t' \ Y) (S @ T)" by simp_all + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ Y \ fv t \ fv t') (S @ T)" by (metis Un_commute Un_assoc) + thus ?case by auto +qed auto + +lemma wf\<^sub>s\<^sub>s\<^sub>t_append_suffix: + "wf'\<^sub>s\<^sub>s\<^sub>t V S \ wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \ wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \ V \ wf'\<^sub>s\<^sub>s\<^sub>t V (S@S')" +proof (induction V S rule: wf'\<^sub>s\<^sub>s\<^sub>t.induct) + case (2 V t S) + hence *: "fv t \ V" "wf'\<^sub>s\<^sub>s\<^sub>t V S" by simp_all + hence "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \ wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \ V" + using "2.prems"(2) unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by auto + thus ?case using "2.IH" * by simp +next + case (3 V t S) + hence *: "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t) S" by simp_all + hence "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \ wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \ (V \ fv t)" + using "3.prems"(2) unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by auto + thus ?case using "3.IH" * by simp +next + case (4 V t t' S) + hence *: "fv t' \ V" "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t) S" by simp_all + moreover have "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (\t := t'\) = fv t \ fv t'" + by simp + moreover have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t (\t := t'\#S) = fv t \ fv t' \ wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S" + unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by auto + ultimately have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \ wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \ (V \ fv t)" + using "4.prems"(2) by blast + thus ?case using "4.IH" * by simp +next + case (6 V t t' S) + hence *: "fv t \ fv t' \ V" "wf'\<^sub>s\<^sub>s\<^sub>t V S" by simp_all + moreover have "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (insert\t,t'\) = fv t \ fv t'" + by simp + moreover have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t (insert\t,t'\#S) = fv t \ fv t' \ wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S" + unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by auto + ultimately have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \ wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \ V" + using "6.prems"(2) by blast + thus ?case using "6.IH" * by simp +next + case (8 V t t' S) + hence *: "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t \ fv t') S" by simp_all + moreover have "vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (select\t,t'\) = fv t \ fv t'" + by simp + moreover have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t (select\t,t'\#S) = fv t \ fv t' \ wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S" + unfolding wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by auto + ultimately have "wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S' \ wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t S \ (V \ fv t \ fv t')" + using "8.prems"(2) by blast + thus ?case using "8.IH" * by simp +qed (simp_all add: wf\<^sub>s\<^sub>s\<^sub>tI wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def) + +lemma wf\<^sub>s\<^sub>s\<^sub>t_append_suffix': + assumes "wf'\<^sub>s\<^sub>s\<^sub>t V S" + and "\((\x. case x of + Receive t \ fv t + | Equality Assign _ t' \ fv t' + | Insert t t' \ fv t \ fv t' + | _ \ {}) ` set S') \ wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S \ V" + shows "wf'\<^sub>s\<^sub>s\<^sub>t V (S@S')" +using assms +by (induction V S rule: wf'\<^sub>s\<^sub>s\<^sub>t.induct) + (auto simp add: wf\<^sub>s\<^sub>s\<^sub>tI' wf\<^sub>s\<^sub>s\<^sub>t_vars_mono wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def) + +lemma wf\<^sub>s\<^sub>s\<^sub>t_subst_apply: + "wf'\<^sub>s\<^sub>s\<^sub>t V S \ wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)) (S \\<^sub>s\<^sub>s\<^sub>t \)" +proof (induction S arbitrary: V rule: wf'\<^sub>s\<^sub>s\<^sub>t.induct) + case (2 V t S) + hence "wf'\<^sub>s\<^sub>s\<^sub>t V S" "fv t \ V" by simp_all + hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)) (S \\<^sub>s\<^sub>s\<^sub>t \)" "fv (t \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using "2.IH" subst_apply_fv_subset by simp_all + thus ?case by (simp add: subst_apply_stateful_strand_def) +next + case (3 V t S) + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t) S" by simp + hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ fv t))) (S \\<^sub>s\<^sub>s\<^sub>t \)" using "3.IH" by metis + hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ fv (t \ \)) (S \\<^sub>s\<^sub>s\<^sub>t \)" by (metis subst_apply_fv_union) + thus ?case by (simp add: subst_apply_stateful_strand_def) +next + case (4 V t t' S) + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t) S" "fv t' \ V" by auto + hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ fv t))) (S \\<^sub>s\<^sub>s\<^sub>t \)" and *: "fv (t' \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using "4.IH" subst_apply_fv_subset by force+ + hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ fv (t \ \)) (S \\<^sub>s\<^sub>s\<^sub>t \)" by (metis subst_apply_fv_union) + thus ?case using * by (simp add: subst_apply_stateful_strand_def) +next + case (6 V t t' S) + hence "wf'\<^sub>s\<^sub>s\<^sub>t V S" "fv t \ fv t' \ V" by auto + hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)) (S \\<^sub>s\<^sub>s\<^sub>t \)" "fv (t \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" "fv (t' \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using "6.IH" subst_apply_fv_subset by force+ + thus ?case by (simp add: sup_assoc subst_apply_stateful_strand_def) +next + case (8 V t t' S) + hence "wf'\<^sub>s\<^sub>s\<^sub>t (V \ fv t \ fv t') S" by auto + hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ fv t \ fv t'))) (S \\<^sub>s\<^sub>s\<^sub>t \)" + using "8.IH" subst_apply_fv_subset by force + hence "wf'\<^sub>s\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ fv (t \ \) \ fv (t' \ \)) (S \\<^sub>s\<^sub>s\<^sub>t \)" by (metis subst_apply_fv_union) + thus ?case by (simp add: subst_apply_stateful_strand_def) +qed (auto simp add: subst_apply_stateful_strand_def) + +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Typing.thy b/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Typing.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Typing.thy @@ -0,0 +1,1871 @@ +(* +(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: Stateful_Typing.thy + Author: Andreas Viktor Hess, DTU +*) + +section \Extending the Typing Result to Stateful Constraints\ + +theory Stateful_Typing +imports Typing_Result Stateful_Strands +begin + +text \Locale setup\ +locale stateful_typed_model = typed_model arity public Ana \ + for arity::"'fun \ nat" + and public::"'fun \ bool" + and Ana::"('fun,'var) term \ (('fun,'var) term list \ ('fun,'var) term list)" + and \::"('fun,'var) term \ ('fun,'atom::finite) term_type" + + + fixes Pair::"'fun" + assumes Pair_arity: "arity Pair = 2" + and Ana_subst': "\f T \ K M. Ana (Fun f T) = (K,M) \ Ana (Fun f T \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \,M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" +begin + +lemma Ana_invar_subst'[simp]: "Ana_invar_subst \" +using Ana_subst' unfolding Ana_invar_subst_def by force + +definition pair where + "pair d \ case d of (t,t') \ Fun Pair [t,t']" + +fun tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s:: + "(('fun,'var) term \ ('fun,'var) term) list \ + ('fun,'var) dbstatelist \ + (('fun,'var) term \ ('fun,'var) term) list list" +where + "tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s [] D = [[]]" +| "tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ((s,t)#F) D = + concat (map (\d. map ((#) (pair (s,t), pair d)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)) D)" + +text \ + A translation/reduction \tr\ from stateful constraints to (lists of) "non-stateful" constraints. + The output represents a finite disjunction of constraints whose models constitute exactly the + models of the input constraint. The typing result for "non-stateful" constraints is later lifted + to the stateful setting through this reduction procedure. +\ +fun tr::"('fun,'var) stateful_strand \ ('fun,'var) dbstatelist \ ('fun,'var) strand list" +where + "tr [] D = [[]]" +| "tr (send\t\#A) D = map ((#) (send\t\\<^sub>s\<^sub>t)) (tr A D)" +| "tr (receive\t\#A) D = map ((#) (receive\t\\<^sub>s\<^sub>t)) (tr A D)" +| "tr (\ac: t \ t'\#A) D = map ((#) (\ac: t \ t'\\<^sub>s\<^sub>t)) (tr A D)" +| "tr (insert\t,s\#A) D = tr A (List.insert (t,s) D)" +| "tr (delete\t,s\#A) D = + concat (map (\Di. map (\B. (map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di)@ + (map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di])@B) + (tr A [d\D. d \ set Di])) + (subseqs D))" +| "tr (\ac: t \ s\#A) D = + concat (map (\B. map (\d. \ac: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t#B) D) (tr A D))" +| "tr (\X\\\: F \\: F'\#A) D = + map ((@) (map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D))) (tr A D)" + +text \Type-flaw resistance of stateful constraint steps\ +fun tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p where + "tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = ((\\. Unifier \ t t') \ \ t = \ t')" +| "tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (NegChecks X F F') = ( + (F' = [] \ (\x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F-set X. \a. \ (Var x) = TAtom a)) \ + (\f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` set F') \ + T = [] \ (\s \ set T. s \ Var ` set X)))" +| "tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p _ = True" + +text \Type-flaw resistance of stateful constraints\ +definition tfr\<^sub>s\<^sub>s\<^sub>t where "tfr\<^sub>s\<^sub>s\<^sub>t S \ tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S) \ list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p S" + + +subsection \Small Lemmata\ +lemma pair_in_pair_image_iff: + "pair (s,t) \ pair ` P \ (s,t) \ P" +unfolding pair_def by fast + +lemma subst_apply_pairs_pair_image_subst: + "pair ` set (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) = pair ` set F \\<^sub>s\<^sub>e\<^sub>t \" +unfolding subst_apply_pairs_def pair_def by (induct F) auto + +lemma Ana_subst_subterms_cases: + fixes \::"('fun,'var) subst" + assumes t: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \)" + and s: "s \ set (snd (Ana t))" + shows "(\u \ subterms\<^sub>s\<^sub>e\<^sub>t M. t = u \ \ \ s \ set (snd (Ana u)) \\<^sub>s\<^sub>e\<^sub>t \) \ (\x \ fv\<^sub>s\<^sub>e\<^sub>t M. t \ \ x)" +proof (cases "t \ subterms\<^sub>s\<^sub>e\<^sub>t M \\<^sub>s\<^sub>e\<^sub>t \") + case True + then obtain u where u: "u \ subterms\<^sub>s\<^sub>e\<^sub>t M" "t = u \ \" by moura + show ?thesis + proof (cases u) + case (Var x) + hence "x \ fv\<^sub>s\<^sub>e\<^sub>t M" using fv_subset_subterms[OF u(1)] by simp + thus ?thesis using u(2) Var by fastforce + next + case (Fun f T) + hence "set (snd (Ana t)) = set (snd (Ana u)) \\<^sub>s\<^sub>e\<^sub>t \" + using Ana_subst'[of f T _ _ \] u(2) by (cases "Ana u") auto + thus ?thesis using s u by blast + qed +qed (use s t subterms\<^sub>s\<^sub>e\<^sub>t_subst in blast) + +lemma tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_alt_def: + "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p S = + ((\ac t t'. Equality ac t t' \ set S \ (\\. Unifier \ t t') \ \ t = \ t') \ + (\X F F'. NegChecks X F F' \ set S \ ( + (F' = [] \ (\x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F-set X. \a. \ (Var x) = TAtom a)) \ + (\f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` set F') \ + T = [] \ (\s \ set T. s \ Var ` set X)))))" + (is "?P S = ?Q S") +proof + show "?P S \ ?Q S" + proof (induction S) + case (Cons x S) thus ?case by (cases x) auto + qed simp + + show "?Q S \ ?P S" + proof (induction S) + case (Cons x S) thus ?case by (cases x) auto + qed simp +qed + +lemma fun_pair_eq[dest]: "pair d = pair d' \ d = d'" +proof - + obtain t s t' s' where "d = (t,s)" "d' = (t',s')" by moura + thus "pair d = pair d' \ d = d'" unfolding pair_def by simp +qed + +lemma fun_pair_subst: "pair d \ \ = pair (d \\<^sub>p \)" +using surj_pair[of d] unfolding pair_def by force + +lemma fun_pair_subst_set: "pair ` M \\<^sub>s\<^sub>e\<^sub>t \ = pair ` (M \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \)" +proof + show "pair ` M \\<^sub>s\<^sub>e\<^sub>t \ \ pair ` (M \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \)" + using fun_pair_subst[of _ \] by fastforce + + show "pair ` (M \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) \ pair ` M \\<^sub>s\<^sub>e\<^sub>t \" + proof + fix t assume t: "t \ pair ` (M \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \)" + then obtain p where p: "p \ M" "t = pair (p \\<^sub>p \)" by blast + thus "t \ pair ` M \\<^sub>s\<^sub>e\<^sub>t \" using fun_pair_subst[of p \] by force + qed +qed + +lemma fun_pair_eq_subst: "pair d \ \ = pair d' \ \ \ d \\<^sub>p \ = d' \\<^sub>p \" +by (metis fun_pair_subst fun_pair_eq[of "d \\<^sub>p \" "d' \\<^sub>p \"]) + +lemma setops\<^sub>s\<^sub>s\<^sub>t_pair_image_cons[simp]: + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (x#S) = pair ` setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p x \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (send\t\#S) = pair ` setops\<^sub>s\<^sub>s\<^sub>t S" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (receive\t\#S) = pair ` setops\<^sub>s\<^sub>s\<^sub>t S" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (\ac: t \ t'\#S) = pair ` setops\<^sub>s\<^sub>s\<^sub>t S" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (insert\t,s\#S) = {pair (t,s)} \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (delete\t,s\#S) = {pair (t,s)} \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (\ac: t \ s\#S) = {pair (t,s)} \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (\X\\\: F \\: G\#S) = pair ` set G \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S" +unfolding setops\<^sub>s\<^sub>s\<^sub>t_def by auto + +lemma setops\<^sub>s\<^sub>s\<^sub>t_pair_image_subst_cons[simp]: + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (x#S \\<^sub>s\<^sub>s\<^sub>t \) = pair ` setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (send\t\#S \\<^sub>s\<^sub>s\<^sub>t \) = pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (receive\t\#S \\<^sub>s\<^sub>s\<^sub>t \) = pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (\ac: t \ t'\#S \\<^sub>s\<^sub>s\<^sub>t \) = pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (insert\t,s\#S \\<^sub>s\<^sub>s\<^sub>t \) = {pair (t,s) \ \} \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (delete\t,s\#S \\<^sub>s\<^sub>s\<^sub>t \) = {pair (t,s) \ \} \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (\ac: t \ s\#S \\<^sub>s\<^sub>s\<^sub>t \) = {pair (t,s) \ \} \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t (\X\\\: F \\: G\#S \\<^sub>s\<^sub>s\<^sub>t \) = + pair ` set (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" +using subst_sst_cons[of _ S \] unfolding setops\<^sub>s\<^sub>s\<^sub>t_def pair_def by auto + +lemma setops\<^sub>s\<^sub>s\<^sub>t_are_pairs: "t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ \s s'. t = pair (s,s')" +proof (induction A) + case (Cons a A) thus ?case + by (cases a) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + +lemma fun_pair_wf\<^sub>t\<^sub>r\<^sub>m: "wf\<^sub>t\<^sub>r\<^sub>m t \ wf\<^sub>t\<^sub>r\<^sub>m t' \ wf\<^sub>t\<^sub>r\<^sub>m (pair (t,t'))" +using Pair_arity unfolding wf\<^sub>t\<^sub>r\<^sub>m_def pair_def by auto + +lemma wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_pairs: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (pair ` set F)" +using fun_pair_wf\<^sub>t\<^sub>r\<^sub>m by blast + +lemma tfr\<^sub>s\<^sub>s\<^sub>t_Nil[simp]: "tfr\<^sub>s\<^sub>s\<^sub>t []" +by (simp add: tfr\<^sub>s\<^sub>s\<^sub>t_def setops\<^sub>s\<^sub>s\<^sub>t_def) + +lemma tfr\<^sub>s\<^sub>s\<^sub>t_append: "tfr\<^sub>s\<^sub>s\<^sub>t (A@B) \ tfr\<^sub>s\<^sub>s\<^sub>t A" +proof - + assume assms: "tfr\<^sub>s\<^sub>s\<^sub>t (A@B)" + let ?M = "trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A" + let ?N = "trms\<^sub>s\<^sub>s\<^sub>t (A@B) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (A@B)" + let ?P = "\t t'. \x \ fv t \ fv t'. \a. \ (Var x) = Var a" + let ?Q = "\X t t'. X = [] \ (\x \ (fv t \ fv t')-set X. \a. \ (Var x) = Var a)" + have *: "SMP ?M - Var`\ \ SMP ?N - Var`\" "?M \ ?N" + using SMP_mono[of ?M ?N] setops\<^sub>s\<^sub>s\<^sub>t_append[of A B] + by auto + { fix s t assume **: "tfr\<^sub>s\<^sub>e\<^sub>t ?N" "s \ SMP ?M - Var`\" "t \ SMP ?M - Var`\" "(\\. Unifier \ s t)" + hence "s \ SMP ?N - Var`\" "t \ SMP ?N - Var`\" using * by auto + hence "\ s = \ t" using **(1,4) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast + } moreover have "\t \ ?N. wf\<^sub>t\<^sub>r\<^sub>m t \ \t \ ?M. wf\<^sub>t\<^sub>r\<^sub>m t" using * by blast + ultimately have "tfr\<^sub>s\<^sub>e\<^sub>t ?N \ tfr\<^sub>s\<^sub>e\<^sub>t ?M" unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast + hence "tfr\<^sub>s\<^sub>e\<^sub>t ?M" using assms unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by metis + thus "tfr\<^sub>s\<^sub>s\<^sub>t A" using assms unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by simp +qed + +lemma tfr\<^sub>s\<^sub>s\<^sub>t_append': "tfr\<^sub>s\<^sub>s\<^sub>t (A@B) \ tfr\<^sub>s\<^sub>s\<^sub>t B" +proof - + assume assms: "tfr\<^sub>s\<^sub>s\<^sub>t (A@B)" + let ?M = "trms\<^sub>s\<^sub>s\<^sub>t B \ pair ` setops\<^sub>s\<^sub>s\<^sub>t B" + let ?N = "trms\<^sub>s\<^sub>s\<^sub>t (A@B) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (A@B)" + let ?P = "\t t'. \x \ fv t \ fv t'. \a. \ (Var x) = Var a" + let ?Q = "\X t t'. X = [] \ (\x \ (fv t \ fv t')-set X. \a. \ (Var x) = Var a)" + have *: "SMP ?M - Var`\ \ SMP ?N - Var`\" "?M \ ?N" + using SMP_mono[of ?M ?N] setops\<^sub>s\<^sub>s\<^sub>t_append[of A B] + by auto + { fix s t assume **: "tfr\<^sub>s\<^sub>e\<^sub>t ?N" "s \ SMP ?M - Var`\" "t \ SMP ?M - Var`\" "(\\. Unifier \ s t)" + hence "s \ SMP ?N - Var`\" "t \ SMP ?N - Var`\" using * by auto + hence "\ s = \ t" using **(1,4) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast + } moreover have "\t \ ?N. wf\<^sub>t\<^sub>r\<^sub>m t \ \t \ ?M. wf\<^sub>t\<^sub>r\<^sub>m t" using * by blast + ultimately have "tfr\<^sub>s\<^sub>e\<^sub>t ?N \ tfr\<^sub>s\<^sub>e\<^sub>t ?M" unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast + hence "tfr\<^sub>s\<^sub>e\<^sub>t ?M" using assms unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by metis + thus "tfr\<^sub>s\<^sub>s\<^sub>t B" using assms unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by simp +qed + +lemma tfr\<^sub>s\<^sub>s\<^sub>t_cons: "tfr\<^sub>s\<^sub>s\<^sub>t (a#A) \ tfr\<^sub>s\<^sub>s\<^sub>t A" +using tfr\<^sub>s\<^sub>s\<^sub>t_append'[of "[a]" A] by simp + +lemma tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst: + assumes s: "tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s) \ range_vars \ = {}" + shows "tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" +proof (cases s) + case (Equality a t t') + thus ?thesis + proof (cases "\\. Unifier \ (t \ \) (t' \ \)") + case True + hence "\\. Unifier \ t t'" by (metis subst_subst_compose[of _ \]) + moreover have "\ t = \ (t \ \)" "\ t' = \ (t' \ \)" by (metis wt_subst_trm''[OF assms(2)])+ + ultimately have "\ (t \ \) = \ (t' \ \)" using s Equality by simp + thus ?thesis using Equality True by simp + qed simp +next + case (NegChecks X F G) + let ?P = "\F G. G = [] \ (\x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F-set X. \a. \ (Var x) = TAtom a)" + let ?Q = "\F G. \f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` set G) \ + T = [] \ (\s \ set T. s \ Var ` set X)" + let ?\ = "rm_vars (set X) \" + + have "?P F G \ ?Q F G" using NegChecks assms(1) by simp + hence "?P (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\) (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\) \ ?Q (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\) (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\)" + proof + assume *: "?P F G" + have "G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\ = []" using * by simp + moreover have "\a. \ (Var x) = TAtom a" when x: "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\) - set X" for x + proof - + obtain t t' where t: "(t,t') \ set (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\)" "x \ fv t \ fv t' - set X" + using x(1) by auto + then obtain u u' where u: "(u,u') \ set F" "u \ ?\ = t" "u' \ ?\ = t'" + unfolding subst_apply_pairs_def by auto + obtain y where y: "y \ fv u \ fv u' - set X" "x \ fv (?\ y)" + using t(2) u(2,3) rm_vars_fv_obtain by fast + hence a: "\a. \ (Var y) = TAtom a" using u * by auto + + have a': "\ (Var y) = \ (?\ y)" + using wt_subst_trm''[OF wt_subst_rm_vars[OF \(1), of "set X"], of "Var y"] + by simp + + have "(\z. ?\ y = Var z) \ (\c. ?\ y = Fun c [])" + proof (cases "?\ y \ subst_range \") + case True thus ?thesis + using a a' \(2) const_type_inv_wf + by (cases "?\ y") fastforce+ + qed fastforce + hence "?\ y = Var x" using y(2) by fastforce + hence "\ (Var x) = \ (Var y)" using a' by simp + thus ?thesis using a by presburger + qed + ultimately show ?thesis by simp + next + assume *: "?Q F G" + have **: "set X \ range_vars ?\ = {}" + using \(3) NegChecks rm_vars_img_fv_subset[of "set X" \] by auto + have "?Q (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\) (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\)" + using ineq_subterm_inj_cond_subst[OF ** *] + trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst[of F "rm_vars (set X) \"] + subst_apply_pairs_pair_image_subst[of G "rm_vars (set X) \"] + by (metis (no_types, lifting) image_Un) + thus ?thesis by simp + qed + thus ?thesis using NegChecks by simp +qed simp_all + +lemma tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_all_wt_subst_apply: + assumes S: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p S" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "bvars\<^sub>s\<^sub>s\<^sub>t S \ range_vars \ = {}" + shows "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (S \\<^sub>s\<^sub>s\<^sub>t \)" +proof - + have "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s) \ range_vars \ = {}" when "s \ set S" for s + using that \(3) unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def range_vars_alt_def by fastforce + thus ?thesis + using tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst[OF _ \(1,2)] S + unfolding list_all_iff + by (auto simp add: subst_apply_stateful_strand_def) +qed + +lemma tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_empty_case: + assumes "tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D = []" + shows "D = []" "F \ []" +proof - + show "F \ []" using assms by (auto intro: ccontr) + + have "tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F (a#A) \ []" for a A + by (induct F "a#A" rule: tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.induct) fastforce+ + thus "D = []" using assms by (cases D) simp_all +qed + +lemma tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_elem_length_eq: + assumes "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)" + shows "length G = length F" +using assms by (induct F D arbitrary: G rule: tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.induct) auto + +lemma tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_index: + assumes "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)" "i < length F" + shows "\d \ set D. G ! i = (pair (F ! i), pair d)" +using assms +proof (induction F D arbitrary: i G rule: tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.induct) + case (2 s t F D) + obtain d G' where G: + "d \ set D" "G' \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)" + "G = (pair (s,t), pair d)#G'" + using "2.prems"(1) by moura + show ?case + using "2.IH"[OF G(1,2)] "2.prems"(2) G(1,3) + by (cases i) auto +qed simp + +lemma tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_cons: + assumes "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)" "d \ set D" + shows "(pair (s,t), pair d)#G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ((s,t)#F) D)" +using assms by auto + +lemma tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_has_pair_lists: + assumes "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)" "g \ set G" + shows "\f \ set F. \d \ set D. g = (pair f, pair d)" +using assms +proof (induction F D arbitrary: G rule: tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.induct) + case (2 s t F D) + obtain d G' where G: + "d \ set D" "G' \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)" + "G = (pair (s,t), pair d)#G'" + using "2.prems"(1) by moura + show ?case + using "2.IH"[OF G(1,2)] "2.prems"(2) G(1,3) + by (cases "g \ set G'") auto +qed simp + +lemma tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_pair_lists: + assumes "f \ set F" "d \ set D" + shows "\G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D). (pair f, pair d) \ set G" + (is "?P F D f d") +proof - + have "\f \ set F. \d \ set D. ?P F D f d" + proof (induction F D rule: tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.induct) + case (2 s t F D) + hence IH: "\f \ set F. \d \ set D. ?P F D f d" by metis + moreover have "\d \ set D. ?P ((s,t)#F) D (s,t) d" + proof + fix d assume d: "d \ set D" + then obtain G where G: "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)" + using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_empty_case(1) by force + hence "(pair (s, t), pair d)#G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ((s,t)#F) D)" + using d by auto + thus "?P ((s,t)#F) D (s,t) d" using d G by auto + qed + ultimately show ?case by fastforce + qed simp + thus ?thesis by (metis assms) +qed + +lemma tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_db_append_subset: + "set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D) \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F (D@E))" (is ?A) + "set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F E) \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F (D@E))" (is ?B) +proof - + show ?A + proof (induction F D rule: tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.induct) + case (2 s t F D) + show ?case + proof + fix G assume "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ((s,t)#F) D)" + then obtain d G' where G': + "d \ set D" "G' \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)" "G = (pair (s,t), pair d)#G'" + by moura + have "d \ set (D@E)" "G' \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F (D@E))" using "2.IH"[OF G'(1)] G'(1,2) by auto + thus "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ((s,t)#F) (D@E))" using G'(3) by auto + qed + qed simp + + show ?B + proof (induction F E rule: tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.induct) + case (2 s t F E) + show ?case + proof + fix G assume "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ((s,t)#F) E)" + then obtain d G' where G': + "d \ set E" "G' \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F E)" "G = (pair (s,t), pair d)#G'" + by moura + have "d \ set (D@E)" "G' \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F (D@E))" using "2.IH"[OF G'(1)] G'(1,2) by auto + thus "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ((s,t)#F) (D@E))" using G'(3) by auto + qed + qed simp +qed + +lemma tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_trms_subset: + "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D) \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \ pair ` set F \ pair ` set D" +proof (induction F D arbitrary: G rule: tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.induct) + case (2 s t F D G) + obtain d G' where G: + "d \ set D" "G' \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)" "G = (pair (s,t), pair d)#G'" + using "2.prems"(1) by moura + + show ?case using "2.IH"[OF G(1,2)] G(1,3) by auto +qed simp + +lemma tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_trms_subset': + "\(trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ` set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)) \ pair ` set F \ pair ` set D" +using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_trms_subset by blast + +lemma tr_trms_subset: + "A' \ set (tr A D) \ trms\<^sub>s\<^sub>t A' \ trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair ` set D" +proof (induction A D arbitrary: A' rule: tr.induct) + case 1 thus ?case by simp +next + case (2 t A D) + then obtain A'' where A'': "A' = send\t\\<^sub>s\<^sub>t#A''" "A'' \ set (tr A D)" by moura + hence "trms\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair ` set D" by (metis "2.IH") + thus ?case using A'' by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +next + case (3 t A D) + then obtain A'' where A'': "A' = receive\t\\<^sub>s\<^sub>t#A''" "A'' \ set (tr A D)" by moura + hence "trms\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair ` set D" by (metis "3.IH") + thus ?case using A'' by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +next + case (4 ac t t' A D) + then obtain A'' where A'': "A' = \ac: t \ t'\\<^sub>s\<^sub>t#A''" "A'' \ set (tr A D)" by moura + hence "trms\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair ` set D" by (metis "4.IH") + thus ?case using A'' by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +next + case (5 t s A D) + hence "A' \ set (tr A (List.insert (t,s) D))" by simp + hence "trms\<^sub>s\<^sub>t A' \ trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair ` set (List.insert (t, s) D)" + by (metis "5.IH") + thus ?case by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +next + case (6 t s A D) + from 6 obtain Di A'' B C where A'': + "Di \ set (subseqs D)" "A'' \ set (tr A [d\D. d \ set Di])" "A' = (B@C)@A''" + "B = map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di" + "C = map (\d. Inequality [] [(pair (t,s) , pair d)]) [d\D. d \ set Di]" + by moura + hence "trms\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair ` set [d\D. d \ set Di]" + by (metis "6.IH") + hence "trms\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t (Delete t s#A) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (Delete t s#A) \ pair ` set D" + by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + moreover have "trms\<^sub>s\<^sub>t (B@C) \ insert (pair (t,s)) (pair ` set D)" + using A''(4,5) subseqs_set_subset[OF A''(1)] by auto + moreover have "pair (t,s) \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (Delete t s#A)" by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + ultimately show ?case using A''(3) trms\<^sub>s\<^sub>t_append[of "B@C" A'] by auto +next + case (7 ac t s A D) + from 7 obtain d A'' where A'': + "d \ set D" "A'' \ set (tr A D)" + "A' = \ac: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t#A''" + by moura + hence "trms\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair ` set D" by (metis "7.IH") + moreover have "trms\<^sub>s\<^sub>t A' = {pair (t,s), pair d} \ trms\<^sub>s\<^sub>t A''" + using A''(1,3) by auto + ultimately show ?case using A''(1) by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) +next + case (8 X F F' A D) + from 8 obtain A'' where A'': + "A'' \ set (tr A D)" "A' = (map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D))@A''" + by moura + + define B where "B \ \(trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ` set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D))" + + have "trms\<^sub>s\<^sub>t A'' \ trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair ` set D" by (metis A''(1) "8.IH") + hence "trms\<^sub>s\<^sub>t A' \ B \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair ` set D" + using A'' B_def by auto + moreover have "B \ pair ` set F' \ pair ` set D" + using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_trms_subset'[of F' D] B_def by simp + moreover have "pair ` setops\<^sub>s\<^sub>s\<^sub>t (\X\\\: F \\: F'\#A) = pair ` set F' \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A" + by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + ultimately show ?case by auto +qed + +lemma tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_vars_subset: + "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s D" +proof (induction F D arbitrary: G rule: tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.induct) + case (2 s t F D G) + obtain d G' where G: + "d \ set D" "G' \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)" "G = (pair (s,t), pair d)#G'" + using "2.prems"(1) by moura + + show ?case using "2.IH"[OF G(1,2)] G(1,3) unfolding pair_def by auto +qed simp + +lemma tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_vars_subset': "\(fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ` set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F D)) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s D" +using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_vars_subset[of _ F D] by blast + +lemma tr_vars_subset: + assumes "A' \ set (tr A D)" + shows "fv\<^sub>s\<^sub>t A' \ fv\<^sub>s\<^sub>s\<^sub>t A \ (\(t,t') \ set D. fv t \ fv t')" (is ?P) + and "bvars\<^sub>s\<^sub>t A' \ bvars\<^sub>s\<^sub>s\<^sub>t A" (is ?Q) +proof - + show ?P using assms + proof (induction A arbitrary: A' D rule: strand_sem_stateful_induct) + case (ConsIn A' D ac t s A) + then obtain A'' d where *: + "d \ set D" "A' = \ac: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t#A''" + "A'' \ set (tr A D)" + by moura + hence "fv\<^sub>s\<^sub>t A'' \ fv\<^sub>s\<^sub>s\<^sub>t A \ (\(t,t')\set D. fv t \ fv t')" by (metis ConsIn.IH) + thus ?case using * unfolding pair_def by auto + next + case (ConsDel A' D t s A) + define Dfv where "Dfv \ \D::('fun,'var) dbstatelist. (\(t,t')\set D. fv t \ fv t')" + define fltD where "fltD \ \Di. filter (\d. d \ set Di) D" + define constr where + "constr \ \Di. (map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di)@ + (map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) (fltD Di))" + from ConsDel obtain A'' Di where *: + "Di \ set (subseqs D)" "A' = (constr Di)@A''" "A'' \ set (tr A (fltD Di))" + unfolding constr_def fltD_def by moura + hence "fv\<^sub>s\<^sub>t A'' \ fv\<^sub>s\<^sub>s\<^sub>t A \ Dfv (fltD Di)" + unfolding Dfv_def constr_def fltD_def by (metis ConsDel.IH) + moreover have "Dfv (fltD Di) \ Dfv D" unfolding Dfv_def constr_def fltD_def by auto + moreover have "Dfv Di \ Dfv D" + using subseqs_set_subset(1)[OF *(1)] unfolding Dfv_def constr_def fltD_def by fast + moreover have "fv\<^sub>s\<^sub>t (constr Di) \ fv t \ fv s \ (Dfv Di \ Dfv (fltD Di))" + unfolding Dfv_def constr_def fltD_def pair_def by auto + moreover have "fv\<^sub>s\<^sub>s\<^sub>t (Delete t s#A) = fv t \ fv s \ fv\<^sub>s\<^sub>s\<^sub>t A" by auto + moreover have "fv\<^sub>s\<^sub>t A' = fv\<^sub>s\<^sub>t (constr Di) \ fv\<^sub>s\<^sub>t A''" using * by force + ultimately have "fv\<^sub>s\<^sub>t A' \ fv\<^sub>s\<^sub>s\<^sub>t (Delete t s#A) \ Dfv D" by auto + thus ?case unfolding Dfv_def fltD_def constr_def by simp + next + case (ConsNegChecks A' D X F F' A) + then obtain A'' where A'': + "A'' \ set (tr A D)" "A' = (map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D))@A''" + by moura + + define B where "B \ \(fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ` set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D))" + + have 1: "fv\<^sub>s\<^sub>t (map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D)) \ (B \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X" + unfolding B_def by auto + + have 2: "B \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s D" + using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_vars_subset'[of F' D] + unfolding B_def by simp + + have "fv\<^sub>s\<^sub>t A' \ ((fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s D \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X) \ fv\<^sub>s\<^sub>t A''" + using 1 2 A''(2) by fastforce + thus ?case using ConsNegChecks.IH[OF A''(1)] by auto + qed fastforce+ + + show ?Q using assms by (induct A arbitrary: A' D rule: strand_sem_stateful_induct) fastforce+ +qed + +lemma tr_vars_disj: + assumes "A' \ set (tr A D)" "\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + and "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + shows "fv\<^sub>s\<^sub>t A' \ bvars\<^sub>s\<^sub>t A' = {}" + using assms tr_vars_subset by fast + +lemma wf_fun_pair_ineqs_map: + assumes "wf\<^sub>s\<^sub>t X A" + shows "wf\<^sub>s\<^sub>t X (map (\d. \Y\\\: [(pair (t, s), pair d)]\\<^sub>s\<^sub>t) D@A)" +using assms by (induct D) auto + +lemma wf_fun_pair_negchecks_map: + assumes "wf\<^sub>s\<^sub>t X A" + shows "wf\<^sub>s\<^sub>t X (map (\G. \Y\\\: (F@G)\\<^sub>s\<^sub>t) M@A)" +using assms by (induct M) auto + +lemma wf_fun_pair_eqs_ineqs_map: + fixes A::"('fun,'var) strand" + assumes "wf\<^sub>s\<^sub>t X A" "Di \ set (subseqs D)" "\(t,t') \ set D. fv t \ fv t' \ X" + shows "wf\<^sub>s\<^sub>t X ((map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di)@ + (map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di])@A)" +proof - + let ?c1 = "map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di" + let ?c2 = "map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di]" + have 1: "wf\<^sub>s\<^sub>t X (?c2@A)" using wf_fun_pair_ineqs_map[OF assms(1)] by simp + have 2: "\(t,t') \ set Di. fv t \ fv t' \ X" + using assms(2,3) by (meson contra_subsetD subseqs_set_subset(1)) + have "wf\<^sub>s\<^sub>t X (?c1@B)" when "wf\<^sub>s\<^sub>t X B" for B::"('fun,'var) strand" + using 2 that by (induct Di) auto + thus ?thesis using 1 by simp +qed + +lemma trms\<^sub>s\<^sub>s\<^sub>t_wt_subst_ex: + assumes \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + and t: "t \ trms\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + shows "\s \. s \ trms\<^sub>s\<^sub>s\<^sub>t S \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = s \ \" +using t +proof (induction S) + case (Cons s S) thus ?case + proof (cases "t \ trms\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)") + case False + hence "t \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (s \\<^sub>s\<^sub>s\<^sub>t\<^sub>p \)" + using Cons.prems trms\<^sub>s\<^sub>s\<^sub>t_subst_cons[of s S \] + by auto + then obtain u where u: "u \ trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" "t = u \ rm_vars (set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s)) \" + using trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst'' by blast + thus ?thesis + using trms\<^sub>s\<^sub>s\<^sub>t_subst_cons[of s S \] + wt_subst_rm_vars[OF \(1), of "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s)"] + wf_trms_subst_rm_vars'[OF \(2), of "set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p s)"] + by fastforce + qed auto +qed simp + +lemma setops\<^sub>s\<^sub>s\<^sub>t_wt_subst_ex: + assumes \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + and t: "t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + shows "\s \. s \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = s \ \" +using t +proof (induction S) + case (Cons x S) thus ?case + proof (cases x) + case (Insert t' s) + hence "t = pair (t',s) \ \ \ t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + using Cons.prems subst_sst_cons[of _ S \] + unfolding pair_def by (force simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + thus ?thesis + using Insert Cons.IH \ by (cases "t = pair (t', s) \ \") (fastforce, auto) + next + case (Delete t' s) + hence "t = pair (t',s) \ \ \ t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + using Cons.prems subst_sst_cons[of _ S \] + unfolding pair_def by (force simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + thus ?thesis + using Delete Cons.IH \ by (cases "t = pair (t', s) \ \") (fastforce, auto) + next + case (InSet ac t' s) + hence "t = pair (t',s) \ \ \ t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + using Cons.prems subst_sst_cons[of _ S \] + unfolding pair_def by (force simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + thus ?thesis + using InSet Cons.IH \ by (cases "t = pair (t', s) \ \") (fastforce, auto) + next + case (NegChecks X F F') + hence "t \ pair ` set (F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \ t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>s\<^sub>t \)" + using Cons.prems subst_sst_cons[of _ S \] + unfolding pair_def by (force simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + thus ?thesis + proof + assume "t \ pair ` set (F' \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)" + then obtain s where s: "t = s \ rm_vars (set X) \" "s \ pair ` set F'" + using subst_apply_pairs_pair_image_subst[of F' "rm_vars (set X) \"] by auto + thus ?thesis + using NegChecks setops\<^sub>s\<^sub>s\<^sub>t_pair_image_cons(8)[of X F F' S] + wt_subst_rm_vars[OF \(1), of "set X"] + wf_trms_subst_rm_vars'[OF \(2), of "set X"] + by fast + qed (use Cons.IH in auto) + qed (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def subst_sst_cons[of _ S \]) +qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + +lemma setops\<^sub>s\<^sub>s\<^sub>t_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t A) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (pair ` setops\<^sub>s\<^sub>s\<^sub>t A)" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t A) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A)" +proof - + show "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t A) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (pair ` setops\<^sub>s\<^sub>s\<^sub>t A)" + proof (induction A) + case (Cons a A) + hence 0: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p a)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (pair ` setops\<^sub>s\<^sub>s\<^sub>t A)" by auto + thus ?case + proof (cases a) + case (NegChecks X F F') + hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F')" using 0 by simp + thus ?thesis using NegChecks wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_pairs[of F'] 0 by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + qed (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def dest: fun_pair_wf\<^sub>t\<^sub>r\<^sub>m) + qed (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + thus "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t A) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A)" by fast +qed + +lemma SMP_MP_split: + assumes "t \ SMP M" + and M: "\m \ M. is_Fun m" + shows "(\\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t \ M \\<^sub>s\<^sub>e\<^sub>t \) \ + t \ SMP ((subterms\<^sub>s\<^sub>e\<^sub>t M \ \((set \ fst \ Ana) ` M)) - M)" + (is "?P t \ ?Q t") +using assms(1) +proof (induction t rule: SMP.induct) + case (MP t) + have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" "M \\<^sub>s\<^sub>e\<^sub>t Var = M" by simp_all + thus ?case using MP by metis +next + case (Subterm t t') + show ?case using Subterm.IH + proof + assume "?P t" + then obtain s \ where s: "s \ M" "t = s \ \" and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" by moura + then obtain f T where fT: "s = Fun f T" using M by fast + + have "(\s'. s' \ s \ t' = s' \ \) \ (\x \ fv s. t' \ \ x)" + using subterm_subst_unfold[OF Subterm.hyps(2)[unfolded s(2)]] by blast + thus ?thesis + proof + assume "\s'. s' \ s \ t' = s' \ \" + then obtain s' where s': "s' \ s" "t' = s' \ \" by moura + show ?thesis + proof (cases "s' \ M") + case True thus ?thesis using s' \ by blast + next + case False + hence "s' \ (subterms\<^sub>s\<^sub>e\<^sub>t M \ \((set \ fst \ Ana) ` M)) - M" using s'(1) s(1) by force + thus ?thesis using SMP.Substitution[OF SMP.MP[of s'] \] s' by presburger + qed + next + assume "\x \ fv s. t' \ \ x" + then obtain x where x: "x \ fv s" "t' \ \ x" by moura + have "Var x \ M" using M by blast + hence "Var x \ (subterms\<^sub>s\<^sub>e\<^sub>t M \ \((set \ fst \ Ana) ` M)) - M" + using s(1) var_is_subterm[OF x(1)] by blast + hence "\ x \ SMP ((subterms\<^sub>s\<^sub>e\<^sub>t M \ \((set \ fst \ Ana) ` M)) - M)" + using SMP.Substitution[OF SMP.MP[of "Var x"] \] by auto + thus ?thesis using SMP.Subterm x(2) by presburger + qed + qed (metis SMP.Subterm[OF _ Subterm.hyps(2)]) +next + case (Substitution t \) + show ?case using Substitution.IH + proof + assume "?P t" + then obtain \ where "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "t \ M \\<^sub>s\<^sub>e\<^sub>t \" by moura + hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" "t \ \ \ M \\<^sub>s\<^sub>e\<^sub>t (\ \\<^sub>s \)" + using wt_subst_compose[of \, OF _ Substitution.hyps(2)] + wf_trm_subst_compose[of \ _ \, OF _ wf_trm_subst_rangeD[OF Substitution.hyps(3)]] + wf_trm_subst_range_iff + by (argo, blast, auto) + thus ?thesis by blast + next + assume "?Q t" thus ?thesis using SMP.Substitution[OF _ Substitution.hyps(2,3)] by meson + qed +next + case (Ana t K T k) + show ?case using Ana.IH + proof + assume "?P t" + then obtain \ where \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "t \ M \\<^sub>s\<^sub>e\<^sub>t \" by moura + then obtain s where s: "s \ M" "t = s \ \" by auto + then obtain f S where fT: "s = Fun f S" using M by (cases s) auto + obtain K' T' where s_Ana: "Ana s = (K', T')" by (metis surj_pair) + hence "set K = set K' \\<^sub>s\<^sub>e\<^sub>t \" "set T = set T' \\<^sub>s\<^sub>e\<^sub>t \" + using Ana_subst'[of f S K' T'] fT Ana.hyps(2) s(2) by auto + then obtain k' where k': "k' \ set K'" "k = k' \ \" using Ana.hyps(3) by fast + show ?thesis + proof (cases "k' \ M") + case True thus ?thesis using k' \(1,2) by blast + next + case False + hence "k' \ (subterms\<^sub>s\<^sub>e\<^sub>t M \ \((set \ fst \ Ana) ` M)) - M" using k'(1) s_Ana s(1) by force + thus ?thesis using SMP.Substitution[OF SMP.MP[of k'] \(1,2)] k'(2) by presburger + qed + next + assume "?Q t" thus ?thesis using SMP.Ana[OF _ Ana.hyps(2,3)] by meson + qed +qed + +lemma setops_subterm_trms: + assumes t: "t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S" + and s: "s \ t" + shows "s \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)" +proof - + obtain u u' where u: "pair (u,u') \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S" "t = pair (u,u')" + using t setops\<^sub>s\<^sub>s\<^sub>t_are_pairs[of _ S] by blast + hence "s \ u \ s \ u'" using s unfolding pair_def by auto + thus ?thesis using u setops\<^sub>s\<^sub>s\<^sub>t_member_iff[of u u' S] unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by force +qed + +lemma setops_subterms_cases: + assumes t: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (pair ` setops\<^sub>s\<^sub>s\<^sub>t S)" + shows "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S) \ t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S" +proof - + obtain s s' where s: "pair (s,s') \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S" "t \ pair (s,s')" + using t setops\<^sub>s\<^sub>s\<^sub>t_are_pairs[of _ S] by blast + hence "t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S \ t \ s \ t \ s'" unfolding pair_def by auto + thus ?thesis using s setops\<^sub>s\<^sub>s\<^sub>t_member_iff[of s s' S] unfolding trms\<^sub>s\<^sub>s\<^sub>t_def by force +qed + +lemma setops_SMP_cases: + assumes "t \ SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t S)" + and "\p. Ana (pair p) = ([], [])" + shows "(\\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \) \ t \ SMP (trms\<^sub>s\<^sub>s\<^sub>t S)" +proof - + have 0: "\((set \ fst \ Ana) ` pair ` setops\<^sub>s\<^sub>s\<^sub>t S) = {}" + proof (induction S) + case (Cons x S) thus ?case + using assms(2) by (cases x) (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + + have 1: "\m \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S. is_Fun m" + proof (induction S) + case (Cons x S) thus ?case + unfolding pair_def by (cases x) (auto simp add: assms(2) setops\<^sub>s\<^sub>s\<^sub>t_def) + qed (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + + have 2: + "subterms\<^sub>s\<^sub>e\<^sub>t (pair ` setops\<^sub>s\<^sub>s\<^sub>t S) \ + \((set \ fst \ Ana) ` (pair ` setops\<^sub>s\<^sub>s\<^sub>t S)) - pair ` setops\<^sub>s\<^sub>s\<^sub>t S + \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)" + using 0 setops_subterms_cases by fast + + show ?thesis + using SMP_MP_split[OF assms(1) 1] SMP_mono[OF 2] SMP_subterms_eq[of "trms\<^sub>s\<^sub>s\<^sub>t S"] + by blast +qed + +lemma tfr_setops_if_tfr_trms: + assumes "Pair \ \(funs_term ` SMP (trms\<^sub>s\<^sub>s\<^sub>t S))" + and "\p. Ana (pair p) = ([], [])" + and "\s \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S. \t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S. (\\. Unifier \ s t) \ \ s = \ t" + and "\s \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S. \t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S. + (\\ \ \. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ + Unifier \ (s \ \) (t \ \)) + \ (\\. Unifier \ s t)" + and tfr: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S)" + shows "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S)" +proof - + have 0: "t \ SMP (trms\<^sub>s\<^sub>s\<^sub>t S) - range Var \ t \ SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t S) - range Var" + when "t \ SMP (trms\<^sub>s\<^sub>s\<^sub>t S \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S) - range Var" for t + using that SMP_union by blast + + have 1: "s \ SMP (trms\<^sub>s\<^sub>s\<^sub>t S) - range Var" + when st: "s \ SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t S) - range Var" + "t \ SMP (trms\<^sub>s\<^sub>s\<^sub>t S) - range Var" + "\\. Unifier \ s t" + for s t + proof - + have "(\\. s \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \) \ s \ SMP (trms\<^sub>s\<^sub>s\<^sub>t S) - range Var" + using st setops_SMP_cases[of s S] assms(2) by blast + moreover { + fix \ assume \: "s \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \" + then obtain s' where s': "s' \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S" "s = s' \ \" by blast + then obtain u u' where u: "s' = Fun Pair [u,u']" + using setops\<^sub>s\<^sub>s\<^sub>t_are_pairs[of s'] unfolding pair_def by fast + hence *: "s = Fun Pair [u \ \, u' \ \]" using \ s' by simp + + obtain f T where fT: "t = Fun f T" using st(2) by (cases t) auto + hence "f \ Pair" using st(2) assms(1) by auto + hence False using st(3) * fT s' u by fast + } ultimately show ?thesis by meson + qed + + have 2: "\ s = \ t" + when "s \ SMP (trms\<^sub>s\<^sub>s\<^sub>t S) - range Var" + "t \ SMP (trms\<^sub>s\<^sub>s\<^sub>t S) - range Var" + "\\. Unifier \ s t" + for s t + using that tfr unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast + + have 3: "\ s = \ t" + when st: "s \ SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t S) - range Var" + "t \ SMP (pair ` setops\<^sub>s\<^sub>s\<^sub>t S) - range Var" + "\\. Unifier \ s t" + for s t + proof - + let ?P = "\s \. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ s \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \" + have "(\\. ?P s \) \ s \ SMP (trms\<^sub>s\<^sub>s\<^sub>t S) - range Var" + "(\\. ?P t \) \ t \ SMP (trms\<^sub>s\<^sub>s\<^sub>t S) - range Var" + using setops_SMP_cases[of _ S] assms(2) st(1,2) by auto + hence "(\\ \'. ?P s \ \ ?P t \') \ \ s = \ t" by (metis 1 2 st) + moreover { + fix \ \' assume *: "?P s \" "?P t \'" + then obtain s' t' where **: + "s' \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S" "t' \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S" "s = s' \ \" "t = t' \ \'" + by blast + hence "\\. Unifier \ s' t'" using st(3) assms(4) * by blast + hence "\ s' = \ t'" using assms(3) ** by blast + hence "\ s = \ t" using * **(3,4) wt_subst_trm''[of \ s'] wt_subst_trm''[of \' t'] by argo + } ultimately show ?thesis by blast + qed + + show ?thesis using 0 1 2 3 unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by metis +qed + + +subsection \The Typing Result for Stateful Constraints\ +context +begin +private lemma tr_wf': + assumes "\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + and "\(t,t') \ set D. fv t \ fv t' \ X" + and "wf'\<^sub>s\<^sub>s\<^sub>t X A" "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + and "A' \ set (tr A D)" + shows "wf\<^sub>s\<^sub>t X A'" +proof - + define P where + "P = (\(D::('fun,'var) dbstatelist) (A::('fun,'var) stateful_strand). + (\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}) \ fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {})" + + have "P D A" using assms(1,4) by (simp add: P_def) + with assms(5,3,2) show ?thesis + proof (induction A arbitrary: A' D X rule: wf'\<^sub>s\<^sub>s\<^sub>t.induct) + case 1 thus ?case by simp + next + case (2 X t A A') + then obtain A'' where A'': "A' = receive\t\\<^sub>s\<^sub>t#A''" "A'' \ set (tr A D)" "fv t \ X" + by moura + have *: "wf'\<^sub>s\<^sub>s\<^sub>t X A" "\(s,s') \ set D. fv s \ fv s' \ X" "P D A" + using 2(1,2,3,4) apply (force, force) + using 2(5) unfolding P_def by force + show ?case using "2.IH"[OF A''(2) *] A''(1,3) by simp + next + case (3 X t A A') + then obtain A'' where A'': "A' = send\t\\<^sub>s\<^sub>t#A''" "A'' \ set (tr A D)" + by moura + have *: "wf'\<^sub>s\<^sub>s\<^sub>t (X \ fv t) A" "\(s,s') \ set D. fv s \ fv s' \ X \ fv t" "P D A" + using 3(1,2,3,4) apply (force, force) + using 3(5) unfolding P_def by force + show ?case using "3.IH"[OF A''(2) *] A''(1) by simp + next + case (4 X t t' A A') + then obtain A'' where A'': "A' = \assign: t \ t'\\<^sub>s\<^sub>t#A''" "A'' \ set (tr A D)" "fv t' \ X" + by moura + have *: "wf'\<^sub>s\<^sub>s\<^sub>t (X \ fv t) A" "\(s,s') \ set D. fv s \ fv s' \ X \ fv t" "P D A" + using 4(1,2,3,4) apply (force, force) + using 4(5) unfolding P_def by force + show ?case using "4.IH"[OF A''(2) *] A''(1,3) by simp + next + case (5 X t t' A A') + then obtain A'' where A'': "A' = \check: t \ t'\\<^sub>s\<^sub>t#A''" "A'' \ set (tr A D)" + by moura + have *: "wf'\<^sub>s\<^sub>s\<^sub>t X A" "P D A" + using 5(3) apply force + using 5(5) unfolding P_def by force + show ?case using "5.IH"[OF A''(2) *(1) 5(4) *(2)] A''(1) by simp + next + case (6 X t s A A') + hence A': "A' \ set (tr A (List.insert (t,s) D))" "fv t \ X" "fv s \ X" by auto + have *: "wf'\<^sub>s\<^sub>s\<^sub>t X A" "\(s,s') \ set (List.insert (t,s) D). fv s \ fv s' \ X" using 6 by auto + have **: "P (List.insert (t,s) D) A" using 6(5) unfolding P_def by force + show ?case using "6.IH"[OF A'(1) * **] A'(2,3) by simp + next + case (7 X t s A A') + let ?constr = "\Di. (map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di)@ + (map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di])" + from 7 obtain Di A'' where A'': + "A' = ?constr Di@A''" "A'' \ set (tr A [d\D. d \ set Di])" + "Di \ set (subseqs D)" + by moura + have *: "wf'\<^sub>s\<^sub>s\<^sub>t X A" "\(t',s') \ set [d\D. d \ set Di]. fv t' \ fv s' \ X" + using 7 by auto + have **: "P [d\D. d \ set Di] A" using 7 unfolding P_def by force + have ***: "\(t, t') \ set D. fv t \ fv t' \ X" using 7 by auto + show ?case + using "7.IH"[OF A''(2) * **] A''(1) wf_fun_pair_eqs_ineqs_map[OF _ A''(3) ***] + by simp + next + case (8 X t s A A') + then obtain d A'' where A'': + "A' = \assign: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t#A''" + "A'' \ set (tr A D)" "d \ set D" + by moura + have *: "wf'\<^sub>s\<^sub>s\<^sub>t (X \ fv t \ fv s) A" "\(t',s')\set D. fv t' \ fv s' \ X \ fv t \ fv s" "P D A" + using 8(1,2,3,4) apply (force, force) + using 8(5) unfolding P_def by force + have **: "fv (pair d) \ X" using A''(3) "8.prems"(3) unfolding pair_def by fastforce + have ***: "fv (pair (t,s)) = fv s \ fv t" unfolding pair_def by auto + show ?case using "8.IH"[OF A''(2) *] A''(1) ** *** unfolding pair_def by (simp add: Un_assoc) + next + case (9 X t s A A') + then obtain d A'' where A'': + "A' = \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t#A''" + "A'' \ set (tr A D)" "d \ set D" + by moura + have *: "wf'\<^sub>s\<^sub>s\<^sub>t X A""P D A" + using 9(3) apply force + using 9(5) unfolding P_def by force + have **: "fv (pair d) \ X" using A''(3) "9.prems"(3) unfolding pair_def by fastforce + have ***: "fv (pair (t,s)) = fv s \ fv t" unfolding pair_def by auto + show ?case using "9.IH"[OF A''(2) *(1) 9(4) *(2)] A''(1) ** *** by (simp add: Un_assoc) + next + case (10 X Y F F' A A') + from 10 obtain A'' where A'': + "A' = (map (\G. \Y\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D))@A''" "A'' \ set (tr A D)" + by moura + + have *: "wf'\<^sub>s\<^sub>s\<^sub>t X A" "\(t',s') \ set D. fv t' \ fv s' \ X" using 10 by auto + + have "bvars\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t (\Y\\\: F \\: F'\#A)" "fv\<^sub>s\<^sub>s\<^sub>t A \ fv\<^sub>s\<^sub>s\<^sub>t (\Y\\\: F \\: F'\#A)" by auto + hence **: "P D A" using 10 unfolding P_def by blast + + show ?case using "10.IH"[OF A''(2) * **] A''(1) wf_fun_pair_negchecks_map by simp + qed +qed + +private lemma tr_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s: + assumes "A' \ set (tr A [])" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t A)" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t A')" +using tr_trms_subset[OF assms(1)] setops\<^sub>s\<^sub>s\<^sub>t_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s(2)[OF assms(2)] +by auto + +lemma tr_wf: + assumes "A' \ set (tr A [])" + and "wf\<^sub>s\<^sub>s\<^sub>t A" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t A)" + shows "wf\<^sub>s\<^sub>t {} A'" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t A')" + and "fv\<^sub>s\<^sub>t A' \ bvars\<^sub>s\<^sub>t A' = {}" +using tr_wf'[OF _ _ _ _ assms(1)] + tr_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s[OF assms(1,3)] + tr_vars_disj[OF assms(1)] + assms(2) +by fastforce+ + +private lemma tr_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p: + assumes "A' \ set (tr A D)" "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p A" + and "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" (is "?P0 A D") + and "\(t,s) \ set D. (fv t \ fv s) \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" (is "?P1 A D") + and "\t \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair ` set D. \t' \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair ` set D. + (\\. Unifier \ t t') \ \ t = \ t'" (is "?P3 A D") + shows "list_all tfr\<^sub>s\<^sub>t\<^sub>p A'" +proof - + have sublmm: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p A" "?P0 A D" "?P1 A D" "?P3 A D" + when p: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a#A)" "?P0 (a#A) D" "?P1 (a#A) D" "?P3 (a#A) D" + for a A D + using p(1) apply (simp add: tfr\<^sub>s\<^sub>s\<^sub>t_def) + using p(2) fv\<^sub>s\<^sub>s\<^sub>t_cons_subset bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset apply fast + using p(3) bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset apply fast + using p(4) setops\<^sub>s\<^sub>s\<^sub>t_cons_subset by fast + + show ?thesis using assms + proof (induction A D arbitrary: A' rule: tr.induct) + case 1 thus ?case by simp + next + case (2 t A D) + note prems = "2.prems" + note IH = "2.IH" + from prems(1) obtain A'' where A'': "A' = send\t\\<^sub>s\<^sub>t#A''" "A'' \ set (tr A D)" + by moura + have "list_all tfr\<^sub>s\<^sub>t\<^sub>p A''" using IH[OF A''(2)] prems(5) sublmm[OF prems(2,3,4,5)] by meson + thus ?case using A''(1) by simp + next + case (3 t A D) + note prems = "3.prems" + note IH = "3.IH" + from prems(1) obtain A'' where A'': "A' = receive\t\\<^sub>s\<^sub>t#A''" "A'' \ set (tr A D)" + by moura + have "list_all tfr\<^sub>s\<^sub>t\<^sub>p A''" using IH[OF A''(2)] prems(5) sublmm[OF prems(2,3,4,5)] by meson + thus ?case using A''(1) by simp + next + case (4 ac t t' A D) + note prems = "4.prems" + note IH = "4.IH" + from prems(1) obtain A'' where A'': + "A' = \ac: t \ t'\\<^sub>s\<^sub>t#A''" "A'' \ set (tr A D)" + by moura + have "list_all tfr\<^sub>s\<^sub>t\<^sub>p A''" using IH[OF A''(2)] prems(5) sublmm[OF prems(2,3,4,5)] by meson + moreover have "(\\. Unifier \ t t') \ \ t = \ t'" using prems(2) by (simp add: tfr\<^sub>s\<^sub>s\<^sub>t_def) + ultimately show ?case using A''(1) by auto + next + case (5 t s A D) + note prems = "5.prems" + note IH = "5.IH" + from prems(1) have A': "A' \ set (tr A (List.insert (t,s) D))" by simp + + have 1: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p A" using sublmm[OF prems(2,3,4,5)] by simp + + have "pair ` setops\<^sub>s\<^sub>s\<^sub>t (Insert t s#A) \ pair`set D = + pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair`set (List.insert (t,s) D)" + by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + hence 3: "?P3 A (List.insert (t,s) D)" using prems(5) by metis + moreover have "?P1 A (List.insert (t, s) D)" using prems(3,4) bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset[of A] by auto + ultimately have "list_all tfr\<^sub>s\<^sub>t\<^sub>p A'" using IH[OF A' sublmm(1,2)[OF prems(2,3,4,5)] _ 3] by metis + thus ?case using A'(1) by auto + next + case (6 t s A D) + note prems = "6.prems" + note IH = "6.IH" + + define constr where constr: + "constr \ (\Di. (map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di)@ + (map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di]))" + + from prems(1) obtain Di A'' where A'': + "A' = constr Di@A''" "A'' \ set (tr A [d\D. d \ set Di])" + "Di \ set (subseqs D)" + unfolding constr by auto + + define Q1 where "Q1 \ (\(F::(('fun,'var) term \ ('fun,'var) term) list) X. + \x \ (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X. \a. \ (Var x) = TAtom a)" + + define Q2 where "Q2 \ (\(F::(('fun,'var) term \ ('fun,'var) term) list) X. + \f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ T = [] \ (\s \ set T. s \ Var ` set X))" + + have "set [d\D. d \ set Di] \ set D" + "pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ pair ` set [d\D. d \ set Di] + \ pair ` setops\<^sub>s\<^sub>s\<^sub>t (Delete t s#A) \ pair ` set D" + by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + hence *: "?P3 A [d\D. d \ set Di]" using prems(5) by blast + have **: "?P1 A [d\D. d \ set Di]" using prems(4,5) by auto + have 1: "list_all tfr\<^sub>s\<^sub>t\<^sub>p A''" + using IH[OF A''(3,2) sublmm(1,2)[OF prems(2,3,4,5)] ** *] + by metis + + have 2: "\ac: u \ u'\\<^sub>s\<^sub>t \ set A'' \ + (\d \ set Di. u = pair (t,s) \ u' = pair d)" + when "\ac: u \ u'\\<^sub>s\<^sub>t \ set A'" for ac u u' + using that A''(1) unfolding constr by force + have 3: "Inequality X U \ set A' \ Inequality X U \ set A'' \ + (\d \ set [d\D. d \ set Di]. + U = [(pair (t,s), pair d)] \ Q2 [(pair (t,s), pair d)] X)" + for X U + using A''(1) unfolding Q2_def constr by force + have 4: + "\d\set D. (\\. Unifier \ (pair (t,s)) (pair d)) \ \ (pair (t,s)) = \ (pair d)" + using prems(5) by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + + { fix ac u u' + assume a: "\ac: u \ u'\\<^sub>s\<^sub>t \ set A'" "\\. Unifier \ u u'" + hence "\ac: u \ u'\\<^sub>s\<^sub>t \ set A'' \ (\d \ set Di. u = pair (t,s) \ u' = pair d)" + using 2 by metis + hence "\ u = \ u'" + using 1(1) 4 subseqs_set_subset[OF A''(3)] a(2) tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of A''] + by blast + } moreover { + fix u U + assume "\U\\\: u\\<^sub>s\<^sub>t \ set A'" + hence "\U\\\: u\\<^sub>s\<^sub>t \ set A'' \ + (\d \ set [d\D. d \ set Di]. u = [(pair (t,s), pair d)] \ Q2 u U)" + using 3 by metis + hence "Q1 u U \ Q2 u U" + using 1 4 subseqs_set_subset[OF A''(3)] tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of A''] + unfolding Q1_def Q2_def + by blast + } ultimately show ?case using tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of A'] unfolding Q1_def Q2_def by blast + next + case (7 ac t s A D) + note prems = "7.prems" + note IH = "7.IH" + + from prems(1) obtain d A'' where A'': + "A' = \ac: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t#A''" + "A'' \ set (tr A D)" "d \ set D" + by moura + + have "list_all tfr\<^sub>s\<^sub>t\<^sub>p A''" + using IH[OF A''(2) sublmm(1,2,3)[OF prems(2,3,4,5)] sublmm(4)[OF prems(2,3,4,5)]] + by metis + moreover have "(\\. Unifier \ (pair (t,s)) (pair d)) \ \ (pair (t,s)) = \ (pair d)" + using prems(2,5) A''(3) unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def) + ultimately show ?case using A''(1) by fastforce + next + case (8 X F F' A D) + note prems = "8.prems" + note IH = "8.IH" + + define constr where "constr = (map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D))" + + define Q1 where "Q1 \ (\(F::(('fun,'var) term \ ('fun,'var) term) list) X. + \x \ (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X. \a. \ (Var x) = TAtom a)" + + define Q2 where "Q2 \ (\(M::('fun,'var) terms) X. + \f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t M \ T = [] \ (\s \ set T. s \ Var ` set X))" + + have Q2_subset: "Q2 M' X" when "M' \ M" "Q2 M X" for X M M' + using that unfolding Q2_def by auto + + have Q2_supset: "Q2 (M \ M') X" when "Q2 M X" "Q2 M' X" for X M M' + using that unfolding Q2_def by auto + + from prems(1) obtain A'' where A'': "A' = constr@A''" "A'' \ set (tr A D)" + using constr_def by moura + + have 0: "F' = [] \ constr = [\X\\\: F\\<^sub>s\<^sub>t]" unfolding constr_def by simp + + have 1: "list_all tfr\<^sub>s\<^sub>t\<^sub>p A''" + using IH[OF A''(2) sublmm(1,2,3)[OF prems(2,3,4,5)] sublmm(4)[OF prems(2,3,4,5)]] + by metis + + have 2: "(F' = [] \ Q1 F X) \ Q2 (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` set F') X" + using prems(2) unfolding Q1_def Q2_def by simp + + have 3: "list_all tfr\<^sub>s\<^sub>t\<^sub>p constr" when "F' = []" "Q1 F X" + using that 0 2 tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of constr] unfolding Q1_def by auto + + { fix c assume "c \ set constr" + hence "\G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D). c = \X\\\: (F@G)\\<^sub>s\<^sub>t" unfolding constr_def by force + } moreover { + fix G + assume G: "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D)" + and c: "\X\\\: (F@G)\\<^sub>s\<^sub>t \ set constr" + and e: "Q2 (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` set F') X" + + have d_Q2: "Q2 (pair ` set D) X" unfolding Q2_def + proof (intro allI impI) + fix f T assume "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (pair ` set D)" + then obtain d where d: "d \ set D" "Fun f T \ subterms (pair d)" by auto + hence "fv (pair d) \ set X = {}" using prems(4) unfolding pair_def by force + thus "T = [] \ (\s \ set T. s \ Var ` set X)" + by (metis fv_disj_Fun_subterm_param_cases d(2)) + qed + + have "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F@G) \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` set F' \ pair ` set D" + using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_trms_subset[OF G] by auto + hence "Q2 (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F@G)) X" using Q2_subset[OF _ Q2_supset[OF e d_Q2]] by metis + hence "tfr\<^sub>s\<^sub>t\<^sub>p (\X\\\: (F@G)\\<^sub>s\<^sub>t)" by (metis Q2_def tfr\<^sub>s\<^sub>t\<^sub>p.simps(2)) + } ultimately have 4: "list_all tfr\<^sub>s\<^sub>t\<^sub>p constr" when "Q2 (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` set F') X" + using that Ball_set by blast + + have 5: "list_all tfr\<^sub>s\<^sub>t\<^sub>p constr" using 2 3 4 by metis + + show ?case using 1 5 A''(1) by simp + qed +qed + +lemma tr_tfr: + assumes "A' \ set (tr A [])" and "tfr\<^sub>s\<^sub>s\<^sub>t A" and "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + shows "tfr\<^sub>s\<^sub>t A'" +proof - + have *: "trms\<^sub>s\<^sub>t A' \ trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A" using tr_trms_subset[OF assms(1)] by simp + hence "SMP (trms\<^sub>s\<^sub>t A') \ SMP (trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A)" using SMP_mono by simp + moreover have "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A)" using assms(2) unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by fast + ultimately have 1: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t A')" by (metis tfr_subset(2)[OF _ *]) + + have **: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p A" using assms(2) unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by fast + have "pair ` setops\<^sub>s\<^sub>s\<^sub>t A \ SMP (trms\<^sub>s\<^sub>s\<^sub>t A \ pair ` setops\<^sub>s\<^sub>s\<^sub>t A) - Var`\" + using setops\<^sub>s\<^sub>s\<^sub>t_are_pairs unfolding pair_def by auto + hence ***: "\t \ pair`setops\<^sub>s\<^sub>s\<^sub>t A. \t' \ pair`setops\<^sub>s\<^sub>s\<^sub>t A. (\\. Unifier \ t t') \ \ t = \ t'" + using assms(2) unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def tfr\<^sub>s\<^sub>e\<^sub>t_def by blast + have 2: "list_all tfr\<^sub>s\<^sub>t\<^sub>p A'" + using tr_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p[OF assms(1) ** assms(3)] *** unfolding pair_def by fastforce + + show ?thesis by (metis 1 2 tfr\<^sub>s\<^sub>t_def) +qed + +private lemma fun_pair_ineqs: + assumes "d \\<^sub>p \ \\<^sub>p \ \ d' \\<^sub>p \" + shows "pair d \ \ \ \ \ pair d' \ \" +proof - + have "d \\<^sub>p (\ \\<^sub>s \) \ d' \\<^sub>p \" using assms subst_pair_compose by metis + hence "pair d \ (\ \\<^sub>s \) \ pair d' \ \" using fun_pair_eq_subst by metis + thus ?thesis by simp +qed + +private lemma tr_Delete_constr_iff_aux1: + assumes "\d \ set Di. (t,s) \\<^sub>p \ = d \\<^sub>p \" + and "\d \ set D - set Di. (t,s) \\<^sub>p \ \ d \\<^sub>p \" + shows "\M; (map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di)@ + (map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di])\\<^sub>d \" +proof - + from assms(2) have + "\M; map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di]\\<^sub>d \" + proof (induction D) + case (Cons d D) + hence IH: "\M; map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D . d \ set Di]\\<^sub>d \" by auto + thus ?case + proof (cases "d \ set Di") + case False + hence "(t,s) \\<^sub>p \ \ d \\<^sub>p \" using Cons by simp + hence "pair (t,s) \ \ \ pair d \ \" using fun_pair_eq_subst by metis + moreover have "\t (\::('fun,'var) subst). subst_domain \ = {} \ t \ \ = t" by auto + ultimately have "\\. subst_domain \ = {} \ pair (t,s) \ \ \ \ \ pair d \ \ \ \" by metis + thus ?thesis using IH by (simp add: ineq_model_def) + qed simp + qed simp + moreover { + fix B assume "\M; B\\<^sub>d \" + with assms(1) have "\M; (map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di)@B\\<^sub>d \" + unfolding pair_def by (induction Di) auto + } ultimately show ?thesis by metis +qed + +private lemma tr_Delete_constr_iff_aux2: + assumes "ground M" + and "\M; (map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di)@ + (map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di])\\<^sub>d \" + shows "(\d \ set Di. (t,s) \\<^sub>p \ = d \\<^sub>p \) \ (\d \ set D - set Di. (t,s) \\<^sub>p \ \ d \\<^sub>p \)" +proof - + let ?c1 = "map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di" + let ?c2 = "map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di]" + + have "M \\<^sub>s\<^sub>e\<^sub>t \ = M" using assms(1) subst_all_ground_ident by metis + moreover have "ik\<^sub>s\<^sub>t ?c1 = {}" by auto + ultimately have *: + "\M; map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di\\<^sub>d \" + "\M; map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di]\\<^sub>d \" + using strand_sem_split(3,4)[of M ?c1 ?c2 \] assms(2) by auto + + from *(1) have 1: "\d \ set Di. (t,s) \\<^sub>p \ = d \\<^sub>p \" unfolding pair_def by (induct Di) auto + from *(2) have 2: "\d \ set D - set Di. (t,s) \\<^sub>p \ \ d \\<^sub>p \" + proof (induction D arbitrary: Di) + case (Cons d D) thus ?case + proof (cases "d \ set Di") + case False + hence IH: "\d \ set D - set Di. (t,s) \\<^sub>p \ \ d \\<^sub>p \" using Cons by force + have "\t (\::('fun,'var) subst). subst_domain \ = {} \ ground (subst_range \) \ \ = Var" + by auto + moreover have "ineq_model \ [] [((pair (t,s)), (pair d))]" + using False Cons.prems by simp + ultimately have "pair (t,s) \ \ \ pair d \ \" by (simp add: ineq_model_def) + thus ?thesis using IH unfolding pair_def by force + qed simp + qed simp + + show ?thesis by (metis 1 2) +qed + +private lemma tr_Delete_constr_iff: + fixes \::"('fun,'var) subst" + assumes "ground M" + shows "set Di \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \ {(t,s) \\<^sub>p \} \ (t,s) \\<^sub>p \ \ (set D - set Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \ + \M; (map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di)@ + (map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di])\\<^sub>d \" +proof - + let ?constr = "(map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di)@ + (map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di])" + { assume "set Di \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \ {(t,s) \\<^sub>p \}" "(t,s) \\<^sub>p \ \ (set D - set Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + hence "\d \ set Di. (t,s) \\<^sub>p \ = d \\<^sub>p \" "\d \ set D - set Di. (t,s) \\<^sub>p \ \ d \\<^sub>p \" + by auto + hence "\M; ?constr\\<^sub>d \" using tr_Delete_constr_iff_aux1 by simp + } moreover { + assume "\M; ?constr\\<^sub>d \" + hence "\d \ set Di. (t,s) \\<^sub>p \ = d \\<^sub>p \" "\d \ set D - set Di. (t,s) \\<^sub>p \ \ d \\<^sub>p \" + using assms tr_Delete_constr_iff_aux2 by auto + hence "set Di \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \ {(t,s) \\<^sub>p \} \ (t,s) \\<^sub>p \ \ (set D - set Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" by force + } ultimately show ?thesis by metis +qed + +private lemma tr_NotInSet_constr_iff: + fixes \::"('fun,'var) subst" + assumes "\(t,t') \ set D. (fv t \ fv t') \ set X = {}" + shows "(\\. subst_domain \ = set X \ ground (subst_range \) \ (t,s) \\<^sub>p \ \\<^sub>p \ \ set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) + \ \M; map (\d. \X\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) D\\<^sub>d \" +proof - + { assume "\\. subst_domain \ = set X \ ground (subst_range \) \ (t,s) \\<^sub>p \ \\<^sub>p \ \ set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + with assms have "\M; map (\d. \X\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) D\\<^sub>d \" + proof (induction D) + case (Cons d D) + obtain t' s' where d: "d = (t',s')" by moura + have "\M; map (\d. \X\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) D\\<^sub>d \" + "map (\d. \X\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) (d#D) = + \X\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t#map (\d. \X\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) D" + using Cons by auto + moreover have + "\\. subst_domain \ = set X \ ground (subst_range \) \ pair (t, s) \ \ \ \ \ pair d \ \" + using fun_pair_ineqs[of \ _ "(t,s)" \ d] Cons.prems(2) by auto + moreover have "(fv t' \ fv s') \ set X = {}" using Cons.prems(1) d by auto + hence "\\. subst_domain \ = set X \ pair d \ \ = pair d" using d unfolding pair_def by auto + ultimately show ?case by (simp add: ineq_model_def) + qed simp + } moreover { + fix \::"('fun,'var) subst" + assume "\M; map (\d. \X\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) D\\<^sub>d \" + and \: "subst_domain \ = set X" "ground (subst_range \)" + with assms have "(t,s) \\<^sub>p \ \\<^sub>p \ \ set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + proof (induction D) + case (Cons d D) + obtain t' s' where d: "d = (t',s')" by moura + have "(t,s) \\<^sub>p \ \\<^sub>p \ \ set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + "pair (t,s) \ \ \ \ \ pair d \ \ \ \" + using Cons d by (auto simp add: ineq_model_def simp del: subst_range.simps) + moreover have "pair d \ \ = pair d" + using Cons.prems(1) fun_pair_subst[of d \] d \(1) unfolding pair_def by auto + ultimately show ?case unfolding pair_def by force + qed simp + } ultimately show ?thesis by metis +qed + +lemma tr_NegChecks_constr_iff: + "(\G\set L. ineq_model \ X (F@G)) \ \M; map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) L\\<^sub>d \" (is ?A) + "negchecks_model \ D X F F' \ \M; D; [\X\\\: F \\: F'\]\\<^sub>s \" (is ?B) +proof - + show ?A by (induct L) auto + show ?B by simp +qed + +lemma tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_sem_equiv: + fixes \::"('fun,'var) subst" + assumes "\(t,t') \ set D. (fv t \ fv t') \ set X = {}" + shows "negchecks_model \ (set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) X F F' \ + (\G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D). ineq_model \ X (F@G))" +proof - + define P where + "P \ \\::('fun,'var) subst. subst_domain \ = set X \ ground (subst_range \)" + + define Ineq where + "Ineq \ \(\::('fun,'var) subst) F. list_ex (\f. fst f \ \ \\<^sub>s \ \ snd f \ \ \\<^sub>s \) F" + + define Ineq' where + "Ineq' \ \(\::('fun,'var) subst) F. list_ex (\f. fst f \ \ \\<^sub>s \ \ snd f \ \) F" + + define Notin where + "Notin \ \(\::('fun,'var) subst) D F'. list_ex (\f. f \\<^sub>p \ \\<^sub>s \ \ set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) F'" + + have sublmm: + "((s,t) \\<^sub>p \ \\<^sub>s \ \ set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) \ (list_all (\d. Ineq' \ [(pair (s,t),pair d)]) D)" + for s t \ D + unfolding pair_def by (induct D) (auto simp add: Ineq'_def) + + have "Notin \ D F' \ (\G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D). Ineq' \ G)" + (is "?A \ ?B") + when "P \" for \ + proof + show "?A \ ?B" + proof (induction F' D rule: tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.induct) + case (2 s t F' D) + show ?case + proof (cases "Notin \ D F'") + case False + hence "(s,t) \\<^sub>p \ \\<^sub>s \ \ set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + using "2.prems" + by (auto simp add: Notin_def) + hence "pair (s,t) \ \ \\<^sub>s \ \ pair d \ \" when "d \ set D" for d + using that sublmm Ball_set[of D "\d. Ineq' \ [(pair (s,t), pair d)]"] + by (simp add: Ineq'_def) + moreover have "\d \ set D. \G'. G = (pair (s,t), pair d)#G'" + when "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ((s,t)#F') D)" for G + using that tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_index[OF that, of 0] by force + ultimately show ?thesis by (simp add: Ineq'_def) + qed (auto dest: "2.IH" simp add: Ineq'_def) + qed (simp add: Notin_def) + + have "\?A \ \?B" + proof (induction F' D rule: tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.induct) + case (2 s t F' D) + then obtain G where G: "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D)" "\Ineq' \ G" + by (auto simp add: Notin_def) + + obtain d where d: "d \ set D" "pair (s,t) \ \ \\<^sub>s \ = pair d \ \" + using "2.prems" + unfolding pair_def by (auto simp add: Notin_def) + thus ?case + using G(2) tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_cons[OF G(1) d(1)] + by (auto simp add: Ineq'_def) + qed (simp add: Ineq'_def) + thus "?B \ ?A" by metis + qed + hence *: "(\\. P \ \ Ineq \ F \ Notin \ D F') \ + (\G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D). \\. P \ \ Ineq \ F \ Ineq' \ G)" + by auto + + have "snd g \ \ = snd g" + when "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D)" "g \ set G" "P \" + for \ g G + using assms that(3) tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_has_pair_lists[OF that(1,2)] + unfolding pair_def by (fastforce simp add: P_def) + hence **: "Ineq' \ G = Ineq \ G" + when "G \ set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D)" "P \" + for \ G + using Bex_set[of G "\f. fst f \ \ \\<^sub>s \ \ snd f \ \"] + Bex_set[of G "\f. fst f \ \ \\<^sub>s \ \ snd f \ \ \\<^sub>s \"] + that + by (simp add: Ineq_def Ineq'_def) + + show ?thesis + using * ** + by (simp add: Ineq_def Ineq'_def Notin_def P_def negchecks_model_def ineq_model_def) +qed + +lemma tr_sem_equiv': + assumes "\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + and "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + and "ground M" + and \: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + shows "\M; set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \ \ (\A' \ set (tr A D). \M; A'\\<^sub>d \)" (is "?P \ ?Q") +proof + have \_grounds: "\t. fv (t \ \) = {}" by (rule interpretation_grounds[OF \]) + have "\A' \ set (tr A D). \M; A'\\<^sub>d \" when ?P using that assms(1,2,3) + proof (induction A arbitrary: D rule: strand_sem_stateful_induct) + case (ConsRcv M D t A) + have "\insert (t \ \) M; set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" + "\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "ground (insert (t \ \) M)" + using \ ConsRcv.prems unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by force+ + then obtain A' where A': "A' \ set (tr A D)" "\insert (t \ \) M; A'\\<^sub>d \" by (metis ConsRcv.IH) + thus ?case by auto + next + case (ConsSnd M D t A) + have "\M; set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" + "\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "ground M" + and *: "M \ t \ \" + using \ ConsSnd.prems unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by force+ + then obtain A' where A': "A' \ set (tr A D)" "\M; A'\\<^sub>d \" by (metis ConsSnd.IH) + thus ?case using * by auto + next + case (ConsEq M D ac t t' A) + have "\M; set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" + "\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "ground M" + and *: "t \ \ = t' \ \" + using \ ConsEq.prems unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by force+ + then obtain A' where A': "A' \ set (tr A D)" "\M; A'\\<^sub>d \" by (metis ConsEq.IH) + thus ?case using * by auto + next + case (ConsIns M D t s A) + have "\M; set (List.insert (t,s) D) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" + "\(t,t') \ set (List.insert (t,s) D). (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "ground M" + using ConsIns.prems unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by force+ + then obtain A' where A': "A' \ set (tr A (List.insert (t,s) D))" "\M; A'\\<^sub>d \" + by (metis ConsIns.IH) + thus ?case by auto + next + case (ConsDel M D t s A) + have *: "\M; (set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) - {(t,s) \\<^sub>p \}; A\\<^sub>s \" + "\(t,t')\set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "ground M" + using ConsDel.prems unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by force+ + then obtain Di where Di: + "Di \ set D" "Di \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \ {(t,s) \\<^sub>p \}" "(t,s) \\<^sub>p \ \ (set D - Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + using subset_subst_pairs_diff_exists'[of "set D"] by moura + hence **: "(set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) - {(t,s) \\<^sub>p \} = (set D - Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" by blast + + obtain Di' where Di': "set Di' = Di" "Di' \ set (subseqs D)" + using subset_sublist_exists[OF Di(1)] by moura + hence ***: "(set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) - {(t,s) \\<^sub>p \} = (set [d\D. d \ set Di'] \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \)" + using Di ** by auto + + define constr where "constr \ + map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di'@ + map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di']" + + have ****: "\(t,t')\set [d\D. d \ set Di']. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + using *(2) Di(1) Di'(1) subseqs_set_subset[OF Di'(2)] by simp + have "set D - Di = set [d\D. d \ set Di']" using Di Di' by auto + hence *****: "\M; set [d\D. d \ set Di'] \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" + using *(1) ** by metis + obtain A' where A': "A' \ set (tr A [d\D. d \ set Di'])" "\M; A'\\<^sub>d \" + using ConsDel.IH[OF ***** **** *(3,4)] by moura + hence constr_sat: "\M; constr\\<^sub>d \" + using Di Di' *(1) *** tr_Delete_constr_iff[OF *(4), of \ Di' t s D] + unfolding constr_def by auto + + have "constr@A' \ set (tr (Delete t s#A) D)" using A'(1) Di' unfolding constr_def by auto + moreover have "ik\<^sub>s\<^sub>t constr = {}" unfolding constr_def by auto + hence "\M \\<^sub>s\<^sub>e\<^sub>t \; constr\\<^sub>d \" "\M \ (ik\<^sub>s\<^sub>t constr \\<^sub>s\<^sub>e\<^sub>t \); A'\\<^sub>d \" + using constr_sat A'(2) subst_all_ground_ident[OF *(4)] by simp_all + ultimately show ?case + using strand_sem_append(2)[of _ _ \] + subst_all_ground_ident[OF *(4), of \] + by metis + next + case (ConsIn M D ac t s A) + have "\M; set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" + "\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "ground M" + and *: "(t,s) \\<^sub>p \ \ set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + using \ ConsIn.prems unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by force+ + then obtain A' where A': "A' \ set (tr A D)" "\M; A'\\<^sub>d \" by (metis ConsIn.IH) + moreover obtain d where "d \ set D" "pair (t,s) \ \ = pair d \ \" + using * unfolding pair_def by auto + ultimately show ?case using * by auto + next + case (ConsNegChecks M D X F F' A) + let ?ineqs = "(map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D))" + have 1: "\M; set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" "ground M" using ConsNegChecks by auto + have 2: "\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + using ConsNegChecks.prems(2,3) \ unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by fastforce+ + + have 3: "negchecks_model \ (set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) X F F'" using ConsNegChecks.prems(1) by simp + from 1 2 obtain A' where A': "A' \ set (tr A D)" "\M; A'\\<^sub>d \" by (metis ConsNegChecks.IH) + + have 4: "\(t,t') \ set D. (fv t \ fv t') \ set X = {}" + using ConsNegChecks.prems(2) unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def by auto + + have "\M; ?ineqs\\<^sub>d \" + using 3 tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_sem_equiv[OF 4] tr_NegChecks_constr_iff + by metis + moreover have "ik\<^sub>s\<^sub>t ?ineqs = {}" by auto + moreover have "M \\<^sub>s\<^sub>e\<^sub>t \ = M" using 1(2) \ by (simp add: subst_all_ground_ident) + ultimately show ?case + using strand_sem_append(2)[of M ?ineqs \ A'] A' + by force + qed simp + thus "?P \ ?Q" by metis + + have "(\A' \ set (tr A D). \M; A'\\<^sub>d \) \ ?P" using assms(1,2,3) + proof (induction A arbitrary: D rule: strand_sem_stateful_induct) + case (ConsRcv M D t A) + have "\A' \ set (tr A D). \insert (t \ \) M; A'\\<^sub>d \" + "\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "ground (insert (t \ \) M)" + using \ ConsRcv.prems unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by force+ + hence "\insert (t \ \) M; set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" by (metis ConsRcv.IH) + thus ?case by auto + next + case (ConsSnd M D t A) + have "\A' \ set (tr A D). \M; A'\\<^sub>d \" + "\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "ground M" + and *: "M \ t \ \" + using \ ConsSnd.prems unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by force+ + hence "\M; set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" by (metis ConsSnd.IH) + thus ?case using * by auto + next + case (ConsEq M D ac t t' A) + have "\A' \ set (tr A D). \M; A'\\<^sub>d \" + "\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "ground M" + and *: "t \ \ = t' \ \" + using \ ConsEq.prems unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by force+ + hence "\M; set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" by (metis ConsEq.IH) + thus ?case using * by auto + next + case (ConsIns M D t s A) + hence "\A' \ set (tr A (List.insert (t,s) D)). \M; A'\\<^sub>d \" + "\(t,t') \ set (List.insert (t,s) D). (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "ground M" + unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by auto+ + hence "\M; set (List.insert (t,s) D) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" by (metis ConsIns.IH) + thus ?case by auto + next + case (ConsDel M D t s A) + define constr where "constr \ + \Di. map (\d. \check: (pair (t,s)) \ (pair d)\\<^sub>s\<^sub>t) Di@ + map (\d. \[]\\\: [(pair (t,s), pair d)]\\<^sub>s\<^sub>t) [d\D. d \ set Di]" + let ?flt = "\Di. filter (\d. d \ set Di) D" + + have "\Di \ set (subseqs D). \B' \ set (tr A (?flt Di)). B = constr Di@B'" + when "B \ set (tr (delete\t,s\#A) D)" for B + using that unfolding constr_def by auto + then obtain A' Di where A': + "constr Di@A' \ set (tr (Delete t s#A) D)" + "A' \ set (tr A (?flt Di))" + "Di \ set (subseqs D)" + "\M; constr Di@A'\\<^sub>d \" + using ConsDel.prems(1) by blast + + have 1: "\(t,t')\set (?flt Di). (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" using ConsDel.prems(2) by auto + have 2: "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" using ConsDel.prems(3) by force+ + have "ik\<^sub>s\<^sub>t (constr Di) = {}" unfolding constr_def by auto + hence 3: "\M; A'\\<^sub>d \" + using subst_all_ground_ident[OF ConsDel.prems(4)] A'(4) + strand_sem_split(4)[of M "constr Di" A' \] + by simp + have IH: "\M; set (?flt Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" + by (metis ConsDel.IH[OF _ 1 2 ConsDel.prems(4)] 3 A'(2)) + + have "\M; constr Di\\<^sub>d \" + using subst_all_ground_ident[OF ConsDel.prems(4)] strand_sem_split(3) A'(4) + by metis + hence *: "set Di \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \ {(t,s) \\<^sub>p \}" "(t,s) \\<^sub>p \ \ (set D - set Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + using tr_Delete_constr_iff[OF ConsDel.prems(4), of \ Di t s D] unfolding constr_def by auto + have 4: "set (?flt Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ = (set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) - {((t,s) \\<^sub>p \)}" + proof + show "set (?flt Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \ \ (set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) - {((t,s) \\<^sub>p \)}" + proof + fix u u' assume u: "(u,u') \ set (?flt Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + then obtain v v' where v: "(v,v') \ set D - set Di" "(v,v') \\<^sub>p \ = (u,u')" by auto + hence "(u,u') \ (t,s) \\<^sub>p \" using * by force + thus "(u,u') \ (set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) - {((t,s) \\<^sub>p \)}" + using u v * subseqs_set_subset[OF A'(3)] by auto + qed + show "(set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \) - {((t,s) \\<^sub>p \)} \ set (?flt Di) \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + using * subseqs_set_subset[OF A'(3)] by force + qed + + show ?case using 4 IH by simp + next + case (ConsIn M D ac t s A) + have "\A' \ set (tr A D). \M; A'\\<^sub>d \" + "\(t,t') \ set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "ground M" + and *: "(t,s) \\<^sub>p \ \ set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \" + using ConsIn.prems(1,2,3,4) apply (fastforce, fastforce, fastforce, fastforce) + using ConsIn.prems(1) tr.simps(7)[of ac t s A D] unfolding pair_def by fastforce + hence "\M; set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" by (metis ConsIn.IH) + moreover obtain d where "d \ set D" "pair (t,s) \ \ = pair d \ \" + using * unfolding pair_def by auto + ultimately show ?case using * by auto + next + case (ConsNegChecks M D X F F' A) + let ?ineqs = "(map (\G. \X\\\: (F@G)\\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' D))" + + obtain B where B: + "?ineqs@B \ set (tr (NegChecks X F F'#A) D)" "\M; ?ineqs@B\\<^sub>d \" "B \ set (tr A D)" + using ConsNegChecks.prems(1) by moura + moreover have "M \\<^sub>s\<^sub>e\<^sub>t \ = M" + using ConsNegChecks.prems(4) \ by (simp add: subst_all_ground_ident) + moreover have "ik\<^sub>s\<^sub>t ?ineqs = {}" by auto + ultimately have "\M; B\\<^sub>d \" using strand_sem_split(4)[of M ?ineqs B \] by simp + moreover have "\(t,t')\set D. (fv t \ fv t') \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" + using ConsNegChecks.prems(2,3) unfolding fv\<^sub>s\<^sub>s\<^sub>t_def bvars\<^sub>s\<^sub>s\<^sub>t_def by force+ + ultimately have "\M; set D \\<^sub>p\<^sub>s\<^sub>e\<^sub>t \; A\\<^sub>s \" + by (metis ConsNegChecks.IH B(3) ConsNegChecks.prems(4)) + moreover have "\(t, t')\set D. (fv t \ fv t') \ set X = {}" + using ConsNegChecks.prems(2) unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def by force + ultimately show ?case + using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_sem_equiv tr_NegChecks_constr_iff + B(2) strand_sem_split(3)[of M ?ineqs B \] \M \\<^sub>s\<^sub>e\<^sub>t \ = M\ + by simp + qed simp + thus "?Q \ ?P" by metis +qed + +lemma tr_sem_equiv: + assumes "fv\<^sub>s\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>s\<^sub>t A = {}" and "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + shows "\ \\<^sub>s A \ (\A' \ set (tr A []). (\ \ \A'\))" +using tr_sem_equiv'[OF _ assms(1) _ assms(2), of "[]" "{}"] +unfolding constr_sem_d_def +by auto + +theorem stateful_typing_result: + assumes "wf\<^sub>s\<^sub>s\<^sub>t \" + and "tfr\<^sub>s\<^sub>s\<^sub>t \" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t \)" + and "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and "\ \\<^sub>s \" + obtains \\<^sub>\ + where "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" + and "\\<^sub>\ \\<^sub>s \" + and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)" +proof - + obtain \' where \': + "\' \ set (tr \ [])" "\ \ \\'\" + using tr_sem_equiv[of \] assms(1,4,5) + by auto + + have *: "wf\<^sub>s\<^sub>t {} \'" + "fv\<^sub>s\<^sub>t \' \ bvars\<^sub>s\<^sub>t \' = {}" + "tfr\<^sub>s\<^sub>t \'" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t \')" + using tr_wf[OF \'(1) assms(1,3)] + tr_tfr[OF \'(1) assms(2)] assms(1) + by metis+ + + obtain \\<^sub>\ where \\<^sub>\: + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "\{}; \'\\<^sub>d \\<^sub>\" + "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)" + using wt_attack_if_tfr_attack_d + * Ana_invar_subst' assms(4) + \'(2) + unfolding constr_sem_d_def + by moura + + thus ?thesis + using that tr_sem_equiv[of \] assms(1,3) \'(1) + unfolding constr_sem_d_def + by auto +qed + +end + +end + +subsection \Proving type-flaw resistance automatically\ +definition pair' where + "pair' pair_fun d \ case d of (t,t') \ Fun pair_fun [t,t']" + +fun comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p where + "comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ pair_fun (\_: t \ t'\) = (mgu t t' \ None \ \ t = \ t')" +| "comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ pair_fun (\X\\\: F \\: F'\) = ( + (F' = [] \ (\x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. is_Var (\ (Var x)))) \ + (\u \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair' pair_fun ` set F'). + is_Fun u \ (args u = [] \ (\s \ set (args u). s \ Var ` set X))))" +| "comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p _ _ _ = True" + +definition comp_tfr\<^sub>s\<^sub>s\<^sub>t where + "comp_tfr\<^sub>s\<^sub>s\<^sub>t arity Ana \ pair_fun M S \ + list_all (comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ pair_fun) S \ + list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (trms_list\<^sub>s\<^sub>s\<^sub>t S) \ + has_all_wt_instances_of \ (trms\<^sub>s\<^sub>s\<^sub>t S \ pair' pair_fun ` setops\<^sub>s\<^sub>s\<^sub>t S) (set M) \ + comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \ M" + +locale stateful_typed_model' = stateful_typed_model arity public Ana \ Pair + for arity::"'fun \ nat" + and public::"'fun \ bool" + and Ana::"('fun,(('fun,'atom::finite) term_type \ nat)) term + \ (('fun,(('fun,'atom) term_type \ nat)) term list + \ ('fun,(('fun,'atom) term_type \ nat)) term list)" + and \::"('fun,(('fun,'atom) term_type \ nat)) term \ ('fun,'atom) term_type" + and Pair::"'fun" + + + assumes \_Var_fst': "\\ n m. \ (Var (\,n)) = \ (Var (\,m))" + and Ana_const': "\c T. arity c = 0 \ Ana (Fun c T) = ([], [])" +begin + +sublocale typed_model' +by (unfold_locales, rule \_Var_fst', metis Ana_const', metis Ana_subst') + +lemma pair_code: + "pair d = pair' Pair d" +by (simp add: pair_def pair'_def) + +lemma tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p: "tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p a = comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ Pair a" +proof (cases a) + case (Equality ac t t') + thus ?thesis + using mgu_always_unifies[of t _ t'] mgu_gives_MGU[of t t'] + by auto +next + case (NegChecks X F F') + thus ?thesis + using tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(2)[of X F F'] + comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p.simps(2)[of \ Pair X F F'] + Fun_range_case(2)[of "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ pair ` set F')"] + unfolding is_Var_def pair_code[symmetric] + by auto +qed auto + +lemma tfr\<^sub>s\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>s\<^sub>t: + assumes "comp_tfr\<^sub>s\<^sub>s\<^sub>t arity Ana \ Pair M S" + shows "tfr\<^sub>s\<^sub>s\<^sub>t S" +unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def +proof + have comp_tfr\<^sub>s\<^sub>e\<^sub>t_M: "comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \ M" + using assms unfolding comp_tfr\<^sub>s\<^sub>s\<^sub>t_def by blast + + have wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + and wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_S: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t S \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S)" + and S_trms_instance_M: "has_all_wt_instances_of \ (trms\<^sub>s\<^sub>s\<^sub>t S \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S) (set M)" + using assms setops\<^sub>s\<^sub>s\<^sub>t_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s(2)[of S] trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t[of S] + unfolding comp_tfr\<^sub>s\<^sub>s\<^sub>t_def comp_tfr\<^sub>s\<^sub>e\<^sub>t_def list_all_iff pair_code[symmetric] wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric] + finite_SMP_representation_def + by (meson, meson, blast, meson) + + show "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t S \ pair ` setops\<^sub>s\<^sub>s\<^sub>t S)" + using tfr_subset(3)[OF tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[OF comp_tfr\<^sub>s\<^sub>e\<^sub>t_M] SMP_SMP_subset] + SMP_I'[OF wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_S wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_M S_trms_instance_M] + by blast + + have "list_all (comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p \ Pair) S" by (metis assms comp_tfr\<^sub>s\<^sub>s\<^sub>t_def) + thus "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p S" by (induct S) (simp_all add: tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p) +qed + +lemma tfr\<^sub>s\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>s\<^sub>t': + assumes "comp_tfr\<^sub>s\<^sub>s\<^sub>t arity Ana \ Pair (SMP0 Ana \ (trms_list\<^sub>s\<^sub>s\<^sub>t S@map pair (setops_list\<^sub>s\<^sub>s\<^sub>t S))) S" + shows "tfr\<^sub>s\<^sub>s\<^sub>t S" +by (rule tfr\<^sub>s\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>s\<^sub>t[OF assms]) + +end + +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Strands_and_Constraints.thy b/thys/Stateful_Protocol_Composition_and_Typing/Strands_and_Constraints.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Strands_and_Constraints.thy @@ -0,0 +1,2783 @@ +(* +(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: Strands_and_Constraints.thy + Author: Andreas Viktor Hess, DTU +*) + +section \Strands and Symbolic Intruder Constraints\ +theory Strands_and_Constraints +imports Messages More_Unification Intruder_Deduction +begin + +subsection \Constraints, Strands and Related Definitions\ +datatype poscheckvariant = Assign ("assign") | Check ("check") + +text \ + A strand (or constraint) step is either a message transmission (either a message being sent \Send\ + or being received \Receive\) or a check on messages (a positive check \Equality\---which can be + either an "assignment" or just a check---or a negative check \Inequality\) +\ +datatype (funs\<^sub>s\<^sub>t\<^sub>p: 'a, vars\<^sub>s\<^sub>t\<^sub>p: 'b) strand_step = + Send "('a,'b) term" ("send\_\\<^sub>s\<^sub>t" 80) +| Receive "('a,'b) term" ("receive\_\\<^sub>s\<^sub>t" 80) +| Equality poscheckvariant "('a,'b) term" "('a,'b) term" ("\_: _ \ _\\<^sub>s\<^sub>t" [80,80]) +| Inequality (bvars\<^sub>s\<^sub>t\<^sub>p: "'b list") "(('a,'b) term \ ('a,'b) term) list" ("\_\\\: _\\<^sub>s\<^sub>t" [80,80]) +where + "bvars\<^sub>s\<^sub>t\<^sub>p (Send _) = []" +| "bvars\<^sub>s\<^sub>t\<^sub>p (Receive _) = []" +| "bvars\<^sub>s\<^sub>t\<^sub>p (Equality _ _ _) = []" + +text \ + A strand is a finite sequence of strand steps (constraints and strands share the same datatype) +\ +type_synonym ('a,'b) strand = "('a,'b) strand_step list" + +type_synonym ('a,'b) strands = "('a,'b) strand set" + +abbreviation "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ \(t,t') \ set F. {t,t'}" + +fun trms\<^sub>s\<^sub>t\<^sub>p::"('a,'b) strand_step \ ('a,'b) terms" where + "trms\<^sub>s\<^sub>t\<^sub>p (Send t) = {t}" +| "trms\<^sub>s\<^sub>t\<^sub>p (Receive t) = {t}" +| "trms\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = {t,t'}" +| "trms\<^sub>s\<^sub>t\<^sub>p (Inequality _ F) = trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" + +lemma vars\<^sub>s\<^sub>t\<^sub>p_unfold[simp]: "vars\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p x) \ set (bvars\<^sub>s\<^sub>t\<^sub>p x)" +by (cases x) auto + +text \The set of terms occurring in a strand\ +definition trms\<^sub>s\<^sub>t where "trms\<^sub>s\<^sub>t S \ \(trms\<^sub>s\<^sub>t\<^sub>p ` set S)" + +fun trms_list\<^sub>s\<^sub>t\<^sub>p::"('a,'b) strand_step \ ('a,'b) term list" where + "trms_list\<^sub>s\<^sub>t\<^sub>p (Send t) = [t]" +| "trms_list\<^sub>s\<^sub>t\<^sub>p (Receive t) = [t]" +| "trms_list\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = [t,t']" +| "trms_list\<^sub>s\<^sub>t\<^sub>p (Inequality _ F) = concat (map (\(t,t'). [t,t']) F)" + +text \The set of terms occurring in a strand (list variant)\ +definition trms_list\<^sub>s\<^sub>t where "trms_list\<^sub>s\<^sub>t S \ remdups (concat (map trms_list\<^sub>s\<^sub>t\<^sub>p S))" + +text \The set of variables occurring in a sent message\ +definition fv\<^sub>s\<^sub>n\<^sub>d::"('a,'b) strand_step \ 'b set" where + "fv\<^sub>s\<^sub>n\<^sub>d x \ case x of Send t \ fv t | _ \ {}" + +text \The set of variables occurring in a received message\ +definition fv\<^sub>r\<^sub>c\<^sub>v::"('a,'b) strand_step \ 'b set" where + "fv\<^sub>r\<^sub>c\<^sub>v x \ case x of Receive t \ fv t | _ \ {}" + +text \The set of variables occurring in an equality constraint\ +definition fv\<^sub>e\<^sub>q::"poscheckvariant \ ('a,'b) strand_step \ 'b set" where + "fv\<^sub>e\<^sub>q ac x \ case x of Equality ac' s t \ if ac = ac' then fv s \ fv t else {} | _ \ {}" + +text \The set of variables occurring at the left-hand side of an equality constraint\ +definition fv_l\<^sub>e\<^sub>q::"poscheckvariant \ ('a,'b) strand_step \ 'b set" where + "fv_l\<^sub>e\<^sub>q ac x \ case x of Equality ac' s t \ if ac = ac' then fv s else {} | _ \ {}" + +text \The set of variables occurring at the right-hand side of an equality constraint\ +definition fv_r\<^sub>e\<^sub>q::"poscheckvariant \ ('a,'b) strand_step \ 'b set" where + "fv_r\<^sub>e\<^sub>q ac x \ case x of Equality ac' s t \ if ac = ac' then fv t else {} | _ \ {}" + +text \The free variables of inequality constraints\ +definition fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q::"('a,'b) strand_step \ 'b set" where + "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x \ case x of Inequality X F \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X | _ \ {}" + +fun fv\<^sub>s\<^sub>t\<^sub>p::"('a,'b) strand_step \ 'b set" where + "fv\<^sub>s\<^sub>t\<^sub>p (Send t) = fv t" +| "fv\<^sub>s\<^sub>t\<^sub>p (Receive t) = fv t" +| "fv\<^sub>s\<^sub>t\<^sub>p (Equality _ t t') = fv t \ fv t'" +| "fv\<^sub>s\<^sub>t\<^sub>p (Inequality X F) = (\(t,t') \ set F. fv t \ fv t') - set X" + +text \The set of free variables of a strand\ +definition fv\<^sub>s\<^sub>t::"('a,'b) strand \ 'b set" where + "fv\<^sub>s\<^sub>t S \ \(set (map fv\<^sub>s\<^sub>t\<^sub>p S))" + +text \The set of bound variables of a strand\ +definition bvars\<^sub>s\<^sub>t::"('a,'b) strand \ 'b set" where + "bvars\<^sub>s\<^sub>t S \ \(set (map (set \ bvars\<^sub>s\<^sub>t\<^sub>p) S))" + +text \The set of all variables occurring in a strand\ +definition vars\<^sub>s\<^sub>t::"('a,'b) strand \ 'b set" where + "vars\<^sub>s\<^sub>t S \ \(set (map vars\<^sub>s\<^sub>t\<^sub>p S))" + +abbreviation wfrestrictedvars\<^sub>s\<^sub>t\<^sub>p::"('a,'b) strand_step \ 'b set" where + "wfrestrictedvars\<^sub>s\<^sub>t\<^sub>p x \ + case x of Inequality _ _ \ {} | Equality Check _ _ \ {} | _ \ vars\<^sub>s\<^sub>t\<^sub>p x" + +text \The variables of a strand whose occurrences might be restricted by well-formedness constraints\ +definition wfrestrictedvars\<^sub>s\<^sub>t::"('a,'b) strand \ 'b set" where + "wfrestrictedvars\<^sub>s\<^sub>t S \ \(set (map wfrestrictedvars\<^sub>s\<^sub>t\<^sub>p S))" + +abbreviation wfvarsoccs\<^sub>s\<^sub>t\<^sub>p where + "wfvarsoccs\<^sub>s\<^sub>t\<^sub>p x \ case x of Send t \ fv t | Equality Assign s t \ fv s | _ \ {}" + +text \The variables of a strand that occur in sent messages or as variables in assignments\ +definition wfvarsoccs\<^sub>s\<^sub>t where + "wfvarsoccs\<^sub>s\<^sub>t S \ \(set (map wfvarsoccs\<^sub>s\<^sub>t\<^sub>p S))" + +text \The variables occurring at the right-hand side of assignment steps\ +fun assignment_rhs\<^sub>s\<^sub>t where + "assignment_rhs\<^sub>s\<^sub>t [] = {}" +| "assignment_rhs\<^sub>s\<^sub>t (Equality Assign t t'#S) = insert t' (assignment_rhs\<^sub>s\<^sub>t S)" +| "assignment_rhs\<^sub>s\<^sub>t (x#S) = assignment_rhs\<^sub>s\<^sub>t S" + +text \The set function symbols occurring in a strand\ +definition funs\<^sub>s\<^sub>t::"('a,'b) strand \ 'a set" where + "funs\<^sub>s\<^sub>t S \ \(set (map funs\<^sub>s\<^sub>t\<^sub>p S))" + +fun subst_apply_strand_step::"('a,'b) strand_step \ ('a,'b) subst \ ('a,'b) strand_step" + (infix "\\<^sub>s\<^sub>t\<^sub>p" 51) where + "Send t \\<^sub>s\<^sub>t\<^sub>p \ = Send (t \ \)" +| "Receive t \\<^sub>s\<^sub>t\<^sub>p \ = Receive (t \ \)" +| "Equality a t t' \\<^sub>s\<^sub>t\<^sub>p \ = Equality a (t \ \) (t' \ \)" +| "Inequality X F \\<^sub>s\<^sub>t\<^sub>p \ = Inequality X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)" + +text \Substitution application for strands\ +definition subst_apply_strand::"('a,'b) strand \ ('a,'b) subst \ ('a,'b) strand" + (infix "\\<^sub>s\<^sub>t" 51) where + "S \\<^sub>s\<^sub>t \ \ map (\x. x \\<^sub>s\<^sub>t\<^sub>p \) S" + +text \The semantics of inequality constraints\ +definition + "ineq_model (\::('a,'b) subst) X F \ + (\\. subst_domain \ = set X \ ground (subst_range \) \ + list_ex (\f. fst f \ (\ \\<^sub>s \) \ snd f \ (\ \\<^sub>s \)) F)" + +fun simple\<^sub>s\<^sub>t\<^sub>p where + "simple\<^sub>s\<^sub>t\<^sub>p (Receive t) = True" +| "simple\<^sub>s\<^sub>t\<^sub>p (Send (Var v)) = True" +| "simple\<^sub>s\<^sub>t\<^sub>p (Inequality X F) = (\\. ineq_model \ X F)" +| "simple\<^sub>s\<^sub>t\<^sub>p _ = False" + +text \Simple constraints\ +definition simple where "simple S \ list_all simple\<^sub>s\<^sub>t\<^sub>p S" + +text \The intruder knowledge of a constraint\ +fun ik\<^sub>s\<^sub>t::"('a,'b) strand \ ('a,'b) terms" where + "ik\<^sub>s\<^sub>t [] = {}" +| "ik\<^sub>s\<^sub>t (Receive t#S) = insert t (ik\<^sub>s\<^sub>t S)" +| "ik\<^sub>s\<^sub>t (_#S) = ik\<^sub>s\<^sub>t S" + +text \Strand well-formedness\ +fun wf\<^sub>s\<^sub>t::"'b set \ ('a,'b) strand \ bool" where + "wf\<^sub>s\<^sub>t V [] = True" +| "wf\<^sub>s\<^sub>t V (Receive t#S) = (fv t \ V \ wf\<^sub>s\<^sub>t V S)" +| "wf\<^sub>s\<^sub>t V (Send t#S) = wf\<^sub>s\<^sub>t (V \ fv t) S" +| "wf\<^sub>s\<^sub>t V (Equality Assign s t#S) = (fv t \ V \ wf\<^sub>s\<^sub>t (V \ fv s) S)" +| "wf\<^sub>s\<^sub>t V (Equality Check s t#S) = wf\<^sub>s\<^sub>t V S" +| "wf\<^sub>s\<^sub>t V (Inequality _ _#S) = wf\<^sub>s\<^sub>t V S" + +text \Well-formedness of constraint states\ +definition wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r::"('a,'b) strand \ ('a,'b) subst \ bool" where + "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \ \ (wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>s\<^sub>t {} S \ subst_domain \ \ vars\<^sub>s\<^sub>t S = {} \ + range_vars \ \ bvars\<^sub>s\<^sub>t S = {} \ fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S = {})" + +declare trms\<^sub>s\<^sub>t_def[simp] +declare fv\<^sub>s\<^sub>n\<^sub>d_def[simp] +declare fv\<^sub>r\<^sub>c\<^sub>v_def[simp] +declare fv\<^sub>e\<^sub>q_def[simp] +declare fv_l\<^sub>e\<^sub>q_def[simp] +declare fv_r\<^sub>e\<^sub>q_def[simp] +declare fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q_def[simp] +declare fv\<^sub>s\<^sub>t_def[simp] +declare vars\<^sub>s\<^sub>t_def[simp] +declare bvars\<^sub>s\<^sub>t_def[simp] +declare wfrestrictedvars\<^sub>s\<^sub>t_def[simp] +declare wfvarsoccs\<^sub>s\<^sub>t_def[simp] + +lemmas wf\<^sub>s\<^sub>t_induct = wf\<^sub>s\<^sub>t.induct[case_names Nil ConsRcv ConsSnd ConsEq ConsEq2 ConsIneq] +lemmas ik\<^sub>s\<^sub>t_induct = ik\<^sub>s\<^sub>t.induct[case_names Nil ConsRcv ConsSnd ConsEq ConsIneq] +lemmas assignment_rhs\<^sub>s\<^sub>t_induct = assignment_rhs\<^sub>s\<^sub>t.induct[case_names Nil ConsEq2 ConsSnd ConsRcv ConsEq ConsIneq] + + +subsubsection \Lexicographical measure on strands\ +definition size\<^sub>s\<^sub>t::"('a,'b) strand \ nat" where + "size\<^sub>s\<^sub>t S \ size_list (\x. Max (insert 0 (size ` trms\<^sub>s\<^sub>t\<^sub>p x))) S" + +definition measure\<^sub>s\<^sub>t::"((('a, 'b) strand \ ('a,'b) subst) \ ('a, 'b) strand \ ('a,'b) subst) set" +where + "measure\<^sub>s\<^sub>t \ measures [\(S,\). card (fv\<^sub>s\<^sub>t S), \(S,\). size\<^sub>s\<^sub>t S]" + +lemma measure\<^sub>s\<^sub>t_alt_def: + "((s,x),(t,y)) \ measure\<^sub>s\<^sub>t = + (card (fv\<^sub>s\<^sub>t s) < card (fv\<^sub>s\<^sub>t t) \ (card (fv\<^sub>s\<^sub>t s) = card (fv\<^sub>s\<^sub>t t) \ size\<^sub>s\<^sub>t s < size\<^sub>s\<^sub>t t))" +by (simp add: measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def) + +lemma measure\<^sub>s\<^sub>t_trans: "trans measure\<^sub>s\<^sub>t" +by (simp add: trans_def measure\<^sub>s\<^sub>t_def size\<^sub>s\<^sub>t_def) + + +subsubsection \Some lemmata\ +lemma trms_list\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>t: "trms\<^sub>s\<^sub>t S = set (trms_list\<^sub>s\<^sub>t S)" +unfolding trms\<^sub>s\<^sub>t_def trms_list\<^sub>s\<^sub>t_def +proof (induction S) + case (Cons x S) thus ?case by (cases x) auto +qed simp + +lemma subst_apply_strand_step_def: + "s \\<^sub>s\<^sub>t\<^sub>p \ = (case s of + Send t \ Send (t \ \) + | Receive t \ Receive (t \ \) + | Equality a t t' \ Equality a (t \ \) (t' \ \) + | Inequality X F \ Inequality X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \))" +by (cases s) simp_all + +lemma subst_apply_strand_nil[simp]: "[] \\<^sub>s\<^sub>t \ = []" +unfolding subst_apply_strand_def by simp + +lemma finite_funs\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (funs\<^sub>s\<^sub>t\<^sub>p x)" by (cases x) auto +lemma finite_funs\<^sub>s\<^sub>t[simp]: "finite (funs\<^sub>s\<^sub>t S)" unfolding funs\<^sub>s\<^sub>t_def by simp +lemma finite_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[simp]: "finite (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s x)" by (induct x) auto +lemma finite_trms\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (trms\<^sub>s\<^sub>t\<^sub>p x)" by (cases x) auto +lemma finite_vars\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (vars\<^sub>s\<^sub>t\<^sub>p x)" by auto +lemma finite_bvars\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (set (bvars\<^sub>s\<^sub>t\<^sub>p x))" by rule +lemma finite_fv\<^sub>s\<^sub>n\<^sub>d[simp]: "finite (fv\<^sub>s\<^sub>n\<^sub>d x)" by (cases x) auto +lemma finite_fv\<^sub>r\<^sub>c\<^sub>v[simp]: "finite (fv\<^sub>r\<^sub>c\<^sub>v x)" by (cases x) auto +lemma finite_fv\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (fv\<^sub>s\<^sub>t\<^sub>p x)" by (cases x) auto +lemma finite_vars\<^sub>s\<^sub>t[simp]: "finite (vars\<^sub>s\<^sub>t S)" by simp +lemma finite_bvars\<^sub>s\<^sub>t[simp]: "finite (bvars\<^sub>s\<^sub>t S)" by simp +lemma finite_fv\<^sub>s\<^sub>t[simp]: "finite (fv\<^sub>s\<^sub>t S)" by simp + +lemma finite_wfrestrictedvars\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (wfrestrictedvars\<^sub>s\<^sub>t\<^sub>p x)" +by (cases x) (auto split: poscheckvariant.splits) + +lemma finite_wfrestrictedvars\<^sub>s\<^sub>t[simp]: "finite (wfrestrictedvars\<^sub>s\<^sub>t S)" +using finite_wfrestrictedvars\<^sub>s\<^sub>t\<^sub>p by auto + +lemma finite_wfvarsoccs\<^sub>s\<^sub>t\<^sub>p[simp]: "finite (wfvarsoccs\<^sub>s\<^sub>t\<^sub>p x)" +by (cases x) (auto split: poscheckvariant.splits) + +lemma finite_wfvarsoccs\<^sub>s\<^sub>t[simp]: "finite (wfvarsoccs\<^sub>s\<^sub>t S)" +using finite_wfvarsoccs\<^sub>s\<^sub>t\<^sub>p by auto + +lemma finite_ik\<^sub>s\<^sub>t[simp]: "finite (ik\<^sub>s\<^sub>t S)" +by (induct S rule: ik\<^sub>s\<^sub>t.induct) simp_all + +lemma finite_assignment_rhs\<^sub>s\<^sub>t[simp]: "finite (assignment_rhs\<^sub>s\<^sub>t S)" +by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) simp_all + +lemma ik\<^sub>s\<^sub>t_is_rcv_set: "ik\<^sub>s\<^sub>t A = {t. Receive t \ set A}" +by (induct A rule: ik\<^sub>s\<^sub>t.induct) auto + +lemma ik\<^sub>s\<^sub>tD[dest]: "t \ ik\<^sub>s\<^sub>t S \ Receive t \ set S" +by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto + +lemma ik\<^sub>s\<^sub>tD'[dest]: "t \ ik\<^sub>s\<^sub>t S \ t \ trms\<^sub>s\<^sub>t S" +by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto + +lemma ik\<^sub>s\<^sub>tD''[dest]: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t S) \ t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" +by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto + +lemma ik\<^sub>s\<^sub>t_subterm_exD: + assumes "t \ ik\<^sub>s\<^sub>t S" + shows "\x \ set S. t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p x)" +using assms ik\<^sub>s\<^sub>tD by force + +lemma assignment_rhs\<^sub>s\<^sub>tD[dest]: "t \ assignment_rhs\<^sub>s\<^sub>t S \ \t'. Equality Assign t' t \ set S" +by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) auto + +lemma assignment_rhs\<^sub>s\<^sub>tD'[dest]: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (assignment_rhs\<^sub>s\<^sub>t S) \ t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" +by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) auto + +lemma bvars\<^sub>s\<^sub>t_split: "bvars\<^sub>s\<^sub>t (S@S') = bvars\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S'" +unfolding bvars\<^sub>s\<^sub>t_def by auto + +lemma bvars\<^sub>s\<^sub>t_singleton: "bvars\<^sub>s\<^sub>t [x] = set (bvars\<^sub>s\<^sub>t\<^sub>p x)" +unfolding bvars\<^sub>s\<^sub>t_def by auto + +lemma strand_fv_bvars_disjointD: + assumes "fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S = {}" "Inequality X F \ set S" + shows "set X \ bvars\<^sub>s\<^sub>t S" "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \ fv\<^sub>s\<^sub>t S" +using assms by (induct S) fastforce+ + +lemma strand_fv_bvars_disjoint_unfold: + assumes "fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S = {}" "Inequality X F \ set S" "Inequality Y G \ set S" + shows "set Y \ (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X) = {}" +proof - + have "set X \ bvars\<^sub>s\<^sub>t S" "set Y \ bvars\<^sub>s\<^sub>t S" + "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \ fv\<^sub>s\<^sub>t S" "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G - set Y \ fv\<^sub>s\<^sub>t S" + using strand_fv_bvars_disjointD[OF assms(1)] assms(2,3) by auto + thus ?thesis using assms(1) by fastforce +qed + +lemma strand_subst_hom[iff]: + "(S@S') \\<^sub>s\<^sub>t \ = (S \\<^sub>s\<^sub>t \)@(S' \\<^sub>s\<^sub>t \)" "(x#S) \\<^sub>s\<^sub>t \ = (x \\<^sub>s\<^sub>t\<^sub>p \)#(S \\<^sub>s\<^sub>t \)" +unfolding subst_apply_strand_def by auto + +lemma strand_subst_comp: "range_vars \ \ bvars\<^sub>s\<^sub>t S = {} \ S \\<^sub>s\<^sub>t \ \\<^sub>s \ = ((S \\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>t \)" +proof (induction S) + case (Cons x S) + have *: "range_vars \ \ bvars\<^sub>s\<^sub>t S = {}" "range_vars \ \ (set (bvars\<^sub>s\<^sub>t\<^sub>p x)) = {}" + using Cons bvars\<^sub>s\<^sub>t_split[of "[x]" S] append_Cons inf_sup_absorb + by (metis (no_types, lifting) Int_iff Un_commute disjoint_iff_not_equal self_append_conv2, + metis append_self_conv2 bvars\<^sub>s\<^sub>t_singleton inf_bot_right inf_left_commute) + hence IH: "S \\<^sub>s\<^sub>t \ \\<^sub>s \ = (S \\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>t \" using Cons.IH by auto + have "(x#S \\<^sub>s\<^sub>t \ \\<^sub>s \) = (x \\<^sub>s\<^sub>t\<^sub>p \ \\<^sub>s \)#(S \\<^sub>s\<^sub>t \ \\<^sub>s \)" by (metis strand_subst_hom(2)) + hence "... = (x \\<^sub>s\<^sub>t\<^sub>p \ \\<^sub>s \)#((S \\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>t \)" by (metis IH) + hence "... = ((x \\<^sub>s\<^sub>t\<^sub>p \) \\<^sub>s\<^sub>t\<^sub>p \)#((S \\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>t \)" using rm_vars_comp[OF *(2)] + proof (induction x) + case (Inequality X F) thus ?case + by (induct F) (auto simp add: subst_apply_pairs_def subst_apply_strand_step_def) + qed (simp_all add: subst_apply_strand_step_def) + thus ?case using IH by auto +qed (simp add: subst_apply_strand_def) + +lemma strand_substI[intro]: + "subst_domain \ \ fv\<^sub>s\<^sub>t S = {} \ S \\<^sub>s\<^sub>t \ = S" + "subst_domain \ \ vars\<^sub>s\<^sub>t S = {} \ S \\<^sub>s\<^sub>t \ = S" +proof - + show "subst_domain \ \ vars\<^sub>s\<^sub>t S = {} \ S \\<^sub>s\<^sub>t \ = S" + proof (induction S) + case (Cons x S) + hence "S \\<^sub>s\<^sub>t \ = S" by auto + moreover have "vars\<^sub>s\<^sub>t\<^sub>p x \ subst_domain \ = {}" using Cons.prems by auto + hence "x \\<^sub>s\<^sub>t\<^sub>p \ = x" + proof (induction x) + case (Inequality X F) thus ?case + by (induct F) (force simp add: subst_apply_pairs_def)+ + qed auto + ultimately show ?case by simp + qed (simp add: subst_apply_strand_def) + + show "subst_domain \ \ fv\<^sub>s\<^sub>t S = {} \ S \\<^sub>s\<^sub>t \ = S" + proof (induction S) + case (Cons x S) + hence "S \\<^sub>s\<^sub>t \ = S" by auto + moreover have "fv\<^sub>s\<^sub>t\<^sub>p x \ subst_domain \ = {}" + using Cons.prems by auto + hence "x \\<^sub>s\<^sub>t\<^sub>p \ = x" + proof (induction x) + case (Inequality X F) thus ?case + by (induct F) (force simp add: subst_apply_pairs_def)+ + qed auto + ultimately show ?case by simp + qed (simp add: subst_apply_strand_def) +qed + +lemma strand_substI': + "fv\<^sub>s\<^sub>t S = {} \ S \\<^sub>s\<^sub>t \ = S" + "vars\<^sub>s\<^sub>t S = {} \ S \\<^sub>s\<^sub>t \ = S" +by (metis inf_bot_right strand_substI(1), + metis inf_bot_right strand_substI(2)) + +lemma strand_subst_set: "(set (S \\<^sub>s\<^sub>t \)) = ((\x. x \\<^sub>s\<^sub>t\<^sub>p \) ` (set S))" +by (auto simp add: subst_apply_strand_def) + +lemma strand_map_inv_set_snd_rcv_subst: + assumes "finite (M::('a,'b) terms)" + shows "set ((map Send (inv set M)) \\<^sub>s\<^sub>t \) = Send ` (M \\<^sub>s\<^sub>e\<^sub>t \)" (is ?A) + "set ((map Receive (inv set M)) \\<^sub>s\<^sub>t \) = Receive ` (M \\<^sub>s\<^sub>e\<^sub>t \)" (is ?B) +proof - + { fix f::"('a,'b) term \ ('a,'b) strand_step" assume f: "f = Send \ f = Receive" + from assms have "set ((map f (inv set M)) \\<^sub>s\<^sub>t \) = f ` (M \\<^sub>s\<^sub>e\<^sub>t \)" + proof (induction rule: finite_induct) + case empty thus ?case unfolding inv_def by auto + next + case (insert m M) + have "set (map f (inv set (insert m M)) \\<^sub>s\<^sub>t \) = + insert (f m \\<^sub>s\<^sub>t\<^sub>p \) (set (map f (inv set M) \\<^sub>s\<^sub>t \))" + by (simp add: insert.hyps(1) inv_set_fset subst_apply_strand_def) + thus ?case using f insert.IH by auto + qed + } + thus "?A" "?B" by auto +qed + +lemma strand_ground_subst_vars_subset: + assumes "ground (subst_range \)" shows "vars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ vars\<^sub>s\<^sub>t S" +proof (induction S) + case (Cons x S) + have "vars\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) \ vars\<^sub>s\<^sub>t\<^sub>p x" using ground_subst_fv_subset[OF assms] + proof (cases x) + case (Inequality X F) + let ?\ = "rm_vars (set X) \" + have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" + proof (induction F) + case (Cons f F) + obtain t t' where f: "f = (t,t')" by (metis surj_pair) + hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (f#F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\) = fv (t \ ?\) \ fv (t' \ ?\) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\)" + "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (f#F) = fv t \ fv t' \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" + by (auto simp add: subst_apply_pairs_def) + thus ?case + using ground_subst_fv_subset[OF ground_subset[OF rm_vars_img_subset assms, of "set X"]] + Cons.IH + by (metis (no_types, lifting) Un_mono) + qed (simp add: subst_apply_pairs_def) + moreover have + "vars\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) \ set X" + "vars\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ set X" + using Inequality + by (auto simp add: subst_apply_pairs_def) + ultimately show ?thesis by auto + qed auto + thus ?case using Cons.IH by auto +qed (simp add: subst_apply_strand_def) + +lemma ik_union_subset: "\(P ` ik\<^sub>s\<^sub>t S) \ (\x \ (set S). \(P ` trms\<^sub>s\<^sub>t\<^sub>p x))" +by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto + +lemma ik_snd_empty[simp]: "ik\<^sub>s\<^sub>t (map Send X) = {}" +by (induct "map Send X" arbitrary: X rule: ik\<^sub>s\<^sub>t.induct) auto + +lemma ik_snd_empty'[simp]: "ik\<^sub>s\<^sub>t [Send t] = {}" by simp + +lemma ik_append[iff]: "ik\<^sub>s\<^sub>t (S@S') = ik\<^sub>s\<^sub>t S \ ik\<^sub>s\<^sub>t S'" by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto + +lemma ik_cons: "ik\<^sub>s\<^sub>t (x#S) = ik\<^sub>s\<^sub>t [x] \ ik\<^sub>s\<^sub>t S" using ik_append[of "[x]" S] by simp + +lemma assignment_rhs_append[iff]: "assignment_rhs\<^sub>s\<^sub>t (S@S') = assignment_rhs\<^sub>s\<^sub>t S \ assignment_rhs\<^sub>s\<^sub>t S'" +by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) auto + +lemma eqs_rcv_map_empty: "assignment_rhs\<^sub>s\<^sub>t (map Receive M) = {}" +by auto + +lemma ik_rcv_map: assumes "t \ set L" shows "t \ ik\<^sub>s\<^sub>t (map Receive L)" +proof - + { fix L L' + have "t \ ik\<^sub>s\<^sub>t [Receive t]" by auto + hence "t \ ik\<^sub>s\<^sub>t (map Receive L@Receive t#map Receive L')" using ik_append by auto + hence "t \ ik\<^sub>s\<^sub>t (map Receive (L@t#L'))" by auto + } + thus ?thesis using assms split_list_last by force +qed + +lemma ik_subst: "ik\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) = ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \" +by (induct rule: ik\<^sub>s\<^sub>t_induct) auto + +lemma ik_rcv_map': assumes "t \ ik\<^sub>s\<^sub>t (map Receive L)" shows "t \ set L" +using assms by force + +lemma ik_append_subset[simp]: "ik\<^sub>s\<^sub>t S \ ik\<^sub>s\<^sub>t (S@S')" "ik\<^sub>s\<^sub>t S' \ ik\<^sub>s\<^sub>t (S@S')" +by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto + +lemma assignment_rhs_append_subset[simp]: + "assignment_rhs\<^sub>s\<^sub>t S \ assignment_rhs\<^sub>s\<^sub>t (S@S')" + "assignment_rhs\<^sub>s\<^sub>t S' \ assignment_rhs\<^sub>s\<^sub>t (S@S')" +by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) auto + +lemma trms\<^sub>s\<^sub>t_cons: "trms\<^sub>s\<^sub>t (x#S) = trms\<^sub>s\<^sub>t\<^sub>p x \ trms\<^sub>s\<^sub>t S" by simp + +lemma trm_strand_subst_cong: + "t \ trms\<^sub>s\<^sub>t S \ t \ \ \ trms\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) + \ (\X F. Inequality X F \ set S \ t \ rm_vars (set X) \ \ trms\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \))" + (is "t \ trms\<^sub>s\<^sub>t S \ ?P t \ S") + "t \ trms\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ (\t'. t = t' \ \ \ t' \ trms\<^sub>s\<^sub>t S) + \ (\X F. Inequality X F \ set S \ (\t' \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. t = t' \ rm_vars (set X) \))" + (is "t \ trms\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ ?Q t \ S") +proof - + show "t \ trms\<^sub>s\<^sub>t S \ ?P t \ S" + proof (induction S) + case (Cons x S) show ?case + proof (cases "t \ trms\<^sub>s\<^sub>t S") + case True + hence "?P t \ S" using Cons by simp + thus ?thesis + by (cases x) + (metis (no_types, lifting) Un_iff list.set_intros(2) strand_subst_hom(2) trms\<^sub>s\<^sub>t_cons)+ + next + case False + hence "t \ trms\<^sub>s\<^sub>t\<^sub>p x" using Cons.prems by auto + thus ?thesis + proof (induction x) + case (Inequality X F) + hence "t \ rm_vars (set X) \ \ trms\<^sub>s\<^sub>t\<^sub>p (Inequality X F \\<^sub>s\<^sub>t\<^sub>p \)" + by (induct F) (auto simp add: subst_apply_pairs_def subst_apply_strand_step_def) + thus ?case by fastforce + qed (auto simp add: subst_apply_strand_step_def) + qed + qed simp + + show "t \ trms\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ ?Q t \ S" + proof (induction S) + case (Cons x S) show ?case + proof (cases "t \ trms\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)") + case True + hence "?Q t \ S" using Cons by simp + thus ?thesis by (cases x) force+ + next + case False + hence "t \ trms\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \)" using Cons.prems by auto + thus ?thesis + proof (induction x) + case (Inequality X F) + hence "t \ trms\<^sub>s\<^sub>t\<^sub>p (Inequality X F) \\<^sub>s\<^sub>e\<^sub>t rm_vars (set X) \" + by (induct F) (force simp add: subst_apply_pairs_def)+ + thus ?case by fastforce + qed (auto simp add: subst_apply_strand_step_def) + qed + qed simp +qed + + +subsection \Lemmata: Free Variables of Strands\ +lemma fv_trm_snd_rcv[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p (Send t)) = fv t" "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p (Receive t)) = fv t" +by simp_all + +lemma in_strand_fv_subset: "x \ set S \ vars\<^sub>s\<^sub>t\<^sub>p x \ vars\<^sub>s\<^sub>t S" by fastforce +lemma in_strand_fv_subset_snd: "Send t \ set S \ fv t \ \(set (map fv\<^sub>s\<^sub>n\<^sub>d S))" by auto +lemma in_strand_fv_subset_rcv: "Receive t \ set S \ fv t \ \(set (map fv\<^sub>r\<^sub>c\<^sub>v S))" by auto + +lemma fv\<^sub>s\<^sub>n\<^sub>dE: + assumes "v \ \(set (map fv\<^sub>s\<^sub>n\<^sub>d S))" + obtains t where "send\t\\<^sub>s\<^sub>t \ set S" "v \ fv t" +proof - + have "\t. send\t\\<^sub>s\<^sub>t \ set S \ v \ fv t" + by (metis (no_types, lifting) assms UN_E empty_iff set_map strand_step.case_eq_if + fv\<^sub>s\<^sub>n\<^sub>d_def strand_step.collapse(1)) + thus ?thesis by (metis that) +qed + +lemma fv\<^sub>r\<^sub>c\<^sub>vE: + assumes "v \ \(set (map fv\<^sub>r\<^sub>c\<^sub>v S))" + obtains t where "receive\t\\<^sub>s\<^sub>t \ set S" "v \ fv t" +proof - + have "\t. receive\t\\<^sub>s\<^sub>t \ set S \ v \ fv t" + by (metis (no_types, lifting) assms UN_E empty_iff set_map strand_step.case_eq_if + fv\<^sub>r\<^sub>c\<^sub>v_def strand_step.collapse(2)) + thus ?thesis by (metis that) +qed + +lemma vars\<^sub>s\<^sub>t\<^sub>pI[intro]: "x \ fv\<^sub>s\<^sub>t\<^sub>p s \ x \ vars\<^sub>s\<^sub>t\<^sub>p s" +by (induct s rule: fv\<^sub>s\<^sub>t\<^sub>p.induct) auto + +lemma vars\<^sub>s\<^sub>tI[intro]: "x \ fv\<^sub>s\<^sub>t S \ x \ vars\<^sub>s\<^sub>t S" using vars\<^sub>s\<^sub>t\<^sub>pI by fastforce + +lemma fv\<^sub>s\<^sub>t_subset_vars\<^sub>s\<^sub>t[simp]: "fv\<^sub>s\<^sub>t S \ vars\<^sub>s\<^sub>t S" using vars\<^sub>s\<^sub>tI by force + +lemma vars\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>t: "vars\<^sub>s\<^sub>t S = fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S" +proof (induction S) + case (Cons x S) thus ?case + proof (induction x) + case (Inequality X F) thus ?case by (induct F) auto + qed auto +qed simp + +lemma fv\<^sub>s\<^sub>t\<^sub>p_is_subterm_trms\<^sub>s\<^sub>t\<^sub>p: "x \ fv\<^sub>s\<^sub>t\<^sub>p a \ Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p a)" +using var_is_subterm by (cases a) force+ + +lemma fv\<^sub>s\<^sub>t_is_subterm_trms\<^sub>s\<^sub>t: "x \ fv\<^sub>s\<^sub>t A \ Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t A)" +proof (induction A) + case (Cons a A) thus ?case using fv\<^sub>s\<^sub>t\<^sub>p_is_subterm_trms\<^sub>s\<^sub>t\<^sub>p by (cases "x \ fv\<^sub>s\<^sub>t A") auto +qed simp + +lemma vars_st_snd_map: "vars\<^sub>s\<^sub>t (map Send X) = fv (Fun f X)" by auto + +lemma vars_st_rcv_map: "vars\<^sub>s\<^sub>t (map Receive X) = fv (Fun f X)" by auto + +lemma vars_snd_rcv_union: + "vars\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>n\<^sub>d x \ fv\<^sub>r\<^sub>c\<^sub>v x \ fv\<^sub>e\<^sub>q assign x \ fv\<^sub>e\<^sub>q check x \ fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x \ set (bvars\<^sub>s\<^sub>t\<^sub>p x)" +proof (cases x) + case (Equality ac t t') thus ?thesis by (cases ac) auto +qed auto + +lemma fv_snd_rcv_union: + "fv\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>s\<^sub>n\<^sub>d x \ fv\<^sub>r\<^sub>c\<^sub>v x \ fv\<^sub>e\<^sub>q assign x \ fv\<^sub>e\<^sub>q check x \ fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x" +proof (cases x) + case (Equality ac t t') thus ?thesis by (cases ac) auto +qed auto + +lemma fv_snd_rcv_empty[simp]: "fv\<^sub>s\<^sub>n\<^sub>d x = {} \ fv\<^sub>r\<^sub>c\<^sub>v x = {}" by (cases x) simp_all + +lemma vars_snd_rcv_strand[iff]: + "vars\<^sub>s\<^sub>t (S::('a,'b) strand) = + (\(set (map fv\<^sub>s\<^sub>n\<^sub>d S))) \ (\(set (map fv\<^sub>r\<^sub>c\<^sub>v S))) \ (\(set (map (fv\<^sub>e\<^sub>q assign) S))) + \ (\(set (map (fv\<^sub>e\<^sub>q check) S))) \ (\(set (map fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q S))) \ bvars\<^sub>s\<^sub>t S" +unfolding bvars\<^sub>s\<^sub>t_def +proof (induction S) + case (Cons x S) + have "\s V. vars\<^sub>s\<^sub>t\<^sub>p (s::('a,'b) strand_step) \ V = + fv\<^sub>s\<^sub>n\<^sub>d s \ fv\<^sub>r\<^sub>c\<^sub>v s \ fv\<^sub>e\<^sub>q assign s \ fv\<^sub>e\<^sub>q check s \ fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q s \ set (bvars\<^sub>s\<^sub>t\<^sub>p s) \ V" + by (metis vars_snd_rcv_union) + thus ?case using Cons.IH by (auto simp add: sup_assoc sup_left_commute) +qed simp + +lemma fv_snd_rcv_strand[iff]: + "fv\<^sub>s\<^sub>t (S::('a,'b) strand) = + (\(set (map fv\<^sub>s\<^sub>n\<^sub>d S))) \ (\(set (map fv\<^sub>r\<^sub>c\<^sub>v S))) \ (\(set (map (fv\<^sub>e\<^sub>q assign) S))) + \ (\(set (map (fv\<^sub>e\<^sub>q check) S))) \ (\(set (map fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q S)))" +unfolding bvars\<^sub>s\<^sub>t_def +proof (induction S) + case (Cons x S) + have "\s V. fv\<^sub>s\<^sub>t\<^sub>p (s::('a,'b) strand_step) \ V = + fv\<^sub>s\<^sub>n\<^sub>d s \ fv\<^sub>r\<^sub>c\<^sub>v s \ fv\<^sub>e\<^sub>q assign s \ fv\<^sub>e\<^sub>q check s \ fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q s \ V" + by (metis fv_snd_rcv_union) + thus ?case using Cons.IH by (auto simp add: sup_assoc sup_left_commute) +qed simp + +lemma vars_snd_rcv_strand2[iff]: + "wfrestrictedvars\<^sub>s\<^sub>t (S::('a,'b) strand) = + (\(set (map fv\<^sub>s\<^sub>n\<^sub>d S))) \ (\(set (map fv\<^sub>r\<^sub>c\<^sub>v S))) \ (\(set (map (fv\<^sub>e\<^sub>q assign) S)))" +by (induct S) (auto simp add: split: strand_step.split poscheckvariant.split) + +lemma fv_snd_rcv_strand_subset[simp]: + "\(set (map fv\<^sub>s\<^sub>n\<^sub>d S)) \ fv\<^sub>s\<^sub>t S" "\(set (map fv\<^sub>r\<^sub>c\<^sub>v S)) \ fv\<^sub>s\<^sub>t S" + "\(set (map (fv\<^sub>e\<^sub>q ac) S)) \ fv\<^sub>s\<^sub>t S" "\(set (map fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q S)) \ fv\<^sub>s\<^sub>t S" + "wfvarsoccs\<^sub>s\<^sub>t S \ fv\<^sub>s\<^sub>t S" +proof - + show "\(set (map fv\<^sub>s\<^sub>n\<^sub>d S)) \ fv\<^sub>s\<^sub>t S" "\(set (map fv\<^sub>r\<^sub>c\<^sub>v S)) \ fv\<^sub>s\<^sub>t S" "\(set (map fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q S)) \ fv\<^sub>s\<^sub>t S" + using fv_snd_rcv_strand[of S] by auto + + show "\(set (map (fv\<^sub>e\<^sub>q ac) S)) \ fv\<^sub>s\<^sub>t S" + by (induct S) (auto split: strand_step.split poscheckvariant.split) + + show "wfvarsoccs\<^sub>s\<^sub>t S \ fv\<^sub>s\<^sub>t S" + by (induct S) (auto split: strand_step.split poscheckvariant.split) +qed + +lemma vars_snd_rcv_strand_subset2[simp]: + "\(set (map fv\<^sub>s\<^sub>n\<^sub>d S)) \ wfrestrictedvars\<^sub>s\<^sub>t S" "\(set (map fv\<^sub>r\<^sub>c\<^sub>v S)) \ wfrestrictedvars\<^sub>s\<^sub>t S" + "\(set (map (fv\<^sub>e\<^sub>q assign) S)) \ wfrestrictedvars\<^sub>s\<^sub>t S" "wfvarsoccs\<^sub>s\<^sub>t S \ wfrestrictedvars\<^sub>s\<^sub>t S" +by (induction S) (auto split: strand_step.split poscheckvariant.split) + +lemma wfrestrictedvars\<^sub>s\<^sub>t_subset_vars\<^sub>s\<^sub>t: "wfrestrictedvars\<^sub>s\<^sub>t S \ vars\<^sub>s\<^sub>t S" +by (induction S) (auto split: strand_step.split poscheckvariant.split) + +lemma subst_sends_strand_step_fv_to_img: "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) \ fv\<^sub>s\<^sub>t\<^sub>p x \ range_vars \" +using subst_sends_fv_to_img[of _ \] +proof (cases x) + case (Inequality X F) + let ?\ = "rm_vars (set X) \" + have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ range_vars ?\" + proof (induction F) + case (Cons f F) thus ?case + using subst_sends_fv_to_img[of _ ?\] + by (auto simp add: subst_apply_pairs_def) + qed (auto simp add: subst_apply_pairs_def) + hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ range_vars \" + using rm_vars_img_subset[of "set X" \] fv_set_mono + unfolding range_vars_alt_def by blast+ + thus ?thesis using Inequality by (auto simp add: subst_apply_strand_step_def) +qed (auto simp add: subst_apply_strand_step_def) + +lemma subst_sends_strand_fv_to_img: "fv\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>t S \ range_vars \" +proof (induction S) + case (Cons x S) + have *: "fv\<^sub>s\<^sub>t (x#S \\<^sub>s\<^sub>t \) = fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) \ fv\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" + "fv\<^sub>s\<^sub>t (x#S) \ range_vars \ = fv\<^sub>s\<^sub>t\<^sub>p x \ fv\<^sub>s\<^sub>t S \ range_vars \" + by auto + thus ?case using Cons.IH subst_sends_strand_step_fv_to_img[of x \] by auto +qed simp + +lemma ineq_apply_subst: + assumes "subst_domain \ \ set X = {}" + shows "(Inequality X F) \\<^sub>s\<^sub>t\<^sub>p \ = Inequality X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" +using rm_vars_apply'[OF assms] by (simp add: subst_apply_strand_step_def) + +lemma fv_strand_step_subst: + assumes "P = fv\<^sub>s\<^sub>t\<^sub>p \ P = fv\<^sub>r\<^sub>c\<^sub>v \ P = fv\<^sub>s\<^sub>n\<^sub>d \ P = fv\<^sub>e\<^sub>q ac \ P = fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q" + and "set (bvars\<^sub>s\<^sub>t\<^sub>p x) \ (subst_domain \ \ range_vars \) = {}" + shows "fv\<^sub>s\<^sub>e\<^sub>t (\ ` (P x)) = P (x \\<^sub>s\<^sub>t\<^sub>p \)" +proof (cases x) + case (Send t) + hence "vars\<^sub>s\<^sub>t\<^sub>p x = fv t" "fv\<^sub>s\<^sub>n\<^sub>d x = fv t" by auto + thus ?thesis using assms Send subst_apply_fv_unfold[of _ \] by auto +next + case (Receive t) + hence "vars\<^sub>s\<^sub>t\<^sub>p x = fv t" "fv\<^sub>r\<^sub>c\<^sub>v x = fv t" by auto + thus ?thesis using assms Receive subst_apply_fv_unfold[of _ \] by auto +next + case (Equality ac' t t') show ?thesis + proof (cases "ac = ac'") + case True + hence "vars\<^sub>s\<^sub>t\<^sub>p x = fv t \ fv t'" "fv\<^sub>e\<^sub>q ac x = fv t \ fv t'" + using Equality + by auto + thus ?thesis + using assms Equality subst_apply_fv_unfold[of _ \] True + by auto + next + case False + hence "vars\<^sub>s\<^sub>t\<^sub>p x = fv t \ fv t'" "fv\<^sub>e\<^sub>q ac x = {}" + using Equality + by auto + thus ?thesis + using assms Equality subst_apply_fv_unfold[of _ \] False + by auto + qed +next + case (Inequality X F) + hence 1: "set X \ (subst_domain \ \ range_vars \) = {}" + "x \\<^sub>s\<^sub>t\<^sub>p \ = Inequality X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + "rm_vars (set X) \ = \" + using assms ineq_apply_subst[of \ X F] rm_vars_apply'[of \ "set X"] + unfolding range_vars_alt_def by force+ + + have 2: "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" using Inequality by auto + hence "fv\<^sub>s\<^sub>e\<^sub>t (\ ` fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x) = fv\<^sub>s\<^sub>e\<^sub>t (\ ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X" + using fv\<^sub>s\<^sub>e\<^sub>t_subst_img_eq[OF 1(1), of "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"] by simp + hence 3: "fv\<^sub>s\<^sub>e\<^sub>t (\ ` fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X" by (metis fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_step_subst) + + have 4: "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X" using 1(2) by auto + + show ?thesis + using assms(1) Inequality subst_apply_fv_unfold[of _ \] 1(2) 2 3 4 + unfolding fv\<^sub>e\<^sub>q_def fv\<^sub>r\<^sub>c\<^sub>v_def fv\<^sub>s\<^sub>n\<^sub>d_def + by (metis (no_types) Sup_empty image_empty fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.simps fv\<^sub>s\<^sub>e\<^sub>t.simps + fv\<^sub>s\<^sub>t\<^sub>p.simps(4) strand_step.simps(20)) +qed + +lemma fv_strand_subst: + assumes "P = fv\<^sub>s\<^sub>t\<^sub>p \ P = fv\<^sub>r\<^sub>c\<^sub>v \ P = fv\<^sub>s\<^sub>n\<^sub>d \ P = fv\<^sub>e\<^sub>q ac \ P = fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q" + and "bvars\<^sub>s\<^sub>t S \ (subst_domain \ \ range_vars \) = {}" + shows "fv\<^sub>s\<^sub>e\<^sub>t (\ ` (\(set (map P S)))) = \(set (map P (S \\<^sub>s\<^sub>t \)))" +using assms(2) +proof (induction S) + case (Cons x S) + hence *: "bvars\<^sub>s\<^sub>t S \ (subst_domain \ \ range_vars \) = {}" + "set (bvars\<^sub>s\<^sub>t\<^sub>p x) \ (subst_domain \ \ range_vars \) = {}" + unfolding bvars\<^sub>s\<^sub>t_def by force+ + hence **: "fv\<^sub>s\<^sub>e\<^sub>t (\ ` P x) = P (x \\<^sub>s\<^sub>t\<^sub>p \)" using fv_strand_step_subst[OF assms(1), of x \] by auto + have "fv\<^sub>s\<^sub>e\<^sub>t (\ ` (\(set (map P (x#S))))) = fv\<^sub>s\<^sub>e\<^sub>t (\ ` P x) \ (\(set (map P ((S \\<^sub>s\<^sub>t \)))))" + using Cons unfolding range_vars_alt_def bvars\<^sub>s\<^sub>t_def by force + hence "fv\<^sub>s\<^sub>e\<^sub>t (\ ` (\(set (map P (x#S))))) = P (x \\<^sub>s\<^sub>t\<^sub>p \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` (\(set (map P S))))" + using ** by simp + thus ?case using Cons.IH[OF *(1)] unfolding bvars\<^sub>s\<^sub>t_def by simp +qed simp + +lemma fv_strand_subst2: + assumes "bvars\<^sub>s\<^sub>t S \ (subst_domain \ \ range_vars \) = {}" + shows "fv\<^sub>s\<^sub>e\<^sub>t (\ ` (wfrestrictedvars\<^sub>s\<^sub>t S)) = wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" +by (metis (no_types, lifting) assms fv\<^sub>s\<^sub>e\<^sub>t.simps vars_snd_rcv_strand2 fv_strand_subst UN_Un image_Un) + +lemma fv_strand_subst': + assumes "bvars\<^sub>s\<^sub>t S \ (subst_domain \ \ range_vars \) = {}" + shows "fv\<^sub>s\<^sub>e\<^sub>t (\ ` (fv\<^sub>s\<^sub>t S)) = fv\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" +by (metis assms fv_strand_subst fv\<^sub>s\<^sub>t_def) + +lemma fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s: + "fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" +by auto + +lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_in_fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s: "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ x \ fv\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F)" +using fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of F] by blast + +lemma trms\<^sub>s\<^sub>t_append: "trms\<^sub>s\<^sub>t (A@B) = trms\<^sub>s\<^sub>t A \ trms\<^sub>s\<^sub>t B" +by auto + +lemma trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst: "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (a \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) = trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s a \\<^sub>s\<^sub>e\<^sub>t \" +by (auto simp add: subst_apply_pairs_def) + +lemma trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fv_subst_subset: + "t \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ fv (t \ \) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" +by (force simp add: subst_apply_pairs_def) + +lemma trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_fv_subst_subset': + fixes t::"('a,'b) term" and \::"('a,'b) subst" + assumes "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F)" + shows "fv (t \ \) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" +proof - + { fix x assume "x \ fv t" + hence "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" + using fv_subset[OF assms] fv_subterms_set[of "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"] fv_trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_is_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s[of F] + by blast + hence "fv (\ x) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_fv_subset by fast + } thus ?thesis by (meson fv_subst_obtain_var subset_iff) +qed + +lemma trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_funs_term_cases: + assumes "t \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" "f \ funs_term t" + shows "(\u \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. f \ funs_term u) \ (\x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. f \ funs_term (\ x))" +using assms(1) +proof (induction F) + case (Cons g F) + obtain s u where g: "g = (s,u)" by (metis surj_pair) + show ?case + proof (cases "t \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)") + case False + thus ?thesis + using assms(2) Cons.prems g funs_term_subst[of _ \] + by (auto simp add: subst_apply_pairs_def) + qed (use Cons.IH in fastforce) +qed simp + +lemma trm\<^sub>s\<^sub>t\<^sub>p_subst: + assumes "subst_domain \ \ set (bvars\<^sub>s\<^sub>t\<^sub>p a) = {}" + shows "trms\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>t\<^sub>p \) = trms\<^sub>s\<^sub>t\<^sub>p a \\<^sub>s\<^sub>e\<^sub>t \" +proof - + have "rm_vars (set (bvars\<^sub>s\<^sub>t\<^sub>p a)) \ = \" using assms by force + thus ?thesis + using assms + by (auto simp add: subst_apply_pairs_def subst_apply_strand_step_def + split: strand_step.splits) +qed + +lemma trms\<^sub>s\<^sub>t_subst: + assumes "subst_domain \ \ bvars\<^sub>s\<^sub>t A = {}" + shows "trms\<^sub>s\<^sub>t (A \\<^sub>s\<^sub>t \) = trms\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \" +using assms +proof (induction A) + case (Cons a A) + have 1: "subst_domain \ \ bvars\<^sub>s\<^sub>t A = {}" "subst_domain \ \ set (bvars\<^sub>s\<^sub>t\<^sub>p a) = {}" + using Cons.prems by auto + hence IH: "trms\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \ = trms\<^sub>s\<^sub>t (A \\<^sub>s\<^sub>t \)" using Cons.IH by simp + + have "trms\<^sub>s\<^sub>t (a#A) = trms\<^sub>s\<^sub>t\<^sub>p a \ trms\<^sub>s\<^sub>t A" by auto + hence 2: "trms\<^sub>s\<^sub>t (a#A) \\<^sub>s\<^sub>e\<^sub>t \ = (trms\<^sub>s\<^sub>t\<^sub>p a \\<^sub>s\<^sub>e\<^sub>t \) \ (trms\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \)" by (metis image_Un) + + have "trms\<^sub>s\<^sub>t (a#A \\<^sub>s\<^sub>t \) = (trms\<^sub>s\<^sub>t\<^sub>p (a \\<^sub>s\<^sub>t\<^sub>p \)) \ trms\<^sub>s\<^sub>t (A \\<^sub>s\<^sub>t \)" + by (auto simp add: subst_apply_strand_def) + hence 3: "trms\<^sub>s\<^sub>t (a#A \\<^sub>s\<^sub>t \) = (trms\<^sub>s\<^sub>t\<^sub>p a \\<^sub>s\<^sub>e\<^sub>t \) \ trms\<^sub>s\<^sub>t (A \\<^sub>s\<^sub>t \)" + using trm\<^sub>s\<^sub>t\<^sub>p_subst[OF 1(2)] by auto + + show ?case using IH 2 3 by metis +qed (simp add: subst_apply_strand_def) + +lemma strand_map_set_subst: + assumes \: "bvars\<^sub>s\<^sub>t S \ (subst_domain \ \ range_vars \) = {}" + shows "\(set (map trms\<^sub>s\<^sub>t\<^sub>p (S \\<^sub>s\<^sub>t \))) = (\(set (map trms\<^sub>s\<^sub>t\<^sub>p S))) \\<^sub>s\<^sub>e\<^sub>t \" +using assms +proof (induction S) + case (Cons x S) + hence "bvars\<^sub>s\<^sub>t [x] \ subst_domain \ = {}" "bvars\<^sub>s\<^sub>t S \ (subst_domain \ \ range_vars \) = {}" + unfolding bvars\<^sub>s\<^sub>t_def by force+ + hence *: "subst_domain \ \ set (bvars\<^sub>s\<^sub>t\<^sub>p x) = {}" + "\(set (map trms\<^sub>s\<^sub>t\<^sub>p (S \\<^sub>s\<^sub>t \))) = \(set (map trms\<^sub>s\<^sub>t\<^sub>p S)) \\<^sub>s\<^sub>e\<^sub>t \" + using Cons.IH(1) bvars\<^sub>s\<^sub>t_singleton[of x] by auto + hence "trms\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = (trms\<^sub>s\<^sub>t\<^sub>p x) \\<^sub>s\<^sub>e\<^sub>t \" + proof (cases x) + case (Inequality X F) + thus ?thesis + using rm_vars_apply'[of \ "set X"] * + by (metis (no_types, lifting) image_cong trm\<^sub>s\<^sub>t\<^sub>p_subst) + qed simp_all + thus ?case using * subst_all_insert by auto +qed simp + +lemma subst_apply_fv_subset_strand_trm: + assumes P: "P = fv\<^sub>s\<^sub>t\<^sub>p \ P = fv\<^sub>r\<^sub>c\<^sub>v \ P = fv\<^sub>s\<^sub>n\<^sub>d \ P = fv\<^sub>e\<^sub>q ac \ P = fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q" + and fv_sub: "fv t \ \(set (map P S)) \ V" + and \: "bvars\<^sub>s\<^sub>t S \ (subst_domain \ \ range_vars \) = {}" + shows "fv (t \ \) \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" +using fv_strand_subst[OF P \] subst_apply_fv_subset[OF fv_sub, of \] by force + +lemma subst_apply_fv_subset_strand_trm2: + assumes fv_sub: "fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" + and \: "bvars\<^sub>s\<^sub>t S \ (subst_domain \ \ range_vars \) = {}" + shows "fv (t \ \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" +using fv_strand_subst2[OF \] subst_apply_fv_subset[OF fv_sub, of \] by force + +lemma subst_apply_fv_subset_strand: + assumes P: "P = fv\<^sub>s\<^sub>t\<^sub>p \ P = fv\<^sub>r\<^sub>c\<^sub>v \ P = fv\<^sub>s\<^sub>n\<^sub>d \ P = fv\<^sub>e\<^sub>q ac \ P = fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q" + and P_subset: "P x \ \(set (map P S)) \ V" + and \: "bvars\<^sub>s\<^sub>t S \ (subst_domain \ \ range_vars \) = {}" + "set (bvars\<^sub>s\<^sub>t\<^sub>p x) \ (subst_domain \ \ range_vars \) = {}" + shows "P (x \\<^sub>s\<^sub>t\<^sub>p \) \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" +proof (cases x) + case (Send t) + hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv t" "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>s\<^sub>n\<^sub>d x = fv t" "fv\<^sub>s\<^sub>n\<^sub>d (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + by auto + hence **: "(P x = fv t \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)) \ (P x = {} \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = {})" by (metis P) + moreover + { assume "P x = {}" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" hence ?thesis by simp } + moreover + { assume "P x = fv t" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + hence "fv t \ \(set (map P S)) \ V" using P_subset by auto + hence "fv (t \ \) \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + unfolding vars\<^sub>s\<^sub>t_def using P subst_apply_fv_subset_strand_trm assms by blast + hence ?thesis using \P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)\ by force + } + ultimately show ?thesis by metis +next + case (Receive t) + hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv t" "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "fv\<^sub>r\<^sub>c\<^sub>v x = fv t" "fv\<^sub>r\<^sub>c\<^sub>v (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + by auto + hence **: "(P x = fv t \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)) \ (P x = {} \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = {})" by (metis P) + moreover + { assume "P x = {}" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" hence ?thesis by simp } + moreover + { assume "P x = fv t" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + hence "fv t \ \(set (map P S)) \ V" using P_subset by auto + hence "fv (t \ \) \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + unfolding vars\<^sub>s\<^sub>t_def using P subst_apply_fv_subset_strand_trm assms by blast + hence ?thesis using \P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)\ by blast + } + ultimately show ?thesis by metis +next + case (Equality ac' t t') show ?thesis + proof (cases "ac' = ac") + case True + hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv t \ fv t'" "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)" + "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>e\<^sub>q ac x = fv t \ fv t'" "fv\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)" + "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + using Equality by auto + hence **: "(P x = fv t \ fv t' \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)) + \ (P x = {} \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = {})" + by (metis P) + moreover + { assume "P x = {}" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" hence ?thesis by simp } + moreover + { assume "P x = fv t \ fv t'" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)" + hence "fv t \ \(set (map P S)) \ V" "fv t' \ \(set (map P S)) \ V" using P_subset by auto + hence "fv (t \ \) \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + "fv (t' \ \) \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + unfolding vars\<^sub>s\<^sub>t_def using P subst_apply_fv_subset_strand_trm assms by metis+ + hence ?thesis using \P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)\ by blast + } + ultimately show ?thesis by metis + next + case False + hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv t \ fv t'" "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)" + "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + using Equality by auto + hence **: "(P x = fv t \ fv t' \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)) + \ (P x = {} \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = {})" + by (metis P) + moreover + { assume "P x = {}" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" hence ?thesis by simp } + moreover + { assume "P x = fv t \ fv t'" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)" + hence "fv t \ \(set (map P S)) \ V" "fv t' \ \(set (map P S)) \ V" using P_subset by auto + hence "fv (t \ \) \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + "fv (t' \ \) \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + unfolding vars\<^sub>s\<^sub>t_def using P subst_apply_fv_subset_strand_trm assms by metis+ + hence ?thesis using \P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)\ by blast + } + ultimately show ?thesis by metis + qed +next + case (Inequality X F) + hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X" + "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" + "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X" + using \(2) ineq_apply_subst[of \ X F] by force+ + hence **: "(P x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X) + \ (P x = {} \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = {})" + by (metis P) + moreover + { assume "P x = {}" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" hence ?thesis by simp } + moreover + { assume "P x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X" + hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \ \(set (map P S)) \ V" + using P_subset by auto + hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ set X))" + proof (induction F) + case (Cons f G) + hence IH: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ set X))" + by (metis (no_types, lifting) Diff_subset_conv UN_insert le_sup_iff + list.simps(15) fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.simps) + obtain t t' where f: "f = (t,t')" by (metis surj_pair) + hence "fv t \ \(set (map P S)) \ (V \ set X)" "fv t' \ \(set (map P S)) \ (V \ set X)" + using Cons.prems by auto + hence "fv (t \ \) \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ set X))" + "fv (t' \ \) \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ set X))" + using subst_apply_fv_subset_strand_trm[OF P _ assms(3)] + by blast+ + thus ?case using f IH by (auto simp add: subst_apply_pairs_def) + qed (simp add: subst_apply_pairs_def) + moreover have "fv\<^sub>s\<^sub>e\<^sub>t (\ ` set X) = set X" using assms(4) Inequality by force + ultimately have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X \ \(set (map P (S \\<^sub>s\<^sub>t \))) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + by auto + hence ?thesis using \P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X\ by blast + } + ultimately show ?thesis by metis +qed + +lemma subst_apply_fv_subset_strand2: + assumes P: "P = fv\<^sub>s\<^sub>t\<^sub>p \ P = fv\<^sub>r\<^sub>c\<^sub>v \ P = fv\<^sub>s\<^sub>n\<^sub>d \ P = fv\<^sub>e\<^sub>q ac \ P = fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q \ P = fv_r\<^sub>e\<^sub>q ac" + and P_subset: "P x \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" + and \: "bvars\<^sub>s\<^sub>t S \ (subst_domain \ \ range_vars \) = {}" + "set (bvars\<^sub>s\<^sub>t\<^sub>p x) \ (subst_domain \ \ range_vars \) = {}" + shows "P (x \\<^sub>s\<^sub>t\<^sub>p \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" +proof (cases x) + case (Send t) + hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv t" "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>s\<^sub>n\<^sub>d x = fv t" "fv\<^sub>s\<^sub>n\<^sub>d (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv_r\<^sub>e\<^sub>q ac x = {}" "fv_r\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + by auto + hence **: "(P x = fv t \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)) \ (P x = {} \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = {})" by (metis P) + moreover + { assume "P x = {}" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" hence ?thesis by simp } + moreover + { assume "P x = fv t" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + hence "fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" using P_subset by auto + hence "fv (t \ \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using P subst_apply_fv_subset_strand_trm2 assms by blast + hence ?thesis using \P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)\ by blast + } + ultimately show ?thesis by metis +next + case (Receive t) + hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv t" "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "fv\<^sub>r\<^sub>c\<^sub>v x = fv t" "fv\<^sub>r\<^sub>c\<^sub>v (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv_r\<^sub>e\<^sub>q ac x = {}" "fv_r\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + by auto + hence **: "(P x = fv t \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)) \ (P x = {} \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = {})" by (metis P) + moreover + { assume "P x = {}" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" hence ?thesis by simp } + moreover + { assume "P x = fv t" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + hence "fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" using P_subset by auto + hence "fv (t \ \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using P subst_apply_fv_subset_strand_trm2 assms by blast + hence ?thesis using \P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)\ by blast + } + ultimately show ?thesis by metis +next + case (Equality ac' t t') show ?thesis + proof (cases "ac' = ac") + case True + hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv t \ fv t'" "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)" + "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>e\<^sub>q ac x = fv t \ fv t'" "fv\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)" + "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv_r\<^sub>e\<^sub>q ac x = fv t'" "fv_r\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t' \ \)" + using Equality by auto + hence **: "(P x = fv t \ fv t' \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)) + \ (P x = {} \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = {}) + \ (P x = fv t' \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t' \ \))" + by (metis P) + moreover + { assume "P x = {}" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" hence ?thesis by simp } + moreover + { assume "P x = fv t \ fv t'" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)" + hence "fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" "fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" using P_subset by auto + hence "fv (t \ \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + "fv (t' \ \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using P subst_apply_fv_subset_strand_trm2 assms by blast+ + hence ?thesis using \P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)\ by blast + } + moreover + { assume "P x = fv t'" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t' \ \)" + hence "fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" using P_subset by auto + hence "fv (t' \ \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using P subst_apply_fv_subset_strand_trm2 assms by blast+ + hence ?thesis using \P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t' \ \)\ by blast + } + ultimately show ?thesis by metis + next + case False + hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv t \ fv t'" "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)" + "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = {}" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv_r\<^sub>e\<^sub>q ac x = {}" "fv_r\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + using Equality by auto + hence **: "(P x = fv t \ fv t' \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)) + \ (P x = {} \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = {}) + \ (P x = fv t' \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t' \ \))" + by (metis P) + moreover + { assume "P x = {}" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" hence ?thesis by simp } + moreover + { assume "P x = fv t \ fv t'" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)" + hence "fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" "fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" + using P_subset by auto + hence "fv (t \ \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + "fv (t' \ \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using P subst_apply_fv_subset_strand_trm2 assms by blast+ + hence ?thesis using \P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)\ by blast + } + moreover + { assume "P x = fv t'" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t' \ \)" + hence "fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" using P_subset by auto + hence "fv (t' \ \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using P subst_apply_fv_subset_strand_trm2 assms by blast+ + hence ?thesis using \P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv (t' \ \)\ by blast + } + ultimately show ?thesis by metis + qed +next + case (Inequality X F) + hence *: "fv\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X" + "fv\<^sub>r\<^sub>c\<^sub>v x = {}" "fv\<^sub>r\<^sub>c\<^sub>v (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>s\<^sub>n\<^sub>d x = {}" "fv\<^sub>s\<^sub>n\<^sub>d (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>e\<^sub>q ac x = {}" "fv\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" "fv\<^sub>i\<^sub>n\<^sub>e\<^sub>q (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X" + "fv_r\<^sub>e\<^sub>q ac x = {}" "fv_r\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" + using \(2) ineq_apply_subst[of \ X F] by force+ + hence **: "(P x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X) + \ (P x = {} \ P (x \\<^sub>s\<^sub>t\<^sub>p \) = {})" + by (metis P) + moreover + { assume "P x = {}" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = {}" hence ?thesis by simp } + moreover + { assume "P x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" "P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X" + hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" using P_subset by auto + hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ set X))" + proof (induction F) + case (Cons f G) + hence IH: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ set X))" + by (metis (no_types, lifting) Diff_subset_conv UN_insert le_sup_iff + list.simps(15) fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s.simps) + obtain t t' where f: "f = (t,t')" by (metis surj_pair) + hence "fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ (V \ set X)" "fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S \ (V \ set X)" + using Cons.prems by auto + hence "fv (t \ \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ set X))" + "fv (t' \ \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ set X))" + using subst_apply_fv_subset_strand_trm2[OF _ assms(3)] P + by blast+ + thus ?case using f IH by (auto simp add: subst_apply_pairs_def) + qed (simp add: subst_apply_pairs_def) + moreover have "fv\<^sub>s\<^sub>e\<^sub>t (\ ` set X) = set X" using assms(4) Inequality by force + ultimately have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + by fastforce + hence ?thesis using \P (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) - set X\ by blast + } + ultimately show ?thesis by metis +qed + +lemma strand_subst_fv_bounded_if_img_bounded: + assumes "range_vars \ \ fv\<^sub>s\<^sub>t S" + shows "fv\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>t S" +using subst_sends_strand_fv_to_img[of S \] assms by blast + +lemma strand_fv_subst_subset_if_subst_elim: + assumes "subst_elim \ v" and "v \ fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S \ (subst_domain \ \ range_vars \) = {}" + shows "v \ fv\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" +proof (cases "v \ fv\<^sub>s\<^sub>t S") + case True thus ?thesis + proof (induction S) + case (Cons x S) + have *: "v \ fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \)" + using assms(1) + proof (cases x) + case (Inequality X F) + hence "subst_elim (rm_vars (set X) \) v \ v \ set X" using assms(1) by blast + moreover have "fv\<^sub>s\<^sub>t\<^sub>p (Inequality X F \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \) - set X" + using Inequality by auto + ultimately have "v \ fv\<^sub>s\<^sub>t\<^sub>p (Inequality X F \\<^sub>s\<^sub>t\<^sub>p \)" + by (induct F) (auto simp add: subst_elim_def subst_apply_pairs_def) + thus ?thesis using Inequality by simp + qed (simp_all add: subst_elim_def) + moreover have "v \ fv\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" using Cons.IH + proof (cases "v \ fv\<^sub>s\<^sub>t S") + case False + moreover have "v \ range_vars \" + by (simp add: subst_elimD''[OF assms(1)] range_vars_alt_def) + ultimately show ?thesis by (meson UnE subsetCE subst_sends_strand_fv_to_img) + qed simp + ultimately show ?case by auto + qed simp +next + case False + thus ?thesis + using assms fv_strand_subst' + unfolding subst_elim_def + by (metis (mono_tags, hide_lams) fv\<^sub>s\<^sub>e\<^sub>t.simps imageE mem_simps(8) subst_apply_term.simps(1)) +qed + +lemma strand_fv_subst_subset_if_subst_elim': + assumes "subst_elim \ v" "v \ fv\<^sub>s\<^sub>t S" "range_vars \ \ fv\<^sub>s\<^sub>t S" + shows "fv\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>t S" +using strand_fv_subst_subset_if_subst_elim[OF assms(1)] assms(2) + strand_subst_fv_bounded_if_img_bounded[OF assms(3)] +by blast + +lemma fv_ik_is_fv_rcv: "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t S) = \(set (map fv\<^sub>r\<^sub>c\<^sub>v S))" +by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto + +lemma fv_ik_subset_fv_st[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t S) \ wfrestrictedvars\<^sub>s\<^sub>t S" +by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto + +lemma fv_assignment_rhs_subset_fv_st[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (assignment_rhs\<^sub>s\<^sub>t S) \ wfrestrictedvars\<^sub>s\<^sub>t S" +by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) force+ + +lemma fv_ik_subset_fv_st'[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t S) \ fv\<^sub>s\<^sub>t S" +by (induct S rule: ik\<^sub>s\<^sub>t.induct) auto + +lemma ik\<^sub>s\<^sub>t_var_is_fv: "Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t A) \ x \ fv\<^sub>s\<^sub>t A" +by (meson fv_ik_subset_fv_st'[of A] fv_subset_subterms subsetCE term.set_intros(3)) + +lemma fv_assignment_rhs_subset_fv_st'[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (assignment_rhs\<^sub>s\<^sub>t S) \ fv\<^sub>s\<^sub>t S" +by (induct S rule: assignment_rhs\<^sub>s\<^sub>t.induct) auto + +lemma ik\<^sub>s\<^sub>t_assignment_rhs\<^sub>s\<^sub>t_wfrestrictedvars_subset: + "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>s\<^sub>t A) \ wfrestrictedvars\<^sub>s\<^sub>t A" +using fv_ik_subset_fv_st[of A] fv_assignment_rhs_subset_fv_st[of A] +by simp+ + +lemma strand_step_id_subst[iff]: "x \\<^sub>s\<^sub>t\<^sub>p Var = x" by (cases x) auto + +lemma strand_id_subst[iff]: "S \\<^sub>s\<^sub>t Var = S" using strand_step_id_subst by (induct S) auto + +lemma strand_subst_vars_union_bound[simp]: "vars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ vars\<^sub>s\<^sub>t S \ range_vars \" +proof (induction S) + case (Cons x S) + moreover have "vars\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) \ vars\<^sub>s\<^sub>t\<^sub>p x \ range_vars \" using subst_sends_fv_to_img[of _ \] + proof (cases x) + case (Inequality X F) + define \' where "\' \ rm_vars (set X) \" + have 0: "range_vars \' \ range_vars \" + using rm_vars_img[of "set X" \] + by (auto simp add: \'_def subst_domain_def range_vars_alt_def) + + have "vars\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \') \ set X" "vars\<^sub>s\<^sub>t\<^sub>p x = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ set X" + using Inequality by (auto simp add: \'_def) + moreover have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \') \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ range_vars \" + proof (induction F) + case (Cons f G) + obtain t t' where f: "f = (t,t')" by moura + hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (f#G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \') = fv (t \ \') \ fv (t' \ \') \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \')" + "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (f#G) = fv t \ fv t' \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" + by (auto simp add: subst_apply_pairs_def) + thus ?case + using 0 Cons.IH subst_sends_fv_to_img[of t \'] subst_sends_fv_to_img[of t' \'] + unfolding f by auto + qed (simp add: subst_apply_pairs_def) + ultimately show ?thesis by auto + qed auto + ultimately show ?case by auto +qed simp + +lemma strand_vars_split: + "vars\<^sub>s\<^sub>t (S@S') = vars\<^sub>s\<^sub>t S \ vars\<^sub>s\<^sub>t S'" + "wfrestrictedvars\<^sub>s\<^sub>t (S@S') = wfrestrictedvars\<^sub>s\<^sub>t S \ wfrestrictedvars\<^sub>s\<^sub>t S'" + "fv\<^sub>s\<^sub>t (S@S') = fv\<^sub>s\<^sub>t S \ fv\<^sub>s\<^sub>t S'" +by auto + +lemma bvars_subst_ident: "bvars\<^sub>s\<^sub>t S = bvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" +unfolding bvars\<^sub>s\<^sub>t_def +by (induct S) (simp_all add: subst_apply_strand_step_def split: strand_step.splits) + +lemma strand_subst_subst_idem: + assumes "subst_idem \" "subst_domain \ \ range_vars \ \ fv\<^sub>s\<^sub>t S" "subst_domain \ \ fv\<^sub>s\<^sub>t S = {}" + "range_vars \ \ bvars\<^sub>s\<^sub>t S = {}" "range_vars \ \ bvars\<^sub>s\<^sub>t S = {}" + shows "(S \\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>t \ = (S \\<^sub>s\<^sub>t \)" + and "(S \\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>t (\ \\<^sub>s \) = (S \\<^sub>s\<^sub>t \)" +proof - + from assms(2,3) have "fv\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ subst_domain \ = {}" + using subst_sends_strand_fv_to_img[of S \] by blast + thus "(S \\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>t \ = (S \\<^sub>s\<^sub>t \)" by blast + thus "(S \\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>t (\ \\<^sub>s \) = (S \\<^sub>s\<^sub>t \)" + by (metis assms(1,4,5) bvars_subst_ident strand_subst_comp subst_idem_def) +qed + +lemma strand_subst_img_bound: + assumes "subst_domain \ \ range_vars \ \ fv\<^sub>s\<^sub>t S" + and "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" + shows "range_vars \ \ fv\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" +proof - + have "subst_domain \ \ \(set (map fv\<^sub>s\<^sub>t\<^sub>p S))" by (metis (no_types) fv\<^sub>s\<^sub>t_def Un_subset_iff assms(1)) + thus ?thesis + unfolding range_vars_alt_def fv\<^sub>s\<^sub>t_def + by (metis subst_range.simps fv_set_mono fv_strand_subst Int_commute assms(2) image_Un + le_iff_sup) +qed + +lemma strand_subst_img_bound': + assumes "subst_domain \ \ range_vars \ \ vars\<^sub>s\<^sub>t S" + and "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" + shows "range_vars \ \ vars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" +proof - + have "(subst_domain \ \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` subst_domain \)) \ vars\<^sub>s\<^sub>t S = + subst_domain \ \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` subst_domain \)" + using assms(1) by (metis inf.absorb_iff1 range_vars_alt_def subst_range.simps) + hence "range_vars \ \ fv\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" + using vars_snd_rcv_strand fv_snd_rcv_strand assms(2) strand_subst_img_bound + unfolding range_vars_alt_def + by (metis (no_types) inf_le2 inf_sup_distrib1 subst_range.simps sup_bot.right_neutral) + thus "range_vars \ \ vars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" + by (metis fv_snd_rcv_strand le_supI1 vars_snd_rcv_strand) +qed + +lemma strand_subst_all_fv_subset: + assumes "fv t \ fv\<^sub>s\<^sub>t S" "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" + shows "fv (t \ \) \ fv\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" +using assms by (metis fv_strand_subst' Int_commute subst_apply_fv_subset) + +lemma strand_subst_not_dom_fixed: + assumes "v \ fv\<^sub>s\<^sub>t S" and "v \ subst_domain \" + shows "v \ fv\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" +using assms +proof (induction S) + case (Cons x S') + have 1: "\X. v \ subst_domain (rm_vars (set X) \)" + using Cons.prems(2) rm_vars_dom_subset by force + + show ?case + proof (cases "v \ fv\<^sub>s\<^sub>t S'") + case True thus ?thesis using Cons.IH[OF _ Cons.prems(2)] by auto + next + case False + hence 2: "v \ fv\<^sub>s\<^sub>t\<^sub>p x" using Cons.prems(1) by simp + hence "v \ fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \)" using Cons.prems(2) subst_not_dom_fixed + proof (cases x) + case (Inequality X F) + hence "v \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" using 2 by simp + hence "v \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)" + using subst_not_dom_fixed[OF _ 1] + by (induct F) (auto simp add: subst_apply_pairs_def) + thus ?thesis using Inequality 2 by auto + qed (force simp add: subst_domain_def)+ + thus ?thesis by auto + qed +qed simp + +lemma strand_vars_unfold: "v \ vars\<^sub>s\<^sub>t S \ \S' x S''. S = S'@x#S'' \ v \ vars\<^sub>s\<^sub>t\<^sub>p x" +proof (induction S) + case (Cons x S) thus ?case + proof (cases "v \ vars\<^sub>s\<^sub>t\<^sub>p x") + case True thus ?thesis by blast + next + case False + hence "v \ vars\<^sub>s\<^sub>t S" using Cons.prems by auto + thus ?thesis using Cons.IH by (metis append_Cons) + qed +qed simp + +lemma strand_fv_unfold: "v \ fv\<^sub>s\<^sub>t S \ \S' x S''. S = S'@x#S'' \ v \ fv\<^sub>s\<^sub>t\<^sub>p x" +proof (induction S) + case (Cons x S) thus ?case + proof (cases "v \ fv\<^sub>s\<^sub>t\<^sub>p x") + case True thus ?thesis by blast + next + case False + hence "v \ fv\<^sub>s\<^sub>t S" using Cons.prems by auto + thus ?thesis using Cons.IH by (metis append_Cons) + qed +qed simp + +lemma subterm_if_in_strand_ik: + "t \ ik\<^sub>s\<^sub>t S \ \t'. Receive t' \ set S \ t \ t'" +by (induct S rule: ik\<^sub>s\<^sub>t_induct) auto + +lemma fv_subset_if_in_strand_ik: + "t \ ik\<^sub>s\<^sub>t S \ fv t \ \(set (map fv\<^sub>r\<^sub>c\<^sub>v S))" +proof - + assume "t \ ik\<^sub>s\<^sub>t S" + then obtain t' where "Receive t' \ set S" "t \ t'" by (metis subterm_if_in_strand_ik) + hence "fv t \ fv t'" by (simp add: subtermeq_vars_subset) + thus ?thesis using in_strand_fv_subset_rcv[OF \Receive t' \ set S\] by auto +qed + +lemma fv_subset_if_in_strand_ik': + "t \ ik\<^sub>s\<^sub>t S \ fv t \ fv\<^sub>s\<^sub>t S" +using fv_subset_if_in_strand_ik[of t S] fv_snd_rcv_strand_subset(2)[of S] by blast + +lemma vars_subset_if_in_strand_ik2: + "t \ ik\<^sub>s\<^sub>t S \ fv t \ wfrestrictedvars\<^sub>s\<^sub>t S" +using fv_subset_if_in_strand_ik[of t S] vars_snd_rcv_strand_subset2(2)[of S] by blast + + +subsection \Lemmata: Simple Strands\ +lemma simple_Cons[dest]: "simple (s#S) \ simple S" +unfolding simple_def by auto + +lemma simple_split[dest]: + assumes "simple (S@S')" + shows "simple S" "simple S'" +using assms unfolding simple_def by auto + +lemma simple_append[intro]: "\simple S; simple S'\ \ simple (S@S')" +unfolding simple_def by auto + +lemma simple_append_sym[sym]: "simple (S@S') \ simple (S'@S)" by auto + +lemma not_simple_if_snd_fun: "(\S' S'' f X. S = S'@Send (Fun f X)#S'') \ \simple S" +unfolding simple_def by auto + +lemma not_list_all_elim: "\list_all P A \ \B x C. A = B@x#C \ \P x \ list_all P B" +proof (induction A rule: List.rev_induct) + case (snoc a A) + show ?case + proof (cases "list_all P A") + case True + thus ?thesis using snoc.prems by auto + next + case False + then obtain B x C where "A = B@x#C" "\P x" "list_all P B" using snoc.IH[OF False] by auto + thus ?thesis by auto + qed +qed simp + +lemma not_simple\<^sub>s\<^sub>t\<^sub>p_elim: + assumes "\simple\<^sub>s\<^sub>t\<^sub>p x" + shows "(\f T. x = Send (Fun f T)) \ + (\a t t'. x = Equality a t t') \ + (\X F. x = Inequality X F \ \(\\. ineq_model \ X F))" +using assms by (cases x) (fastforce elim: simple\<^sub>s\<^sub>t\<^sub>p.elims)+ + +lemma not_simple_elim: + assumes "\simple S" + shows "(\A B f T. S = A@Send (Fun f T)#B \ simple A) \ + (\A B a t t'. S = A@Equality a t t'#B \ simple A) \ + (\A B X F. S = A@Inequality X F#B \ \(\\. ineq_model \ X F))" +by (metis assms not_list_all_elim not_simple\<^sub>s\<^sub>t\<^sub>p_elim simple_def) + +lemma simple_fun_prefix_unique: + assumes "A = S@Send (Fun f X)#S'" "simple S" + shows "\T g Y T'. A = T@Send (Fun g Y)#T' \ simple T \ S = T \ f = g \ X = Y \ S' = T'" +proof - + { fix T g Y T' assume *: "A = T@Send (Fun g Y)#T'" "simple T" + { assume "length S < length T" hence False using assms * + by (metis id_take_nth_drop not_simple_if_snd_fun nth_append nth_append_length) + } + moreover + { assume "length S > length T" hence False using assms * + by (metis id_take_nth_drop not_simple_if_snd_fun nth_append nth_append_length) + } + ultimately have "S = T" using assms * by (meson List.append_eq_append_conv linorder_neqE_nat) + } + thus ?thesis using assms(1) by blast +qed + +lemma simple_snd_is_var: "\Send t \ set S; simple S\ \ \v. t = Var v" +unfolding simple_def +by (metis list_all_append list_all_simps(1) simple\<^sub>s\<^sub>t\<^sub>p.elims(2) split_list_first + strand_step.distinct(1) strand_step.distinct(5) strand_step.inject(1)) + + +subsection \Lemmata: Strand Measure\ +lemma measure\<^sub>s\<^sub>t_wellfounded: "wf measure\<^sub>s\<^sub>t" unfolding measure\<^sub>s\<^sub>t_def by simp + +lemma strand_size_append[iff]: "size\<^sub>s\<^sub>t (S@S') = size\<^sub>s\<^sub>t S + size\<^sub>s\<^sub>t S'" +by (induct S) (auto simp add: size\<^sub>s\<^sub>t_def) + +lemma strand_size_map_fun_lt[simp]: + "size\<^sub>s\<^sub>t (map Send X) < size (Fun f X)" + "size\<^sub>s\<^sub>t (map Send X) < size\<^sub>s\<^sub>t [Send (Fun f X)]" + "size\<^sub>s\<^sub>t (map Send X) < size\<^sub>s\<^sub>t [Receive (Fun f X)]" +by (induct X) (auto simp add: size\<^sub>s\<^sub>t_def) + +lemma strand_size_rm_fun_lt[simp]: + "size\<^sub>s\<^sub>t (S@S') < size\<^sub>s\<^sub>t (S@Send (Fun f X)#S')" + "size\<^sub>s\<^sub>t (S@S') < size\<^sub>s\<^sub>t (S@Receive (Fun f X)#S')" +by (induct S) (auto simp add: size\<^sub>s\<^sub>t_def) + +lemma strand_fv_card_map_fun_eq: + "card (fv\<^sub>s\<^sub>t (S@Send (Fun f X)#S')) = card (fv\<^sub>s\<^sub>t (S@(map Send X)@S'))" +proof - + have "fv\<^sub>s\<^sub>t (S@Send (Fun f X)#S') = fv\<^sub>s\<^sub>t (S@(map Send X)@S')" by auto + thus ?thesis by simp +qed + +lemma strand_fv_card_rm_fun_le[simp]: "card (fv\<^sub>s\<^sub>t (S@S')) \ card (fv\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" +by (force intro: card_mono) + +lemma strand_fv_card_rm_eq_le[simp]: "card (fv\<^sub>s\<^sub>t (S@S')) \ card (fv\<^sub>s\<^sub>t (S@Equality a t t'#S'))" +by (force intro: card_mono) + + +subsection \Lemmata: Well-formed Strands\ +lemma wf_prefix[dest]: "wf\<^sub>s\<^sub>t V (S@S') \ wf\<^sub>s\<^sub>t V S" +by (induct S rule: wf\<^sub>s\<^sub>t.induct) auto + +lemma wf_vars_mono[simp]: "wf\<^sub>s\<^sub>t V S \ wf\<^sub>s\<^sub>t (V \ W) S" +proof (induction S arbitrary: V) + case (Cons x S) thus ?case + proof (cases x) + case (Send t) + hence "wf\<^sub>s\<^sub>t (V \ fv t \ W) S" using Cons.prems(1) Cons.IH by simp + thus ?thesis using Send by (simp add: sup_commute sup_left_commute) + next + case (Equality a t t') + show ?thesis + proof (cases a) + case Assign + hence "wf\<^sub>s\<^sub>t (V \ fv t \ W) S" "fv t' \ V \ W" using Equality Cons.prems(1) Cons.IH by auto + thus ?thesis using Equality Assign by (simp add: sup_commute sup_left_commute) + next + case Check thus ?thesis using Equality Cons by auto + qed + qed auto +qed simp + +lemma wf\<^sub>s\<^sub>tI[intro]: "wfrestrictedvars\<^sub>s\<^sub>t S \ V \ wf\<^sub>s\<^sub>t V S" +proof (induction S) + case (Cons x S) thus ?case + proof (cases x) + case (Send t) + hence "wf\<^sub>s\<^sub>t V S" "V \ fv t = V" using Cons by auto + thus ?thesis using Send by simp + next + case (Equality a t t') + show ?thesis + proof (cases a) + case Assign + hence "wf\<^sub>s\<^sub>t V S" "fv t' \ V" using Equality Cons by auto + thus ?thesis using wf_vars_mono Equality Assign by simp + next + case Check thus ?thesis using Equality Cons by auto + qed + qed simp_all +qed simp + +lemma wf\<^sub>s\<^sub>tI'[intro]: "\(fv\<^sub>r\<^sub>c\<^sub>v ` set S) \ \(fv_r\<^sub>e\<^sub>q assign ` set S) \ V \ wf\<^sub>s\<^sub>t V S" +proof (induction S) + case (Cons x S) thus ?case + proof (cases x) + case (Equality a t t') thus ?thesis using Cons by (cases a) auto + qed simp_all +qed simp + +lemma wf_append_exec: "wf\<^sub>s\<^sub>t V (S@S') \ wf\<^sub>s\<^sub>t (V \ wfvarsoccs\<^sub>s\<^sub>t S) S'" +proof (induction S arbitrary: V) + case (Cons x S V) thus ?case + proof (cases x) + case (Send t) + hence "wf\<^sub>s\<^sub>t (V \ fv t \ wfvarsoccs\<^sub>s\<^sub>t S) S'" using Cons.prems Cons.IH by simp + thus ?thesis using Send by (auto simp add: sup_assoc) + next + case (Equality a t t') show ?thesis + proof (cases a) + case Assign + hence "wf\<^sub>s\<^sub>t (V \ fv t \ wfvarsoccs\<^sub>s\<^sub>t S) S'" using Equality Cons.prems Cons.IH by auto + thus ?thesis using Equality Assign by (auto simp add: sup_assoc) + next + case Check + hence "wf\<^sub>s\<^sub>t (V \ wfvarsoccs\<^sub>s\<^sub>t S) S'" using Equality Cons.prems Cons.IH by auto + thus ?thesis using Equality Check by (auto simp add: sup_assoc) + qed + qed auto +qed simp + +lemma wf_append_suffix: + "wf\<^sub>s\<^sub>t V S \ wfrestrictedvars\<^sub>s\<^sub>t S' \ wfrestrictedvars\<^sub>s\<^sub>t S \ V \ wf\<^sub>s\<^sub>t V (S@S')" +proof (induction V S rule: wf\<^sub>s\<^sub>t_induct) + case (ConsSnd V t S) + hence *: "wf\<^sub>s\<^sub>t (V \ fv t) S" by simp_all + hence "wfrestrictedvars\<^sub>s\<^sub>t S' \ wfrestrictedvars\<^sub>s\<^sub>t S \ (V \ fv t)" + using ConsSnd.prems(2) by fastforce + thus ?case using ConsSnd.IH * by simp +next + case (ConsRcv V t S) + hence *: "fv t \ V" "wf\<^sub>s\<^sub>t V S" by simp_all + hence "wfrestrictedvars\<^sub>s\<^sub>t S' \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" + using ConsRcv.prems(2) by fastforce + thus ?case using ConsRcv.IH * by simp +next + case (ConsEq V t t' S) + hence *: "fv t' \ V" "wf\<^sub>s\<^sub>t (V \ fv t) S" by simp_all + moreover have "vars\<^sub>s\<^sub>t\<^sub>p (Equality Assign t t') = fv t \ fv t'" + by simp + moreover have "wfrestrictedvars\<^sub>s\<^sub>t (Equality Assign t t'#S) = fv t \ fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S" + by auto + ultimately have "wfrestrictedvars\<^sub>s\<^sub>t S' \ wfrestrictedvars\<^sub>s\<^sub>t S \ (V \ fv t)" + using ConsEq.prems(2) by blast + thus ?case using ConsEq.IH * by simp +qed (simp_all add: wf\<^sub>s\<^sub>tI) + +lemma wf_append_suffix': + assumes "wf\<^sub>s\<^sub>t V S" + and "\(fv\<^sub>r\<^sub>c\<^sub>v ` set S') \ \(fv_r\<^sub>e\<^sub>q assign ` set S') \ wfvarsoccs\<^sub>s\<^sub>t S \ V" + shows "wf\<^sub>s\<^sub>t V (S@S')" +using assms +proof (induction V S rule: wf\<^sub>s\<^sub>t_induct) + case (ConsSnd V t S) + hence *: "wf\<^sub>s\<^sub>t (V \ fv t) S" by simp_all + have "wfvarsoccs\<^sub>s\<^sub>t (send\t\\<^sub>s\<^sub>t#S) = fv t \ wfvarsoccs\<^sub>s\<^sub>t S" + unfolding wfvarsoccs\<^sub>s\<^sub>t_def by simp + hence "(\a\set S'. fv\<^sub>r\<^sub>c\<^sub>v a) \ (\a\set S'. fv_r\<^sub>e\<^sub>q assign a) \ wfvarsoccs\<^sub>s\<^sub>t S \ (V \ fv t)" + using ConsSnd.prems(2) unfolding wfvarsoccs\<^sub>s\<^sub>t_def by auto + thus ?case using ConsSnd.IH[OF *] by auto +next + case (ConsEq V t t' S) + hence *: "fv t' \ V" "wf\<^sub>s\<^sub>t (V \ fv t) S" by simp_all + have "wfvarsoccs\<^sub>s\<^sub>t (\assign: t \ t'\\<^sub>s\<^sub>t#S) = fv t \ wfvarsoccs\<^sub>s\<^sub>t S" + unfolding wfvarsoccs\<^sub>s\<^sub>t_def by simp + hence "(\a\set S'. fv\<^sub>r\<^sub>c\<^sub>v a) \ (\a\set S'. fv_r\<^sub>e\<^sub>q assign a) \ wfvarsoccs\<^sub>s\<^sub>t S \ (V \ fv t)" + using ConsEq.prems(2) unfolding wfvarsoccs\<^sub>s\<^sub>t_def by auto + thus ?case using ConsEq.IH[OF *(2)] *(1) by auto +qed (auto simp add: wf\<^sub>s\<^sub>tI') + +lemma wf_send_compose: "wf\<^sub>s\<^sub>t V (S@(map Send X)@S') = wf\<^sub>s\<^sub>t V (S@Send (Fun f X)#S')" +proof (induction S arbitrary: V) + case Nil thus ?case + proof (induction X arbitrary: V) + case (Cons y Y) thus ?case by (simp add: sup_assoc) + qed simp +next + case (Cons s S) thus ?case + proof (cases s) + case (Equality ac t t') thus ?thesis using Cons by (cases ac) auto + qed auto +qed + +lemma wf_snd_append[iff]: "wf\<^sub>s\<^sub>t V (S@[Send t]) = wf\<^sub>s\<^sub>t V S" +by (induct S rule: wf\<^sub>s\<^sub>t.induct) simp_all + +lemma wf_snd_append': "wf\<^sub>s\<^sub>t V S \ wf\<^sub>s\<^sub>t V (Send t#S)" +by simp + +lemma wf_rcv_append[dest]: "wf\<^sub>s\<^sub>t V (S@Receive t#S') \ wf\<^sub>s\<^sub>t V (S@S')" +by (induct S rule: wf\<^sub>s\<^sub>t.induct) simp_all + +lemma wf_rcv_append'[intro]: + "\wf\<^sub>s\<^sub>t V (S@S'); fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ V\ \ wf\<^sub>s\<^sub>t V (S@Receive t#S')" +proof (induction S rule: wf\<^sub>s\<^sub>t_induct) + case (ConsRcv V t' S) + hence "wf\<^sub>s\<^sub>t V (S@S')" "fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" + by auto+ + thus ?case using ConsRcv by auto +next + case (ConsEq V t' t'' S) + hence "fv t'' \ V" by simp + moreover have + "wfrestrictedvars\<^sub>s\<^sub>t (Equality Assign t' t''#S) = fv t' \ fv t'' \ wfrestrictedvars\<^sub>s\<^sub>t S" + by auto + ultimately have "fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ (V \ fv t')" + using ConsEq.prems(2) by blast + thus ?case using ConsEq by auto +qed auto + +lemma wf_rcv_append''[intro]: "\wf\<^sub>s\<^sub>t V S; fv t \ \(set (map fv\<^sub>s\<^sub>n\<^sub>d S))\ \ wf\<^sub>s\<^sub>t V (S@[Receive t])" +by (induct S) + (simp, metis vars_snd_rcv_strand_subset2(1) append_Nil2 le_supI1 order_trans wf_rcv_append') + +lemma wf_rcv_append'''[intro]: "\wf\<^sub>s\<^sub>t V S; fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ V\ \ wf\<^sub>s\<^sub>t V (S@[Receive t])" +by (simp add: wf_rcv_append'[of _ _ "[]"]) + +lemma wf_eq_append[dest]: "wf\<^sub>s\<^sub>t V (S@Equality a t t'#S') \ fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ V \ wf\<^sub>s\<^sub>t V (S@S')" +proof (induction S rule: wf\<^sub>s\<^sub>t_induct) + case (Nil V) + hence "wf\<^sub>s\<^sub>t (V \ fv t) S'" by (cases a) auto + moreover have "V \ fv t = V" using Nil by auto + ultimately show ?case by simp +next + case (ConsRcv V u S) + hence "wf\<^sub>s\<^sub>t V (S @ Equality a t t' # S')" "fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" "fv u \ V" + by fastforce+ + hence "wf\<^sub>s\<^sub>t V (S@S')" using ConsRcv.IH by auto + thus ?case using \fv u \ V\ by simp +next + case (ConsEq V u u' S) + hence "wf\<^sub>s\<^sub>t (V \ fv u) (S@Equality a t t'#S')" "fv t \ wfrestrictedvars\<^sub>s\<^sub>t S \ (V \ fv u)" "fv u' \ V" + by auto + hence "wf\<^sub>s\<^sub>t (V \ fv u) (S@S')" using ConsEq.IH by auto + thus ?case using \fv u' \ V\ by simp +qed auto + +lemma wf_eq_append'[intro]: + "\wf\<^sub>s\<^sub>t V (S@S'); fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S \ V\ \ wf\<^sub>s\<^sub>t V (S@Equality a t t'#S')" +proof (induction S rule: wf\<^sub>s\<^sub>t_induct) + case Nil thus ?case by (cases a) auto +next + case (ConsEq V u u' S) + hence "wf\<^sub>s\<^sub>t (V \ fv u) (S@S')" "fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S \ V \ fv u" + by fastforce+ + thus ?case using ConsEq by auto +next + case (ConsEq2 V u u' S) + hence "wf\<^sub>s\<^sub>t V (S@S')" by auto + thus ?case using ConsEq2 by auto +next + case (ConsRcv V u S) + hence "wf\<^sub>s\<^sub>t V (S@S')" "fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S \ V" + by fastforce+ + thus ?case using ConsRcv by auto +next + case (ConsSnd V u S) + hence "wf\<^sub>s\<^sub>t (V \ fv u) (S@S')" "fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S \ (V \ fv u)" + by fastforce+ + thus ?case using ConsSnd by auto +qed auto + +lemma wf_eq_append''[intro]: + "\wf\<^sub>s\<^sub>t V (S@S'); fv t' \ wfvarsoccs\<^sub>s\<^sub>t S \ V\ \ wf\<^sub>s\<^sub>t V (S@[Equality a t t']@S')" +proof (induction S rule: wf\<^sub>s\<^sub>t_induct) + case Nil thus ?case by (cases a) auto +next + case (ConsEq V u u' S) + hence "wf\<^sub>s\<^sub>t (V \ fv u) (S@S')" "fv t' \ wfvarsoccs\<^sub>s\<^sub>t S \ V \ fv u" by fastforce+ + thus ?case using ConsEq by auto +next + case (ConsEq2 V u u' S) + hence "wf\<^sub>s\<^sub>t (V \ fv u) (S@S')" "fv t' \ wfvarsoccs\<^sub>s\<^sub>t S \ V \ fv u" by fastforce+ + thus ?case using ConsEq2 by auto +next + case (ConsRcv V u S) + hence "wf\<^sub>s\<^sub>t V (S@S')" "fv t' \ wfvarsoccs\<^sub>s\<^sub>t S \ V" by fastforce+ + thus ?case using ConsRcv by auto +next + case (ConsSnd V u S) + hence "wf\<^sub>s\<^sub>t (V \ fv u) (S@S')" "fv t' \ wfvarsoccs\<^sub>s\<^sub>t S \ (V \ fv u)" by auto + thus ?case using ConsSnd by auto +qed auto + +lemma wf_eq_append'''[intro]: + "\wf\<^sub>s\<^sub>t V S; fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S \ V\ \ wf\<^sub>s\<^sub>t V (S@[Equality a t t'])" +by (simp add: wf_eq_append'[of _ _ "[]"]) + +lemma wf_eq_check_append[dest]: "wf\<^sub>s\<^sub>t V (S@Equality Check t t'#S') \ wf\<^sub>s\<^sub>t V (S@S')" +by (induct S rule: wf\<^sub>s\<^sub>t.induct) simp_all + +lemma wf_eq_check_append'[intro]: "wf\<^sub>s\<^sub>t V (S@S') \ wf\<^sub>s\<^sub>t V (S@Equality Check t t'#S')" +by (induct S rule: wf\<^sub>s\<^sub>t.induct) auto + +lemma wf_eq_check_append''[intro]: "wf\<^sub>s\<^sub>t V S \ wf\<^sub>s\<^sub>t V (S@[Equality Check t t'])" +by (induct S rule: wf\<^sub>s\<^sub>t.induct) auto + +lemma wf_ineq_append[dest]: "wf\<^sub>s\<^sub>t V (S@Inequality X F#S') \ wf\<^sub>s\<^sub>t V (S@S')" +by (induct S rule: wf\<^sub>s\<^sub>t.induct) simp_all + +lemma wf_ineq_append'[intro]: "wf\<^sub>s\<^sub>t V (S@S') \ wf\<^sub>s\<^sub>t V (S@Inequality X F#S')" +by (induct S rule: wf\<^sub>s\<^sub>t.induct) auto + +lemma wf_ineq_append''[intro]: "wf\<^sub>s\<^sub>t V S \ wf\<^sub>s\<^sub>t V (S@[Inequality X F])" +by (induct S rule: wf\<^sub>s\<^sub>t.induct) auto + +lemma wf_rcv_fv_single[elim]: "wf\<^sub>s\<^sub>t V (Receive t#S') \ fv t \ V" +by simp + +lemma wf_rcv_fv: "wf\<^sub>s\<^sub>t V (S@Receive t#S') \ fv t \ wfvarsoccs\<^sub>s\<^sub>t S \ V" +by (induct S arbitrary: V) (auto split!: strand_step.split poscheckvariant.split) + +lemma wf_eq_fv: "wf\<^sub>s\<^sub>t V (S@Equality Assign t t'#S') \ fv t' \ wfvarsoccs\<^sub>s\<^sub>t S \ V" +by (induct S arbitrary: V) (auto split!: strand_step.split poscheckvariant.split) + +lemma wf_simple_fv_occurrence: + assumes "wf\<^sub>s\<^sub>t {} S" "simple S" "v \ wfrestrictedvars\<^sub>s\<^sub>t S" + shows "\S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f. S = S\<^sub>p\<^sub>r\<^sub>e@Send (Var v)#S\<^sub>s\<^sub>u\<^sub>f \ v \ wfrestrictedvars\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e" +using assms +proof (induction S rule: List.rev_induct) + case (snoc x S) + from \wf\<^sub>s\<^sub>t {} (S@[x])\ have "wf\<^sub>s\<^sub>t {} S" "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>s\<^sub>t S) [x]" + using wf_append_exec[THEN wf_vars_mono, of "{}" S "[x]" "wfrestrictedvars\<^sub>s\<^sub>t S - wfvarsoccs\<^sub>s\<^sub>t S"] + vars_snd_rcv_strand_subset2(4)[of S] + Diff_partition[of "wfvarsoccs\<^sub>s\<^sub>t S" "wfrestrictedvars\<^sub>s\<^sub>t S"] + by auto + from \simple (S@[x])\ have "simple S" "simple\<^sub>s\<^sub>t\<^sub>p x" unfolding simple_def by auto + + show ?case + proof (cases "v \ wfrestrictedvars\<^sub>s\<^sub>t S") + case False + show ?thesis + proof (cases x) + case (Receive t) + hence "fv t \ wfrestrictedvars\<^sub>s\<^sub>t S" using \wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>s\<^sub>t S) [x]\ by simp + hence "v \ wfrestrictedvars\<^sub>s\<^sub>t S" + using \v \ wfrestrictedvars\<^sub>s\<^sub>t (S@[x])\ \x = Receive t\ + by auto + thus ?thesis using \x = Receive t\ snoc.IH[OF \wf\<^sub>s\<^sub>t {} S\ \simple S\] by fastforce + next + case (Send t) + hence "v \ vars\<^sub>s\<^sub>t\<^sub>p x" using \v \ wfrestrictedvars\<^sub>s\<^sub>t (S@[x])\ False by auto + from Send obtain w where "t = Var w" using \simple\<^sub>s\<^sub>t\<^sub>p x\ by (cases t) simp_all + hence "v = w" using \x = Send t\ \v \ vars\<^sub>s\<^sub>t\<^sub>p x\ by simp + thus ?thesis using \x = Send t\ \v \ wfrestrictedvars\<^sub>s\<^sub>t S\ \t = Var w\ by auto + next + case (Equality ac t t') thus ?thesis using snoc.prems(2) unfolding simple_def by auto + next + case (Inequality t t') thus ?thesis using False snoc.prems(3) by auto + qed + qed (use snoc.IH[OF \wf\<^sub>s\<^sub>t {} S\ \simple S\] in fastforce) +qed simp + +lemma Unifier_strand_fv_subset: + assumes g_in_ik: "t \ ik\<^sub>s\<^sub>t S" + and \: "Unifier \ (Fun f X) t" + and disj: "bvars\<^sub>s\<^sub>t S \ (subst_domain \ \ range_vars \) = {}" + shows "fv (Fun f X \ \) \ \(set (map fv\<^sub>r\<^sub>c\<^sub>v (S \\<^sub>s\<^sub>t \)))" +by (metis (no_types) fv_subset_if_in_strand_ik[OF g_in_ik] + disj \ fv_strand_subst subst_apply_fv_subset) + +lemma wf\<^sub>s\<^sub>t_induct'[consumes 1, case_names Nil ConsSnd ConsRcv ConsEq ConsEq2 ConsIneq]: + fixes S::"('a,'b) strand" + assumes "wf\<^sub>s\<^sub>t V S" + "P []" + "\t S. \wf\<^sub>s\<^sub>t V S; P S\ \ P (S@[Send t])" + "\t S. \wf\<^sub>s\<^sub>t V S; P S; fv t \ V \ wfvarsoccs\<^sub>s\<^sub>t S\ \ P (S@[Receive t])" + "\t t' S. \wf\<^sub>s\<^sub>t V S; P S; fv t' \ V \ wfvarsoccs\<^sub>s\<^sub>t S\ \ P (S@[Equality Assign t t'])" + "\t t' S. \wf\<^sub>s\<^sub>t V S; P S\ \ P (S@[Equality Check t t'])" + "\X F S. \wf\<^sub>s\<^sub>t V S; P S\ \ P (S@[Inequality X F])" + shows "P S" +using assms +proof (induction S rule: List.rev_induct) + case (snoc x S) + hence *: "wf\<^sub>s\<^sub>t V S" "wf\<^sub>s\<^sub>t (V \ wfvarsoccs\<^sub>s\<^sub>t S) [x]" by (metis wf_prefix, metis wf_append_exec) + have IH: "P S" using snoc.IH[OF *(1)] snoc.prems by auto + note ** = snoc.prems(3,4,5,6,7)[OF *(1) IH] *(2) + show ?case using **(1,2,4,5,6) + proof (cases x) + case (Equality ac t t') + then show ?thesis using **(3,4,6) by (cases ac) auto + qed auto +qed simp + +lemma wf_subst_apply: + "wf\<^sub>s\<^sub>t V S \ wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)) (S \\<^sub>s\<^sub>t \)" +proof (induction S arbitrary: V rule: wf\<^sub>s\<^sub>t_induct) + case (ConsRcv V t S) + hence "wf\<^sub>s\<^sub>t V S" "fv t \ V" by simp_all + hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)) (S \\<^sub>s\<^sub>t \)" "fv (t \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using ConsRcv.IH subst_apply_fv_subset by simp_all + thus ?case by simp +next + case (ConsSnd V t S) + hence "wf\<^sub>s\<^sub>t (V \ fv t) S" by simp + hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ fv t))) (S \\<^sub>s\<^sub>t \)" using ConsSnd.IH by metis + hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ fv (t \ \)) (S \\<^sub>s\<^sub>t \)" using subst_apply_fv_union by metis + thus ?case by simp +next + case (ConsEq V t t' S) + hence "wf\<^sub>s\<^sub>t (V \ fv t) S" "fv t' \ V" by auto + hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` (V \ fv t))) (S \\<^sub>s\<^sub>t \)" and *: "fv (t' \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using ConsEq.IH subst_apply_fv_subset by force+ + hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ fv (t \ \)) (S \\<^sub>s\<^sub>t \)" using subst_apply_fv_union by metis + thus ?case using * by simp +qed simp_all + +lemma wf_unify: + assumes wf: "wf\<^sub>s\<^sub>t V (S@Send (Fun f X)#S')" + and g_in_ik: "t \ ik\<^sub>s\<^sub>t S" + and \: "Unifier \ (Fun f X) t" + and disj: "bvars\<^sub>s\<^sub>t (S@Send (Fun f X)#S') \ (subst_domain \ \ range_vars \) = {}" + shows "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)) ((S@S') \\<^sub>s\<^sub>t \)" +using assms +proof (induction S' arbitrary: V rule: List.rev_induct) + case (snoc x S' V) + have fun_fv_bound: "fv (Fun f X \ \) \ \(set (map fv\<^sub>r\<^sub>c\<^sub>v (S \\<^sub>s\<^sub>t \)))" + using snoc.prems(4) bvars\<^sub>s\<^sub>t_split Unifier_strand_fv_subset[OF g_in_ik \] by auto + hence "fv (Fun f X \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \))" using fv_ik_is_fv_rcv by metis + hence "fv (Fun f X \ \) \ wfrestrictedvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" using fv_ik_subset_fv_st[of "S \\<^sub>s\<^sub>t \"] by blast + hence *: "fv ((Fun f X) \ \) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" by fastforce + + from snoc.prems(1) have "wf\<^sub>s\<^sub>t V (S@Send (Fun f X)#S')" + using wf_prefix[of V "S@Send (Fun f X)#S'" "[x]"] by simp + hence **: "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)) ((S@S') \\<^sub>s\<^sub>t \)" + using snoc.IH[OF _ snoc.prems(2,3)] snoc.prems(4) by auto + + from snoc.prems(1) have ***: "wf\<^sub>s\<^sub>t (V \ wfvarsoccs\<^sub>s\<^sub>t (S@Send (Fun f X)#S')) [x]" + using wf_append_exec[of V "(S@Send (Fun f X)#S')" "[x]"] by simp + + from snoc.prems(4) have disj': + "bvars\<^sub>s\<^sub>t (S@S') \ (subst_domain \ \ range_vars \) = {}" + "set (bvars\<^sub>s\<^sub>t\<^sub>p x) \ (subst_domain \ \ range_vars \) = {}" + by auto + + show ?case + proof (cases x) + case (Send t) + thus ?thesis using wf_snd_append[of "fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" "(S@S') \\<^sub>s\<^sub>t \"] ** by auto + next + case (Receive t) + hence "fv\<^sub>s\<^sub>t\<^sub>p x \ V \ wfvarsoccs\<^sub>s\<^sub>t (S@Send (Fun f X)#S')" using *** by auto + hence "fv\<^sub>s\<^sub>t\<^sub>p x \ V \ wfrestrictedvars\<^sub>s\<^sub>t (S@Send (Fun f X)#S')" + using vars_snd_rcv_strand_subset2(4)[of "S@Send (Fun f X)#S'"] by blast + hence "fv\<^sub>s\<^sub>t\<^sub>p x \ V \ fv (Fun f X) \ wfrestrictedvars\<^sub>s\<^sub>t (S@S')" by auto + hence "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ fv ((Fun f X) \ \) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" + by (metis (no_types) inf_sup_aci(5) subst_apply_fv_subset_strand2 subst_apply_fv_union disj') + hence "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" using * by blast + hence "fv (t \ \) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) " using \x = Receive t\ by auto + hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)) (((S@S') \\<^sub>s\<^sub>t \)@[Receive (t \ \)])" + using wf_rcv_append'''[OF **, of "t \ \"] by metis + thus ?thesis using \x = Receive t\ by auto + next + case (Equality ac s s') show ?thesis + proof (cases ac) + case Assign + hence "fv s' \ V \ wfvarsoccs\<^sub>s\<^sub>t (S@Send (Fun f X)#S')" using Equality *** by auto + hence "fv s' \ V \ wfrestrictedvars\<^sub>s\<^sub>t (S@Send (Fun f X)#S')" + using vars_snd_rcv_strand_subset2(4)[of "S@Send (Fun f X)#S'"] by blast + hence "fv s' \ V \ fv (Fun f X) \ wfrestrictedvars\<^sub>s\<^sub>t (S@S')" by auto + moreover have "fv s' = fv_r\<^sub>e\<^sub>q ac x" "fv (s' \ \) = fv_r\<^sub>e\<^sub>q ac (x \\<^sub>s\<^sub>t\<^sub>p \)" + using Equality by simp_all + ultimately have "fv (s' \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ fv (Fun f X \ \) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" + using subst_apply_fv_subset_strand2[of "fv\<^sub>e\<^sub>q ac" ac x] + by (metis disj'(1) subst_apply_fv_subset_strand_trm2 subst_apply_fv_union sup_commute) + hence "fv (s' \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" using * by blast + hence "fv (s' \ \) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using \x = Equality ac s s'\ by auto + hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)) (((S@S') \\<^sub>s\<^sub>t \)@[Equality ac (s \ \) (s' \ \)])" + using wf_eq_append'''[OF **] by metis + thus ?thesis using \x = Equality ac s s'\ by auto + next + case Check thus ?thesis using wf_eq_check_append''[OF **] Equality by simp + qed + next + case (Inequality t t') thus ?thesis using wf_ineq_append''[OF **] by simp + qed +qed (auto dest: wf_subst_apply) + +lemma wf_equality: + assumes wf: "wf\<^sub>s\<^sub>t V (S@Equality ac t t'#S')" + and \: "mgu t t' = Some \" + and disj: "bvars\<^sub>s\<^sub>t (S@Equality ac t t'#S') \ (subst_domain \ \ range_vars \) = {}" + shows "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)) ((S@S') \\<^sub>s\<^sub>t \)" +using assms +proof (induction S' arbitrary: V rule: List.rev_induct) + case Nil thus ?case using wf_prefix[of V S "[Equality ac t t']"] wf_subst_apply[of V S \] by auto +next + case (snoc x S' V) show ?case + proof (cases ac) + case Assign + hence "fv t' \ V \ wfvarsoccs\<^sub>s\<^sub>t S" + using wf_eq_fv[of V, of S t t' "S'@[x]"] snoc by auto + hence "fv t' \ V \ wfrestrictedvars\<^sub>s\<^sub>t S" + using vars_snd_rcv_strand_subset2(4)[of S] by blast + hence "fv t' \ V \ wfrestrictedvars\<^sub>s\<^sub>t (S@S')" by force + moreover have disj': + "bvars\<^sub>s\<^sub>t (S@S') \ (subst_domain \ \ range_vars \) = {}" + "set (bvars\<^sub>s\<^sub>t\<^sub>p x) \ (subst_domain \ \ range_vars \) = {}" + "bvars\<^sub>s\<^sub>t (S@Equality ac t t'#S') \ (subst_domain \ \ range_vars \) = {}" + using snoc.prems(3) by auto + ultimately have + "fv (t' \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" + by (metis inf_sup_aci(5) subst_apply_fv_subset_strand_trm2) + moreover have "fv (t \ \) = fv (t' \ \)" + by (metis MGU_is_Unifier[OF mgu_gives_MGU[OF \]]) + ultimately have *: + "fv (t \ \) \ fv (t' \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" + by simp + + from snoc.prems(1) have "wf\<^sub>s\<^sub>t V (S@Equality ac t t'#S')" + using wf_prefix[of V "S@Equality ac t t'#S'"] by simp + hence **: "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)) ((S@S') \\<^sub>s\<^sub>t \)" by (metis snoc.IH \ disj'(3)) + + from snoc.prems(1) have ***: "wf\<^sub>s\<^sub>t (V \ wfvarsoccs\<^sub>s\<^sub>t (S@Equality ac t t'#S')) [x]" + using wf_append_exec[of V "(S@Equality ac t t'#S')" "[x]"] by simp + + show ?thesis + proof (cases x) + case (Send t) + thus ?thesis using wf_snd_append[of "fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" "(S@S') \\<^sub>s\<^sub>t \"] ** by auto + next + case (Receive s) + hence "fv\<^sub>s\<^sub>t\<^sub>p x \ V \ wfvarsoccs\<^sub>s\<^sub>t (S@Equality ac t t'#S')" using *** by auto + hence "fv\<^sub>s\<^sub>t\<^sub>p x \ V \ wfrestrictedvars\<^sub>s\<^sub>t (S@Equality ac t t'#S')" + using vars_snd_rcv_strand_subset2(4)[of "S@Equality ac t t'#S'"] by blast + hence "fv\<^sub>s\<^sub>t\<^sub>p x \ V \ fv t \ fv t' \ wfrestrictedvars\<^sub>s\<^sub>t (S@S')" + by (cases ac) auto + hence "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ fv (t \ \) \ fv (t' \ \) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" + using subst_apply_fv_subset_strand2[of fv\<^sub>s\<^sub>t\<^sub>p] + by (metis (no_types) inf_sup_aci(5) subst_apply_fv_union disj'(1,2)) + hence "fv\<^sub>s\<^sub>t\<^sub>p (x \\<^sub>s\<^sub>t\<^sub>p \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" + when "ac = Assign" + using * that by blast + hence "fv (s \ \) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \) \ (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V))" + when "ac = Assign" + using \x = Receive s\ that by auto + hence "wf\<^sub>s\<^sub>t (fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)) (((S@S') \\<^sub>s\<^sub>t \)@[Receive (s \ \)])" + when "ac = Assign" + using wf_rcv_append'''[OF **, of "s \ \"] that by metis + thus ?thesis using \x = Receive s\ Assign by auto + next + case (Equality ac' s s') show ?thesis + proof (cases ac') + case Assign + hence "fv s' \ V \ wfvarsoccs\<^sub>s\<^sub>t (S@Equality ac t t'#S')" using *** Equality by auto + hence "fv s' \ V \ wfrestrictedvars\<^sub>s\<^sub>t (S@Equality ac t t'#S')" + using vars_snd_rcv_strand_subset2(4)[of "S@Equality ac t t'#S'"] by blast + hence "fv s' \ V \ fv t \ fv t' \ wfrestrictedvars\<^sub>s\<^sub>t (S@S')" + by (cases ac) auto + moreover have "fv s' = fv_r\<^sub>e\<^sub>q ac' x" "fv (s' \ \) = fv_r\<^sub>e\<^sub>q ac' (x \\<^sub>s\<^sub>t\<^sub>p \)" + using Equality by simp_all + ultimately have + "fv (s' \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ fv (t \ \) \ fv (t' \ \) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" + using subst_apply_fv_subset_strand2[of "fv_r\<^sub>e\<^sub>q ac'" ac' x] + by (metis disj'(1) subst_apply_fv_subset_strand_trm2 subst_apply_fv_union sup_commute) + hence "fv (s' \ \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \)" + using * \ac = Assign\ by blast + hence ****: + "fv (s' \ \) \ wfrestrictedvars\<^sub>s\<^sub>t ((S@S') \\<^sub>s\<^sub>t \) \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` V)" + using \x = Equality ac' s s'\ \ac = Assign\ by auto + thus ?thesis + using \x = Equality ac' s s'\ ** **** wf_eq_append' \ac = Assign\ + by (metis (no_types, lifting) append.assoc append_Nil2 strand_step.case(3) + strand_subst_hom subst_apply_strand_step_def) + next + case Check thus ?thesis using wf_eq_check_append''[OF **] Equality by simp + qed + next + case (Inequality s s') thus ?thesis using wf_ineq_append''[OF **] by simp + qed + qed (metis snoc.prems(1) wf_eq_check_append wf_subst_apply) +qed + +lemma wf_rcv_prefix_ground: + "wf\<^sub>s\<^sub>t {} ((map Receive M)@S) \ vars\<^sub>s\<^sub>t (map Receive M) = {}" +by (induct M) auto + +lemma simple_wfvarsoccs\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>n\<^sub>d: + assumes "simple S" + shows "wfvarsoccs\<^sub>s\<^sub>t S = \(set (map fv\<^sub>s\<^sub>n\<^sub>d S))" +using assms unfolding simple_def +proof (induction S) + case (Cons x S) thus ?case by (cases x) auto +qed simp + +lemma wf\<^sub>s\<^sub>t_simple_induct[consumes 2, case_names Nil ConsSnd ConsRcv ConsIneq]: + fixes S::"('a,'b) strand" + assumes "wf\<^sub>s\<^sub>t V S" "simple S" + "P []" + "\v S. \wf\<^sub>s\<^sub>t V S; simple S; P S\ \ P (S@[Send (Var v)])" + "\t S. \wf\<^sub>s\<^sub>t V S; simple S; P S; fv t \ V \ \(set (map fv\<^sub>s\<^sub>n\<^sub>d S))\ \ P (S@[Receive t])" + "\X F S. \wf\<^sub>s\<^sub>t V S; simple S; P S\ \ P (S@[Inequality X F])" + shows "P S" +using assms +proof (induction S rule: wf\<^sub>s\<^sub>t_induct') + case (ConsSnd t S) + hence "P S" by auto + obtain v where "t = Var v" using simple_snd_is_var[OF _ \simple (S@[Send t])\] by auto + thus ?case using ConsSnd.prems(3)[OF \wf\<^sub>s\<^sub>t V S\ _ \P S\] \simple (S@[Send t])\ by auto +next + case (ConsRcv t S) thus ?case using simple_wfvarsoccs\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>n\<^sub>d[of "S@[Receive t]"] by auto +qed (auto simp add: simple_def) + +lemma wf_trm_stp_dom_fv_disjoint: + "\wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \; t \ trms\<^sub>s\<^sub>t S\ \ subst_domain \ \ fv t = {}" +unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by force + +lemma wf_constr_bvars_disj: "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \ \ (subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" +unfolding range_vars_alt_def wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by fastforce + +lemma wf_constr_bvars_disj': + assumes "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \" "subst_domain \ \ range_vars \ \ fv\<^sub>s\<^sub>t S" + shows "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" (is ?A) + and "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) = {}" (is ?B) +proof - + have "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" "fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S = {}" + using assms(1) unfolding range_vars_alt_def wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by fastforce+ + thus ?A and ?B using assms(2) bvars_subst_ident[of S \] by blast+ +qed + +lemma (in intruder_model) wf_simple_strand_first_Send_var_split: + assumes "wf\<^sub>s\<^sub>t {} S" "simple S" "\v \ wfrestrictedvars\<^sub>s\<^sub>t S. t \ \ = \ v" + shows "\v S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f. S = S\<^sub>p\<^sub>r\<^sub>e@Send (Var v)#S\<^sub>s\<^sub>u\<^sub>f \ t \ \ = \ v + \ \(\w \ wfrestrictedvars\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e. t \ \ = \ w)" + (is "?P S") +using assms +proof (induction S rule: wf\<^sub>s\<^sub>t_simple_induct) + case (ConsSnd v S) show ?case + proof (cases "\w \ wfrestrictedvars\<^sub>s\<^sub>t S. t \ \ = \ w") + case True thus ?thesis using ConsSnd.IH by fastforce + next + case False thus ?thesis using ConsSnd.prems by auto + qed +next + case (ConsRcv t' S) + have "fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S" using ConsRcv.hyps(3) vars_snd_rcv_strand_subset2(1) by force + hence "\v \ wfrestrictedvars\<^sub>s\<^sub>t S. t \ \ = \ v" + using ConsRcv.prems(1) by fastforce + hence "?P S" by (metis ConsRcv.IH) + thus ?case by fastforce +next + case (ConsIneq X F S) + moreover have "wfrestrictedvars\<^sub>s\<^sub>t (S @ [Inequality X F]) = wfrestrictedvars\<^sub>s\<^sub>t S" by auto + ultimately have "?P S" by blast + thus ?case by fastforce +qed simp + +lemma (in intruder_model) wf_strand_first_Send_var_split: + assumes "wf\<^sub>s\<^sub>t {} S" "\v \ wfrestrictedvars\<^sub>s\<^sub>t S. t \ \ \ \ v" + shows "\S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f. \(\w \ wfrestrictedvars\<^sub>s\<^sub>t S\<^sub>p\<^sub>r\<^sub>e. t \ \ \ \ w) + \ ((\t'. S = S\<^sub>p\<^sub>r\<^sub>e@Send t'#S\<^sub>s\<^sub>u\<^sub>f \ t \ \ \ t' \ \) + \ (\t' t''. S = S\<^sub>p\<^sub>r\<^sub>e@Equality Assign t' t''#S\<^sub>s\<^sub>u\<^sub>f \ t \ \ \ t' \ \))" + (is "\S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f. ?P S\<^sub>p\<^sub>r\<^sub>e \ ?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f") +using assms +proof (induction S rule: wf\<^sub>s\<^sub>t_induct') + case (ConsSnd t' S) show ?case + proof (cases "\w \ wfrestrictedvars\<^sub>s\<^sub>t S. t \ \ \ \ w") + case True + then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f" + using ConsSnd.IH by moura + thus ?thesis by fastforce + next + case False + then obtain v where v: "v \ fv t'" "t \ \ \ \ v" + using ConsSnd.prems by auto + hence "t \ \ \ t' \ \" + using subst_mono[of "Var v" t' \] vars_iff_subtermeq[of v t'] term.order_trans + by auto + thus ?thesis using False v by auto + qed +next + case (ConsRcv t' S) + have "fv t' \ wfrestrictedvars\<^sub>s\<^sub>t S" + using ConsRcv.hyps vars_snd_rcv_strand_subset2(4)[of S] by blast + hence "\v \ wfrestrictedvars\<^sub>s\<^sub>t S. t \ \ \ \ v" + using ConsRcv.prems by fastforce + then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f" + using ConsRcv.IH by moura + thus ?case by fastforce +next + case (ConsEq s s' S) + have *: "fv s' \ wfrestrictedvars\<^sub>s\<^sub>t S" + using ConsEq.hyps vars_snd_rcv_strand_subset2(4)[of S] + by blast + show ?case + proof (cases "\v \ wfrestrictedvars\<^sub>s\<^sub>t S. t \ \ \ \ v") + case True + then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f" + using ConsEq.IH by moura + thus ?thesis by fastforce + next + case False + then obtain v where "v \ fv s" "t \ \ \ \ v" using ConsEq.prems * by auto + hence "t \ \ \ s \ \" + using vars_iff_subtermeq[of v s] subst_mono[of "Var v" s \] term.order_trans + by auto + thus ?thesis using False by fastforce + qed +next + case (ConsEq2 s s' S) + have "wfrestrictedvars\<^sub>s\<^sub>t (S@[Equality Check s s']) = wfrestrictedvars\<^sub>s\<^sub>t S" by auto + hence "\v \ wfrestrictedvars\<^sub>s\<^sub>t S. t \ \ \ \ v" using ConsEq2.prems by metis + then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f" + using ConsEq2.IH by moura + thus ?case by fastforce +next + case (ConsIneq X F S) + hence "\v \ wfrestrictedvars\<^sub>s\<^sub>t S. t \ \ \ \ v" by fastforce + then obtain S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f where "?P S\<^sub>p\<^sub>r\<^sub>e" "?Q S S\<^sub>p\<^sub>r\<^sub>e S\<^sub>s\<^sub>u\<^sub>f" + using ConsIneq.IH by moura + thus ?case by fastforce +qed simp + + +subsection \Constraint Semantics\ +context intruder_model +begin + +subsubsection \Definitions\ +text \The constraint semantics in which the intruder is limited to composition only\ +fun strand_sem_c::"('fun,'var) terms \ ('fun,'var) strand \ ('fun,'var) subst \ bool" ("\_; _\\<^sub>c") +where + "\M; []\\<^sub>c = (\\. True)" +| "\M; Send t#S\\<^sub>c = (\\. M \\<^sub>c t \ \ \ \M; S\\<^sub>c \)" +| "\M; Receive t#S\\<^sub>c = (\\. \insert (t \ \) M; S\\<^sub>c \)" +| "\M; Equality _ t t'#S\\<^sub>c = (\\. t \ \ = t' \ \ \ \M; S\\<^sub>c \)" +| "\M; Inequality X F#S\\<^sub>c = (\\. ineq_model \ X F \ \M; S\\<^sub>c \)" + +definition constr_sem_c ("_ \\<^sub>c \_,_\") where "\ \\<^sub>c \S,\\ \ (\ supports \ \ \{}; S\\<^sub>c \)" +abbreviation constr_sem_c' ("_ \\<^sub>c \_\" 90) where "\ \\<^sub>c \S\ \ \ \\<^sub>c \S,Var\" + +text \The full constraint semantics\ +fun strand_sem_d::"('fun,'var) terms \ ('fun,'var) strand \ ('fun,'var) subst \ bool" ("\_; _\\<^sub>d") +where + "\M; []\\<^sub>d = (\\. True)" +| "\M; Send t#S\\<^sub>d = (\\. M \ t \ \ \ \M; S\\<^sub>d \)" +| "\M; Receive t#S\\<^sub>d = (\\. \insert (t \ \) M; S\\<^sub>d \)" +| "\M; Equality _ t t'#S\\<^sub>d = (\\. t \ \ = t' \ \ \ \M; S\\<^sub>d \)" +| "\M; Inequality X F#S\\<^sub>d = (\\. ineq_model \ X F \ \M; S\\<^sub>d \)" + +definition constr_sem_d ("_ \ \_,_\") where "\ \ \S,\\ \ (\ supports \ \ \{}; S\\<^sub>d \)" +abbreviation constr_sem_d' ("_ \ \_\" 90) where "\ \ \S\ \ \ \ \S,Var\" + +lemmas strand_sem_induct = strand_sem_c.induct[case_names Nil ConsSnd ConsRcv ConsEq ConsIneq] + + +subsubsection \Lemmata\ +lemma strand_sem_d_if_c: "\ \\<^sub>c \S,\\ \ \ \ \S,\\" +proof - + assume *: "\ \\<^sub>c \S,\\" + { fix M have "\M; S\\<^sub>c \ \ \M; S\\<^sub>d \" + proof (induction S rule: strand_sem_induct) + case (ConsSnd M t S) + hence "M \\<^sub>c t \ \" "\M; S\\<^sub>d \" by auto + thus ?case using strand_sem_d.simps(2)[of M t S] by auto + qed (auto simp add: ineq_model_def) + } + thus ?thesis using * by (simp add: constr_sem_c_def constr_sem_d_def) +qed + +lemma strand_sem_mono_ik: + "\M \ M'; \M; S\\<^sub>c \\ \ \M'; S\\<^sub>c \" (is "\?A'; ?A''\ \ ?A") + "\M \ M'; \M; S\\<^sub>d \\ \ \M'; S\\<^sub>d \" (is "\?B'; ?B''\ \ ?B") +proof - + show "\?A'; ?A''\ \ ?A" + proof (induction M S arbitrary: M M' rule: strand_sem_induct) + case (ConsRcv M t S) + thus ?case using ConsRcv.IH[of "insert (t \ \) M" "insert (t \ \) M'"] by auto + next + case (ConsSnd M t S) + hence "M \\<^sub>c t \ \" "\M'; S\\<^sub>c \" by auto + hence "M' \\<^sub>c t \ \" using ideduct_synth_mono \M \ M'\ by metis + thus ?case using \\M'; S\\<^sub>c \\ by simp + qed auto + + show "\?B'; ?B''\ \ ?B" + proof (induction M S arbitrary: M M' rule: strand_sem_induct) + case (ConsRcv M t S) + thus ?case using ConsRcv.IH[of "insert (t \ \) M" "insert (t \ \) M'"] by auto + next + case (ConsSnd M t S) + hence "M \ t \ \" "\M'; S\\<^sub>d \" by auto + hence "M' \ t \ \" using ideduct_mono \M \ M'\ by metis + thus ?case using \\M'; S\\<^sub>d \\ by simp + qed auto +qed + +context +begin +private lemma strand_sem_split_left: + "\M; S@S'\\<^sub>c \ \ \M; S\\<^sub>c \" + "\M; S@S'\\<^sub>d \ \ \M; S\\<^sub>d \" +proof (induct S arbitrary: M) + case (Cons x S) + { case 1 thus ?case using Cons by (cases x) simp_all } + { case 2 thus ?case using Cons by (cases x) simp_all } +qed simp_all + +private lemma strand_sem_split_right: + "\M; S@S'\\<^sub>c \ \ \M \ (ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \); S'\\<^sub>c \" + "\M; S@S'\\<^sub>d \ \ \M \ (ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \); S'\\<^sub>d \" +proof (induction S arbitrary: M rule: ik\<^sub>s\<^sub>t_induct) + case (ConsRcv t S) + { case 1 thus ?case using ConsRcv.IH[of "insert (t \ \) M"] by simp } + { case 2 thus ?case using ConsRcv.IH[of "insert (t \ \) M"] by simp } +qed simp_all + +lemmas strand_sem_split[dest] = + strand_sem_split_left(1) strand_sem_split_right(1) + strand_sem_split_left(2) strand_sem_split_right(2) +end + +lemma strand_sem_Send_split[dest]: + "\\M; map Send T\\<^sub>c \; t \ set T\ \ \M; [Send t]\\<^sub>c \" (is "\?A'; ?A''\ \ ?A") + "\\M; map Send T\\<^sub>d \; t \ set T\ \ \M; [Send t]\\<^sub>d \" (is "\?B'; ?B''\ \ ?B") + "\\M; map Send T@S\\<^sub>c \; t \ set T\ \ \M; Send t#S\\<^sub>c \" (is "\?C'; ?C''\ \ ?C") + "\\M; map Send T@S\\<^sub>d \; t \ set T\ \ \M; Send t#S\\<^sub>d \" (is "\?D'; ?D''\ \ ?D") +proof - + show A: "\?A'; ?A''\ \ ?A" by (induct "map Send T" arbitrary: T rule: strand_sem_c.induct) auto + show B: "\?B'; ?B''\ \ ?B" by (induct "map Send T" arbitrary: T rule: strand_sem_d.induct) auto + show "\?C'; ?C''\ \ ?C" "\?D'; ?D''\ \ ?D" + using list.set_map list.simps(8) set_empty ik_snd_empty sup_bot.right_neutral + by (metis (no_types, lifting) A strand_sem_split(1,2) strand_sem_c.simps(2), + metis (no_types, lifting) B strand_sem_split(3,4) strand_sem_d.simps(2)) +qed + +lemma strand_sem_Send_map: + "(\t. t \ set T \ \M; [Send t]\\<^sub>c \) \ \M; map Send T\\<^sub>c \" + "(\t. t \ set T \ \M; [Send t]\\<^sub>d \) \ \M; map Send T\\<^sub>d \" +by (induct T) auto + +lemma strand_sem_Receive_map: "\M; map Receive T\\<^sub>c \" "\M; map Receive T\\<^sub>d \" +by (induct T arbitrary: M) auto + +lemma strand_sem_append[intro]: + "\\M; S\\<^sub>c \; \M \ (ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \); S'\\<^sub>c \\ \ \M; S@S'\\<^sub>c \" + "\\M; S\\<^sub>d \; \M \ (ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \); S'\\<^sub>d \\ \ \M; S@S'\\<^sub>d \" +proof (induction S arbitrary: M) + case (Cons x S) + { case 1 thus ?case using Cons by (cases x) auto } + { case 2 thus ?case using Cons by (cases x) auto } +qed simp_all + +lemma ineq_model_subst: + fixes F::"(('a,'b) term \ ('a,'b) term) list" + assumes "(subst_domain \ \ range_vars \) \ set X = {}" + and "ineq_model (\ \\<^sub>s \) X F" + shows "ineq_model \ X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" +proof - + { fix \::"('a,'b) subst" and t t' + assume \: "subst_domain \ = set X" "ground (subst_range \)" + and *: "list_ex (\f. fst f \ (\ \\<^sub>s (\ \\<^sub>s \)) \ snd f \ (\ \\<^sub>s (\ \\<^sub>s \))) F" + obtain f where f: "f \ set F" "fst f \ \ \\<^sub>s (\ \\<^sub>s \) \ snd f \ \ \\<^sub>s (\ \\<^sub>s \)" + using * by (induct F) auto + have "\ \\<^sub>s (\ \\<^sub>s \) = \ \\<^sub>s (\ \\<^sub>s \)" + by (metis (no_types, lifting) \ subst_compose_assoc assms(1) inf_sup_aci(1) + subst_comp_eq_if_disjoint_vars sup_inf_absorb range_vars_alt_def) + hence "(fst f \ \) \ \ \\<^sub>s \ \ (snd f \ \) \ \ \\<^sub>s \" using f by auto + moreover have "(fst f \ \, snd f \ \) \ set (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using f(1) by (auto simp add: subst_apply_pairs_def) + ultimately have "list_ex (\f. fst f \ (\ \\<^sub>s \) \ snd f \ (\ \\<^sub>s \)) (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using f(1) Bex_set by fastforce + } + thus ?thesis using assms unfolding ineq_model_def by simp +qed + +lemma ineq_model_subst': + fixes F::"(('a,'b) term \ ('a,'b) term) list" + assumes "(subst_domain \ \ range_vars \) \ set X = {}" + and "ineq_model \ X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + shows "ineq_model (\ \\<^sub>s \) X F" +proof - + { fix \::"('a,'b) subst" and t t' + assume \: "subst_domain \ = set X" "ground (subst_range \)" + and *: "list_ex (\f. fst f \ (\ \\<^sub>s \) \ snd f \ (\ \\<^sub>s \)) (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + obtain f where f: "f \ set (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" "fst f \ \ \\<^sub>s \ \ snd f \ \ \\<^sub>s \" + using * by (induct F) (auto simp add: subst_apply_pairs_def) + then obtain g where g: "g \ set F" "f = g \\<^sub>p \" by (auto simp add: subst_apply_pairs_def) + have "\ \\<^sub>s (\ \\<^sub>s \) = \ \\<^sub>s (\ \\<^sub>s \)" + by (metis (no_types, lifting) \ subst_compose_assoc assms(1) inf_sup_aci(1) + subst_comp_eq_if_disjoint_vars sup_inf_absorb range_vars_alt_def) + hence "fst g \ \ \\<^sub>s (\ \\<^sub>s \) \ snd g \ \ \\<^sub>s (\ \\<^sub>s \)" + using f(2) g by (simp add: prod.case_eq_if) + hence "list_ex (\f. fst f \ (\ \\<^sub>s (\ \\<^sub>s \)) \ snd f \ (\ \\<^sub>s (\ \\<^sub>s \))) F" + using g Bex_set by fastforce + } + thus ?thesis using assms unfolding ineq_model_def by simp +qed + +lemma ineq_model_ground_subst: + fixes F::"(('a,'b) term \ ('a,'b) term) list" + assumes "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \ subst_domain \" + and "ground (subst_range \)" + and "ineq_model \ X F" + shows "ineq_model (\ \\<^sub>s \) X F" +proof - + { fix \::"('a,'b) subst" and t t' + assume \: "subst_domain \ = set X" "ground (subst_range \)" + and *: "list_ex (\f. fst f \ (\ \\<^sub>s \) \ snd f \ (\ \\<^sub>s \ )) F" + obtain f where f: "f \ set F" "fst f \ \ \\<^sub>s \ \ snd f \ \ \\<^sub>s \" + using * by (induct F) auto + hence "fv (fst f) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" "fv (snd f) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" by auto + hence "fv (fst f) - set X \ subst_domain \" "fv (snd f) - set X \ subst_domain \" + using assms(1) by auto + hence "fv (fst f \ \) \ subst_domain \" "fv (snd f \ \) \ subst_domain \" + using \ by (simp_all add: range_vars_alt_def subst_fv_unfold_ground_img) + hence "fv (fst f \ \ \\<^sub>s \) = {}" "fv (snd f \ \ \\<^sub>s \) = {}" + using assms(2) by (simp_all add: subst_fv_dom_ground_if_ground_img) + hence "fst f \ \ \\<^sub>s (\ \\<^sub>s \) \ snd f \ \ \\<^sub>s (\ \\<^sub>s \)" using f(2) subst_ground_ident by fastforce + hence "list_ex (\f. fst f \ (\ \\<^sub>s (\ \\<^sub>s \)) \ snd f \ (\ \\<^sub>s (\ \\<^sub>s \))) F" + using f(1) Bex_set by fastforce + } + thus ?thesis using assms unfolding ineq_model_def by simp +qed + +context +begin +private lemma strand_sem_subst_c: + assumes "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" + shows "\M; S\\<^sub>c (\ \\<^sub>s \) \ \M; S \\<^sub>s\<^sub>t \\\<^sub>c \" +using assms +proof (induction S arbitrary: \ M rule: strand_sem_induct) + case (ConsSnd M t S) + hence "\M; S \\<^sub>s\<^sub>t \\\<^sub>c \" "M \\<^sub>c t \ (\ \\<^sub>s \)" by auto + hence "M \\<^sub>c (t \ \) \ \" + using subst_comp_all[of \ \ M] subst_subst_compose[of t \ \] by simp + thus ?case + using \\M; S \\<^sub>s\<^sub>t \\\<^sub>c \\ + unfolding subst_apply_strand_def + by simp +next + case (ConsRcv M t S) + have *: "\insert (t \ \ \\<^sub>s \) M; S\\<^sub>c (\ \\<^sub>s \)" using ConsRcv.prems(1) by simp + have "bvars\<^sub>s\<^sub>t (Receive t#S) = bvars\<^sub>s\<^sub>t S" by auto + hence **: "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" using ConsRcv.prems(2) by blast + have "\M; Receive (t \ \)#(S \\<^sub>s\<^sub>t \)\\<^sub>c \" + using ConsRcv.IH[OF * **] by (simp add: subst_all_insert) + thus ?case by simp +next + case (ConsIneq M X F S) + hence *: "\M; S \\<^sub>s\<^sub>t \\\<^sub>c \" and + ***: "(subst_domain \ \ range_vars \) \ set X = {}" + unfolding bvars\<^sub>s\<^sub>t_def ineq_model_def by auto + have **: "ineq_model (\ \\<^sub>s \) X F" + using ConsIneq by (auto simp add: subst_compose_assoc ineq_model_def) + have "\\. subst_domain \ = set X \ ground (subst_range \) + \ (subst_domain \ \ range_vars \) \ (subst_domain \ \ range_vars \) = {}" + using * ** *** unfolding range_vars_alt_def by auto + hence "\\. subst_domain \ = set X \ ground (subst_range \) \ \ \\<^sub>s \ = \ \\<^sub>s \" + by (metis subst_comp_eq_if_disjoint_vars) + hence "ineq_model \ X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using ineq_model_subst[OF *** **] + by blast + moreover have "rm_vars (set X) \ = \" using ConsIneq.prems(2) by force + ultimately show ?case using * by auto +qed simp_all + +private lemma strand_sem_subst_c': + assumes "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" + shows "\M; S \\<^sub>s\<^sub>t \\\<^sub>c \ \ \M; S\\<^sub>c (\ \\<^sub>s \)" +using assms +proof (induction S arbitrary: \ M rule: strand_sem_induct) + case (ConsSnd M t S) + hence "\M; [Send t] \\<^sub>s\<^sub>t \\\<^sub>c \" "\M; S \\<^sub>s\<^sub>t \\\<^sub>c \" by auto + hence "\M; S\\<^sub>c (\ \\<^sub>s \)" using ConsSnd.IH[OF _] ConsSnd.prems(2) by auto + moreover have "\M; [Send t]\\<^sub>c (\ \\<^sub>s \)" + proof - + have "M \\<^sub>c t \ \ \ \" using \\M; [Send t] \\<^sub>s\<^sub>t \\\<^sub>c \\ by auto + hence "M \\<^sub>c t \ (\ \\<^sub>s \)" using subst_subst_compose by metis + thus "\M; [Send t]\\<^sub>c (\ \\<^sub>s \)" by auto + qed + ultimately show ?case by auto +next + case (ConsRcv M t S) + hence "\(insert (t \ \ \ \) M); S \\<^sub>s\<^sub>t \\\<^sub>c \" by (simp add: subst_all_insert) + thus ?case using ConsRcv.IH ConsRcv.prems(2) by auto +next + case (ConsIneq M X F S) + have \: "rm_vars (set X) \ = \" using ConsIneq.prems(2) by force + hence *: "\M; S\\<^sub>c (\ \\<^sub>s \)" + and ***: "(subst_domain \ \ range_vars \) \ set X = {}" + using ConsIneq unfolding bvars\<^sub>s\<^sub>t_def ineq_model_def by auto + have **: "ineq_model \ X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using ConsIneq.prems(1) \ by (auto simp add: subst_compose_assoc ineq_model_def) + have "\\. subst_domain \ = set X \ ground (subst_range \) + \ (subst_domain \ \ range_vars \) \ (subst_domain \ \ range_vars \) = {}" + using * ** *** unfolding range_vars_alt_def by auto + hence "\\. subst_domain \ = set X \ ground (subst_range \) \ \ \\<^sub>s \ = \ \\<^sub>s \" + by (metis subst_comp_eq_if_disjoint_vars) + hence "ineq_model (\ \\<^sub>s \) X F" + using ineq_model_subst'[OF *** **] + by blast + thus ?case using * by auto +next + case ConsEq thus ?case unfolding bvars\<^sub>s\<^sub>t_def by auto +qed simp_all + +private lemma strand_sem_subst_d: + assumes "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" + shows "\M; S\\<^sub>d (\ \\<^sub>s \) \ \M; S \\<^sub>s\<^sub>t \\\<^sub>d \" +using assms +proof (induction S arbitrary: \ M rule: strand_sem_induct) + case (ConsSnd M t S) + hence "\M; S \\<^sub>s\<^sub>t \\\<^sub>d \" "M \ t \ (\ \\<^sub>s \)" by auto + hence "M \ (t \ \) \ \" + using subst_comp_all[of \ \ M] subst_subst_compose[of t \ \] by simp + thus ?case using \\M; S \\<^sub>s\<^sub>t \\\<^sub>d \\ by simp +next + case (ConsRcv M t S) + have *: "\insert (t \ \ \\<^sub>s \) M; S\\<^sub>d (\ \\<^sub>s \)" using ConsRcv.prems(1) by simp + have "bvars\<^sub>s\<^sub>t (Receive t#S) = bvars\<^sub>s\<^sub>t S" by auto + hence **: "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" using ConsRcv.prems(2) by blast + have "\M; Receive (t \ \)#(S \\<^sub>s\<^sub>t \)\\<^sub>d \" + using ConsRcv.IH[OF * **] by (simp add: subst_all_insert) + thus ?case by simp +next + case (ConsIneq M X F S) + hence *: "\M; S \\<^sub>s\<^sub>t \\\<^sub>d \" and + ***: "(subst_domain \ \ range_vars \) \ set X = {}" + unfolding bvars\<^sub>s\<^sub>t_def ineq_model_def by auto + have **: "ineq_model (\ \\<^sub>s \) X F" + using ConsIneq by (auto simp add: subst_compose_assoc ineq_model_def) + have "\\. subst_domain \ = set X \ ground (subst_range \) + \ (subst_domain \ \ range_vars \) \ (subst_domain \ \ range_vars \) = {}" + using * ** *** unfolding range_vars_alt_def by auto + hence "\\. subst_domain \ = set X \ ground (subst_range \) \ \ \\<^sub>s \ = \ \\<^sub>s \" + by (metis subst_comp_eq_if_disjoint_vars) + hence "ineq_model \ X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using ineq_model_subst[OF *** **] + by blast + moreover have "rm_vars (set X) \ = \" using ConsIneq.prems(2) by force + ultimately show ?case using * by auto +next + case ConsEq thus ?case unfolding bvars\<^sub>s\<^sub>t_def by auto +qed simp_all + +private lemma strand_sem_subst_d': + assumes "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" + shows "\M; S \\<^sub>s\<^sub>t \\\<^sub>d \ \ \M; S\\<^sub>d (\ \\<^sub>s \)" +using assms +proof (induction S arbitrary: \ M rule: strand_sem_induct) + case (ConsSnd M t S) + hence "\M; [Send t] \\<^sub>s\<^sub>t \\\<^sub>d \" "\M; S \\<^sub>s\<^sub>t \\\<^sub>d \" by auto + hence "\M; S\\<^sub>d (\ \\<^sub>s \)" using ConsSnd.IH[OF _] ConsSnd.prems(2) by auto + moreover have "\M; [Send t]\\<^sub>d (\ \\<^sub>s \)" + proof - + have "M \ t \ \ \ \" using \\M; [Send t] \\<^sub>s\<^sub>t \\\<^sub>d \\ by auto + hence "M \ t \ (\ \\<^sub>s \)" using subst_subst_compose by metis + thus "\M; [Send t]\\<^sub>d (\ \\<^sub>s \)" by auto + qed + ultimately show ?case by auto +next + case (ConsRcv M t S) + hence "\insert (t \ \ \ \) M; S \\<^sub>s\<^sub>t \\\<^sub>d \" by (simp add: subst_all_insert) + thus ?case using ConsRcv.IH ConsRcv.prems(2) by auto +next + case (ConsIneq M X F S) + have \: "rm_vars (set X) \ = \" using ConsIneq.prems(2) by force + hence *: "\M; S\\<^sub>d (\ \\<^sub>s \)" + and ***: "(subst_domain \ \ range_vars \) \ set X = {}" + using ConsIneq unfolding bvars\<^sub>s\<^sub>t_def ineq_model_def by auto + have **: "ineq_model \ X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + using ConsIneq.prems(1) \ by (auto simp add: subst_compose_assoc ineq_model_def) + have "\\. subst_domain \ = set X \ ground (subst_range \) + \ (subst_domain \ \ range_vars \) \ (subst_domain \ \ range_vars \) = {}" + using * ** *** unfolding range_vars_alt_def by auto + hence "\\. subst_domain \ = set X \ ground (subst_range \) \ \ \\<^sub>s \ = \ \\<^sub>s \" + by (metis subst_comp_eq_if_disjoint_vars) + hence "ineq_model (\ \\<^sub>s \) X F" + using ineq_model_subst'[OF *** **] + by blast + thus ?case using * by auto +next + case ConsEq thus ?case unfolding bvars\<^sub>s\<^sub>t_def by auto +qed simp_all + +lemmas strand_sem_subst = + strand_sem_subst_c strand_sem_subst_c' strand_sem_subst_d strand_sem_subst_d' +end + +lemma strand_sem_subst_subst_idem: + assumes \: "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" + shows "\\M; S \\<^sub>s\<^sub>t \\\<^sub>c (\ \\<^sub>s \); subst_idem \\ \ \M; S\\<^sub>c (\ \\<^sub>s \)" +using strand_sem_subst(2)[OF assms, of M "\ \\<^sub>s \"] subst_compose_assoc[of \ \ \] +unfolding subst_idem_def by argo + +lemma strand_sem_subst_comp: + assumes "(subst_domain \ \ range_vars \) \ bvars\<^sub>s\<^sub>t S = {}" + and "\M; S\\<^sub>c \" "subst_domain \ \ (vars\<^sub>s\<^sub>t S \ fv\<^sub>s\<^sub>e\<^sub>t M) = {}" + shows "\M; S\\<^sub>c (\ \\<^sub>s \)" +proof - + from assms(3) have "subst_domain \ \ vars\<^sub>s\<^sub>t S = {}" "subst_domain \ \ fv\<^sub>s\<^sub>e\<^sub>t M = {}" by auto + hence "S \\<^sub>s\<^sub>t \ = S" "M \\<^sub>s\<^sub>e\<^sub>t \ = M" using strand_substI set_subst_ident[of M \] by (blast, blast) + thus ?thesis using assms(2) by (auto simp add: strand_sem_subst(2)[OF assms(1)]) +qed + +lemma strand_sem_c_imp_ineqs_neq: + assumes "\M; S\\<^sub>c \" "Inequality X [(t,t')] \ set S" + shows "t \ t' \ (\\. subst_domain \ = set X \ ground (subst_range \) + \ t \ \ \ t' \ \ \ t \ \ \ \ \ t' \ \ \ \)" +using assms +proof (induction rule: strand_sem_induct) + case (ConsIneq M Y F S) thus ?case + proof (cases "Inequality X [(t,t')] \ set S") + case False + hence "X = Y" "F = [(t,t')]" using ConsIneq by auto + hence *: "\\. subst_domain \ = set X \ ground (subst_range \) \ t \ \ \ \ \ t' \ \ \ \" + using ConsIneq by (auto simp add: ineq_model_def) + then obtain \ where \: "subst_domain \ = set X" "ground (subst_range \)" "t \ \ \ \ \ t' \ \ \ \" + using interpretation_subst_exists'[of "set X"] by moura + hence "t \ t'" by auto + moreover have "\\ \. t \ \ \ \ \ t' \ \ \ \ \ t \ \ \ t' \ \" by auto + ultimately show ?thesis using * by auto + qed simp +qed simp_all + +lemma strand_sem_c_imp_ineq_model: + assumes "\M; S\\<^sub>c \" "Inequality X F \ set S" + shows "ineq_model \ X F" +using assms by (induct S rule: strand_sem_induct) force+ + +lemma strand_sem_wf_simple_fv_sat: + assumes "wf\<^sub>s\<^sub>t {} S" "simple S" "\{}; S\\<^sub>c \" + shows "\v. v \ wfrestrictedvars\<^sub>s\<^sub>t S \ ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c \ v" +using assms +proof (induction S rule: wf\<^sub>s\<^sub>t_simple_induct) + case (ConsRcv t S) + have "v \ wfrestrictedvars\<^sub>s\<^sub>t S" + using ConsRcv.hyps(3) ConsRcv.prems(1) vars_snd_rcv_strand2 + by fastforce + moreover have "\{}; S\\<^sub>c \" using \\{}; S@[Receive t]\\<^sub>c \\ by blast + moreover have "ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \ \ ik\<^sub>s\<^sub>t (S@[Receive t]) \\<^sub>s\<^sub>e\<^sub>t \" by auto + ultimately show ?case using ConsRcv.IH ideduct_synth_mono by meson +next + case (ConsIneq X F S) + hence "v \ wfrestrictedvars\<^sub>s\<^sub>t S" by fastforce + moreover have "\{}; S\\<^sub>c \" using \\{}; S@[Inequality X F]\\<^sub>c \\ by blast + moreover have "ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \ \ ik\<^sub>s\<^sub>t (S@[Inequality X F]) \\<^sub>s\<^sub>e\<^sub>t \" by auto + ultimately show ?case using ConsIneq.IH ideduct_synth_mono by meson +next + case (ConsSnd w S) + hence *: "\{}; S\\<^sub>c \" "ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c \ w" by auto + have **: "ik\<^sub>s\<^sub>t S \\<^sub>s\<^sub>e\<^sub>t \ \ ik\<^sub>s\<^sub>t (S@[Send (Var w)]) \\<^sub>s\<^sub>e\<^sub>t \" by simp + show ?case + proof (cases "v = w") + case True thus ?thesis using *(2) ideduct_synth_mono[OF _ **] by meson + next + case False + hence "v \ wfrestrictedvars\<^sub>s\<^sub>t S" using ConsSnd.prems(1) by auto + thus ?thesis using ConsSnd.IH[OF _ *(1)] ideduct_synth_mono[OF _ **] by metis + qed +qed simp + +lemma strand_sem_wf_ik_or_assignment_rhs_fun_subterm: + assumes "wf\<^sub>s\<^sub>t {} A" "\{}; A\\<^sub>c \" "Var x \ ik\<^sub>s\<^sub>t A" "\ x = Fun f T" + "t\<^sub>i \ set T" "\ik\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t\<^sub>i" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + obtains S where + "Fun f S \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t A) \ Fun f S \ subterms\<^sub>s\<^sub>e\<^sub>t (assignment_rhs\<^sub>s\<^sub>t A)" + "Fun f T = Fun f S \ \" +proof - + have "x \ wfrestrictedvars\<^sub>s\<^sub>t A" + by (metis (no_types) assms(3) set_rev_mp term.set_intros(3) vars_subset_if_in_strand_ik2) + moreover have "Fun f T \ \ = Fun f T" + by (metis subst_ground_ident interpretation_grounds_all assms(4,7)) + ultimately obtain A\<^sub>p\<^sub>r\<^sub>e A\<^sub>s\<^sub>u\<^sub>f where *: + "\(\w \ wfrestrictedvars\<^sub>s\<^sub>t A\<^sub>p\<^sub>r\<^sub>e. Fun f T \ \ w)" + "(\t. A = A\<^sub>p\<^sub>r\<^sub>e@Send t#A\<^sub>s\<^sub>u\<^sub>f \ Fun f T \ t \ \) \ + (\t t'. A = A\<^sub>p\<^sub>r\<^sub>e@Equality Assign t t'#A\<^sub>s\<^sub>u\<^sub>f \ Fun f T \ t \ \)" + using wf_strand_first_Send_var_split[OF assms(1)] assms(4) subtermeqI' by metis + moreover + { fix t assume **: "A = A\<^sub>p\<^sub>r\<^sub>e@Send t#A\<^sub>s\<^sub>u\<^sub>f" "Fun f T \ t \ \" + hence "ik\<^sub>s\<^sub>t A\<^sub>p\<^sub>r\<^sub>e \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \" "\ik\<^sub>s\<^sub>t A\<^sub>p\<^sub>r\<^sub>e \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t\<^sub>i" + using assms(2,6) by (auto intro: ideduct_synth_mono) + then obtain s where s: "s \ ik\<^sub>s\<^sub>t A\<^sub>p\<^sub>r\<^sub>e" "Fun f T \ s \ \" + using assms(5) **(2) by (induct rule: intruder_synth_induct) auto + then obtain g S where gS: "Fun g S \ s" "Fun f T = Fun g S \ \" + using subterm_subst_not_img_subterm[OF s(2)] *(1) by force + hence ?thesis using that **(1) s(1) by force + } + moreover + { fix t t' assume **: "A = A\<^sub>p\<^sub>r\<^sub>e@Equality Assign t t'#A\<^sub>s\<^sub>u\<^sub>f" "Fun f T \ t \ \" + with assms(2) have "t \ \ = t' \ \" by auto + hence "Fun f T \ t' \ \" using **(2) by auto + from assms(1) **(1) have "fv t' \ wfrestrictedvars\<^sub>s\<^sub>t A\<^sub>p\<^sub>r\<^sub>e" + using wf_eq_fv[of "{}" A\<^sub>p\<^sub>r\<^sub>e t t' A\<^sub>s\<^sub>u\<^sub>f] vars_snd_rcv_strand_subset2(4)[of A\<^sub>p\<^sub>r\<^sub>e] + by blast + then obtain g S where gS: "Fun g S \ t'" "Fun f T = Fun g S \ \" + using subterm_subst_not_img_subterm[OF \Fun f T \ t' \ \\] *(1) by fastforce + hence ?thesis using that **(1) by auto + } + ultimately show ?thesis by auto +qed + +lemma strand_sem_not_unif_is_sat_ineq: + assumes "\\. Unifier \ t t'" + shows "\M; [Inequality X [(t,t')]]\\<^sub>c \" "\M; [Inequality X [(t,t')]]\\<^sub>d \" +using assms list_ex_simps(1)[of _ "(t,t')" "[]"] prod.sel[of t t'] + strand_sem_c.simps(1,5) strand_sem_d.simps(1,5) +unfolding ineq_model_def by presburger+ + +lemma ineq_model_singleI[intro]: + assumes "\\. subst_domain \ = set X \ ground (subst_range \) \ t \ \ \ \ \ t' \ \ \ \" + shows "ineq_model \ X [(t,t')]" +using assms unfolding ineq_model_def by auto + +lemma ineq_model_singleE: + assumes "ineq_model \ X [(t,t')]" + shows "\\. subst_domain \ = set X \ ground (subst_range \) \ t \ \ \ \ \ t' \ \ \ \" +using assms unfolding ineq_model_def by auto + +lemma ineq_model_single_iff: + fixes F::"(('a,'b) term \ ('a,'b) term) list" + shows "ineq_model \ X F \ + ineq_model \ X [(Fun f (Fun c []#map fst F),Fun f (Fun c []#map snd F))]" + (is "?A \ ?B") +proof - + let ?P = "\\ f. fst f \ (\ \\<^sub>s \) \ snd f \ (\ \\<^sub>s \)" + let ?Q = "\\ t t'. t \ (\ \\<^sub>s \) \ t' \ (\ \\<^sub>s \)" + let ?T = "\g. Fun c []#map g F" + let ?S = "\\ g. map (\x. x \ (\ \\<^sub>s \)) (Fun c []#map g F)" + let ?t = "Fun f (?T fst)" + let ?t' = "Fun f (?T snd)" + + have len: "\g h. length (?T g) = length (?T h)" + "\g h \. length (?S \ g) = length (?T h)" + "\g h \. length (?S \ g) = length (?T h)" + "\g h \ \. length (?S \ g) = length (?S \ h)" + by simp_all + + { fix \::"('a,'b) subst" + assume \: "subst_domain \ = set X" "ground (subst_range \)" + have "list_ex (?P \) F \ ?Q \ ?t ?t'" + proof + assume "list_ex (?P \) F" + then obtain a where a: "a \ set F" "?P \ a" by (metis (mono_tags, lifting) Bex_set) + thus "?Q \ ?t ?t'" by auto + qed (fastforce simp add: Bex_set) + } thus ?thesis unfolding ineq_model_def by auto +qed + + +subsection \Constraint Semantics (Alternative, Equivalent Version)\ +text \These are the constraint semantics used in the CSF 2017 paper\ +fun strand_sem_c'::"('fun,'var) terms \ ('fun,'var) strand \ ('fun,'var) subst \ bool" ("\_; _\\<^sub>c''") + where + "\M; []\\<^sub>c' = (\\. True)" +| "\M; Send t#S\\<^sub>c' = (\\. M \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \ \ \M; S\\<^sub>c' \)" +| "\M; Receive t#S\\<^sub>c' = \insert t M; S\\<^sub>c'" +| "\M; Equality _ t t'#S\\<^sub>c' = (\\. t \ \ = t' \ \ \ \M; S\\<^sub>c' \)" +| "\M; Inequality X F#S\\<^sub>c' = (\\. ineq_model \ X F \ \M; S\\<^sub>c' \)" + +fun strand_sem_d'::"('fun,'var) terms \ ('fun,'var) strand \ ('fun,'var) subst \ bool" ("\_; _\\<^sub>d''") +where + "\M; []\\<^sub>d' = (\\. True)" +| "\M; Send t#S\\<^sub>d' = (\\. M \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \ \ \M; S\\<^sub>d' \)" +| "\M; Receive t#S\\<^sub>d' = \insert t M; S\\<^sub>d'" +| "\M; Equality _ t t'#S\\<^sub>d' = (\\. t \ \ = t' \ \ \ \M; S\\<^sub>d' \)" +| "\M; Inequality X F#S\\<^sub>d' = (\\. ineq_model \ X F \ \M; S\\<^sub>d' \)" + +lemma strand_sem_eq_defs: + "\M; \\\<^sub>c' \ = \M \\<^sub>s\<^sub>e\<^sub>t \; \\\<^sub>c \" + "\M; \\\<^sub>d' \ = \M \\<^sub>s\<^sub>e\<^sub>t \; \\\<^sub>d \" +proof - + have 1: "\M; \\\<^sub>c' \ \ \M \\<^sub>s\<^sub>e\<^sub>t \; \\\<^sub>c \" + by (induct \ arbitrary: M rule: strand_sem_induct) force+ + have 2: "\M \\<^sub>s\<^sub>e\<^sub>t \; \\\<^sub>c \ \ \M; \\\<^sub>c' \" + by (induct \ arbitrary: M rule: strand_sem_c'.induct) auto + have 3: "\M; \\\<^sub>d' \ \ \M \\<^sub>s\<^sub>e\<^sub>t \; \\\<^sub>d \" + by (induct \ arbitrary: M rule: strand_sem_induct) force+ + have 4: "\M \\<^sub>s\<^sub>e\<^sub>t \; \\\<^sub>d \ \ \M; \\\<^sub>d' \" + by (induct \ arbitrary: M rule: strand_sem_d'.induct) auto + + show "\M; \\\<^sub>c' \ = \M \\<^sub>s\<^sub>e\<^sub>t \; \\\<^sub>c \" "\M; \\\<^sub>d' \ = \M \\<^sub>s\<^sub>e\<^sub>t \; \\\<^sub>d \" + by (metis 1 2, metis 3 4) +qed + +lemma strand_sem_split'[dest]: + "\M; S@S'\\<^sub>c' \ \ \M; S\\<^sub>c' \" + "\M; S@S'\\<^sub>c' \ \ \M \ ik\<^sub>s\<^sub>t S; S'\\<^sub>c' \" + "\M; S@S'\\<^sub>d' \ \ \M; S\\<^sub>d' \" + "\M; S@S'\\<^sub>d' \ \ \M \ ik\<^sub>s\<^sub>t S; S'\\<^sub>d' \" +using strand_sem_eq_defs[of M "S@S'" \] + strand_sem_eq_defs[of M S \] + strand_sem_eq_defs[of "M \ ik\<^sub>s\<^sub>t S" S' \] + strand_sem_split(2,4) +by (auto simp add: image_Un) + +lemma strand_sem_append'[intro]: + "\M; S\\<^sub>c' \ \ \M \ ik\<^sub>s\<^sub>t S; S'\\<^sub>c' \ \ \M; S@S'\\<^sub>c' \" + "\M; S\\<^sub>d' \ \ \M \ ik\<^sub>s\<^sub>t S; S'\\<^sub>d' \ \ \M; S@S'\\<^sub>d' \" +using strand_sem_eq_defs[of M "S@S'" \] + strand_sem_eq_defs[of M S \] + strand_sem_eq_defs[of "M \ ik\<^sub>s\<^sub>t S" S' \] +by (auto simp add: image_Un) + +end + +subsection \Dual Strands\ +fun dual\<^sub>s\<^sub>t::"('a,'b) strand \ ('a,'b) strand" where + "dual\<^sub>s\<^sub>t [] = []" +| "dual\<^sub>s\<^sub>t (Receive t#S) = Send t#(dual\<^sub>s\<^sub>t S)" +| "dual\<^sub>s\<^sub>t (Send t#S) = Receive t#(dual\<^sub>s\<^sub>t S)" +| "dual\<^sub>s\<^sub>t (x#S) = x#(dual\<^sub>s\<^sub>t S)" + +lemma dual\<^sub>s\<^sub>t_append: "dual\<^sub>s\<^sub>t (A@B) = (dual\<^sub>s\<^sub>t A)@(dual\<^sub>s\<^sub>t B)" +by (induct A rule: dual\<^sub>s\<^sub>t.induct) auto + +lemma dual\<^sub>s\<^sub>t_self_inverse: "dual\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t S) = S" +proof (induction S) + case (Cons x S) thus ?case by (cases x) auto +qed simp + +lemma dual\<^sub>s\<^sub>t_trms_eq: "trms\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t S) = trms\<^sub>s\<^sub>t S" +proof (induction S) + case (Cons x S) thus ?case by (cases x) auto +qed simp + +lemma dual\<^sub>s\<^sub>t_fv: "fv\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t A) = fv\<^sub>s\<^sub>t A" +by (induct A rule: dual\<^sub>s\<^sub>t.induct) auto + +lemma dual\<^sub>s\<^sub>t_bvars: "bvars\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t A) = bvars\<^sub>s\<^sub>t A" +by (induct A rule: dual\<^sub>s\<^sub>t.induct) fastforce+ + + +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Typed_Model.thy b/thys/Stateful_Protocol_Composition_and_Typing/Typed_Model.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Typed_Model.thy @@ -0,0 +1,2363 @@ +(* +(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: Typed_Model.thy + Author: Andreas Viktor Hess, DTU +*) + +section \The Typed Model\ +theory Typed_Model +imports Lazy_Intruder +begin + +text \Term types\ +type_synonym ('f,'v) term_type = "('f,'v) term" + +text \Constructors for term types\ +abbreviation (input) TAtom::"'v \ ('f,'v) term_type" where + "TAtom a \ Var a" + +abbreviation (input) TComp::"['f, ('f,'v) term_type list] \ ('f,'v) term_type" where + "TComp f T \ Fun f T" + + +text \ + The typed model extends the intruder model with a typing function \\\ that assigns types to terms. +\ +locale typed_model = intruder_model arity public Ana + for arity::"'fun \ nat" + and public::"'fun \ bool" + and Ana::"('fun,'var) term \ (('fun,'var) term list \ ('fun,'var) term list)" + + + fixes \::"('fun,'var) term \ ('fun,'atom::finite) term_type" + assumes const_type: "\c. arity c = 0 \ \a. \T. \ (Fun c T) = TAtom a" + and fun_type: "\f T. arity f > 0 \ \ (Fun f T) = TComp f (map \ T)" + and infinite_typed_consts: "\a. infinite {c. \ (Fun c []) = TAtom a \ public c}" + and \_wf: "\t f T. TComp f T \ \ t \ arity f > 0" + "\x. wf\<^sub>t\<^sub>r\<^sub>m (\ (Var x))" + and no_private_funs[simp]: "\f. arity f > 0 \ public f" +begin + +subsection \Definitions\ +text \The set of atomic types\ +abbreviation "\\<^sub>a \ UNIV::('atom set)" + +text \Well-typed substitutions\ +definition wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t where + "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ (\v. \ (Var v) = \ (\ v))" + +text \The set of sub-message patterns (SMP)\ +inductive_set SMP::"('fun,'var) terms \ ('fun,'var) terms" for M where + MP[intro]: "t \ M \ t \ SMP M" +| Subterm[intro]: "\t \ SMP M; t' \ t\ \ t' \ SMP M" +| Substitution[intro]: "\t \ SMP M; wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \; wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)\ \ (t \ \) \ SMP M" +| Ana[intro]: "\t \ SMP M; Ana t = (K,T); k \ set K\ \ k \ SMP M" + +text \ + Type-flaw resistance for sets: + Unifiable sub-message patterns must have the same type (unless they are variables) +\ +definition tfr\<^sub>s\<^sub>e\<^sub>t where + "tfr\<^sub>s\<^sub>e\<^sub>t M \ (\s \ SMP M - (Var`\). \t \ SMP M - (Var`\). (\\. Unifier \ s t) \ \ s = \ t)" + +text \ + Type-flaw resistance for strand steps: + - The terms in a satisfiable equality step must have the same types + - Inequality steps must satisfy the conditions of the "inequality lemma"\ +fun tfr\<^sub>s\<^sub>t\<^sub>p where + "tfr\<^sub>s\<^sub>t\<^sub>p (Equality a t t') = ((\\. Unifier \ t t') \ \ t = \ t')" +| "tfr\<^sub>s\<^sub>t\<^sub>p (Inequality X F) = ( + (\x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \a. \ (Var x) = TAtom a) \ + (\f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ T = [] \ (\s \ set T. s \ Var ` set X)))" +| "tfr\<^sub>s\<^sub>t\<^sub>p _ = True" + +text \ + Type-flaw resistance for strands: + - The set of terms in strands must be type-flaw resistant + - The steps of strands must be type-flaw resistant +\ +definition tfr\<^sub>s\<^sub>t where + "tfr\<^sub>s\<^sub>t S \ tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S) \ list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + + +subsection \Small Lemmata\ +lemma tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def: + "list_all tfr\<^sub>s\<^sub>t\<^sub>p S \ + ((\a t t'. Equality a t t' \ set S \ (\\. Unifier \ t t') \ \ t = \ t') \ + (\X F. Inequality X F \ set S \ + (\x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \a. \ (Var x) = TAtom a) + \ (\f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ T = [] \ (\s \ set T. s \ Var ` set X))))" + (is "?P S \ ?Q S") +proof + show "?P S \ ?Q S" + proof (induction S) + case (Cons x S) thus ?case by (cases x) auto + qed simp + + show "?Q S \ ?P S" + proof (induction S) + case (Cons x S) thus ?case by (cases x) auto + qed simp +qed + + +lemma \_wf': "wf\<^sub>t\<^sub>r\<^sub>m t \ wf\<^sub>t\<^sub>r\<^sub>m (\ t)" +proof (induction t) + case (Fun f T) + hence *: "arity f = length T" "\t. t \ set T \ wf\<^sub>t\<^sub>r\<^sub>m (\ t)" unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto + { assume "arity f = 0" hence ?case using const_type[of f] by auto } + moreover + { assume "arity f > 0" hence ?case using fun_type[of f] * by force } + ultimately show ?case by auto +qed (metis \_wf(2)) + +lemma fun_type_inv: assumes "\ t = TComp f T" shows "arity f > 0" "public f" +using \_wf(1)[of f T t] assms by simp_all + +lemma fun_type_inv_wf: assumes "\ t = TComp f T" "wf\<^sub>t\<^sub>r\<^sub>m t" shows "arity f = length T" +using \_wf'[OF assms(2)] assms(1) unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto + +lemma const_type_inv: "\ (Fun c X) = TAtom a \ arity c = 0" +by (rule ccontr, simp add: fun_type) + +lemma const_type_inv_wf: assumes "\ (Fun c X) = TAtom a" and "wf\<^sub>t\<^sub>r\<^sub>m (Fun c X)" shows "X = []" +by (metis assms const_type_inv length_0_conv subtermeqI' wf\<^sub>t\<^sub>r\<^sub>m_def) + +lemma const_type': "\c \ \. \a \ \\<^sub>a. \X. \ (Fun c X) = TAtom a" using const_type by simp +lemma fun_type': "\f \ \\<^sub>f. \X. \ (Fun f X) = TComp f (map \ X)" using fun_type by simp + +lemma infinite_public_consts[simp]: "infinite {c. public c \ arity c = 0}" +proof - + fix a::'atom + define A where "A \ {c. \ (Fun c []) = TAtom a \ public c}" + define B where "B \ {c. public c \ arity c = 0}" + + have "arity c = 0" when c: "c \ A" for c + using c const_type_inv unfolding A_def by blast + hence "A \ B" unfolding A_def B_def by blast + hence "infinite B" + using infinite_typed_consts[of a, unfolded A_def[symmetric]] + by (metis infinite_super) + thus ?thesis unfolding B_def by blast +qed + +lemma infinite_fun_syms[simp]: + "infinite {c. public c \ arity c > 0} \ infinite \\<^sub>f" + "infinite \" "infinite \\<^sub>p\<^sub>u\<^sub>b" "infinite (UNIV::'fun set)" +by (metis \\<^sub>f_unfold finite_Collect_conjI, + metis infinite_public_consts finite_Collect_conjI, + use infinite_public_consts \pub_unfold in \force simp add: Collect_conj_eq\, + metis UNIV_I finite_subset subsetI infinite_public_consts(1)) + +lemma id_univ_proper_subset[simp]: "\\<^sub>f \ UNIV" "(\f. arity f > 0) \ \ \ UNIV" +by (metis finite.emptyI inf_top.right_neutral top.not_eq_extremum disjoint_fun_syms + infinite_fun_syms(2) inf_commute) + (metis top.not_eq_extremum UNIV_I const_arity_eq_zero less_irrefl) + +lemma exists_fun_notin_funs_term: "\f::'fun. f \ funs_term t" +by (metis UNIV_eq_I finite_fun_symbols infinite_fun_syms(4)) + +lemma exists_fun_notin_funs_terms: + assumes "finite M" shows "\f::'fun. f \ \(funs_term ` M)" +by (metis assms finite_fun_symbols infinite_fun_syms(4) ex_new_if_finite finite_UN) + +lemma exists_notin_funs\<^sub>s\<^sub>t: "\f. f \ funs\<^sub>s\<^sub>t (S::('fun,'var) strand)" +by (metis UNIV_eq_I finite_funs\<^sub>s\<^sub>t infinite_fun_syms(4)) + +lemma infinite_typed_consts': "infinite {c. \ (Fun c []) = TAtom a \ public c \ arity c = 0}" +proof - + { fix c assume "\ (Fun c []) = TAtom a" "public c" + hence "arity c = 0" using const_type[of c] fun_type[of c "[]"] by auto + } hence "{c. \ (Fun c []) = TAtom a \ public c \ arity c = 0} = + {c. \ (Fun c []) = TAtom a \ public c}" + by auto + thus "infinite {c. \ (Fun c []) = TAtom a \ public c \ arity c = 0}" + using infinite_typed_consts[of a] by metis +qed + +lemma atypes_inhabited: "\c. \ (Fun c []) = TAtom a \ wf\<^sub>t\<^sub>r\<^sub>m (Fun c []) \ public c \ arity c = 0" +proof - + obtain c where "\ (Fun c []) = TAtom a" "public c" "arity c = 0" + using infinite_typed_consts'(1)[of a] not_finite_existsD by blast + thus ?thesis using const_type_inv[OF \\ (Fun c []) = TAtom a\] unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto +qed + +lemma atype_ground_term_ex: "\t. fv t = {} \ \ t = TAtom a \ wf\<^sub>t\<^sub>r\<^sub>m t" +using atypes_inhabited[of a] by force + +lemma fun_type_id_eq: "\ (Fun f X) = TComp g Y \ f = g" +by (metis const_type fun_type neq0_conv "term.inject"(2) "term.simps"(4)) + +lemma fun_type_length_eq: "\ (Fun f X) = TComp g Y \ length X = length Y" +by (metis fun_type fun_type_id_eq fun_type_inv(1) length_map term.inject(2)) + +lemma type_ground_inhabited: "\t'. fv t' = {} \ \ t = \ t'" +proof - + { fix \::"('fun, 'atom) term_type" assume "\f T. Fun f T \ \ \ 0 < arity f" + hence "\t'. fv t' = {} \ \ = \ t'" + proof (induction \) + case (Fun f T) + hence "arity f > 0" by auto + + from Fun.IH Fun.prems(1) have "\Y. map \ Y = T \ (\x \ set Y. fv x = {})" + proof (induction T) + case (Cons x X) + hence "\g Y. Fun g Y \ Fun f X \ 0 < arity g" by auto + hence "\Y. map \ Y = X \ (\x\set Y. fv x = {})" using Cons by auto + moreover have "\t'. fv t' = {} \ x = \ t'" using Cons by auto + ultimately obtain y Y where + "fv y = {}" "\ y = x" "map \ Y = X" "\x\set Y. fv x = {}" + using Cons by moura + hence "map \ (y#Y) = x#X \ (\x\set (y#Y). fv x = {})" by auto + thus ?case by meson + qed simp + then obtain Y where "map \ Y = T" "\x \ set Y. fv x = {}" by metis + hence "fv (Fun f Y) = {}" "\ (Fun f Y) = TComp f T" using fun_type[OF \arity f > 0\] by auto + thus ?case by (metis exI[of "\t. fv t = {} \ \ t = TComp f T" "Fun f Y"]) + qed (metis atype_ground_term_ex) + } + thus ?thesis by (metis \_wf(1)) +qed + +lemma type_wfttype_inhabited: + assumes "\f T. Fun f T \ \ \ 0 < arity f" "wf\<^sub>t\<^sub>r\<^sub>m \" + shows "\t. \ t = \ \ wf\<^sub>t\<^sub>r\<^sub>m t" +using assms +proof (induction \) + case (Fun f Y) + have IH: "\t. \ t = y \ wf\<^sub>t\<^sub>r\<^sub>m t" when y: "y \ set Y " for y + proof - + have "wf\<^sub>t\<^sub>r\<^sub>m y" + using Fun y unfolding wf\<^sub>t\<^sub>r\<^sub>m_def + by (metis Fun_param_is_subterm term.le_less_trans) + moreover have "Fun g Z \ y \ 0 < arity g" for g Z + using Fun y by auto + ultimately show ?thesis using Fun.IH[OF y] by auto + qed + + from Fun have "arity f = length Y" "arity f > 0" unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by force+ + moreover from IH have "\X. map \ X = Y \ (\x \ set X. wf\<^sub>t\<^sub>r\<^sub>m x)" + by (induct Y, simp_all, metis list.simps(9) set_ConsD) + ultimately show ?case by (metis fun_type length_map wf_trmI) +qed (use atypes_inhabited wf\<^sub>t\<^sub>r\<^sub>m_def in blast) + +lemma type_pgwt_inhabited: "wf\<^sub>t\<^sub>r\<^sub>m t \ \t'. \ t = \ t' \ public_ground_wf_term t'" +proof - + assume "wf\<^sub>t\<^sub>r\<^sub>m t" + { fix \ assume "\ t = \" + hence "\t'. \ t = \ t' \ public_ground_wf_term t'" using \wf\<^sub>t\<^sub>r\<^sub>m t\ + proof (induction \ arbitrary: t) + case (Var a t) + then obtain c where "\ t = \ (Fun c [])" "arity c = 0" "public c" + using const_type_inv[of _ "[]" a] infinite_typed_consts(1)[of a] not_finite_existsD + by force + thus ?case using PGWT[OF \public c\, of "[]"] by auto + next + case (Fun f Y t) + have *: "arity f > 0" "public f" "arity f = length Y" + using fun_type_inv[OF \\ t = TComp f Y\] fun_type_inv_wf[OF \\ t = TComp f Y\ \wf\<^sub>t\<^sub>r\<^sub>m t\] + by auto + have "\y. y \ set Y \ \t'. y = \ t' \ public_ground_wf_term t'" + using Fun.prems(1) Fun.IH \_wf(1)[of _ _ t] \_wf'[OF \wf\<^sub>t\<^sub>r\<^sub>m t\] type_wfttype_inhabited + by (metis Fun_param_is_subterm term.order_trans wf_trm_subtermeq) + hence "\X. map \ X = Y \ (\x \ set X. public_ground_wf_term x)" + by (induct Y, simp_all, metis list.simps(9) set_ConsD) + then obtain X where X: "map \ X = Y" "\x. x \ set X \ public_ground_wf_term x" by moura + hence "arity f = length X" using *(3) by auto + have "\ t = \ (Fun f X)" "public_ground_wf_term (Fun f X)" + using fun_type[OF *(1), of X] Fun.prems(1) X(1) apply simp + using PGWT[OF *(2) \arity f = length X\ X(2)] by metis + thus ?case by metis + qed + } + thus ?thesis using \wf\<^sub>t\<^sub>r\<^sub>m t\ by auto +qed + +lemma pgwt_type_map: + assumes "public_ground_wf_term t" + shows "\ t = TAtom a \ \f. t = Fun f []" "\ t = TComp g Y \ \X. t = Fun g X \ map \ X = Y" +proof - + let ?A = "\ t = TAtom a \ (\f. t = Fun f [])" + let ?B = "\ t = TComp g Y \ (\X. t = Fun g X \ map \ X = Y)" + have "?A \ ?B" + proof (cases "\ t") + case (Var a) + obtain f X where "t = Fun f X" "arity f = length X" + using pgwt_fun[OF assms(1)] pgwt_arity[OF assms(1)] by fastforce+ + thus ?thesis using const_type_inv \\ t = TAtom a\ by auto + next + case (Fun g Y) + obtain f X where *: "t = Fun f X" using pgwt_fun[OF assms(1)] by force + hence "f = g" "map \ X = Y" + using fun_type_id_eq \\ t = TComp g Y\ fun_type[OF fun_type_inv(1)[OF \\ t = TComp g Y\]] + by fastforce+ + thus ?thesis using *(1) \\ t = TComp g Y\ by auto + qed + thus "\ t = TAtom a \ \f. t = Fun f []" "\ t = TComp g Y \ \X. t = Fun g X \ map \ X = Y" + by auto +qed + +lemma wt_subst_Var[simp]: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" by (metis wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + +lemma wt_subst_trm: "(\v. v \ fv t \ \ (Var v) = \ (\ v)) \ \ t = \ (t \ \)" +proof (induction t) + case (Fun f X) + hence *: "\x. x \ set X \ \ x = \ (x \ \)" by auto + show ?case + proof (cases "f \ \\<^sub>f") + case True + hence "\X. \ (Fun f X) = TComp f (map \ X)" using fun_type' by auto + thus ?thesis using * by auto + next + case False + hence "\a \ \\<^sub>a. \X. \ (Fun f X) = TAtom a" using const_type' by auto + thus ?thesis by auto + qed +qed auto + +lemma wt_subst_trm': "\wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \; \ s = \ t\ \ \ (s \ \) = \ (t \ \)" +by (metis wt_subst_trm wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + +lemma wt_subst_trm'': "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ \ t = \ (t \ \)" +by (metis wt_subst_trm wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + +lemma wt_subst_compose: + assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" +proof - + have "\v. \ (\ v) = \ (\ v \ \)" using wt_subst_trm \wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\ unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by metis + moreover have "\v. \ (Var v) = \ (\ v)" using \wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\ unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by metis + ultimately have "\v. \ (Var v) = \ (\ v \ \)" by metis + thus ?thesis unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_compose_def by metis +qed + +lemma wt_subst_TAtom_Var_cases: + assumes \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + and x: "\ (Var x) = TAtom a" + shows "(\y. \ x = Var y) \ (\c. \ x = Fun c [])" +proof (cases "(\y. \ x = Var y)") + case False + then obtain c T where c: "\ x = Fun c T" + by (cases "\ x") simp_all + hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun c T)" + using \(2) by fastforce + hence "T = []" + using const_type_inv_wf[of c T a] x c wt_subst_trm''[OF \(1), of "Var x"] + by fastforce + thus ?thesis + using c by blast +qed simp + +lemma wt_subst_TAtom_fv: + assumes \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "\x. wf\<^sub>t\<^sub>r\<^sub>m (\ x)" + and "\x \ fv t - X. \a. \ (Var x) = TAtom a" + shows "\x \ fv (t \ \) - fv\<^sub>s\<^sub>e\<^sub>t (\ ` X). \a. \ (Var x) = TAtom a" +using assms(3) +proof (induction t) + case (Var x) thus ?case + proof (cases "x \ X") + case False + with Var obtain a where "\ (Var x) = TAtom a" by moura + hence *: "\ (\ x) = TAtom a" "wf\<^sub>t\<^sub>r\<^sub>m (\ x)" using \ unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by auto + show ?thesis + proof (cases "\ x") + case (Var y) thus ?thesis using * by auto + next + case (Fun f T) + hence "T = []" using * const_type_inv[of f T a] unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto + thus ?thesis using Fun by auto + qed + qed auto +qed fastforce + +lemma wt_subst_TAtom_subterms_subst: + assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "\x \ fv t. \a. \ (Var x) = TAtom a" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\ ` fv t)" + shows "subterms (t \ \) = subterms t \\<^sub>s\<^sub>e\<^sub>t \" +using assms(2,3) +proof (induction t) + case (Var x) + obtain a where a: "\ (Var x) = TAtom a" using Var.prems(1) by moura + hence "\ (\ x) = TAtom a" using wt_subst_trm''[OF assms(1), of "Var x"] by simp + hence "(\y. \ x = Var y) \ (\c. \ x = Fun c [])" + using const_type_inv_wf Var.prems(2) by (cases "\ x") auto + thus ?case by auto +next + case (Fun f T) + have "subterms (t \ \) = subterms t \\<^sub>s\<^sub>e\<^sub>t \" when "t \ set T" for t + using that Fun.prems(1,2) Fun.IH[OF that] + by auto + thus ?case by auto +qed + +lemma wt_subst_TAtom_subterms_set_subst: + assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "\x \ fv\<^sub>s\<^sub>e\<^sub>t M. \a. \ (Var x) = TAtom a" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\ ` fv\<^sub>s\<^sub>e\<^sub>t M)" + shows "subterms\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \) = subterms\<^sub>s\<^sub>e\<^sub>t M \\<^sub>s\<^sub>e\<^sub>t \" +proof + show "subterms\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \) \ subterms\<^sub>s\<^sub>e\<^sub>t M \\<^sub>s\<^sub>e\<^sub>t \" + proof + fix t assume "t \ subterms\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \)" + then obtain s where s: "s \ M" "t \ subterms (s \ \)" by auto + thus "t \ subterms\<^sub>s\<^sub>e\<^sub>t M \\<^sub>s\<^sub>e\<^sub>t \" + using assms(2,3) wt_subst_TAtom_subterms_subst[OF assms(1), of s] + by auto + qed + + show "subterms\<^sub>s\<^sub>e\<^sub>t M \\<^sub>s\<^sub>e\<^sub>t \ \ subterms\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \)" + proof + fix t assume "t \ subterms\<^sub>s\<^sub>e\<^sub>t M \\<^sub>s\<^sub>e\<^sub>t \" + then obtain s where s: "s \ M" "t \ subterms s \\<^sub>s\<^sub>e\<^sub>t \" by auto + thus "t \ subterms\<^sub>s\<^sub>e\<^sub>t (M \\<^sub>s\<^sub>e\<^sub>t \)" + using assms(2,3) wt_subst_TAtom_subterms_subst[OF assms(1), of s] + by auto + qed +qed + +lemma wt_subst_subst_upd: + assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and "\ (Var x) = \ t" + shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\(x := t))" +using assms unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def +by (metis fun_upd_other fun_upd_same) + +lemma wt_subst_const_fv_type_eq: + assumes "\x \ fv t. \a. \ (Var x) = TAtom a" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "\x \ fv (t \ \). \y \ fv t. \ (Var x) = \ (Var y)" +using assms(1) +proof (induction t) + case (Var x) + then obtain a where a: "\ (Var x) = TAtom a" by moura + show ?case + proof (cases "\ x") + case (Fun f T) + hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" "\ (Fun f T) = TAtom a" + using a wt_subst_trm''[OF \(1), of "Var x"] \(2) by fastforce+ + thus ?thesis using const_type_inv_wf Fun by fastforce + qed (use a wt_subst_trm''[OF \(1), of "Var x"] in simp) +qed fastforce + +lemma TComp_term_cases: + assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "\ t = TComp f T" + shows "(\v. t = Var v) \ (\T'. t = Fun f T' \ T = map \ T' \ T' \ [])" +proof (cases "\v. t = Var v") + case False + then obtain T' where T': "t = Fun f T'" "T = map \ T'" + using assms fun_type[OF fun_type_inv(1)[OF assms(2)]] fun_type_id_eq + by (cases t) force+ + thus ?thesis using assms fun_type_inv(1) fun_type_inv_wf by fastforce +qed metis + +lemma TAtom_term_cases: + assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "\ t = TAtom \" + shows "(\v. t = Var v) \ (\f. t = Fun f [])" +using assms const_type_inv unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (cases t) auto + +lemma subtermeq_imp_subtermtypeeq: + assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "s \ t" + shows "\ s \ \ t" +using assms(2,1) +proof (induction t) + case (Fun f T) thus ?case + proof (cases "s = Fun f T") + case False + then obtain x where x: "x \ set T" "s \ x" using Fun.prems(1) by auto + hence "wf\<^sub>t\<^sub>r\<^sub>m x" using wf_trm_subtermeq[OF Fun.prems(2)] Fun_param_is_subterm[of _ T f] by auto + hence "\ s \ \ x" using Fun.IH[OF x] by simp + moreover have "arity f > 0" using x fun_type_inv_wf Fun.prems + by (metis length_pos_if_in_set term.order_refl wf\<^sub>t\<^sub>r\<^sub>m_def) + ultimately show ?thesis using x Fun.prems fun_type[of f T] by auto + qed simp +qed simp + +lemma subterm_funs_term_in_type: + assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "Fun f T \ t" "\ (Fun f T) = TComp f (map \ T)" + shows "f \ funs_term (\ t)" +using assms(2,1,3) +proof (induction t) + case (Fun f' T') + hence [simp]: "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" by (metis wf_trm_subtermeq) + { fix a assume \: "\ (Fun f' T') = TAtom a" + hence "Fun f T = Fun f' T'" using Fun TAtom_term_cases subtermeq_Var_const by metis + hence False using Fun.prems(3) \ by simp + } + moreover + { fix g S assume \: "\ (Fun f' T') = TComp g S" + hence "g = f'" "S = map \ T'" + using Fun.prems(2) fun_type_id_eq[OF \] fun_type[OF fun_type_inv(1)[OF \]] + by auto + hence \': "\ (Fun f' T') = TComp f' (map \ T')" using \ by auto + hence "g \ funs_term (\ (Fun f' T'))" using \ by auto + moreover { + assume "Fun f T \ Fun f' T'" + then obtain x where "x \ set T'" "Fun f T \ x" using Fun.prems(1) by auto + hence "f \ funs_term (\ x)" + using Fun.IH[OF _ _ _ Fun.prems(3), of x] wf_trm_subtermeq[OF \wf\<^sub>t\<^sub>r\<^sub>m (Fun f' T')\, of x] + by force + moreover have "\ x \ set (map \ T')" using \' \x \ set T'\ by auto + ultimately have "f \ funs_term (\ (Fun f' T'))" using \' by auto + } + ultimately have ?case by (cases "Fun f T = Fun f' T'") (auto simp add: \g = f'\) + } + ultimately show ?case by (cases "\ (Fun f' T')") auto +qed simp + +lemma wt_subst_fv_termtype_subterm: + assumes "x \ fv (\ y)" + and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and "wf\<^sub>t\<^sub>r\<^sub>m (\ y)" + shows "\ (Var x) \ \ (Var y)" +using subtermeq_imp_subtermtypeeq[OF assms(3) var_is_subterm[OF assms(1)]] + wt_subst_trm''[OF assms(2), of "Var y"] +by auto + +lemma wt_subst_fv\<^sub>s\<^sub>e\<^sub>t_termtype_subterm: + assumes "x \ fv\<^sub>s\<^sub>e\<^sub>t (\ ` Y)" + and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "\y \ Y. \ (Var x) \ \ (Var y)" +using wt_subst_fv_termtype_subterm[OF _ assms(2), of x] assms(1,3) +by fastforce + +lemma funs_term_type_iff: + assumes t: "wf\<^sub>t\<^sub>r\<^sub>m t" + and f: "arity f > 0" + shows "f \ funs_term (\ t) \ (f \ funs_term t \ (\x \ fv t. f \ funs_term (\ (Var x))))" + (is "?P t \ ?Q t") +using t +proof (induction t) + case (Fun g T) + hence IH: "?P s \ ?Q s" when "s \ set T" for s + using that wf_trm_subterm[OF _ Fun_param_is_subterm] + by blast + have 0: "arity g = length T" using Fun.prems unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto + show ?case + proof (cases "f = g") + case True thus ?thesis using fun_type[OF f] by simp + next + case False + have "?P (Fun g T) \ (\s \ set T. ?P s)" + proof + assume *: "?P (Fun g T)" + hence "\ (Fun g T) = TComp g (map \ T)" + using const_type[of g] fun_type[of g] by force + thus "\s \ set T. ?P s" using False * by force + next + assume *: "\s \ set T. ?P s" + hence "\ (Fun g T) = TComp g (map \ T)" + using 0 const_type[of g] fun_type[of g] by force + thus "?P (Fun g T)" using False * by force + qed + thus ?thesis using False f IH by auto + qed +qed simp + +lemma funs_term_type_iff': + assumes M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" + and f: "arity f > 0" + shows "f \ \(funs_term ` \ ` M) \ + (f \ \(funs_term ` M) \ (\x \ fv\<^sub>s\<^sub>e\<^sub>t M. f \ funs_term (\ (Var x))))" (is "?A \ ?B") +proof + assume ?A + then obtain t where "t \ M" "wf\<^sub>t\<^sub>r\<^sub>m t" "f \ funs_term (\ t)" using M by moura + thus ?B using funs_term_type_iff[OF _ f, of t] by auto +next + assume ?B + then obtain t where "t \ M" "wf\<^sub>t\<^sub>r\<^sub>m t" "f \ funs_term t \ (\x \ fv t. f \ funs_term (\ (Var x)))" + using M by auto + thus ?A using funs_term_type_iff[OF _ f, of t] by blast +qed + +lemma Ana_subterm_type: + assumes "Ana t = (K,M)" + and "wf\<^sub>t\<^sub>r\<^sub>m t" + and "m \ set M" + shows "\ m \ \ t" +proof - + have "m \ t" using Ana_subterm[OF assms(1)] assms(3) by auto + thus ?thesis using subtermeq_imp_subtermtypeeq[OF assms(2)] by simp +qed + +lemma wf_trm_TAtom_subterms: + assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "\ t = TAtom \" + shows "subterms t = {t}" +using assms const_type_inv unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (cases t) force+ + +lemma wf_trm_TComp_subterm: + assumes "wf\<^sub>t\<^sub>r\<^sub>m s" "t \ s" + obtains f T where "\ s = TComp f T" +proof (cases s) + case (Var x) thus ?thesis using \t \ s\ by simp +next + case (Fun g S) + hence "length S > 0" using assms Fun_subterm_inside_params[of t g S] by auto + hence "arity g > 0" by (metis \wf\<^sub>t\<^sub>r\<^sub>m s\ \s = Fun g S\ term.order_refl wf\<^sub>t\<^sub>r\<^sub>m_def) + thus ?thesis using fun_type \s = Fun g S\ that by auto +qed + +lemma SMP_empty[simp]: "SMP {} = {}" +proof (rule ccontr) + assume "SMP {} \ {}" + then obtain t where "t \ SMP {}" by auto + thus False by (induct t rule: SMP.induct) auto +qed + +lemma SMP_I: + assumes "s \ M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "t \ s \ \" "\v. wf\<^sub>t\<^sub>r\<^sub>m (\ v)" + shows "t \ SMP M" +using SMP.Substitution[OF SMP.MP[OF assms(1)] assms(2)] SMP.Subterm[of "s \ \" M t] assms(3,4) +by (cases "t = s \ \") simp_all + +lemma SMP_wf_trm: + assumes "t \ SMP M" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" + shows "wf\<^sub>t\<^sub>r\<^sub>m t" +using assms(1) +by (induct t rule: SMP.induct) + (use assms(2) in blast, + use wf_trm_subtermeq in blast, + use wf_trm_subst in blast, + use Ana_keys_wf' in blast) + +lemma SMP_ikI[intro]: "t \ ik\<^sub>s\<^sub>t S \ t \ SMP (trms\<^sub>s\<^sub>t S)" by force + +lemma MP_setI[intro]: "x \ set S \ trms\<^sub>s\<^sub>t\<^sub>p x \ trms\<^sub>s\<^sub>t S" by force + +lemma SMP_setI[intro]: "x \ set S \ trms\<^sub>s\<^sub>t\<^sub>p x \ SMP (trms\<^sub>s\<^sub>t S)" by force + +lemma SMP_subset_I: + assumes M: "\t \ M. \s \. s \ N \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = s \ \" + shows "SMP M \ SMP N" +proof + fix t show "t \ SMP M \ t \ SMP N" + proof (induction t rule: SMP.induct) + case (MP t) + then obtain s \ where s: "s \ N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "t = s \ \" + using M by moura + show ?case using SMP_I[OF s(1,2), of "s \ \"] s(3,4) wf_trm_subst_range_iff by fast + qed (auto intro!: SMP.Substitution[of _ N]) +qed + +lemma SMP_union: "SMP (A \ B) = SMP A \ SMP B" +proof + show "SMP (A \ B) \ SMP A \ SMP B" + proof + fix t assume "t \ SMP (A \ B)" + thus "t \ SMP A \ SMP B" by (induct rule: SMP.induct) blast+ + qed + + { fix t assume "t \ SMP A" hence "t \ SMP (A \ B)" by (induct rule: SMP.induct) blast+ } + moreover { fix t assume "t \ SMP B" hence "t \ SMP (A \ B)" by (induct rule: SMP.induct) blast+ } + ultimately show "SMP A \ SMP B \ SMP (A \ B)" by blast +qed + +lemma SMP_append[simp]: "SMP (trms\<^sub>s\<^sub>t (S@S')) = SMP (trms\<^sub>s\<^sub>t S) \ SMP (trms\<^sub>s\<^sub>t S')" (is "?A = ?B") +using SMP_union by simp + +lemma SMP_mono: "A \ B \ SMP A \ SMP B" +proof - + assume "A \ B" + then obtain C where "B = A \ C" by moura + thus "SMP A \ SMP B" by (simp add: SMP_union) +qed + +lemma SMP_Union: "SMP (\m \ M. f m) = (\m \ M. SMP (f m))" +proof + show "SMP (\m\M. f m) \ (\m\M. SMP (f m))" + proof + fix t assume "t \ SMP (\m\M. f m)" + thus "t \ (\m\M. SMP (f m))" by (induct t rule: SMP.induct) force+ + qed + show "(\m\M. SMP (f m)) \ SMP (\m\M. f m)" + proof + fix t assume "t \ (\m\M. SMP (f m))" + then obtain m where "m \ M" "t \ SMP (f m)" by moura + thus "t \ SMP (\m\M. f m)" using SMP_mono[of "f m" "\m\M. f m"] by auto + qed +qed + +lemma SMP_singleton_ex: + "t \ SMP M \ (\m \ M. t \ SMP {m})" + "m \ M \ t \ SMP {m} \ t \ SMP M" +using SMP_Union[of "\t. {t}" M] by auto + +lemma SMP_Cons: "SMP (trms\<^sub>s\<^sub>t (x#S)) = SMP (trms\<^sub>s\<^sub>t [x]) \ SMP (trms\<^sub>s\<^sub>t S)" +using SMP_append[of "[x]" S] by auto + +lemma SMP_Nil[simp]: "SMP (trms\<^sub>s\<^sub>t []) = {}" +proof - + { fix t assume "t \ SMP (trms\<^sub>s\<^sub>t [])" hence False by induct auto } + thus ?thesis by blast +qed + +lemma SMP_subset_union_eq: assumes "M \ SMP N" shows "SMP N = SMP (M \ N)" +proof - + { fix t assume "t \ SMP (M \ N)" hence "t \ SMP N" + using assms by (induction rule: SMP.induct) blast+ + } + thus ?thesis using SMP_union by auto +qed + +lemma SMP_subterms_subset: "subterms\<^sub>s\<^sub>e\<^sub>t M \ SMP M" +proof + fix t assume "t \ subterms\<^sub>s\<^sub>e\<^sub>t M" + then obtain m where "m \ M" "t \ m" by auto + thus "t \ SMP M" using SMP_I[of _ _ Var] by auto +qed + +lemma SMP_SMP_subset: "N \ SMP M \ SMP N \ SMP M" +by (metis SMP_mono SMP_subset_union_eq Un_commute Un_upper2) + +lemma wt_subst_rm_vars: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (rm_vars X \)" +using rm_vars_dom unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by auto + +lemma wt_subst_SMP_subset: + assumes "trms\<^sub>s\<^sub>t S \ SMP S'" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "trms\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \) \ SMP S'" +proof + fix t assume *: "t \ trms\<^sub>s\<^sub>t (S \\<^sub>s\<^sub>t \)" + show "t \ SMP S'" using trm_strand_subst_cong(2)[OF *] + proof + assume "\t'. t = t' \ \ \ t' \ trms\<^sub>s\<^sub>t S" + thus "t \ SMP S'" using assms SMP.Substitution by auto + next + assume "\X F. Inequality X F \ set S \ (\t'\trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. t = t' \ rm_vars (set X) \)" + then obtain X F t' where **: + "Inequality X F \ set S" "t'\trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" "t = t' \ rm_vars (set X) \" + by force + then obtain s where s: "s \ trms\<^sub>s\<^sub>t\<^sub>p (Inequality X F)" "t = s \ rm_vars (set X) \" by moura + hence "s \ SMP (trms\<^sub>s\<^sub>t S)" using **(1) by force + hence "t \ SMP (trms\<^sub>s\<^sub>t S)" + using SMP.Substitution[OF _ wt_subst_rm_vars[OF assms(2)] wf_trms_subst_rm_vars'[OF assms(3)]] + unfolding s(2) by blast + thus "t \ SMP S'" by (metis SMP_union SMP_subset_union_eq UnCI assms(1)) + qed +qed + +lemma MP_subset_SMP: "\(trms\<^sub>s\<^sub>t\<^sub>p ` set S) \ SMP (trms\<^sub>s\<^sub>t S)" "trms\<^sub>s\<^sub>t S \ SMP (trms\<^sub>s\<^sub>t S)" "M \ SMP M" +by auto + +lemma SMP_fun_map_snd_subset: "SMP (trms\<^sub>s\<^sub>t (map Send X)) \ SMP (trms\<^sub>s\<^sub>t [Send (Fun f X)])" +proof + fix t assume "t \ SMP (trms\<^sub>s\<^sub>t (map Send X))" thus "t \ SMP (trms\<^sub>s\<^sub>t [Send (Fun f X)])" + proof (induction t rule: SMP.induct) + case (MP t) + hence "t \ set X" by auto + hence "t \ Fun f X" by (metis subtermI') + thus ?case using SMP.Subterm[of "Fun f X" "trms\<^sub>s\<^sub>t [Send (Fun f X)]" t] using SMP.MP by auto + qed blast+ +qed + +lemma SMP_wt_subst_subset: + assumes "t \ SMP (M \\<^sub>s\<^sub>e\<^sub>t \)" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "t \ SMP M" +using assms wf_trm_subst_range_iff[of \] by (induct t rule: SMP.induct) blast+ + +lemma SMP_wt_instances_subset: + assumes "\t \ M. \s \ N. \\. t = s \ \ \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + and "t \ SMP M" + shows "t \ SMP N" +proof - + obtain m where m: "m \ M" "t \ SMP {m}" using SMP_singleton_ex(1)[OF assms(2)] by blast + then obtain n \ where n: "n \ N" "m = n \ \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using assms(1) by fast + + have "t \ SMP (N \\<^sub>s\<^sub>e\<^sub>t \)" using n(1,2) SMP_singleton_ex(2)[of m "N \\<^sub>s\<^sub>e\<^sub>t \", OF _ m(2)] by fast + thus ?thesis using SMP_wt_subst_subset[OF _ n(3,4)] by blast +qed + +lemma SMP_consts: + assumes "\t \ M. \c. t = Fun c []" + and "\t \ M. Ana t = ([], [])" + shows "SMP M = M" +proof + show "SMP M \ M" + proof + fix t show "t \ SMP M \ t \ M" + apply (induction t rule: SMP.induct) + by (use assms in auto) + qed +qed auto + +lemma SMP_subterms_eq: + "SMP (subterms\<^sub>s\<^sub>e\<^sub>t M) = SMP M" +proof + show "SMP M \ SMP (subterms\<^sub>s\<^sub>e\<^sub>t M)" using SMP_mono[of M "subterms\<^sub>s\<^sub>e\<^sub>t M"] by blast + show "SMP (subterms\<^sub>s\<^sub>e\<^sub>t M) \ SMP M" + proof + fix t show "t \ SMP (subterms\<^sub>s\<^sub>e\<^sub>t M) \ t \ SMP M" by (induction t rule: SMP.induct) blast+ + qed +qed + +lemma SMP_funs_term: + assumes t: "t \ SMP M" "f \ funs_term t \ (\x \ fv t. f \ funs_term (\ (Var x)))" + and f: "arity f > 0" + and M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" + and Ana_f: "\s K T. Ana s = (K,T) \ f \ \(funs_term ` set K) \ f \ funs_term s" + shows "f \ \(funs_term ` M) \ (\x \ fv\<^sub>s\<^sub>e\<^sub>t M. f \ funs_term (\ (Var x)))" +using t +proof (induction t rule: SMP.induct) + case (Subterm t t') + thus ?case by (metis UN_I vars_iff_subtermeq funs_term_subterms_eq(1) term.order_trans) +next + case (Substitution t \) + show ?case + using M SMP_wf_trm[OF Substitution.hyps(1)] wf_trm_subst[of \ t, OF Substitution.hyps(3)] + funs_term_type_iff[OF _ f] wt_subst_trm''[OF Substitution.hyps(2), of t] + Substitution.prems Substitution.IH + by metis +next + case (Ana t K T t') + thus ?case + using Ana_f[OF Ana.hyps(2)] Ana_keys_fv[OF Ana.hyps(2)] + by fastforce +qed auto + +lemma id_type_eq: + assumes "\ (Fun f X) = \ (Fun g Y)" + shows "f \ \ \ g \ \" "f \ \\<^sub>f \ g \ \\<^sub>f" +using assms const_type' fun_type' id_union_univ(1) +by (metis UNIV_I UnE "term.distinct"(1))+ + +lemma fun_type_arg_cong: + assumes "f \ \\<^sub>f" "g \ \\<^sub>f" "\ (Fun f (x#X)) = \ (Fun g (y#Y))" + shows "\ x = \ y" "\ (Fun f X) = \ (Fun g Y)" +using assms fun_type' by auto + +lemma fun_type_arg_cong': + assumes "f \ \\<^sub>f" "g \ \\<^sub>f" "\ (Fun f (X@x#X')) = \ (Fun g (Y@y#Y'))" "length X = length Y" + shows "\ x = \ y" +using assms +proof (induction X arbitrary: Y) + case Nil thus ?case using fun_type_arg_cong(1)[of f g x X' y Y'] by auto +next + case (Cons x' X Y'') + then obtain y' Y where "Y'' = y'#Y" by (metis length_Suc_conv) + hence "\ (Fun f (X@x#X')) = \ (Fun g (Y@y#Y'))" "length X = length Y" + using Cons.prems(3,4) fun_type_arg_cong(2)[OF Cons.prems(1,2), of x' "X@x#X'"] by auto + thus ?thesis using Cons.IH[OF Cons.prems(1,2)] by auto +qed + +lemma fun_type_param_idx: "\ (Fun f T) = Fun g S \ i < length T \ \ (T ! i) = S ! i" +by (metis fun_type fun_type_id_eq fun_type_inv(1) nth_map term.inject(2)) + +lemma fun_type_param_ex: + assumes "\ (Fun f T) = Fun g (map \ S)" "t \ set S" + shows "\s \ set T. \ s = \ t" +using fun_type_length_eq[OF assms(1)] length_map[of \ S] assms(2) + fun_type_param_idx[OF assms(1)] nth_map in_set_conv_nth +by metis + +lemma tfr_stp_all_split: + "list_all tfr\<^sub>s\<^sub>t\<^sub>p (x#S) \ list_all tfr\<^sub>s\<^sub>t\<^sub>p [x]" + "list_all tfr\<^sub>s\<^sub>t\<^sub>p (x#S) \ list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S') \ list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S') \ list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" + "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@x#S') \ list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')" +by fastforce+ + +lemma tfr_stp_all_append: + assumes "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" + shows "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')" +using assms by fastforce + +lemma tfr_stp_all_wt_subst_apply: + assumes "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + "bvars\<^sub>s\<^sub>t S \ range_vars \ = {}" + shows "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S \\<^sub>s\<^sub>t \)" +using assms(1,4) +proof (induction S) + case (Cons x S) + hence IH: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S \\<^sub>s\<^sub>t \)" + using tfr_stp_all_split(2)[of x S] + unfolding range_vars_alt_def by fastforce + thus ?case + proof (cases x) + case (Equality a t t') + hence "(\\. Unifier \ t t') \ \ t = \ t'" using Cons.prems by auto + hence "(\\. Unifier \ (t \ \) (t' \ \)) \ \ (t \ \) = \ (t' \ \)" + by (metis Unifier_comp' wt_subst_trm'[OF assms(2)]) + moreover have "(x#S) \\<^sub>s\<^sub>t \ = Equality a (t \ \) (t' \ \)#(S \\<^sub>s\<^sub>t \)" + using \x = Equality a t t'\ by auto + ultimately show ?thesis using IH by auto + next + case (Inequality X F) + let ?\ = "rm_vars (set X) \" + let ?G = "F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\" + + let ?P = "\F X. \x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \a. \ (Var x) = TAtom a" + let ?Q = "\F X. + \f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ T = [] \ (\s \ set T. s \ Var ` set X)" + + have 0: "set X \ range_vars ?\ = {}" + using Cons.prems(2) Inequality rm_vars_img_subset[of "set X"] + by (auto simp add: subst_domain_def range_vars_alt_def) + + have 1: "?P F X \ ?Q F X" using Inequality Cons.prems by simp + + have 2: "fv\<^sub>s\<^sub>e\<^sub>t (?\ ` set X) = set X" by auto + + have "?P ?G X" when "?P F X" using that + proof (induction F) + case (Cons g G) + obtain t t' where g: "g = (t,t')" by (metis surj_pair) + + have "\x \ (fv (t \ ?\) \ fv (t' \ ?\)) - set X. \a. \ (Var x) = Var a" + proof - + have *: "\x \ fv t - set X. \a. \ (Var x) = Var a" + "\x \ fv t' - set X. \a. \ (Var x) = Var a" + using g Cons.prems by simp_all + + have **: "\x. wf\<^sub>t\<^sub>r\<^sub>m (?\ x)" + using \(2) wf_trm_subst_range_iff[of \] wf_trm_subst_rm_vars'[of \ _ "set X"] by simp + + show ?thesis + using wt_subst_TAtom_fv[OF wt_subst_rm_vars[OF \(1)] ** *(1)] + wt_subst_TAtom_fv[OF wt_subst_rm_vars[OF \(1)] ** *(2)] + wt_subst_trm'[OF wt_subst_rm_vars[OF \(1), of "set X"]] 2 + by blast + qed + moreover have "\x\fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\) - set X. \a. \ (Var x) = Var a" + using Cons by auto + ultimately show ?case using g by (auto simp add: subst_apply_pairs_def) + qed (simp add: subst_apply_pairs_def) + hence "?P ?G X \ ?Q ?G X" + using 1 ineq_subterm_inj_cond_subst[OF 0, of "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"] trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst[of F ?\] + by presburger + moreover have "(x#S) \\<^sub>s\<^sub>t \ = Inequality X (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\)#(S \\<^sub>s\<^sub>t \)" + using \x = Inequality X F\ by auto + ultimately show ?thesis using IH by simp + qed auto +qed simp + +lemma tfr_stp_all_same_type: + "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@Equality a t t'#S') \ Unifier \ t t' \ \ t = \ t'" +by force+ + +lemma tfr_subset: + "\A B. tfr\<^sub>s\<^sub>e\<^sub>t (A \ B) \ tfr\<^sub>s\<^sub>e\<^sub>t A" + "\A B. tfr\<^sub>s\<^sub>e\<^sub>t B \ A \ B \ tfr\<^sub>s\<^sub>e\<^sub>t A" + "\A B. tfr\<^sub>s\<^sub>e\<^sub>t B \ SMP A \ SMP B \ tfr\<^sub>s\<^sub>e\<^sub>t A" +proof - + show 1: "tfr\<^sub>s\<^sub>e\<^sub>t (A \ B) \ tfr\<^sub>s\<^sub>e\<^sub>t A" for A B + using SMP_union[of A B] unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by simp + + fix A B assume B: "tfr\<^sub>s\<^sub>e\<^sub>t B" + + show "A \ B \ tfr\<^sub>s\<^sub>e\<^sub>t A" + proof - + assume "A \ B" + then obtain C where "B = A \ C" by moura + thus ?thesis using B 1 by blast + qed + + show "SMP A \ SMP B \ tfr\<^sub>s\<^sub>e\<^sub>t A" + proof - + assume "SMP A \ SMP B" + then obtain C where "SMP B = SMP A \ C" by moura + thus ?thesis using B unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast + qed +qed + +lemma tfr_empty[simp]: "tfr\<^sub>s\<^sub>e\<^sub>t {}" +unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by simp + +lemma tfr_consts_mono: + assumes "\t \ M. \c. t = Fun c []" + and "\t \ M. Ana t = ([], [])" + and "tfr\<^sub>s\<^sub>e\<^sub>t N" + shows "tfr\<^sub>s\<^sub>e\<^sub>t (N \ M)" +proof - + { fix s t + assume *: "s \ SMP (N \ M) - range Var" "t \ SMP (N \ M) - range Var" "\\. Unifier \ s t" + hence **: "is_Fun s" "is_Fun t" "s \ SMP N \ s \ M" "t \ SMP N \ t \ M" + using assms(3) SMP_consts[OF assms(1,2)] SMP_union[of N M] by auto + moreover have "\ s = \ t" when "s \ SMP N" "t \ SMP N" + using that assms(3) *(3) **(1,2) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast + moreover have "\ s = \ t" when st: "s \ M" "t \ M" + proof - + obtain c d where "s = Fun c []" "t = Fun d []" using st assms(1) by moura + hence "s = t" using *(3) by fast + thus ?thesis by metis + qed + moreover have "\ s = \ t" when st: "s \ SMP N" "t \ M" + proof - + obtain c where "t = Fun c []" using st assms(1) by moura + hence "s = t" using *(3) **(1,2) by auto + thus ?thesis by metis + qed + moreover have "\ s = \ t" when st: "s \ M" "t \ SMP N" + proof - + obtain c where "s = Fun c []" using st assms(1) by moura + hence "s = t" using *(3) **(1,2) by auto + thus ?thesis by metis + qed + ultimately have "\ s = \ t" by metis + } thus ?thesis by (metis tfr\<^sub>s\<^sub>e\<^sub>t_def) +qed + +lemma dual\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>t\<^sub>p: "list_all tfr\<^sub>s\<^sub>t\<^sub>p S \ list_all tfr\<^sub>s\<^sub>t\<^sub>p (dual\<^sub>s\<^sub>t S)" +proof (induction S) + case (Cons x S) + have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Cons.prems by simp + hence IH: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (dual\<^sub>s\<^sub>t S)" using Cons.IH by metis + from Cons show ?case + proof (cases x) + case (Equality a t t') + hence "(\\. Unifier \ t t') \ \ t = \ t'" using Cons by auto + thus ?thesis using Equality IH by fastforce + next + case (Inequality X F) + have "set (dual\<^sub>s\<^sub>t (x#S)) = insert x (set (dual\<^sub>s\<^sub>t S))" using Inequality by auto + moreover have "(\x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \a. \ (Var x) = Var a) \ + (\f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ T = [] \ (\s \ set T. s \ Var ` set X))" + using Cons.prems Inequality by auto + ultimately show ?thesis using Inequality IH by auto + qed auto +qed simp + +lemma subst_var_inv_wt: + assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst_var_inv \ X)" +using assms f_inv_into_f[of _ \ X] +unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_var_inv_def +by presburger + +lemma subst_var_inv_wf_trms: + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (subst_var_inv \ X))" +using f_inv_into_f[of _ \ X] +unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_var_inv_def +by auto + +lemma unify_list_wt_if_same_type: + assumes "Unification.unify E B = Some U" "\(s,t) \ set E. wf\<^sub>t\<^sub>r\<^sub>m s \ wf\<^sub>t\<^sub>r\<^sub>m t \ \ s = \ t" + and "\(v,t) \ set B. \ (Var v) = \ t" + shows "\(v,t) \ set U. \ (Var v) = \ t" +using assms +proof (induction E B arbitrary: U rule: Unification.unify.induct) + case (2 f X g Y E B U) + hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun g Y)" "\ (Fun f X) = \ (Fun g Y)" by auto + + from "2.prems"(1) obtain E' where *: "decompose (Fun f X) (Fun g Y) = Some E'" + and [simp]: "f = g" "length X = length Y" "E' = zip X Y" + and **: "Unification.unify (E'@E) B = Some U" + by (auto split: option.splits) + + have "\(s,t) \ set E'. wf\<^sub>t\<^sub>r\<^sub>m s \ wf\<^sub>t\<^sub>r\<^sub>m t \ \ s = \ t" + proof - + { fix s t assume "(s,t) \ set E'" + then obtain X' X'' Y' Y'' where "X = X'@s#X''" "Y = Y'@t#Y''" "length X' = length Y'" + using zip_arg_subterm_split[of s t X Y] \E' = zip X Y\ by metis + hence "\ (Fun f (X'@s#X'')) = \ (Fun g (Y'@t#Y''))" by (metis \\ (Fun f X) = \ (Fun g Y)\) + + from \E' = zip X Y\ have "\(s,t) \ set E'. s \ Fun f X \ t \ Fun g Y" + using zip_arg_subterm[of _ _ X Y] by blast + with \(s,t) \ set E'\ have "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t" + using wf_trm_subterm \wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\ \wf\<^sub>t\<^sub>r\<^sub>m (Fun g Y)\ by (blast,blast) + moreover have "f \ \\<^sub>f" + proof (rule ccontr) + assume "f \ \\<^sub>f" + hence "f \ \" "arity f = 0" using const_arity_eq_zero[of f] by simp_all + thus False using \wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\ * \(s,t) \ set E'\ unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto + qed + hence "\ s = \ t" + using fun_type_arg_cong' \f \ \\<^sub>f\ \\ (Fun f (X'@s#X'')) = \ (Fun g (Y'@t#Y''))\ + \length X' = length Y'\ \f = g\ + by metis + ultimately have "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t" "\ s = \ t" by metis+ + } + thus ?thesis by blast + qed + moreover have "\(s,t) \ set E. wf\<^sub>t\<^sub>r\<^sub>m s \ wf\<^sub>t\<^sub>r\<^sub>m t \ \ s = \ t" using "2.prems"(2) by auto + ultimately show ?case using "2.IH"[OF * ** _ "2.prems"(3)] by fastforce +next + case (3 v t E B U) + hence "\ (Var v) = \ t" "wf\<^sub>t\<^sub>r\<^sub>m t" by auto + hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst v t)" + and *: "\(v, t) \ set ((v,t)#B). \ (Var v) = \ t" + "\t t'. (t,t') \ set E \ \ t = \ t'" + using "3.prems"(2,3) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_def by auto + + show ?case + proof (cases "t = Var v") + assume "t = Var v" thus ?case using 3 by auto + next + assume "t \ Var v" + hence "v \ fv t" using "3.prems"(1) by auto + hence **: "Unification.unify (subst_list (subst v t) E) ((v, t)#B) = Some U" + using Unification.unify.simps(3)[of v t E B] "3.prems"(1) \t \ Var v\ by auto + + have "\(s, t) \ set (subst_list (subst v t) E). wf\<^sub>t\<^sub>r\<^sub>m s \ wf\<^sub>t\<^sub>r\<^sub>m t" + using wf_trm_subst_singleton[OF _ \wf\<^sub>t\<^sub>r\<^sub>m t\] "3.prems"(2) + unfolding subst_list_def subst_def by auto + moreover have "\(s, t) \ set (subst_list (subst v t) E). \ s = \ t" + using *(2)[THEN wt_subst_trm'[OF \wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst v t)\]] by (simp add: subst_list_def) + ultimately show ?thesis using "3.IH"(2)[OF \t \ Var v\ \v \ fv t\ ** _ *(1)] by auto + qed +next + case (4 f X v E B U) + hence "\ (Var v) = \ (Fun f X)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" by auto + hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst v (Fun f X))" + and *: "\(v, t) \ set ((v,(Fun f X))#B). \ (Var v) = \ t" + "\t t'. (t,t') \ set E \ \ t = \ t'" + using "4.prems"(2,3) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_def by auto + + have "v \ fv (Fun f X)" using "4.prems"(1) by force + hence **: "Unification.unify (subst_list (subst v (Fun f X)) E) ((v, (Fun f X))#B) = Some U" + using Unification.unify.simps(3)[of v "Fun f X" E B] "4.prems"(1) by auto + + have "\(s, t) \ set (subst_list (subst v (Fun f X)) E). wf\<^sub>t\<^sub>r\<^sub>m s \ wf\<^sub>t\<^sub>r\<^sub>m t" + using wf_trm_subst_singleton[OF _ \wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\] "4.prems"(2) + unfolding subst_list_def subst_def by auto + moreover have "\(s, t) \ set (subst_list (subst v (Fun f X)) E). \ s = \ t" + using *(2)[THEN wt_subst_trm'[OF \wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst v (Fun f X))\]] by (simp add: subst_list_def) + ultimately show ?case using "4.IH"[OF \v \ fv (Fun f X)\ ** _ *(1)] by auto +qed auto + +lemma mgu_wt_if_same_type: + assumes "mgu s t = Some \" "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t" "\ s = \ t" + shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" +proof - + let ?fv_disj = "\v t S. \(\(v',t') \ S - {(v,t)}. (insert v (fv t)) \ (insert v' (fv t')) \ {})" + + from assms(1) obtain \' where "Unification.unify [(s,t)] [] = Some \'" "subst_of \' = \" + by (auto split: option.splits) + hence "\(v,t) \ set \'. \ (Var v) = \ t" "distinct (map fst \')" + using assms(2,3,4) unify_list_wt_if_same_type unify_list_distinct[of "[(s,t)]"] by auto + thus "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" using \subst_of \' = \\ unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def + proof (induction \' arbitrary: \ rule: List.rev_induct) + case (snoc tt \' \) + then obtain v t where tt: "tt = (v,t)" by (metis surj_pair) + hence \: "\ = subst v t \\<^sub>s subst_of \'" using snoc.prems(3) by simp + + have "\(v,t) \ set \'. \ (Var v) = \ t" "distinct (map fst \')" using snoc.prems(1,2) by auto + then obtain \'' where \'': "subst_of \' = \''" "\v. \ (Var v) = \ (\'' v)" by (metis snoc.IH) + hence "\ t = \ (t \ \'')" for t using wt_subst_trm by blast + hence "\ (Var v) = \ (\'' v)" "\ t = \ (t \ \'')" using \''(2) by auto + moreover have "\ (Var v) = \ t" using snoc.prems(1) tt by simp + moreover have \2: "\ = Var(v := t) \\<^sub>s \'' " using \ \''(1) unfolding subst_def by simp + ultimately have "\ (Var v) = \ (\ v)" unfolding subst_compose_def by simp + + have "subst_domain (subst v t) \ {v}" unfolding subst_def by (auto simp add: subst_domain_def) + hence *: "subst_domain \ \ insert v (subst_domain \'')" + using tt \ \''(1) snoc.prems(2) subst_domain_compose[of _ \''] + by (auto simp add: subst_domain_def) + + have "v \ set (map fst \')" using tt snoc.prems(2) by auto + hence "v \ subst_domain \''" using \''(1) subst_of_dom_subset[of \'] by auto + + { fix w assume "w \ subst_domain \''" + hence "\ w = \'' w" using \2 \''(1) \v \ subst_domain \''\ unfolding subst_compose_def by auto + hence "\ (Var w) = \ (\ w)" using \''(2) by simp + } + thus ?case using \\ (Var v) = \ (\ v)\ * by force + qed simp +qed + +lemma wt_Unifier_if_Unifier: + assumes s_t: "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t" "\ s = \ t" + and \: "Unifier \ s t" + shows "\\. Unifier \ s t \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +using mgu_always_unifies[OF \] mgu_gives_MGU[THEN MGU_is_Unifier[of s _ t]] + mgu_wt_if_same_type[OF _ s_t] mgu_wf_trm[OF _ s_t(1,2)] wf_trm_subst_range_iff +by fast + +end + + +subsection \Automatically Proving Type-Flaw Resistance\ +subsubsection \Definitions: Variable Renaming\ +abbreviation "max_var t \ Max (insert 0 (snd ` fv t))" +abbreviation "max_var_set X \ Max (insert 0 (snd ` X))" + +definition "var_rename n v \ Var (fst v, snd v + Suc n)" +definition "var_rename_inv n v \ Var (fst v, snd v - Suc n)" + + +subsubsection \Definitions: Computing a Finite Representation of the Sub-Message Patterns\ +text \A sufficient requirement for a term to be a well-typed instance of another term\ +definition is_wt_instance_of_cond where + "is_wt_instance_of_cond \ t s \ ( + \ t = \ s \ (case mgu t s of + None \ False + | Some \ \ inj_on \ (fv t) \ (\x \ fv t. is_Var (\ x))))" + +definition has_all_wt_instances_of where + "has_all_wt_instances_of \ N M \ \t \ N. \s \ M. is_wt_instance_of_cond \ t s" + +text \This function computes a finite representation of the set of sub-message patterns\ +definition SMP0 where + "SMP0 Ana \ M \ let + f = \t. Fun (the_Fun (\ t)) (map Var (zip (args (\ t)) [0.. t))])); + g = \M'. map f (filter (\t. is_Var t \ is_Fun (\ t)) M')@ + concat (map (fst \ Ana) M')@concat (map subterms_list M'); + h = remdups \ g + in while (\A. set (h A) \ set A) h M" + +text \These definitions are useful to refine an SMP representation set\ +fun generalize_term where + "generalize_term _ _ n (Var x) = (Var x, n)" +| "generalize_term \ p n (Fun f T) = (let \ = \ (Fun f T) + in if p \ then (Var (\, n), Suc n) + else let (T',n') = foldr (\t (S,m). let (t',m') = generalize_term \ p m t in (t'#S,m')) + T ([],n) + in (Fun f T', n'))" + +definition generalize_terms where + "generalize_terms \ p \ map (fst \ generalize_term \ p 0)" + +definition remove_superfluous_terms where + "remove_superfluous_terms \ T \ + let + f = \S t R. \s \ set S - R. s \ t \ is_wt_instance_of_cond \ t s; + g = \S t (U,R). if f S t R then (U, insert t R) else (t#U, R); + h = \S. remdups (fst (foldr (g S) S ([],{}))) + in while (\S. h S \ S) h T" + + +subsubsection \Definitions: Checking Type-Flaw Resistance\ +definition is_TComp_var_instance_closed where + "is_TComp_var_instance_closed \ M \ \x \ fv\<^sub>s\<^sub>e\<^sub>t (set M). is_Fun (\ (Var x)) \ + list_ex (\t. is_Fun t \ \ t = \ (Var x) \ list_all is_Var (args t) \ distinct (args t)) M" + +definition finite_SMP_representation where + "finite_SMP_representation arity Ana \ M \ + list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) M \ + has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set M)) (set M) \ + has_all_wt_instances_of \ (\((set \ fst \ Ana) ` set M)) (set M) \ + is_TComp_var_instance_closed \ M" + +definition comp_tfr\<^sub>s\<^sub>e\<^sub>t where + "comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \ M \ + finite_SMP_representation arity Ana \ M \ + (let \ = var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t (set M))) + in \s \ set M. \t \ set M. is_Fun s \ is_Fun t \ \ s \ \ t \ mgu s (t \ \) = None)" + +fun comp_tfr\<^sub>s\<^sub>t\<^sub>p where + "comp_tfr\<^sub>s\<^sub>t\<^sub>p \ (\_: t \ t'\\<^sub>s\<^sub>t) = (mgu t t' \ None \ \ t = \ t')" +| "comp_tfr\<^sub>s\<^sub>t\<^sub>p \ (\X\\\: F\\<^sub>s\<^sub>t) = ( + (\x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. is_Var (\ (Var x))) \ + (\u \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F). + is_Fun u \ (args u = [] \ (\s \ set (args u). s \ Var ` set X))))" +| "comp_tfr\<^sub>s\<^sub>t\<^sub>p _ _ = True" + +definition comp_tfr\<^sub>s\<^sub>t where + "comp_tfr\<^sub>s\<^sub>t arity Ana \ M S \ + list_all (comp_tfr\<^sub>s\<^sub>t\<^sub>p \) S \ + list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (trms_list\<^sub>s\<^sub>t S) \ + has_all_wt_instances_of \ (trms\<^sub>s\<^sub>t S) (set M) \ + comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \ M" + + +subsubsection \Small Lemmata\ +lemma less_Suc_max_var_set: + assumes z: "z \ X" + and X: "finite X" + shows "snd z < Suc (max_var_set X)" +proof - + have "snd z \ snd ` X" using z by simp + hence "snd z \ Max (insert 0 (snd ` X))" using X by simp + thus ?thesis using X by simp +qed + +lemma (in typed_model) finite_SMP_representationD: + assumes "finite_SMP_representation arity Ana \ M" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + and "has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set M)) (set M)" + and "has_all_wt_instances_of \ (\((set \ fst \ Ana) ` set M)) (set M)" + and "is_TComp_var_instance_closed \ M" +using assms unfolding finite_SMP_representation_def list_all_iff wf\<^sub>t\<^sub>r\<^sub>m_code by blast+ + +lemma (in typed_model) is_wt_instance_of_condD: + assumes t_instance_s: "is_wt_instance_of_cond \ t s" + obtains \ where + "\ t = \ s" "mgu t s = Some \" + "inj_on \ (fv t)" "\ ` (fv t) \ range Var" +using t_instance_s unfolding is_wt_instance_of_cond_def Let_def by (cases "mgu t s") fastforce+ + +lemma (in typed_model) is_wt_instance_of_condD': + assumes t_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m t" + and s_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m s" + and t_instance_s: "is_wt_instance_of_cond \ t s" + shows "\\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = s \ \" +proof - + obtain \ where s: + "\ t = \ s" "mgu t s = Some \" + "inj_on \ (fv t)" "\ ` (fv t) \ range Var" + by (metis is_wt_instance_of_condD[OF t_instance_s]) + + have 0: "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m s" using s(1) t_wf_trm s_wf_trm by auto + + note 1 = mgu_wt_if_same_type[OF s(2) 0 s(1)] + + note 2 = conjunct1[OF mgu_gives_MGU[OF s(2)]] + + show ?thesis + using s(1) inj_var_ran_unifiable_has_subst_match[OF 2 s(3,4)] + wt_subst_compose[OF 1 subst_var_inv_wt[OF 1, of "fv t"]] + wf_trms_subst_compose[OF mgu_wf_trms[OF s(2) 0] subst_var_inv_wf_trms[of \ "fv t"]] + by auto +qed + +lemma (in typed_model) is_wt_instance_of_condD'': + assumes s_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m s" + and t_instance_s: "is_wt_instance_of_cond \ t s" + and t_var: "t = Var x" + shows "\y. s = Var y \ \ (Var y) = \ (Var x)" +proof - + obtain \ where \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" and s: "Var x = s \ \" + using is_wt_instance_of_condD'[OF _ s_wf_trm t_instance_s] t_var by auto + obtain y where y: "s = Var y" using s by (cases s) auto + show ?thesis using wt_subst_trm''[OF \] s y by metis +qed + +lemma (in typed_model) has_all_wt_instances_ofD: + assumes N_instance_M: "has_all_wt_instances_of \ N M" + and t_in_N: "t \ N" + obtains s \ where + "s \ M" "\ t = \ s" "mgu t s = Some \" + "inj_on \ (fv t)" "\ ` (fv t) \ range Var" +by (metis t_in_N N_instance_M is_wt_instance_of_condD has_all_wt_instances_of_def) + +lemma (in typed_model) has_all_wt_instances_ofD': + assumes N_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N" + and M_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" + and N_instance_M: "has_all_wt_instances_of \ N M" + and t_in_N: "t \ N" + shows "\\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t \ M \\<^sub>s\<^sub>e\<^sub>t \" +using assms is_wt_instance_of_condD' unfolding has_all_wt_instances_of_def by fast + +lemma (in typed_model) has_all_wt_instances_ofD'': + assumes N_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N" + and M_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" + and N_instance_M: "has_all_wt_instances_of \ N M" + and t_in_N: "Var x \ N" + shows "\y. Var y \ M \ \ (Var y) = \ (Var x)" +using assms is_wt_instance_of_condD'' unfolding has_all_wt_instances_of_def by fast + +lemma (in typed_model) has_all_instances_of_if_subset: + assumes "N \ M" + shows "has_all_wt_instances_of \ N M" +using assms inj_onI mgu_same_empty +unfolding has_all_wt_instances_of_def is_wt_instance_of_cond_def +by (smt option.case_eq_if option.discI option.sel subsetD term.discI(1) term.inject(1)) + +lemma (in typed_model) SMP_I': + assumes N_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N" + and M_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" + and N_instance_M: "has_all_wt_instances_of \ N M" + and t_in_N: "t \ N" + shows "t \ SMP M" +using has_all_wt_instances_ofD'[OF N_wf_trms M_wf_trms N_instance_M t_in_N] + SMP.Substitution[OF SMP.MP[of _ M]] +by blast + + +subsubsection \Lemma: Proving Type-Flaw Resistance\ +locale typed_model' = typed_model arity public Ana \ + for arity::"'fun \ nat" + and public::"'fun \ bool" + and Ana::"('fun,(('fun,'atom::finite) term_type \ nat)) term + \ (('fun,(('fun,'atom) term_type \ nat)) term list + \ ('fun,(('fun,'atom) term_type \ nat)) term list)" + and \::"('fun,(('fun,'atom) term_type \ nat)) term \ ('fun,'atom) term_type" + + + assumes \_Var_fst: "\\ n m. \ (Var (\,n)) = \ (Var (\,m))" + and Ana_const: "\c T. arity c = 0 \ Ana (Fun c T) = ([],[])" + and Ana_subst'_or_Ana_keys_subterm: + "(\f T \ K R. Ana (Fun f T) = (K,R) \ Ana (Fun f T \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \,R \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)) \ + (\t K R k. Ana t = (K,R) \ k \ set K \ k \ t)" +begin + +lemma var_rename_inv_comp: "t \ (var_rename n \\<^sub>s var_rename_inv n) = t" +proof (induction t) + case (Fun f T) + hence "map (\t. t \ var_rename n \\<^sub>s var_rename_inv n) T = T" by (simp add: map_idI) + thus ?case by (metis subst_apply_term.simps(2)) +qed (simp add: var_rename_def var_rename_inv_def) + +lemma var_rename_fv_disjoint: + "fv s \ fv (t \ var_rename (max_var s)) = {}" +proof - + have 1: "\v \ fv s. snd v \ max_var s" by simp + have 2: "\v \ fv (t \ var_rename n). snd v > n" for n unfolding var_rename_def by (induct t) auto + show ?thesis using 1 2 by force +qed + +lemma var_rename_fv_set_disjoint: + assumes "finite M" "s \ M" + shows "fv s \ fv (t \ var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M))) = {}" +proof - + have 1: "\v \ fv s. snd v \ max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M)" using assms + proof (induction M rule: finite_induct) + case (insert t M) thus ?case + proof (cases "t = s") + case False + hence "\v \ fv s. snd v \ max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M)" using insert by simp + moreover have "max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M) \ max_var_set (fv\<^sub>s\<^sub>e\<^sub>t (insert t M))" + using insert.hyps(1) insert.prems + by force + ultimately show ?thesis by auto + qed simp + qed simp + + have 2: "\v \ fv (t \ var_rename n). snd v > n" for n unfolding var_rename_def by (induct t) auto + + show ?thesis using 1 2 by force +qed + +lemma var_rename_fv_set_disjoint': + assumes "finite M" + shows "fv\<^sub>s\<^sub>e\<^sub>t M \ fv\<^sub>s\<^sub>e\<^sub>t (N \\<^sub>s\<^sub>e\<^sub>t var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M))) = {}" +using var_rename_fv_set_disjoint[OF assms] by auto + +lemma var_rename_is_renaming[simp]: + "subst_range (var_rename n) \ range Var" + "subst_range (var_rename_inv n) \ range Var" +unfolding var_rename_def var_rename_inv_def by auto + +lemma var_rename_wt[simp]: + "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (var_rename n)" + "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (var_rename_inv n)" +by (auto simp add: var_rename_def var_rename_inv_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def \_Var_fst) + +lemma var_rename_wt': + assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "s = m \ \" + shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (var_rename_inv n \\<^sub>s \)" "s = m \ var_rename n \ var_rename_inv n \\<^sub>s \" +using assms(2) wt_subst_compose[OF var_rename_wt(2)[of n] assms(1)] var_rename_inv_comp[of m n] +by force+ + +lemma var_rename_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_range[simp]: + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (var_rename n))" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (var_rename_inv n))" +using var_rename_is_renaming by fastforce+ + +lemma Fun_range_case: + "(\f T. Fun f T \ M \ P f T) \ (\u \ M. case u of Fun f T \ P f T | _ \ True)" + "(\f T. Fun f T \ M \ P f T) \ (\u \ M. is_Fun u \ P (the_Fun u) (args u))" +by (auto split: "term.splits") + +lemma is_TComp_var_instance_closedD: + assumes x: "\y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var x) = \ (Var y)" "\ (Var x) = TComp f T" + and closed: "is_TComp_var_instance_closed \ M" + shows "\g U. Fun g U \ set M \ \ (Fun g U) = \ (Var x) \ (\u \ set U. is_Var u) \ distinct U" +using assms unfolding is_TComp_var_instance_closed_def list_all_iff list_ex_iff by fastforce + +lemma is_TComp_var_instance_closedD': + assumes "\y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var x) = \ (Var y)" "TComp f T \ \ (Var x)" + and closed: "is_TComp_var_instance_closed \ M" + and wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + shows "\g U. Fun g U \ set M \ \ (Fun g U) = TComp f T \ (\u \ set U. is_Var u) \ distinct U" +using assms(1,2) +proof (induction "\ (Var x)" arbitrary: x) + case (Fun g U) + note IH = Fun.hyps(1) + have g: "arity g > 0" "public g" using Fun.hyps(2) fun_type_inv[of "Var x"] \_Var_fst by simp_all + then obtain V where V: + "Fun g V \ set M" "\ (Fun g V) = \ (Var x)" "\v \ set V. \x. v = Var x" + "distinct V" "length U = length V" + using is_TComp_var_instance_closedD[OF Fun.prems(1) Fun.hyps(2)[symmetric] closed(1)] + by (metis Fun.hyps(2) fun_type_id_eq fun_type_length_eq is_VarE) + hence U: "U = map \ V" using fun_type[OF g(1), of V] Fun.hyps(2) by simp + hence 1: "\ v \ set U" when v: "v \ set V" for v using v by simp + + have 2: "\y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var z) = \ (Var y)" when z: "Var z \ set V" for z + using V(1) fv_subset_subterms Fun_param_in_subterms[OF z] by fastforce + + show ?case + proof (cases "TComp f T = \ (Var x)") + case False + then obtain u where u: "u \ set U" "TComp f T \ u" + using Fun.prems(2) Fun.hyps(2) by moura + then obtain y where y: "Var y \ set V" "\ (Var y) = u" using U V(3) \_Var_fst by auto + show ?thesis using IH[OF _ 2[OF y(1)]] u y(2) by metis + qed (use V in fastforce) +qed simp + +lemma TComp_var_instance_wt_subst_exists: + assumes gT: "\ (Fun g T) = TComp g (map \ U)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun g T)" + and U: "\u \ set U. \y. u = Var y" "distinct U" + shows "\\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ Fun g T = Fun g U \ \" +proof - + define the_i where "the_i \ \y. THE x. x < length U \ U ! x = Var y" + define \ where \: "\ \ \y. if Var y \ set U then T ! the_i y else Var y" + + have g: "arity g > 0" using gT(1,2) fun_type_inv(1) by blast + + have UT: "length U = length T" using fun_type_length_eq gT(1) by fastforce + + have 1: "the_i y < length U \ U ! the_i y = Var y" when y: "Var y \ set U" for y + using theI'[OF distinct_Ex1[OF U(2) y]] unfolding the_i_def by simp + + have 2: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + using \ 1 gT(1) fun_type[OF g] UT + unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def + by (metis (no_types, lifting) nth_map term.inject(2)) + + have "\i \ = T ! i" + using \ 1 U(1) UT distinct_Ex1[OF U(2)] in_set_conv_nth + by (metis (no_types, lifting) subst_apply_term.simps(1)) + hence "T = map (\t. t \ \) U" by (simp add: UT nth_equalityI) + hence 3: "Fun g T = Fun g U \ \" by simp + + have "subst_range \ \ set T" using \ 1 U(1) UT by (auto simp add: subst_domain_def) + hence 4: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" using gT(2) wf_trm_param by auto + + show ?thesis by (metis 2 3 4) +qed + +lemma TComp_var_instance_closed_has_Var: + assumes closed: "is_TComp_var_instance_closed \ M" + and wf_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + and wf_\x: "wf\<^sub>t\<^sub>r\<^sub>m (\ x)" + and y_ex: "\y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var x) = \ (Var y)" + and t: "t \ \ x" + and \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + shows "\y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var y) = \ t" +proof (cases "\ (Var x)") + case (Var a) + hence "t = \ x" + using t wf_\x \_wt + by (metis (full_types) const_type_inv_wf fun_if_subterm subtermeq_Var_const(2) wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + thus ?thesis using y_ex wt_subst_trm''[OF \_wt, of "Var x"] by fastforce +next + case (Fun f T) + hence \_\x: "\ (\ x) = TComp f T" using wt_subst_trm''[OF \_wt, of "Var x"] by auto + + show ?thesis + proof (cases "t = \ x") + case False + hence t_subt_\x: "t \ \ x" using t(1) \_\x by fastforce + + obtain T' where T': "\ x = Fun f T'" using \_\x t_subt_\x fun_type_id_eq by (cases "\ x") auto + + obtain g S where gS: "Fun g S \ \ x" "t \ set S" using Fun_ex_if_subterm[OF t_subt_\x] by blast + + have gS_wf: "wf\<^sub>t\<^sub>r\<^sub>m (Fun g S)" by (rule wf_trm_subtermeq[OF wf_\x gS(1)]) + hence "arity g > 0" using gS(2) by (metis length_pos_if_in_set wf_trm_arity) + hence gS_\: "\ (Fun g S) = TComp g (map \ S)" using fun_type by blast + + obtain h U where hU: + "Fun h U \ set M" "\ (Fun h U) = Fun g (map \ S)" "\u \ set U. is_Var u" + using is_TComp_var_instance_closedD'[OF y_ex _ closed wf_M] + subtermeq_imp_subtermtypeeq[OF wf_\x] gS \_\x Fun gS_\ + by metis + + obtain y where y: "Var y \ set U" "\ (Var y) = \ t" + using hU(3) fun_type_param_ex[OF hU(2) gS(2)] by fast + + have "y \ fv\<^sub>s\<^sub>e\<^sub>t (set M)" using hU(1) y(1) by force + thus ?thesis using y(2) closed by metis + qed (metis y_ex Fun \_\x) +qed + +lemma TComp_var_instance_closed_has_Fun: + assumes closed: "is_TComp_var_instance_closed \ M" + and wf_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + and wf_\x: "wf\<^sub>t\<^sub>r\<^sub>m (\ x)" + and y_ex: "\y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var x) = \ (Var y)" + and t: "t \ \ x" + and \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and t_\: "\ t = TComp g T" + and t_fun: "is_Fun t" + shows "\m \ set M. \\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = m \ \ \ is_Fun m" +proof - + obtain T'' where T'': "t = Fun g T''" using t_\ t_fun fun_type_id_eq by blast + + have g: "arity g > 0" using t_\ fun_type_inv[of t] by simp_all + + have "TComp g T \ \ (Var x)" using \_wt t t_\ + by (metis wf_\x subtermeq_imp_subtermtypeeq wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + then obtain U where U: + "Fun g U \ set M" "\ (Fun g U) = TComp g T" "\u \ set U. \y. u = Var y" + "distinct U" "length T'' = length U" + using is_TComp_var_instance_closedD'[OF y_ex _ closed wf_M] + by (metis t_\ T'' fun_type_id_eq fun_type_length_eq is_VarE) + hence UT': "T = map \ U" using fun_type[OF g, of U] by simp + + show ?thesis + using TComp_var_instance_wt_subst_exists UT' T'' U(1,3,4) t t_\ wf_\x wf_trm_subtermeq + by (metis term.disc(2)) +qed + +lemma TComp_var_and_subterm_instance_closed_has_subterms_instances: + assumes M_var_inst_cl: "is_TComp_var_instance_closed \ M" + and M_subterms_cl: "has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set M)) (set M)" + and M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + and t: "t \\<^sub>s\<^sub>e\<^sub>t set M" + and s: "s \ t \ \" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "\m \ set M. \\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ s = m \ \" +using subterm_subst_unfold[OF s] +proof + assume "\s'. s' \ t \ s = s' \ \" + then obtain s' where s': "s' \ t" "s = s' \ \" by blast + then obtain \ where \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "s' \ set M \\<^sub>s\<^sub>e\<^sub>t \" + using t has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl] + term.order_trans[of s' t] + by blast + then obtain m where m: "m \ set M" "s' = m \ \" by blast + + have "s = m \ (\ \\<^sub>s \)" using s'(2) m(2) by simp + thus ?thesis + using m(1) wt_subst_compose[OF \(1) \(1)] wf_trms_subst_compose[OF \(2) \(2)] by blast +next + assume "\x \ fv t. s \ \ x" + then obtain x where x: "x \ fv t" "s \ \ x" "s \ \ x" by blast + + note 0 = TComp_var_instance_closed_has_Var[OF M_var_inst_cl M_wf] + note 1 = has_all_wt_instances_ofD''[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl] + + have \x_wf: "wf\<^sub>t\<^sub>r\<^sub>m (\ x)" and s_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m s" + using \(2) wf_trm_subterm[OF _ x(2)] by fastforce+ + + have x_fv_ex: "\y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var x) = \ (Var y)" + using x(1) s fv_subset_subterms[OF t] by auto + + obtain y where y: "y \ fv\<^sub>s\<^sub>e\<^sub>t (set M)" "\ (Var y) = \ s" + using 0[of \ x s, OF \x_wf x_fv_ex x(3) \(1)] by metis + then obtain z where z: "Var z \ set M" "\ (Var z) = \ s" + using 1[of y] vars_iff_subtermeq_set[of y "set M"] by metis + + define \ where "\ \ Var(z := s)::('fun, ('fun, 'atom) term \ nat) subst" + + have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "s = Var z \ \" + using z(2) s_wf_trm unfolding \_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by force+ + thus ?thesis using z(1) by blast +qed + +context +begin +private lemma SMP_D_aux1: + assumes "t \ SMP (set M)" + and closed: "has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set M)) (set M)" + "is_TComp_var_instance_closed \ M" + and wf_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + shows "\x \ fv t. \y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var y) = \ (Var x)" +using assms(1) +proof (induction t rule: SMP.induct) + case (MP t) show ?case + proof + fix x assume x: "x \ fv t" + hence "Var x \ subterms\<^sub>s\<^sub>e\<^sub>t (set M)" using MP.hyps vars_iff_subtermeq by fastforce + then obtain \ s where \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + and s: "s \ set M" "Var x = s \ \" + using has_all_wt_instances_ofD'[OF wf_trms_subterms[OF wf_M] wf_M closed(1)] by blast + then obtain y where y: "s = Var y" by (cases s) auto + thus "\y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var y) = \ (Var x)" + using s wt_subst_trm''[OF \(1), of "Var y"] by force + qed +next + case (Subterm t t') + hence "fv t' \ fv t" using subtermeq_vars_subset by auto + thus ?case using Subterm.IH by auto +next + case (Substitution t \) + note IH = Substitution.IH + show ?case + proof + fix x assume x: "x \ fv (t \ \)" + then obtain y where y: "y \ fv t" "\ (Var x) \ \ (Var y)" + using Substitution.hyps(2,3) + by (metis subst_apply_img_var subtermeqI' subtermeq_imp_subtermtypeeq + vars_iff_subtermeq wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def wf_trm_subst_rangeD) + let ?P = "\x. \y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var y) = \ (Var x)" + show "?P x" using y IH + proof (induction "\ (Var y)" arbitrary: y t) + case (Var a) + hence "\ (Var x) = \ (Var y)" by auto + thus ?case using Var(2,4) by auto + next + case (Fun f T) + obtain z where z: "\w \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var z) = \ (Var w)" "\ (Var z) = \ (Var y)" + using Fun.prems(1,3) by blast + show ?case + proof (cases "\ (Var x) = \ (Var y)") + case True thus ?thesis using Fun.prems by auto + next + case False + then obtain \ where \: "\ \ set T" "\ (Var x) \ \" using Fun.prems(2) Fun.hyps(2) by auto + then obtain U where U: + "Fun f U \ set M" "\ (Fun f U) = \ (Var z)" "\u \ set U. \v. u = Var v" "distinct U" + using is_TComp_var_instance_closedD'[OF z(1) _ closed(2) wf_M] Fun.hyps(2) z(2) + by (metis fun_type_id_eq subtermeqI' is_VarE) + hence 1: "\x \ fv (Fun f U). \y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var y) = \ (Var x)" by force + + have "arity f > 0" using U(2) z(2) Fun.hyps(2) fun_type_inv(1) by metis + hence "\ (Fun f U) = TComp f (map \ U)" using fun_type by auto + then obtain u where u: "Var u \ set U" "\ (Var u) = \" + using \(1) U(2,3) z(2) Fun.hyps(2) by auto + show ?thesis + using Fun.hyps(1)[of u "Fun f U"] u \ 1 + by force + qed + qed + qed +next + case (Ana t K T k) + have "fv k \ fv t" using Ana_keys_fv[OF Ana.hyps(2)] Ana.hyps(3) by auto + thus ?case using Ana.IH by auto +qed + +private lemma SMP_D_aux2: + fixes t::"('fun, ('fun, 'atom) term \ nat) term" + assumes t_SMP: "t \ SMP (set M)" + and t_Var: "\x. t = Var x" + and M_SMP_repr: "finite_SMP_representation arity Ana \ M" + shows "\m \ set M. \\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = m \ \" +proof - + have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + and M_var_inst_cl: "is_TComp_var_instance_closed \ M" + and M_subterms_cl: "has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set M)) (set M)" + and M_Ana_cl: "has_all_wt_instances_of \ (\((set \ fst \ Ana) ` set M)) (set M)" + using finite_SMP_representationD[OF M_SMP_repr] by blast+ + + have M_Ana_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\ ((set \ fst \ Ana) ` set M))" + proof + fix k assume "k \ \((set \ fst \ Ana) ` set M)" + then obtain m where m: "m \ set M" "k \ set (fst (Ana m))" by force + thus "wf\<^sub>t\<^sub>r\<^sub>m k" using M_wf Ana_keys_wf'[of m "fst (Ana m)" _ k] surjective_pairing by blast + qed + + note 0 = has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl] + note 1 = has_all_wt_instances_ofD'[OF M_Ana_wf M_wf M_Ana_cl] + + obtain x y where x: "t = Var x" and y: "y \ fv\<^sub>s\<^sub>e\<^sub>t (set M)" "\ (Var y) = \ (Var x)" + using t_Var SMP_D_aux1[OF t_SMP M_subterms_cl M_var_inst_cl M_wf] by fastforce + then obtain m \ where m: "m \ set M" "m \ \ = Var y" and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + using 0[of "Var y"] vars_iff_subtermeq_set[of y "set M"] by fastforce + obtain z where z: "m = Var z" using m(2) by (cases m) auto + + define \ where "\ \ Var(z := Var x)::('fun, ('fun, 'atom) term \ nat) subst" + + have "\ (Var z) = \ (Var x)" using y(2) m(2) z wt_subst_trm''[OF \, of m] by argo + hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" unfolding \_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by force+ + moreover have "t = m \ \" using x z unfolding \_def by simp + ultimately show ?thesis using m(1) by blast +qed + +private lemma SMP_D_aux3: + assumes hyps: "t' \ t" and wf_t: "wf\<^sub>t\<^sub>r\<^sub>m t" and prems: "is_Fun t'" + and IH: + "((\f. t = Fun f []) \ (\m \ set M. \\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = m \ \)) \ + (\m \ set M. \\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = m \ \ \ is_Fun m)" + and M_SMP_repr: "finite_SMP_representation arity Ana \ M" + shows "((\f. t' = Fun f []) \ (\m \ set M. \\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t' = m \ \)) \ + (\m \ set M. \\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t' = m \ \ \ is_Fun m)" +proof (cases "\f. t = Fun f [] \ t' = Fun f []") + case True + have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + and M_var_inst_cl: "is_TComp_var_instance_closed \ M" + and M_subterms_cl: "has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set M)) (set M)" + and M_Ana_cl: "has_all_wt_instances_of \ (\((set \ fst \ Ana) ` set M)) (set M)" + using finite_SMP_representationD[OF M_SMP_repr] by blast+ + + note 0 = has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl] + note 1 = TComp_var_instance_closed_has_Fun[OF M_var_inst_cl M_wf] + note 2 = TComp_var_and_subterm_instance_closed_has_subterms_instances[ + OF M_var_inst_cl M_subterms_cl M_wf] + + have wf_t': "wf\<^sub>t\<^sub>r\<^sub>m t'" using hyps wf_t wf_trm_subterm by blast + + obtain c where "t = Fun c [] \ t' = Fun c []" using True by moura + thus ?thesis + proof + assume c: "t' = Fun c []" + show ?thesis + proof (cases "\f. t = Fun f []") + case True + hence "t = t'" using c hyps by force + thus ?thesis using IH by fast + next + case False + note F = this + then obtain m \ where m: "m \ set M" "t = m \ \" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using IH by blast + + show ?thesis using subterm_subst_unfold[OF hyps[unfolded m(2)]] + proof + assume "\m'. m' \ m \ t' = m' \ \" + then obtain m' where m': "m' \ m" "t' = m' \ \" by moura + obtain n \ where n: "n \ set M" "m' = n \ \" and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using 0[of m'] m(1) m'(1) by blast + have "t' = n \ (\ \\<^sub>s \)" using m'(2) n(2) by auto + thus ?thesis + using c n(1) wt_subst_compose[OF \(1) \(1)] wf_trms_subst_compose[OF \(2) \(2)] by blast + next + assume "\x \ fv m. t' \ \ x" + then obtain x where x: "x \ fv m" "t' \ \ x" "t' \ \ x" by moura + have \x_wf: "wf\<^sub>t\<^sub>r\<^sub>m (\ x)" using \(2) by fastforce + + have x_fv_ex: "\y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var x) = \ (Var y)" using x m by auto + + show ?thesis + proof (cases "\ t'") + case (Var a) + show ?thesis + using c m 2[OF _ hyps[unfolded m(2)] \] + by fast + next + case (Fun g S) + show ?thesis + using c 1[of \ x t', OF \x_wf x_fv_ex x(3) \(1) Fun] + by blast + qed + qed + qed + qed (use IH hyps in simp) +next + case False + note F = False + then obtain m \ where m: + "m \ set M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "t = m \ \" "is_Fun m" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using IH by moura + obtain f T where fT: "t' = Fun f T" "arity f > 0" "\ t' = TComp f (map \ T)" + using F prems fun_type wf_trm_subtermeq[OF wf_t hyps] + by (metis is_FunE length_greater_0_conv subtermeqI' wf\<^sub>t\<^sub>r\<^sub>m_def) + + have closed: "has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set M)) (set M)" + "is_TComp_var_instance_closed \ M" + using M_SMP_repr unfolding finite_SMP_representation_def by metis+ + + have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + using finite_SMP_representationD[OF M_SMP_repr] by blast + + show ?thesis + proof (cases "\x \ fv m. t' \ \ x") + case True + then obtain x where x: "x \ fv m" "t' \ \ x" by moura + have 1: "x \ fv\<^sub>s\<^sub>e\<^sub>t (set M)" using m(1) x(1) by auto + have 2: "is_Fun (\ x)" using prems x(2) by auto + have 3: "wf\<^sub>t\<^sub>r\<^sub>m (\ x)" using m(5) by (simp add: wf_trm_subst_rangeD) + have "\(\f. \ x = Fun f [])" using F x(2) by auto + hence "\f T. \ (Var x) = TComp f T" using 2 3 m(2) + by (metis (no_types) fun_type is_FunE length_greater_0_conv subtermeqI' wf\<^sub>t\<^sub>r\<^sub>m_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) + moreover have "\f T. \ t' = Fun f T" + using False prems wf_trm_subtermeq[OF wf_t hyps] + by (metis (no_types) fun_type is_FunE length_greater_0_conv subtermeqI' wf\<^sub>t\<^sub>r\<^sub>m_def) + ultimately show ?thesis + using TComp_var_instance_closed_has_Fun 1 x(2) m(2) prems closed 3 M_wf + by metis + next + case False + then obtain m' where m': "m' \ m" "t' = m' \ \" "is_Fun m'" + using hyps m(3) subterm_subst_not_img_subterm + by blast + then obtain \ m'' where \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "m'' \ set M" "m' = m'' \ \" + using m(1) has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf closed(1)] by blast + hence t'_m'': "t' = m'' \ \ \\<^sub>s \" using m'(2) by fastforce + + note \\ = wt_subst_compose[OF \(1) m(2)] wf_trms_subst_compose[OF \(2) m(5)] + + show ?thesis + proof (cases "is_Fun m''") + case True thus ?thesis using \(3,4) m'(2,3) m(4) fT t'_m'' \\ by blast + next + case False + then obtain x where x: "m'' = Var x" by moura + hence "\y \ fv\<^sub>s\<^sub>e\<^sub>t (set M). \ (Var x) = \ (Var y)" "t' \ (\ \\<^sub>s \) x" + "\ (Var x) = Fun f (map \ T)" "wf\<^sub>t\<^sub>r\<^sub>m ((\ \\<^sub>s \) x)" + using \\ t'_m'' \(3) fv_subset[OF \(3)] fT(3) subst_apply_term.simps(1)[of x "\ \\<^sub>s \"] + wt_subst_trm''[OF \\(1), of "Var x"] + by (fastforce, blast, argo, fastforce) + thus ?thesis + using x TComp_var_instance_closed_has_Fun[ + of M "\ \\<^sub>s \" x t' f "map \ T", OF closed(2) M_wf _ _ _ \\(1) fT(3) prems] + by blast + qed + qed +qed + +lemma SMP_D: + assumes "t \ SMP (set M)" "is_Fun t" + and M_SMP_repr: "finite_SMP_representation arity Ana \ M" + shows "((\f. t = Fun f []) \ (\m \ set M. \\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = m \ \)) \ + (\m \ set M. \\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = m \ \ \ is_Fun m)" +proof - + have wf_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + and closed: "has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set M)) (set M)" + "has_all_wt_instances_of \ (\((set \ fst \ Ana) ` set M)) (set M)" + "is_TComp_var_instance_closed \ M" + using finite_SMP_representationD[OF M_SMP_repr] by blast+ + + show ?thesis using assms(1,2) + proof (induction t rule: SMP.induct) + case (MP t) + moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" "t = t \ Var" by simp_all + ultimately show ?case by blast + next + case (Subterm t t') + hence t_fun: "is_Fun t" by auto + note * = Subterm.hyps(2) SMP_wf_trm[OF Subterm.hyps(1) wf_M(1)] + Subterm.prems Subterm.IH[OF t_fun] M_SMP_repr + show ?case by (rule SMP_D_aux3[OF *]) + next + case (Substitution t \) + have wf: "wf\<^sub>t\<^sub>r\<^sub>m t" by (metis Substitution.hyps(1) wf_M(1) SMP_wf_trm) + hence wf': "wf\<^sub>t\<^sub>r\<^sub>m (t \ \)" using Substitution.hyps(3) wf_trm_subst by blast + show ?case + proof (cases "\ t") + case (Var a) + hence 1: "\ (t \ \) = TAtom a" using Substitution.hyps(2) by (metis wt_subst_trm'') + then obtain c where c: "t \ \ = Fun c []" + using TAtom_term_cases[OF wf' 1] Substitution.prems by fastforce + hence "(\x. t = Var x) \ t = t \ \" by (cases t) auto + thus ?thesis + proof + assume t_Var: "\x. t = Var x" + then obtain x where x: "t = Var x" "\ x = Fun c []" "\ (Var x) = TAtom a" + using c 1 wt_subst_trm''[OF Substitution.hyps(2), of t] by force + + obtain m \ where m: "m \ set M" "t = m \ \" and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using SMP_D_aux2[OF Substitution.hyps(1) t_Var M_SMP_repr] by moura + + have "m \ (\ \\<^sub>s \) = Fun c []" using c m(2) by auto + thus ?thesis + using c m(1) wt_subst_compose[OF \(1) Substitution.hyps(2)] + wf_trms_subst_compose[OF \(2) Substitution.hyps(3)] + by metis + qed (use c Substitution.IH in auto) + next + case (Fun f T) + hence 1: "\ (t \ \) = TComp f T" using Substitution.hyps(2) by (metis wt_subst_trm'') + have 2: "\(\f. t = Fun f [])" using Fun TComp_term_cases[OF wf] by auto + obtain T'' where T'': "t \ \ = Fun f T''" + using 1 2 fun_type_id_eq Fun Substitution.prems + by fastforce + have f: "arity f > 0" "public f" using fun_type_inv[OF 1] by metis+ + + show ?thesis + proof (cases t) + case (Fun g U) + then obtain m \ where m: + "m \ set M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "t = m \ \" "is_Fun m" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using Substitution.IH Fun 2 by moura + have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" "t \ \ = m \ (\ \\<^sub>s \)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + using wt_subst_compose[OF m(2) Substitution.hyps(2)] m(3) + wf_trms_subst_compose[OF m(5) Substitution.hyps(3)] + by auto + thus ?thesis using m(1,4) by metis + next + case (Var x) + then obtain y where y: "y \ fv\<^sub>s\<^sub>e\<^sub>t (set M)" "\ (Var y) = \ (Var x)" + using SMP_D_aux1[OF Substitution.hyps(1) closed(1,3) wf_M] Fun + by moura + hence 3: "\ (Var y) = TComp f T" using Var Fun \_Var_fst by simp + + obtain h V where V: + "Fun h V \ set M" "\ (Fun h V) = \ (Var y)" "\u \ set V. \z. u = Var z" "distinct V" + by (metis is_VarE is_TComp_var_instance_closedD[OF _ 3 closed(3)] y(1)) + moreover have "length T'' = length V" using 3 V(2) fun_type_length_eq 1 T'' by metis + ultimately have TV: "T = map \ V" + by (metis fun_type[OF f(1)] 3 fun_type_id_eq term.inject(2)) + + obtain \ where \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "t \ \ = Fun h V \ \" + using TComp_var_instance_wt_subst_exists 1 3 T'' TV V(2,3,4) wf' + by (metis fun_type_id_eq) + + have 9: "\ (Fun h V) = \ (\ x)" using y(2) Substitution.hyps(2) V(2) 1 3 Var by auto + + show ?thesis using Var \ 9 V(1) by force + qed + qed + next + case (Ana t K T k) + have 1: "is_Fun t" using Ana.hyps(2,3) by auto + then obtain f U where U: "t = Fun f U" by moura + + have 2: "fv k \ fv t" using Ana_keys_fv[OF Ana.hyps(2)] Ana.hyps(3) by auto + + have wf_t: "wf\<^sub>t\<^sub>r\<^sub>m t" + using SMP_wf_trm[OF Ana.hyps(1)] wf\<^sub>t\<^sub>r\<^sub>m_code wf_M + by auto + hence wf_k: "wf\<^sub>t\<^sub>r\<^sub>m k" + using Ana_keys_wf'[OF Ana.hyps(2)] wf\<^sub>t\<^sub>r\<^sub>m_code Ana.hyps(3) + by auto + + have wf_M_keys: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\((set \ fst \ Ana) ` set M))" + proof + fix t assume "t \ (\((set \ fst \ Ana) ` set M))" + then obtain s where s: "s \ set M" "t \ (set \ fst \ Ana) s" by blast + obtain K R where KR: "Ana s = (K,R)" by (metis surj_pair) + hence "t \ set K" using s(2) by simp + thus "wf\<^sub>t\<^sub>r\<^sub>m t" using Ana_keys_wf'[OF KR] wf_M s(1) by blast + qed + + show ?case using Ana_subst'_or_Ana_keys_subterm + proof + assume "\t K T k. Ana t = (K, T) \ k \ set K \ k \ t" + hence *: "k \ t" using Ana.hyps(2,3) by auto + show ?thesis by (rule SMP_D_aux3[OF * wf_t Ana.prems Ana.IH[OF 1] M_SMP_repr]) + next + assume Ana_subst': + "\f T \ K M. Ana (Fun f T) = (K, M) \ Ana (Fun f T \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" + + have "arity f > 0" using Ana_const[of f U] U Ana.hyps(2,3) by fastforce + hence "U \ []" using wf_t U unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by force + then obtain m \ where m: "m \ set M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "t = m \ \" "is_Fun m" + using Ana.IH[OF 1] U by auto + hence "Ana (t \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \,T \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" using Ana_subst' U Ana.hyps(2) by auto + obtain Km Tm where Ana_m: "Ana m = (Km,Tm)" by moura + hence "Ana (m \ \) = (Km \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \,Tm \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" + using Ana_subst' U m(4) is_FunE[OF m(5)] Ana.hyps(2) + by metis + then obtain km where km: "km \ set Km" "k = km \ \" using Ana.hyps(2,3) m(4) by auto + then obtain \ km' where \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + and km': "km' \ set M" "km = km' \ \" + using Ana_m m(1) has_all_wt_instances_ofD'[OF wf_M_keys wf_M closed(2), of km] by force + + have k\\: "k = km' \ \ \\<^sub>s \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + using km(2) km' wt_subst_compose[OF \(1) m(2)] wf_trms_subst_compose[OF \(2) m(3)] + by auto + + show ?case + proof (cases "is_Fun km'") + case True thus ?thesis using k\\ km'(1) by blast + next + case False + note F = False + then obtain x where x: "km' = Var x" by auto + hence 3: "x \ fv\<^sub>s\<^sub>e\<^sub>t (set M)" using fv_subset[OF km'(1)] by auto + obtain kf kT where kf: "k = Fun kf kT" using Ana.prems by auto + show ?thesis + proof (cases "kT = []") + case True thus ?thesis using k\\(1) k\\(2) k\\(3) kf km'(1) by blast + next + case False + hence 4: "arity kf > 0" using wf_k kf TAtom_term_cases const_type by fastforce + then obtain kT' where kT': "\ k = TComp kf kT'" by (simp add: fun_type kf) + then obtain V where V: + "Fun kf V \ set M" "\ (Fun kf V) = \ (Var x)" "\u \ set V. \v. u = Var v" + "distinct V" "is_Fun (Fun kf V)" + using is_TComp_var_instance_closedD[OF _ _ closed(3), of x] + x m(2) k\\(1) 3 wt_subst_trm''[OF k\\(2)] + by (metis fun_type_id_eq term.disc(2) is_VarE) + have 5: "kT' = map \ V" + using fun_type[OF 4] x kT' k\\ m(2) V(2) + by (metis term.inject(2) wt_subst_trm'') + thus ?thesis + using TComp_var_instance_wt_subst_exists wf_k kf 4 V(3,4) kT' V(1,5) + by metis + qed + qed + qed + qed +qed + +lemma SMP_D': + fixes M + defines "\ \ var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t (set M)))" + assumes M_SMP_repr: "finite_SMP_representation arity Ana \ M" + and s: "s \ SMP (set M)" "is_Fun s" "\f. s = Fun f []" + and t: "t \ SMP (set M)" "is_Fun t" "\f. t = Fun f []" + obtains \ s0 \ t0 + where "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "s0 \ set M" "is_Fun s0" "s = s0 \ \" "\ s = \ s0" + and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "t0 \ set M" "is_Fun t0" "t = t0 \ \ \ \" "\ t = \ t0" +proof - + obtain \ s0 where + s0: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "s0 \ set M" "s = s0 \ \" "is_Fun s0" + using s(3) SMP_D[OF s(1,2) M_SMP_repr] unfolding \_def by metis + + obtain \ t0 where t0: + "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "t0 \ set M" "t = t0 \ \ \ \" "is_Fun t0" + using t(3) SMP_D[OF t(1,2) M_SMP_repr] var_rename_wt'[of _ t] + wf_trms_subst_compose_Var_range(1)[OF _ var_rename_is_renaming(2)] + unfolding \_def by metis + + have "\ s = \ s0" "\ t = \ (t0 \ \)" "\ (t0 \ \) = \ t0" + using s0 t0 wt_subst_trm'' by (metis, metis, metis \_def var_rename_wt(1)) + thus ?thesis using s0 t0 that by simp +qed + +lemma SMP_D'': + fixes t::"('fun, ('fun, 'atom) term \ nat) term" + assumes t_SMP: "t \ SMP (set M)" + and M_SMP_repr: "finite_SMP_representation arity Ana \ M" + shows "\m \ set M. \\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ t = m \ \" +proof (cases "(\x. t = Var x) \ (\c. t = Fun c [])") + case True + have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + and M_var_inst_cl: "is_TComp_var_instance_closed \ M" + and M_subterms_cl: "has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set M)) (set M)" + and M_Ana_cl: "has_all_wt_instances_of \ (\((set \ fst \ Ana) ` set M)) (set M)" + using finite_SMP_representationD[OF M_SMP_repr] by blast+ + + have M_Ana_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\ ((set \ fst \ Ana) ` set M))" + proof + fix k assume "k \ \((set \ fst \ Ana) ` set M)" + then obtain m where m: "m \ set M" "k \ set (fst (Ana m))" by force + thus "wf\<^sub>t\<^sub>r\<^sub>m k" using M_wf Ana_keys_wf'[of m "fst (Ana m)" _ k] surjective_pairing by blast + qed + + show ?thesis using True + proof + assume "\x. t = Var x" + then obtain x y where x: "t = Var x" and y: "y \ fv\<^sub>s\<^sub>e\<^sub>t (set M)" "\ (Var y) = \ (Var x)" + using SMP_D_aux1[OF t_SMP M_subterms_cl M_var_inst_cl M_wf] by fastforce + then obtain m \ where m: "m \ set M" "m \ \ = Var y" and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + using has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl, of "Var y"] + vars_iff_subtermeq_set[of y "set M"] + by fastforce + + obtain z where z: "m = Var z" using m(2) by (cases m) auto + + define \ where "\ \ Var(z := Var x)::('fun, ('fun, 'atom) term \ nat) subst" + + have "\ (Var z) = \ (Var x)" using y(2) m(2) z wt_subst_trm''[OF \, of m] by argo + hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" unfolding \_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by force+ + moreover have "t = m \ \" using x z unfolding \_def by simp + ultimately show ?thesis using m(1) by blast + qed (use SMP_D[OF t_SMP _ M_SMP_repr] in blast) +qed (use SMP_D[OF t_SMP _ M_SMP_repr] in blast) +end + +lemma tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t: + assumes "comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \ M" + shows "tfr\<^sub>s\<^sub>e\<^sub>t (set M)" +proof - + let ?\ = "var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t (set M)))" + have M_SMP_repr: "finite_SMP_representation arity Ana \ M" + by (metis comp_tfr\<^sub>s\<^sub>e\<^sub>t_def assms) + + have M_finite: "finite (set M)" + using assms card_gt_0_iff unfolding comp_tfr\<^sub>s\<^sub>e\<^sub>t_def by blast + + show ?thesis + proof (unfold tfr\<^sub>s\<^sub>e\<^sub>t_def; intro ballI impI) + fix s t assume "s \ SMP (set M) - Var`\" "t \ SMP (set M) - Var`\" + hence st: "s \ SMP (set M)" "is_Fun s" "t \ SMP (set M)" "is_Fun t" by auto + have "\(\\. Unifier \ s t)" when st_type_neq: "\ s \ \ t" + proof (cases "\f. s = Fun f [] \ t = Fun f []") + case False + then obtain \ s0 \ t0 where + s0: "s0 \ set M" "is_Fun s0" "s = s0 \ \" "\ s = \ s0" + and t0: "t0 \ set M" "is_Fun t0" "t = t0 \ ?\ \ \" "\ t = \ t0" + using SMP_D'[OF M_SMP_repr st(1,2) _ st(3,4)] by metis + hence "\(\\. Unifier \ s0 (t0 \ ?\))" + using assms mgu_None_is_subst_neq st_type_neq wt_subst_trm''[OF var_rename_wt(1)] + unfolding comp_tfr\<^sub>s\<^sub>e\<^sub>t_def Let_def by metis + thus ?thesis + using vars_term_disjoint_imp_unifier[OF var_rename_fv_set_disjoint[OF M_finite]] s0(1) t0(1) + unfolding s0(3) t0(3) by (metis (no_types, hide_lams) subst_subst_compose) + qed (use st_type_neq st(2,4) in auto) + thus "\ s = \ t" when "\\. Unifier \ s t" by (metis that) + qed +qed + +lemma tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t': + assumes "let N = SMP0 Ana \ M in set M \ set N \ comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \ N" + shows "tfr\<^sub>s\<^sub>e\<^sub>t (set M)" +by (rule tfr_subset(2)[ + OF tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[OF conjunct2[OF assms[unfolded Let_def]]] + conjunct1[OF assms[unfolded Let_def]]]) + +lemma tfr\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>t\<^sub>p: "tfr\<^sub>s\<^sub>t\<^sub>p a = comp_tfr\<^sub>s\<^sub>t\<^sub>p \ a" +proof (cases a) + case (Equality ac t t') + thus ?thesis + using mgu_always_unifies[of t _ t'] mgu_gives_MGU[of t t'] + by auto +next + case (Inequality X F) + thus ?thesis + using tfr\<^sub>s\<^sub>t\<^sub>p.simps(2)[of X F] + comp_tfr\<^sub>s\<^sub>t\<^sub>p.simps(2)[of \ X F] + Fun_range_case(2)[of "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F)"] + unfolding is_Var_def + by auto +qed auto + +lemma tfr\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>t: + assumes "comp_tfr\<^sub>s\<^sub>t arity Ana \ M S" + shows "tfr\<^sub>s\<^sub>t S" +unfolding tfr\<^sub>s\<^sub>t_def +proof + have comp_tfr\<^sub>s\<^sub>e\<^sub>t_M: "comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \ M" + using assms unfolding comp_tfr\<^sub>s\<^sub>t_def by blast + + have wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + and wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_S: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" + and S_trms_instance_M: "has_all_wt_instances_of \ (trms\<^sub>s\<^sub>t S) (set M)" + using assms wf\<^sub>t\<^sub>r\<^sub>m_code trms_list\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>t + unfolding comp_tfr\<^sub>s\<^sub>t_def comp_tfr\<^sub>s\<^sub>e\<^sub>t_def finite_SMP_representation_def list_all_iff + by blast+ + + show "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" + using tfr_subset(3)[OF tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[OF comp_tfr\<^sub>s\<^sub>e\<^sub>t_M] SMP_SMP_subset] + SMP_I'[OF wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_S wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_M S_trms_instance_M] + by blast + + have "list_all (comp_tfr\<^sub>s\<^sub>t\<^sub>p \) S" by (metis assms comp_tfr\<^sub>s\<^sub>t_def) + thus "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" by (induct S) (simp_all add: tfr\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>t\<^sub>p) +qed + +lemma tfr\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>t': + assumes "comp_tfr\<^sub>s\<^sub>t arity Ana \ (SMP0 Ana \ (trms_list\<^sub>s\<^sub>t S)) S" + shows "tfr\<^sub>s\<^sub>t S" +by (rule tfr\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>t[OF assms]) + + + +subsubsection \Lemmata for Checking Ground SMP (GSMP) Disjointness\ +context +begin +private lemma ground_SMP_disjointI_aux1: + fixes M::"('fun, ('fun, 'atom) term \ nat) term set" + assumes f_def: "f \ \M. {t \ \ | t \. t \ M \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}}" + and g_def: "g \ \M. {t \ M. fv t = {}}" + shows "f (SMP M) = g (SMP M)" +proof + have "t \ f (SMP M)" when t: "t \ SMP M" "fv t = {}" for t + proof - + define \ where "\ \ Var::('fun, ('fun, 'atom) term \ nat) subst" + have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "t = t \ \" + using subst_apply_term_empty[of t] that(2) wt_subst_Var wf_trm_subst_range_Var + unfolding \_def by auto + thus ?thesis using SMP.Substitution[OF t(1), of \] t(2) unfolding f_def by fastforce + qed + thus "g (SMP M) \ f (SMP M)" unfolding g_def by blast +qed (use f_def g_def in blast) + +private lemma ground_SMP_disjointI_aux2: + fixes M::"('fun, ('fun, 'atom) term \ nat) term list" + assumes f_def: "f \ \M. {t \ \ | t \. t \ M \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}}" + and M_SMP_repr: "finite_SMP_representation arity Ana \ M" + shows "f (set M) = f (SMP (set M))" +proof + have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set M)" + and M_var_inst_cl: "is_TComp_var_instance_closed \ M" + and M_subterms_cl: "has_all_wt_instances_of \ (subterms\<^sub>s\<^sub>e\<^sub>t (set M)) (set M)" + and M_Ana_cl: "has_all_wt_instances_of \ (\((set \ fst \ Ana) ` set M)) (set M)" + using finite_SMP_representationD[OF M_SMP_repr] by blast+ + + show "f (SMP (set M)) \ f (set M)" + proof + fix t assume "t \ f (SMP (set M))" + then obtain s \ where s: "t = s \ \" "s \ SMP (set M)" "fv (s \ \) = {}" + and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + unfolding f_def by blast + + have t_wf: "wf\<^sub>t\<^sub>r\<^sub>m t" using SMP_wf_trm[OF s(2) M_wf] s(1) wf_trm_subst[OF \(2)] by blast + + obtain m \ where m: "m \ set M" "s = m \ \" and \: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using SMP_D''[OF s(2) M_SMP_repr] by blast + + have "t = m \ (\ \\<^sub>s \)" "fv (m \ (\ \\<^sub>s \)) = {}" using s(1,3) m(2) by simp_all + thus "t \ f (set M)" + using m(1) wt_subst_compose[OF \(1) \(1)] wf_trms_subst_compose[OF \(2) \(2)] + unfolding f_def by blast + qed +qed (auto simp add: f_def) + +private lemma ground_SMP_disjointI_aux3: + fixes A B C::"('fun, ('fun, 'atom) term \ nat) term set" + defines "P \ \t s. \\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ Unifier \ t s" + assumes f_def: "f \ \M. {t \ \ | t \. t \ M \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}}" + and Q_def: "Q \ \t. intruder_synth' public arity {} t" + and R_def: "R \ \t. \u \ C. is_wt_instance_of_cond \ t u" + and AB: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s A" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s B" "fv\<^sub>s\<^sub>e\<^sub>t A \ fv\<^sub>s\<^sub>e\<^sub>t B = {}" + and C: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s C" + and ABC: "\t \ A. \s \ B. P t s \ (Q t \ Q s) \ (R t \ R s)" + shows "f A \ f B \ f C \ {m. {} \\<^sub>c m}" +proof + fix t assume "t \ f A \ f B" + then obtain ta tb \a \b where + ta: "t = ta \ \a" "ta \ A" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \a" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \a)" "fv (ta \ \a) = {}" + and tb: "t = tb \ \b" "tb \ B" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \b" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \b)" "fv (tb \ \b) = {}" + unfolding f_def by blast + + have ta_tb_wf: "wf\<^sub>t\<^sub>r\<^sub>m ta" "wf\<^sub>t\<^sub>r\<^sub>m tb" "fv ta \ fv tb = {}" "\ ta = \ tb" + using ta(1,2) tb(1,2) AB fv_subset_subterms + wt_subst_trm''[OF ta(3), of ta] wt_subst_trm''[OF tb(3), of tb] + by (fast, fast, blast, simp) + + obtain \ where \: "Unifier \ ta tb" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using vars_term_disjoint_imp_unifier[OF ta_tb_wf(3), of \a \b] + ta(1) tb(1) wt_Unifier_if_Unifier[OF ta_tb_wf(1,2,4)] + by blast + hence "(Q ta \ Q tb) \ (R ta \ R tb)" using ABC ta(2) tb(2) unfolding P_def by blast+ + thus "t \ f C \ {m. {} \\<^sub>c m}" + proof + show "Q ta \ Q tb \ ?thesis" + using ta(1) pgwt_ground[of ta] pgwt_is_empty_synth[of ta] subst_ground_ident[of ta \a] + unfolding Q_def f_def intruder_synth_code[symmetric] by simp + next + assume "R ta \ R tb" + then obtain ua \a where ua: "ta = ua \ \a" "ua \ C" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \a" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \a)" + using \ ABC ta_tb_wf(1,2) ta(2) tb(2) C is_wt_instance_of_condD' + unfolding P_def R_def by metis + + have "t = ua \ (\a \\<^sub>s \a)" "fv t = {}" + using ua(1) ta(1,5) tb(1,5) by auto + thus ?thesis + using ua(2) wt_subst_compose[OF ua(3) ta(3)] wf_trms_subst_compose[OF ua(4) ta(4)] + unfolding f_def by blast + qed +qed + +lemma ground_SMP_disjointI: + fixes A B::"('fun, ('fun, 'atom) term \ nat) term list" and C + defines "f \ \M. {t \ \ | t \. t \ M \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}}" + and "g \ \M. {t \ M. fv t = {}}" + and "Q \ \t. intruder_synth' public arity {} t" + and "R \ \t. \u \ C. is_wt_instance_of_cond \ t u" + assumes AB_fv_disj: "fv\<^sub>s\<^sub>e\<^sub>t (set A) \ fv\<^sub>s\<^sub>e\<^sub>t (set B) = {}" + and A_SMP_repr: "finite_SMP_representation arity Ana \ A" + and B_SMP_repr: "finite_SMP_representation arity Ana \ B" + and C_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s C" + and ABC: "\t \ set A. \s \ set B. \ t = \ s \ mgu t s \ None \ (Q t \ Q s) \ (R t \ R s)" + shows "g (SMP (set A)) \ g (SMP (set B)) \ f C \ {m. {} \\<^sub>c m}" +proof - + have AB_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set A)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (set B)" + using A_SMP_repr B_SMP_repr + unfolding finite_SMP_representation_def wf\<^sub>t\<^sub>r\<^sub>m_code list_all_iff + by blast+ + + let ?P = "\t s. \\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ Unifier \ t s" + have ABC': "\t \ set A. \s \ set B. ?P t s \ (Q t \ Q s) \ (R t \ R s)" + by (metis (no_types) ABC mgu_None_is_subst_neq wt_subst_trm'') + + show ?thesis + using ground_SMP_disjointI_aux1[OF f_def g_def, of "set A"] + ground_SMP_disjointI_aux1[OF f_def g_def, of "set B"] + ground_SMP_disjointI_aux2[OF f_def A_SMP_repr] + ground_SMP_disjointI_aux2[OF f_def B_SMP_repr] + ground_SMP_disjointI_aux3[OF f_def Q_def R_def AB_wf AB_fv_disj C_wf ABC'] + by argo +qed + +end + +end + +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Typing_Result.thy b/thys/Stateful_Protocol_Composition_and_Typing/Typing_Result.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/Typing_Result.thy @@ -0,0 +1,3463 @@ +(* +(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: Typing_Result.thy + Author: Andreas Viktor Hess, DTU +*) + +section \The Typing Result\ + +theory Typing_Result +imports Typed_Model +begin + +subsection \The Typing Result for the Composition-Only Intruder\ +context typed_model +begin + +subsubsection \Well-typedness and Type-Flaw Resistance Preservation\ +context +begin + +private lemma LI_preserves_tfr_stp_all_single: + assumes "(S,\) \ (S',\')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" + shows "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" +using assms +proof (induction rule: LI_rel.induct) + case (Compose S X f S' \) + hence "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" by simp_all + moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (map Send X)" by (induct X) auto + ultimately show ?case by simp +next + case (Unify S f Y \ X S' \) + hence "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')" by simp + + have "fv\<^sub>s\<^sub>t (S@Send (Fun f X)#S') \ bvars\<^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) + moreover have "fv (Fun f X) \ fv\<^sub>s\<^sub>t (S@Send (Fun f X)#S')" by auto + moreover have "fv (Fun f Y) \ fv\<^sub>s\<^sub>t (S@Send (Fun f X)#S')" + using Unify.hyps(2) fv_subset_if_in_strand_ik'[of "Fun f Y" S] by force + ultimately have bvars_disj: + "bvars\<^sub>s\<^sub>t (S@S') \ fv (Fun f X) = {}" "bvars\<^sub>s\<^sub>t (S@S') \ fv (Fun f Y) = {}" + by blast+ + + have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" using Unify.prems(5) by simp + moreover have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)" + proof - + obtain x where "x \ set S" "Fun f Y \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p x)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p x)" + using Unify.hyps(2) Unify.prems(5) by force+ + thus ?thesis using wf_trm_subterm by auto + qed + moreover have + "Fun f X \ SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" "Fun f Y \ SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" + using SMP_append[of S "Send (Fun f X)#S'"] SMP_Cons[of "Send (Fun f X)" S'] + SMP_ikI[OF Unify.hyps(2)] + by auto + hence "\ (Fun f X) = \ (Fun f Y)" + using Unify.prems(4) mgu_gives_MGU[OF Unify.hyps(3)[symmetric]] + unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast + ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" using mgu_wt_if_same_type[OF Unify.hyps(3)[symmetric]] by metis + moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using mgu_wf_trm[OF Unify.hyps(3)[symmetric] \wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\ \wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)\] + by (metis wf_trm_subst_range_iff) + moreover have "bvars\<^sub>s\<^sub>t (S@S') \ range_vars \ = {}" + using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] bvars_disj by fast + ultimately show ?case using tfr_stp_all_wt_subst_apply[OF \list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')\] by metis +next + case (Equality S \ t t' a S' \) + have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')" "\ t = \ t'" + using tfr_stp_all_same_type[of S a t t' S'] + tfr_stp_all_split(5)[of S _ S'] + MGU_is_Unifier[OF mgu_gives_MGU[OF Equality.hyps(2)[symmetric]]] + Equality.prems(3) + by blast+ + moreover have "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" using Equality.prems(5) by auto + ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + using mgu_wt_if_same_type[OF Equality.hyps(2)[symmetric]] + by metis + moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using mgu_wf_trm[OF Equality.hyps(2)[symmetric] \wf\<^sub>t\<^sub>r\<^sub>m t\ \wf\<^sub>t\<^sub>r\<^sub>m t'\] + by (metis wf_trm_subst_range_iff) + moreover have "fv\<^sub>s\<^sub>t (S@Equality a t t'#S') \ bvars\<^sub>s\<^sub>t (S@Equality a t t'#S') = {}" + using Equality.prems(1) by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def) + hence "bvars\<^sub>s\<^sub>t (S@S') \ fv t = {}" "bvars\<^sub>s\<^sub>t (S@S') \ fv t' = {}" by auto + hence "bvars\<^sub>s\<^sub>t (S@S') \ range_vars \ = {}" + using mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] by fast + ultimately show ?case using tfr_stp_all_wt_subst_apply[OF \list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')\] by metis +qed + +private lemma LI_in_SMP_subset_single: + assumes "(S,\) \ (S',\')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + and "trms\<^sub>s\<^sub>t S \ SMP M" + shows "trms\<^sub>s\<^sub>t S' \ SMP M" +using assms +proof (induction rule: LI_rel.induct) + case (Compose S X f S' \) + hence "SMP (trms\<^sub>s\<^sub>t [Send (Fun f X)]) \ SMP M" + proof - + have "SMP (trms\<^sub>s\<^sub>t [Send (Fun f X)]) \ SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" + using trms\<^sub>s\<^sub>t_append SMP_mono by auto + thus ?thesis + using SMP_union[of "trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S')" M] + SMP_subset_union_eq[OF Compose.prems(6)] + by auto + qed + thus ?case using Compose.prems(6) by auto +next + case (Unify S f Y \ X S' \) + have "Fun f X \ SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" by auto + moreover have "MGU \ (Fun f X) (Fun f Y)" + by (metis mgu_gives_MGU[OF Unify.hyps(3)[symmetric]]) + moreover have + "\x. x \ set S \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p x)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" + using Unify.prems(4) by force+ + moreover have "Fun f Y \ SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" + by (meson SMP_ikI Unify.hyps(2) contra_subsetD ik_append_subset(1)) + ultimately have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)" "\ (Fun f X) = \ (Fun f Y)" + using ik\<^sub>s\<^sub>t_subterm_exD[OF \Fun f Y \ ik\<^sub>s\<^sub>t S\] \tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))\ + unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (metis (full_types) SMP_wf_trm Unify.prems(4), blast) + hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" by (metis mgu_wt_if_same_type[OF Unify.hyps(3)[symmetric] \wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\]) + moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using mgu_wf_trm[OF Unify.hyps(3)[symmetric] \wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\ \wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)\] by simp + ultimately have "trms\<^sub>s\<^sub>t ((S@Send (Fun f X)#S') \\<^sub>s\<^sub>t \) \ SMP M" + using SMP.Substitution Unify.prems(6) wt_subst_SMP_subset by metis + thus ?case by auto +next + case (Equality S \ t t' a S' \) + hence "\ t = \ t'" + using tfr_stp_all_same_type MGU_is_Unifier[OF mgu_gives_MGU[OF Equality.hyps(2)[symmetric]]] + by metis + moreover have "t \ SMP (trms\<^sub>s\<^sub>t (S@Equality a t t'#S'))" "t' \ SMP (trms\<^sub>s\<^sub>t (S@Equality a t t'#S'))" + using Equality.prems(1) by auto + moreover have "MGU \ t t'" using mgu_gives_MGU[OF Equality.hyps(2)[symmetric]] by metis + moreover have "\x. x \ set S \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p x)" "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" + using Equality.prems(4) by force+ + ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" by (metis mgu_wt_if_same_type[OF Equality.hyps(2)[symmetric] \wf\<^sub>t\<^sub>r\<^sub>m t\]) + moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using mgu_wf_trm[OF Equality.hyps(2)[symmetric] \wf\<^sub>t\<^sub>r\<^sub>m t\ \wf\<^sub>t\<^sub>r\<^sub>m t'\] by simp + ultimately have "trms\<^sub>s\<^sub>t ((S@Equality a t t'#S') \\<^sub>s\<^sub>t \) \ SMP M" + using SMP.Substitution Equality.prems wt_subst_SMP_subset by metis + thus ?case by auto +qed + +private lemma LI_preserves_tfr_single: + assumes "(S,\) \ (S',\')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" + "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + shows "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S') \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')" +using assms +proof (induction rule: LI_rel.induct) + case (Compose S X f S' \) + let ?SMPmap = "SMP (trms\<^sub>s\<^sub>t (S@map Send X@S')) - (Var`\)" + have "?SMPmap \ SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S')) - (Var`\)" + using SMP_fun_map_snd_subset[of X f] + SMP_append[of "map Send X" S'] SMP_Cons[of "Send (Fun f X)" S'] + SMP_append[of S "Send (Fun f X)#S'"] SMP_append[of S "map Send X@S'"] + by auto + hence "\s \ ?SMPmap. \t \ ?SMPmap. (\\. Unifier \ s t) \ \ s = \ t" + using Compose unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (meson subsetCE) + thus ?case + using LI_preserves_trm_wf[OF r_into_rtrancl[OF LI_rel.Compose[OF Compose.hyps]], of S'] + Compose.prems(5) + unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast +next + case (Unify S f Y \ X S' \) + let ?SMP\ = "SMP (trms\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \)) - (Var`\)" + + have "SMP (trms\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \)) \ SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" + proof + fix s assume "s \ SMP (trms\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \))" thus "s \ SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" + using LI_in_SMP_subset_single[ + OF LI_rel.Unify[OF Unify.hyps] Unify.prems(1,2,4,5,6) + MP_subset_SMP(2)[of "S@Send (Fun f X)#S'"]] + by (metis SMP_union SMP_subset_union_eq Un_iff) + qed + hence "\s \ ?SMP\. \t \ ?SMP\. (\\. Unifier \ s t) \ \ s = \ t" + using Unify.prems(4) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (meson Diff_iff subsetCE) + thus ?case + using LI_preserves_trm_wf[OF r_into_rtrancl[OF LI_rel.Unify[OF Unify.hyps]], of S'] + Unify.prems(5) + unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast +next + case (Equality S \ t t' a S' \) + let ?SMP\ = "SMP (trms\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \)) - (Var`\)" + + have "SMP (trms\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \)) \ SMP (trms\<^sub>s\<^sub>t (S@Equality a t t'#S'))" + proof + fix s assume "s \ SMP (trms\<^sub>s\<^sub>t (S@S' \\<^sub>s\<^sub>t \))" thus "s \ SMP (trms\<^sub>s\<^sub>t (S@Equality a t t'#S'))" + using LI_in_SMP_subset_single[ + OF LI_rel.Equality[OF Equality.hyps] Equality.prems(1,2,4,5,6) + MP_subset_SMP(2)[of "S@Equality a t t'#S'"]] + by (metis SMP_union SMP_subset_union_eq Un_iff) + qed + hence "\s \ ?SMP\. \t \ ?SMP\. (\\. Unifier \ s t) \ \ s = \ t" + using Equality.prems unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (meson Diff_iff subsetCE) + thus ?case + using LI_preserves_trm_wf[OF r_into_rtrancl[OF LI_rel.Equality[OF Equality.hyps]], of _ S'] + Equality.prems + unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast +qed + +private lemma LI_preserves_welltypedness_single: + assumes "(S,\) \ (S',\')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + and "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \' \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \')" +using assms +proof (induction rule: LI_rel.induct) + case (Unify S f Y \ X S' \) + have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" using Unify.prems(5) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by simp + moreover have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)" + proof - + obtain x where "x \ set S" "Fun f Y \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p x)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p x)" + using Unify.hyps(2) Unify.prems(5) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by force + thus ?thesis using wf_trm_subterm by auto + qed + moreover have + "Fun f X \ SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" "Fun f Y \ SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" + using SMP_append[of S "Send (Fun f X)#S'"] SMP_Cons[of "Send (Fun f X)" S'] + SMP_ikI[OF Unify.hyps(2)] + by auto + hence "\ (Fun f X) = \ (Fun f Y)" + using Unify.prems(4) mgu_gives_MGU[OF Unify.hyps(3)[symmetric]] + unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast + ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" using mgu_wt_if_same_type[OF Unify.hyps(3)[symmetric]] by metis + + have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + by (meson mgu_wf_trm[OF Unify.hyps(3)[symmetric] \wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\ \wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)\] + wf_trm_subst_range_iff) + hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + using wf_trm_subst_range_iff wf_trm_subst \wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)\ + unfolding subst_compose_def + by (metis (no_types, lifting)) + thus ?case by (metis wt_subst_compose[OF \wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\ \wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\]) +next + case (Equality S \ t t' a S' \) + have "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" using Equality.prems(5) by simp_all + moreover have "\ t = \ t'" + using \list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@Equality a t t'#S')\ + MGU_is_Unifier[OF mgu_gives_MGU[OF Equality.hyps(2)[symmetric]]] + by auto + ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" using mgu_wt_if_same_type[OF Equality.hyps(2)[symmetric]] by metis + + have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + by (meson mgu_wf_trm[OF Equality.hyps(2)[symmetric] \wf\<^sub>t\<^sub>r\<^sub>m t\ \wf\<^sub>t\<^sub>r\<^sub>m t'\] wf_trm_subst_range_iff) + hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \))" + using wf_trm_subst_range_iff wf_trm_subst \wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)\ + unfolding subst_compose_def + by (metis (no_types, lifting)) + thus ?case by (metis wt_subst_compose[OF \wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\ \wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\]) +qed metis + +lemma LI_preserves_welltypedness: + assumes "(S,\) \\<^sup>* (S',\')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + and "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \'" (is "?A \'") + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \')" (is "?B \'") +proof - + have "?A \' \ ?B \'" using assms + proof (induction S \ rule: converse_rtrancl_induct2) + case (step S1 \1 S2 \2) + hence "?A \2 \ ?B \2" using LI_preserves_welltypedness_single by presburger + moreover have "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S2 \2" + by (fact LI_preserves_wellformedness[OF r_into_rtrancl[OF step.hyps(1)] step.prems(1)]) + moreover have "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S2)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S2)" + using LI_preserves_tfr_single[OF step.hyps(1)] step.prems by presburger+ + moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S2" + using LI_preserves_tfr_stp_all_single[OF step.hyps(1)] step.prems by fastforce + ultimately show ?case using step.IH by presburger + qed simp + thus "?A \'" "?B \'" by simp_all +qed + +lemma LI_preserves_tfr: + assumes "(S,\) \\<^sup>* (S',\')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + and "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + shows "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S')" (is "?A S'") + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')" (is "?B S'") + and "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" (is "?C S'") +proof - + have "?A S' \ ?B S' \ ?C S'" using assms + proof (induction S \ rule: converse_rtrancl_induct2) + case (step S1 \1 S2 \2) + have "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S2 \2" "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S2)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S2)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S2" + using LI_preserves_wellformedness[OF r_into_rtrancl[OF step.hyps(1)] step.prems(1)] + LI_preserves_tfr_single[OF step.hyps(1) step.prems(1,2)] + LI_preserves_tfr_stp_all_single[OF step.hyps(1) step.prems(1,2)] + step.prems(3,4,5,6) + by metis+ + moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \2" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \2)" + using LI_preserves_welltypedness[OF r_into_rtrancl[OF step.hyps(1)] step.prems] + by simp_all + ultimately show ?case using step.IH by presburger + qed blast + thus "?A S'" "?B S'" "?C S'" by simp_all +qed +end + +subsubsection \Simple Constraints are Well-typed Satisfiable\ +text \Proving the existence of a well-typed interpretation\ +context +begin +lemma wt_interpretation_exists: + obtains \::"('fun,'var) subst" + where "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "subst_range \ \ public_ground_wf_terms" +proof + define \ where "\ = (\x. (SOME t. \ (Var x) = \ t \ public_ground_wf_term t))" + + { fix x t assume "\ x = t" + hence "\ (Var x) = \ t \ public_ground_wf_term t" + using someI_ex[of "\t. \ (Var x) = \ t \ public_ground_wf_term t", + OF type_pgwt_inhabited[of "Var x"]] + unfolding \_def wf\<^sub>t\<^sub>r\<^sub>m_def by simp + } hence props: "\ v = t \ \ (Var v) = \ t \ public_ground_wf_term t" for v t by metis + + have "\ v \ Var v" for v using props pgwt_ground by force + hence "subst_domain \ = UNIV" by auto + moreover have "ground (subst_range \)" by (simp add: props pgwt_ground) + ultimately show "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" by metis + show "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def using props by simp + show "subst_range \ \ public_ground_wf_terms" by (auto simp add: props) +qed + +lemma wt_grounding_subst_exists: + "\\. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}" +proof - + obtain \ where \: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "subst_range \ \ public_ground_wf_terms" + using wt_interpretation_exists by blast + show ?thesis using pgwt_wellformed interpretation_grounds[OF \(1)] \(2,3) by blast +qed + +private fun fresh_pgwt::"'fun set \ ('fun,'atom) term_type \ ('fun,'var) term" where + "fresh_pgwt S (TAtom a) = + Fun (SOME c. c \ S \ \ (Fun c []) = TAtom a \ public c) []" +| "fresh_pgwt S (TComp f T) = Fun f (map (fresh_pgwt S) T)" + +private lemma fresh_pgwt_same_type: + assumes "finite S" "wf\<^sub>t\<^sub>r\<^sub>m t" + shows "\ (fresh_pgwt S (\ t)) = \ t" +proof - + let ?P = "\\::('fun,'atom) term_type. wf\<^sub>t\<^sub>r\<^sub>m \ \ (\f T. TComp f T \ \ \ 0 < arity f)" + { fix \ assume "?P \" hence "\ (fresh_pgwt S \) = \" + proof (induction \) + case (Var a) + let ?P = "\c. c \ S \ \ (Fun c []) = Var a \ public c" + let ?Q = "\c. \ (Fun c []) = Var a \ public c" + have " {c. ?Q c} - S = {c. ?P c}" by auto + hence "infinite {c. ?P c}" + using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]] + by metis + hence "\c. ?P c" using not_finite_existsD by blast + thus ?case using someI_ex[of ?P] by auto + next + case (Fun f T) + have f: "0 < arity f" using Fun.prems fun_type_inv by auto + have "\t. t \ set T \ ?P t" + using Fun.prems wf_trm_subtermeq term.le_less_trans Fun_param_is_subterm + by metis + hence "\t. t \ set T \ \ (fresh_pgwt S t) = t" using Fun.prems Fun.IH by auto + hence "map \ (map (fresh_pgwt S) T) = T" by (induct T) auto + thus ?case using fun_type[OF f] by simp + qed + } thus ?thesis using assms(1) \_wf'[OF assms(2)] \_wf(1) by auto +qed + +private lemma fresh_pgwt_empty_synth: + assumes "finite S" "wf\<^sub>t\<^sub>r\<^sub>m t" + shows "{} \\<^sub>c fresh_pgwt S (\ t)" +proof - + let ?P = "\\::('fun,'atom) term_type. wf\<^sub>t\<^sub>r\<^sub>m \ \ (\f T. TComp f T \ \ \ 0 < arity f)" + { fix \ assume "?P \" hence "{} \\<^sub>c fresh_pgwt S \" + proof (induction \) + case (Var a) + let ?P = "\c. c \ S \ \ (Fun c []) = Var a \ public c" + let ?Q = "\c. \ (Fun c []) = Var a \ public c" + have " {c. ?Q c} - S = {c. ?P c}" by auto + hence "infinite {c. ?P c}" + using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]] + by metis + hence "\c. ?P c" using not_finite_existsD by blast + thus ?case + using someI_ex[of ?P] intruder_synth.ComposeC[of "[]" _ "{}"] const_type_inv + by auto + next + case (Fun f T) + have f: "0 < arity f" "length T = arity f" "public f" + using Fun.prems fun_type_inv unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto + have "\t. t \ set T \ ?P t" + using Fun.prems wf_trm_subtermeq term.le_less_trans Fun_param_is_subterm + by metis + hence "\t. t \ set T \ {} \\<^sub>c fresh_pgwt S t" using Fun.prems Fun.IH by auto + moreover have "length (map (fresh_pgwt S) T) = arity f" using f(2) by auto + ultimately show ?case using intruder_synth.ComposeC[of "map (fresh_pgwt S) T" f] f by auto + qed + } thus ?thesis using assms(1) \_wf'[OF assms(2)] \_wf(1) by auto +qed + +private lemma fresh_pgwt_has_fresh_const: + assumes "finite S" "wf\<^sub>t\<^sub>r\<^sub>m t" + obtains c where "Fun c [] \ fresh_pgwt S (\ t)" "c \ S" +proof - + let ?P = "\\::('fun,'atom) term_type. wf\<^sub>t\<^sub>r\<^sub>m \ \ (\f T. TComp f T \ \ \ 0 < arity f)" + { fix \ assume "?P \" hence "\c. Fun c [] \ fresh_pgwt S \ \ c \ S" + proof (induction \) + case (Var a) + let ?P = "\c. c \ S \ \ (Fun c []) = Var a \ public c" + let ?Q = "\c. \ (Fun c []) = Var a \ public c" + have " {c. ?Q c} - S = {c. ?P c}" by auto + hence "infinite {c. ?P c}" + using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]] + by metis + hence "\c. ?P c" using not_finite_existsD by blast + thus ?case using someI_ex[of ?P] by auto + next + case (Fun f T) + have f: "0 < arity f" "length T = arity f" "public f" "T \ []" + using Fun.prems fun_type_inv unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto + obtain t' where t': "t' \ set T" by (meson all_not_in_conv f(4) set_empty) + have "\t. t \ set T \ ?P t" + using Fun.prems wf_trm_subtermeq term.le_less_trans Fun_param_is_subterm + by metis + hence "\t. t \ set T \ \c. Fun c [] \ fresh_pgwt S t \ c \ S" + using Fun.prems Fun.IH by auto + then obtain c where c: "Fun c [] \ fresh_pgwt S t'" "c \ S" using t' by metis + thus ?case using t' by auto + qed + } thus ?thesis using that assms \_wf'[OF assms(2)] \_wf(1) by blast +qed + +private lemma fresh_pgwt_subterm_fresh: + assumes "finite S" "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m s" "funs_term s \ S" + shows "s \ subterms (fresh_pgwt S (\ t))" +proof - + let ?P = "\\::('fun,'atom) term_type. wf\<^sub>t\<^sub>r\<^sub>m \ \ (\f T. TComp f T \ \ \ 0 < arity f)" + { fix \ assume "?P \" hence "s \ subterms (fresh_pgwt S \)" + proof (induction \) + case (Var a) + let ?P = "\c. c \ S \ \ (Fun c []) = Var a \ public c" + let ?Q = "\c. \ (Fun c []) = Var a \ public c" + have " {c. ?Q c} - S = {c. ?P c}" by auto + hence "infinite {c. ?P c}" + using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]] + by metis + hence "\c. ?P c" using not_finite_existsD by blast + thus ?case using someI_ex[of ?P] assms(4) by auto + next + case (Fun f T) + have f: "0 < arity f" "length T = arity f" "public f" + using Fun.prems fun_type_inv unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto + have "\t. t \ set T \ ?P t" + using Fun.prems wf_trm_subtermeq term.le_less_trans Fun_param_is_subterm + by metis + hence "\t. t \ set T \ s \ subterms (fresh_pgwt S t)" using Fun.prems Fun.IH by auto + moreover have "s \ fresh_pgwt S (Fun f T)" + proof - + obtain c where c: "Fun c [] \ fresh_pgwt S (Fun f T)" "c \ S" + using fresh_pgwt_has_fresh_const[OF assms(1)] type_wfttype_inhabited Fun.prems + by metis + hence "\Fun c [] \ s" using assms(4) subtermeq_imp_funs_term_subset by force + thus ?thesis using c(1) by auto + qed + ultimately show ?case by auto + qed + } thus ?thesis using assms(1) \_wf'[OF assms(2)] \_wf(1) by auto +qed + +private lemma wt_fresh_pgwt_term_exists: + assumes "finite T" "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s T" + obtains t where "\ t = \ s" "{} \\<^sub>c t" "\s \ T. \u \ subterms s. u \ subterms t" +proof - + have finite_S: "finite (\(funs_term ` T))" using assms(1) by auto + + have 1: "\ (fresh_pgwt (\(funs_term ` T)) (\ s)) = \ s" + using fresh_pgwt_same_type[OF finite_S assms(2)] by auto + + have 2: "{} \\<^sub>c fresh_pgwt (\(funs_term ` T)) (\ s)" + using fresh_pgwt_empty_synth[OF finite_S assms(2)] by auto + + have 3: "\v \ T. \u \ subterms v. u \ subterms (fresh_pgwt (\(funs_term ` T)) (\ s))" + using fresh_pgwt_subterm_fresh[OF finite_S assms(2)] assms(3) + wf_trm_subtermeq subtermeq_imp_funs_term_subset + by force + + show ?thesis by (rule that[OF 1 2 3]) +qed + +lemma wt_bij_finite_subst_exists: + assumes "finite (S::'var set)" "finite (T::('fun,'var) terms)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s T" + shows "\\::('fun,'var) subst. + subst_domain \ = S + \ bij_betw \ (subst_domain \) (subst_range \) + \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) \ {t. {} \\<^sub>c t} - T + \ (\s \ subst_range \. \u \ subst_range \. (\v. v \ s \ v \ u) \ s = u) + \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ + \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +using assms +proof (induction rule: finite_induct) + case empty + have "subst_domain Var = {}" + "bij_betw Var (subst_domain Var) (subst_range Var)" + "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range Var) \ {t. {} \\<^sub>c t} - T" + "\s \ subst_range Var. \u \ subst_range Var. (\v. v \ s \ v \ u) \ s = u" + "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" + unfolding bij_betw_def + by auto + thus ?case by (force simp add: subst_domain_def) +next + case (insert x S) + then obtain \ where \: + "subst_domain \ = S" "bij_betw \ (subst_domain \) (subst_range \)" + "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) \ {t. {} \\<^sub>c t} - T" + "\s \ subst_range \. \u \ subst_range \. (\v. v \ s \ v \ u) \ s = u" + "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + by (auto simp del: subst_range.simps) + + have *: "finite (T \ subst_range \)" + using insert.prems(1) insert.hyps(1) \(1) by simp + have **: "wf\<^sub>t\<^sub>r\<^sub>m (Var x)" by simp + have ***: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (T \ subst_range \)" using assms(3) \(6) by blast + obtain t where t: + "\ t = \ (Var x)" "{} \\<^sub>c t" + "\s \ T \ subst_range \. \u \ subterms s. u \ subterms t" + using wt_fresh_pgwt_term_exists[OF * ** ***] by auto + + obtain \ where \: "\ \ \y. if x = y then t else \ y" by simp + + have t_ground: "fv t = {}" using t(2) pgwt_ground[of t] pgwt_is_empty_synth[of t] by auto + hence x_dom: "x \ subst_domain \" "x \ subst_domain \" using insert.hyps(2) \(1) \ by auto + moreover have "subst_range \ \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \)" by auto + hence ground_imgs: "ground (subst_range \)" + using \(3) pgwt_ground pgwt_is_empty_synth + by force + ultimately have x_img: "\ x \ subst_range \" + using ground_subst_dom_iff_img + by (auto simp add: subst_domain_def) + + have "ground (insert t (subst_range \))" + using ground_imgs x_dom t_ground + by auto + have \_dom: "subst_domain \ = insert x (subst_domain \)" + using \ t_ground by (auto simp add: subst_domain_def) + have \_img: "subst_range \ = insert t (subst_range \)" + proof + show "subst_range \ \ insert t (subst_range \)" + proof + fix t' assume "t' \ subst_range \" + then obtain y where "y \ subst_domain \" "t' = \ y" by auto + thus "t' \ insert t (subst_range \)" using \ by (auto simp add: subst_domain_def) + qed + show "insert t (subst_range \) \ subst_range \" + proof + fix t' assume t': "t' \ insert t (subst_range \)" + hence "fv t' = {}" using ground_imgs x_img t_ground by auto + hence "t' \ Var x" by auto + show "t' \ subst_range \" + proof (cases "t' = t") + case False + hence "t' \ subst_range \" using t' by auto + then obtain y where "\ y \ subst_range \" "t' = \ y" by auto + hence "y \ subst_domain \" "t' \ Var y" + using ground_subst_dom_iff_img[OF ground_imgs(1)] + by (auto simp add: subst_domain_def simp del: subst_range.simps) + hence "x \ y" using x_dom by auto + hence "\ y = \ y" unfolding \ by auto + thus ?thesis using \t' \ Var y\ \t' = \ y\ subst_imgI[of \ y] by auto + qed (metis subst_imgI \ \t' \ Var x\) + qed + qed + hence \_ground_img: "ground (subst_range \)" + using ground_imgs t_ground + by auto + + have "subst_domain \ = insert x S" using \_dom \(1) by auto + moreover have "bij_betw \ (subst_domain \) (subst_range \)" + proof (intro bij_betwI') + fix y z assume *: "y \ subst_domain \" "z \ subst_domain \" + hence "fv (\ y) = {}" "fv (\ z) = {}" using \_ground_img by auto + { assume "\ y = \ z" hence "y = z" + proof (cases "\ y \ subst_range \ \ \ z \ subst_range \") + case True + hence **: "y \ subst_domain \" "z \ subst_domain \" + using \ \_dom True * t(3) by (metis Un_iff term.order_refl insertE)+ + hence "y \ x" "z \ x" using x_dom by auto + hence "\ y = \ y" "\ z = \ z" using \ by auto + thus ?thesis using \\ y = \ z\ \(2) ** unfolding bij_betw_def inj_on_def by auto + qed (metis \ * \\ y = \ z\ \_dom ground_imgs(1) ground_subst_dom_iff_img insertE) + } + thus "(\ y = \ z) = (y = z)" by auto + next + fix y assume "y \ subst_domain \" thus "\ y \ subst_range \" by auto + next + fix t assume "t \ subst_range \" thus "\z \ subst_domain \. t = \ z" by auto + qed + moreover have "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) \ {t. {} \\<^sub>c t} - T" + proof - + { fix s assume "s \ t" + hence "s \ {t. {} \\<^sub>c t} - T" + using t(2,3) + by (metis Diff_eq_empty_iff Diff_iff Un_upper1 term.order_refl + deduct_synth_subterm mem_Collect_eq) + } thus ?thesis using \(3) \ \_img by auto + qed + moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" using \ t(1) \(5) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by auto + moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using \ \(6) t(2) pgwt_is_empty_synth pgwt_wellformed + wf_trm_subst_range_iff[of \] wf_trm_subst_range_iff[of \] + by metis + moreover have "\s\subst_range \. \u\subst_range \. (\v. v \ s \ v \ u) \ s = u" + using \(4) \_img t(3) by (auto simp del: subst_range.simps) + ultimately show ?case by blast +qed + +private lemma wt_bij_finite_tatom_subst_exists_single: + assumes "finite (S::'var set)" "finite (T::('fun,'var) terms)" + and "\x. x \ S \ \ (Var x) = TAtom a" + shows "\\::('fun,'var) subst. subst_domain \ = S + \ bij_betw \ (subst_domain \) (subst_range \) + \ subst_range \ \ ((\c. Fun c []) ` {c. \ (Fun c []) = TAtom a \ + public c \ arity c = 0}) - T + \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ + \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +proof - + let ?U = "{c. \ (Fun c []) = TAtom a \ public c \ arity c = 0}" + + obtain \ where \: + "subst_domain \ = S" "bij_betw \ (subst_domain \) (subst_range \)" + "subst_range \ \ ((\c. Fun c []) ` ?U) - T" + using bij_finite_const_subst_exists'[OF assms(1,2) infinite_typed_consts'[of a]] + by auto + + { fix x assume "x \ subst_domain \" hence "\ (Var x) = \ (\ x)" by auto } + moreover + { fix x assume "x \ subst_domain \" + hence "\c \ ?U. \ x = Fun c [] \ arity c = 0" using \ by auto + hence "\ (\ x) = TAtom a" "wf\<^sub>t\<^sub>r\<^sub>m (\ x)" using assms(3) const_type wf_trmI[of "[]"] by auto + hence "\ (Var x) = \ (\ x)" "wf\<^sub>t\<^sub>r\<^sub>m (\ x)" using assms(3) \(1) by force+ + } + ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using wf_trm_subst_range_iff[of \] + unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def + by force+ + thus ?thesis using \ by auto +qed + +lemma wt_bij_finite_tatom_subst_exists: + assumes "finite (S::'var set)" "finite (T::('fun,'var) terms)" + and "\x. x \ S \ \a. \ (Var x) = TAtom a" + shows "\\::('fun,'var) subst. subst_domain \ = S + \ bij_betw \ (subst_domain \) (subst_range \) + \ subst_range \ \ ((\c. Fun c []) ` \\<^sub>p\<^sub>u\<^sub>b) - T + \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ + \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +using assms +proof (induction rule: finite_induct) + case empty + have "subst_domain Var = {}" + "bij_betw Var (subst_domain Var) (subst_range Var)" + "subst_range Var \ ((\c. Fun c []) ` \\<^sub>p\<^sub>u\<^sub>b) - T" + "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" + unfolding bij_betw_def + by auto + thus ?case by (auto simp add: subst_domain_def) +next + case (insert x S) + then obtain a where a: "\ (Var x) = TAtom a" by fastforce + + from insert obtain \ where \: + "subst_domain \ = S" "bij_betw \ (subst_domain \) (subst_range \)" + "subst_range \ \ ((\c. Fun c []) ` \\<^sub>p\<^sub>u\<^sub>b) - T" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + by auto + + let ?S' = "{y \ S. \ (Var y) = TAtom a}" + let ?T' = "T \ subst_range \" + + have *: "finite (insert x ?S')" using insert by simp + have **: "finite ?T'" using insert.prems(1) insert.hyps(1) \(1) by simp + have ***: "\y. y \ insert x ?S' \ \ (Var y) = TAtom a" using a by auto + + obtain \ where \: + "subst_domain \ = insert x ?S'" "bij_betw \ (subst_domain \) (subst_range \)" + "subst_range \ \ ((\c. Fun c []) ` \\<^sub>p\<^sub>u\<^sub>b) - ?T'" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using wt_bij_finite_tatom_subst_exists_single[OF * ** ***] const_type_inv[of _ "[]" a] + by blast + + obtain \ where \: "\ \ \y. if x = y then \ y else \ y" by simp + + have x_dom: "x \ subst_domain \" "x \ subst_domain \" "x \ subst_domain \" + using insert.hyps(2) \(1) \(1) \ by (auto simp add: subst_domain_def) + moreover have ground_imgs: "ground (subst_range \)" "ground (subst_range \)" + using pgwt_ground \(3) \(3) by auto + ultimately have x_img: "\ x \ subst_range \" "\ x \ subst_range \" + using ground_subst_dom_iff_img by (auto simp add: subst_domain_def) + + have "ground (insert (\ x) (subst_range \))" using ground_imgs x_dom by auto + have \_dom: "subst_domain \ = insert x (subst_domain \)" + using \(1) \ by (auto simp add: subst_domain_def) + have \_img: "subst_range \ = insert (\ x) (subst_range \)" + proof + show "subst_range \ \ insert (\ x) (subst_range \)" + proof + fix t assume "t \ subst_range \" + then obtain y where "y \ subst_domain \" "t = \ y" by auto + thus "t \ insert (\ x) (subst_range \)" using \ by (auto simp add: subst_domain_def) + qed + show "insert (\ x) (subst_range \) \ subst_range \" + proof + fix t assume t: "t \ insert (\ x) (subst_range \)" + hence "fv t = {}" using ground_imgs x_img(2) by auto + hence "t \ Var x" by auto + show "t \ subst_range \" + proof (cases "t = \ x") + case True thus ?thesis using subst_imgI \ \t \ Var x\ by metis + next + case False + hence "t \ subst_range \" using t by auto + then obtain y where "\ y \ subst_range \" "t = \ y" by auto + hence "y \ subst_domain \" "t \ Var y" + using ground_subst_dom_iff_img[OF ground_imgs(1)] + by (auto simp add: subst_domain_def simp del: subst_range.simps) + hence "x \ y" using x_dom by auto + hence "\ y = \ y" unfolding \ by auto + thus ?thesis using \t \ Var y\ \t = \ y\ subst_imgI[of \ y] by auto + qed + qed + qed + hence \_ground_img: "ground (subst_range \)" using ground_imgs x_img by auto + + have "subst_domain \ = insert x S" using \_dom \(1) by auto + moreover have "bij_betw \ (subst_domain \) (subst_range \)" + proof (intro bij_betwI') + fix y z assume *: "y \ subst_domain \" "z \ subst_domain \" + hence "fv (\ y) = {}" "fv (\ z) = {}" using \_ground_img by auto + { assume "\ y = \ z" hence "y = z" + proof (cases "\ y \ subst_range \ \ \ z \ subst_range \") + case True + hence **: "y \ subst_domain \" "z \ subst_domain \" + using \ \_dom x_img(2) \(3) True + by (metis (no_types) *(1) DiffE Un_upper2 insertE subsetCE, + metis (no_types) *(2) DiffE Un_upper2 insertE subsetCE) + hence "y \ x" "z \ x" using x_dom by auto + hence "\ y = \ y" "\ z = \ z" using \ by auto + thus ?thesis using \\ y = \ z\ \(2) ** unfolding bij_betw_def inj_on_def by auto + qed (metis \ * \\ y = \ z\ \_dom ground_imgs(1) ground_subst_dom_iff_img insertE) + } + thus "(\ y = \ z) = (y = z)" by auto + next + fix y assume "y \ subst_domain \" thus "\ y \ subst_range \" by auto + next + fix t assume "t \ subst_range \" thus "\z \ subst_domain \. t = \ z" by auto + qed + moreover have "subst_range \ \ (\c. Fun c []) ` \\<^sub>p\<^sub>u\<^sub>b - T" + using \(3) \(3) \ by (auto simp add: subst_domain_def) + moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" using \(4) \(4) \ unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by auto + moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using \ \(5) \(5) wf_trm_subst_range_iff[of \] + wf_trm_subst_range_iff[of \] wf_trm_subst_range_iff[of \] + by presburger + ultimately show ?case by blast +qed + +theorem wt_sat_if_simple: + assumes "simple S" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" + and \': "\X F. Inequality X F \ set S \ ineq_model \' X F" + "ground (subst_range \')" + "subst_domain \' = {x \ vars\<^sub>s\<^sub>t S. \X F. Inequality X F \ set S \ x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X}" + and tfr_stp_all: "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + shows "\\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ (\ \\<^sub>c \S, \\) \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" +proof - + from \wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \\ have "wf\<^sub>s\<^sub>t {} S" "subst_idem \" and S_\_disj: "\v \ vars\<^sub>s\<^sub>t S. \ v = Var v" + using subst_idemI[of \] 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 force+ + + obtain \::"('fun,'var) subst" + where \: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "subst_range \ \ public_ground_wf_terms" + using wt_interpretation_exists by blast + hence \_deduct: "\x M. M \\<^sub>c \ x" and \_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using pgwt_deducible pgwt_wellformed by fastforce+ + + let ?P = "\\ X. subst_domain \ = set X \ ground (subst_range \)" + let ?Sineqsvars = "{x \ vars\<^sub>s\<^sub>t S. \X F. Inequality X F \ set S \ x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ x \ set X}" + let ?Strms = "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" + + have finite_vars: "finite ?Sineqsvars" "finite ?Strms" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s ?Strms" + using wf_trm_subtermeq assms(5) by fastforce+ + + define Q1 where "Q1 = (\(F::(('fun,'var) term \ ('fun,'var) term) list) X. + \x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \a. \ (Var x) = TAtom a)" + + define Q2 where "Q2 = (\(F::(('fun,'var) term \ ('fun,'var) term) list) X. + \f T. Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ T = [] \ (\s \ set T. s \ Var ` set X))" + + define Q1' where "Q1' = (\(t::('fun,'var) term) (t'::('fun,'var) term) X. + \x \ (fv t \ fv t') - set X. \a. \ (Var x) = TAtom a)" + + define Q2' where "Q2' = (\(t::('fun,'var) term) (t'::('fun,'var) term) X. + \f T. Fun f T \ subterms t \ subterms t' \ T = [] \ (\s \ set T. s \ Var ` set X))" + + have ex_P: "\X. \\. ?P \ X" using interpretation_subst_exists' by blast + + have tfr_ineq: "\X F. Inequality X F \ set S \ Q1 F X \ Q2 F X" + using tfr_stp_all Q1_def Q2_def tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of S] by blast + + have S_fv_bvars_disj: "fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S = {}" using \wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \\ unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by metis + hence ineqs_vars_not_bound: "\X F x. Inequality X F \ set S \ x \ ?Sineqsvars \ x \ set X" + using strand_fv_bvars_disjoint_unfold by blast + + have \_vars_S_bvars_disj: "(subst_domain \ \ range_vars \) \ set X = {}" + when "Inequality X F \ set S" for F X + using wf_constr_bvars_disj[OF \wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \\] + strand_fv_bvars_disjointD(1)[OF S_fv_bvars_disj that] + by blast + + obtain \::"('fun,'var) subst" + where \_fv_dom: "subst_domain \ = ?Sineqsvars" + and \_subterm_inj: "subterm_inj_on \ (subst_domain \)" + and \_fresh_pub_img: "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) \ {t. {} \\<^sub>c t} - ?Strms" + and \_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and \_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + using wt_bij_finite_subst_exists[OF finite_vars] + subst_inj_on_is_bij_betw subterm_inj_on_alt_def' + by moura + + have \_bij_dom_img: "bij_betw \ (subst_domain \) (subst_range \)" + by (metis \_subterm_inj subst_inj_on_is_bij_betw subterm_inj_on_alt_def) + + have "finite (subst_domain \)" by(metis \_fv_dom finite_vars(1)) + hence \_finite_img: "finite (subst_range \)" using \_bij_dom_img bij_betw_finite by blast + + have \_img_subterms: "\s \ subst_range \. \u \ subst_range \. (\v. v \ s \ v \ u) \ s = u" + by (metis \_subterm_inj subterm_inj_on_alt_def') + + have "subst_range \ \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \)" by auto + hence "subst_range \ \ public_ground_wf_terms - ?Strms" + and \_pgwt_img: + "subst_range \ \ public_ground_wf_terms" + "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) \ public_ground_wf_terms" + using \_fresh_pub_img pgwt_is_empty_synth by blast+ + + have \_img_ground: "ground (subst_range \)" + using \_pgwt_img pgwt_ground by auto + hence \_inj: "inj \" + using \_bij_dom_img subst_inj_is_bij_betw_dom_img_if_ground_img by auto + + have \_ineqs_fv_dom: "\X F. Inequality X F \ set S \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \ subst_domain \" + using \_fv_dom by fastforce + + have \_dom_bvars_disj: "\X F. Inequality X F \ set S \ subst_domain \ \ set X = {}" + using ineqs_vars_not_bound \_fv_dom by fastforce + + have \'1: "\X F \. Inequality X F \ set S \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \ subst_domain \'" + using \'(3) ineqs_vars_not_bound by fastforce + + have \'2: "\X F. Inequality X F \ set S \ subst_domain \' \ set X = {}" + using \'(3) ineqs_vars_not_bound by blast + + have doms_eq: "subst_domain \' = subst_domain \" using \'(3) \_fv_dom by simp + + have \_ineqs_neq: "ineq_model \ X F" when "Inequality X F \ set S" for X F + proof - + obtain a::"'fun" where a: "a \ \(funs_term ` subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \))" + using exists_fun_notin_funs_terms[OF subterms_union_finite[OF \_finite_img]] + by moura + hence a': "\T. Fun a T \ subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \)" + "\S. Fun a [] \ set (Fun a []#S)" "Fun a [] \ Var ` set X" + by (meson a UN_I term.set_intros(1), auto) + + define t where "t \ Fun a (Fun a []#map fst F)" + define t' where "t' \ Fun a (Fun a []#map snd F)" + + note F_in = that + + have t_fv: "fv t \ fv t' \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" + unfolding t_def t'_def by force + + have t_subterms: "subterms t \ subterms t' \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ {t, t', Fun a []}" + unfolding t_def t'_def by force + + have "t \ \ \ \ \ t' \ \ \ \" when "?P \ X" for \ + proof - + have tfr_assms: "Q1 F X \ Q2 F X" using tfr_ineq F_in by metis + + have "Q1 F X \ \x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \c. \ x = Fun c []" + proof + fix x assume "Q1 F X" and x: "x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X" + then obtain a where "\ (Var x) = TAtom a" unfolding Q1_def by moura + hence a: "\ (\ x) = TAtom a" using \_wt unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp + + have "x \ subst_domain \" using \_ineqs_fv_dom x F_in by auto + then obtain f T where fT: "\ x = Fun f T" by (meson \_img_ground ground_img_obtain_fun) + hence "T = []" using \_wf_trm a TAtom_term_cases by fastforce + thus "\c. \ x = Fun c []" using fT by metis + qed + hence 1: "Q1 F X \ \x \ (fv t \ fv t') - set X. \c. \ x = Fun c []" + using t_fv by auto + + have 2: "\Q1 F X \ Q2 F X" by (metis tfr_assms) + + have 3: "subst_domain \ \ set X = {}" using \_dom_bvars_disj F_in by auto + + have 4: "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) \ (subterms t \ subterms t') = {}" + proof - + define M1 where "M1 \ {t, t', Fun a []}" + define M2 where "M2 \ ?Strms" + + have "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ M2" + using F_in unfolding M2_def by force + moreover have "subterms t \ subterms t' \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \ M1" + using t_subterms unfolding M1_def by blast + ultimately have *: "subterms t \ subterms t' \ M2 \ M1" + by auto + + have "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) \ M1 = {}" + "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \) \ M2 = {}" + using a' \_fresh_pub_img + unfolding t_def t'_def M1_def M2_def + by blast+ + thus ?thesis using * by blast + qed + + have 5: "(fv t \ fv t') - subst_domain \ \ set X" + using \_ineqs_fv_dom[OF F_in] t_fv + by auto + + have 6: "\\. ?P \ X \ t \ \ \ \' \ t' \ \ \ \'" + by (metis t_def t'_def \'(1) F_in ineq_model_singleE ineq_model_single_iff) + + have 7: "fv t \ fv t' - set X \ subst_domain \'" using \'1 F_in t_fv by force + + have 8: "subst_domain \' \ set X = {}" using \'2 F_in by auto + + have 9: "Q1' t t' X" when "Q1 F X" + using that t_fv + unfolding Q1_def Q1'_def t_def t'_def + by blast + + have 10: "Q2' t t' X" when "Q2 F X" unfolding Q2'_def + proof (intro allI impI) + fix f T assume "Fun f T \ subterms t \ subterms t'" + moreover { + assume "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F)" + hence "T = [] \ (\s\set T. s \ Var ` set X)" by (metis Q2_def that) + } moreover { + assume "Fun f T = t" hence "T = [] \ (\s\set T. s \ Var ` set X)" + unfolding t_def using a'(2,3) by simp + } moreover { + assume "Fun f T = t'" hence "T = [] \ (\s\set T. s \ Var ` set X)" + unfolding t'_def using a'(2,3) by simp + } moreover { + assume "Fun f T = Fun a []" hence "T = [] \ (\s\set T. s \ Var ` set X)" by simp + } ultimately show "T = [] \ (\s\set T. s \ Var ` set X)" using t_subterms by blast + qed + + note 11 = \_subterm_inj \_img_ground 3 4 5 + + note 12 = 6 7 8 \'(2) doms_eq + + show "t \ \ \ \ \ t' \ \ \ \" + using 1 2 9 10 that sat_ineq_subterm_inj_subst[OF 11 _ 12] + unfolding Q1'_def Q2'_def by metis + qed + thus ?thesis by (metis t_def t'_def ineq_model_singleI ineq_model_single_iff) + qed + + have \_ineqs_fv_dom': "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \ subst_domain \" + when "Inequality X F \ set S" and "?P \ X" for F \ X + using \_ineqs_fv_dom[OF that(1)] + proof (induction F) + case (Cons g G) + obtain t t' where g: "g = (t,t')" by (metis surj_pair) + hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (g#G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) = fv (t \ \) \ fv (t' \ \) \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \)" + "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (g#G) = fv t \ fv t' \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" + by (simp_all add: subst_apply_pairs_def) + moreover have "fv (t \ \) = fv t - subst_domain \" "fv (t' \ \) = fv t' - subst_domain \" + using g that(2) by (simp_all add: subst_fv_unfold_ground_img range_vars_alt_def) + moreover have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \ subst_domain \" using Cons by auto + ultimately show ?case using Cons.prems that(2) by auto + qed (simp add: subst_apply_pairs_def) + + have \_ineqs_ground: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ((F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) = {}" + when "Inequality X F \ set S" and "?P \ X" for F \ X + using \_ineqs_fv_dom'[OF that] + proof (induction F) + case (Cons g G) + obtain t t' where g: "g = (t,t')" by (metis surj_pair) + hence "fv (t \ \) \ subst_domain \" "fv (t' \ \) \ subst_domain \" + using Cons.prems by (auto simp add: subst_apply_pairs_def) + hence "fv (t \ \ \ \) = {}" "fv (t' \ \ \ \) = {}" + using subst_fv_dom_ground_if_ground_img[OF _ \_img_ground] by metis+ + thus ?case using g Cons by (auto simp add: subst_apply_pairs_def) + qed (simp add: subst_apply_pairs_def) + + from \_pgwt_img \_ineqs_neq have \_deduct: "M \\<^sub>c \ x" when "x \ subst_domain \" for x M + using that pgwt_deducible by fastforce + + { fix M::"('fun,'var) terms" + have "\M; S\\<^sub>c (\ \\<^sub>s \ \\<^sub>s \)" + using \wf\<^sub>s\<^sub>t {} S\ \simple S\ S_\_disj \_ineqs_neq \_ineqs_fv_dom' \_vars_S_bvars_disj + proof (induction S arbitrary: M rule: wf\<^sub>s\<^sub>t_simple_induct) + case (ConsSnd v S) + hence S_sat: "\M; S\\<^sub>c (\ \\<^sub>s \ \\<^sub>s \)" and "\ v = Var v" by auto + hence "\M. M \\<^sub>c Var v \ (\ \\<^sub>s \ \\<^sub>s \)" + using \_deduct \_deduct + by (metis ideduct_synth_subst_apply subst_apply_term.simps(1) + subst_subst_compose trm_subst_ident') + thus ?case using strand_sem_append(1)[OF S_sat] by (metis strand_sem_c.simps(1,2)) + next + case (ConsIneq X F S) + have dom_disj: "subst_domain \ \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = {}" + using ConsIneq.prems(1) subst_dom_vars_in_subst + by force + hence *: "F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \ = F" by blast + + have **: "ineq_model \ X F" by (meson ConsIneq.prems(2) in_set_conv_decomp) + + have "\x. x \ vars\<^sub>s\<^sub>t S \ x \ vars\<^sub>s\<^sub>t (S@[Inequality X F])" + "\x. x \ set S \ x \ set (S@[Inequality X F])" by auto + hence IH: "\M; S\\<^sub>c (\ \\<^sub>s \ \\<^sub>s \)" by (metis ConsIneq.IH ConsIneq.prems(1,2,3,4)) + + have "ineq_model (\ \\<^sub>s \) X F" + proof - + have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \) \ subst_domain \" when "?P \ X" for \ + using ConsIneq.prems(3)[OF _ that] by simp + hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \ subst_domain \" + using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_subset ex_P + by (metis Diff_subset_conv Un_commute) + thus ?thesis by (metis ineq_model_ground_subst[OF _ \_img_ground **]) + qed + hence "ineq_model (\ \\<^sub>s \ \\<^sub>s \) X F" + using * ineq_model_subst' subst_compose_assoc ConsIneq.prems(4) + by (metis UnCI list.set_intros(1) set_append) + thus ?case using IH by (auto simp add: ineq_model_def) + qed auto + } + moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\ \\<^sub>s \ \\<^sub>s \)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\ \\<^sub>s \ \\<^sub>s \))" + by (metis wt_subst_compose \wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\ \wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\ \wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\, + metis assms(4) \_wf_trm \_wf_trm wf_trm_subst subst_img_comp_subset') + ultimately show ?thesis + using interpretation_comp(1)[OF \interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\, of "\ \\<^sub>s \"] + subst_idem_support[OF \subst_idem \\, of "\ \\<^sub>s \"] subst_compose_assoc + unfolding constr_sem_c_def by metis +qed +end + + +subsubsection \Theorem: Type-flaw resistant constraints are well-typed satisfiable (composition-only)\ +text \ + There exists well-typed models of satisfiable type-flaw resistant constraints in the + semantics where the intruder is limited to composition only (i.e., he cannot perform + decomposition/analysis of deducible messages). +\ +theorem wt_attack_if_tfr_attack: + assumes "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and "\ \\<^sub>c \S, \\" + and "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \" + and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and "tfr\<^sub>s\<^sub>t S" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + obtains \\<^sub>\ where "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" + and "\\<^sub>\ \\<^sub>c \S, \\" + and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)" +proof - + have tfr: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + using assms(5,6) unfolding tfr\<^sub>s\<^sub>t_def by metis+ + obtain S' \' where *: "simple S'" "(S,\) \\<^sup>* (S',\')" "\{}; S'\\<^sub>c \" + using LI_completeness[OF assms(3,2)] unfolding constr_sem_c_def + by (meson term.order_refl) + have **: "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S' \'" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \'" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \')" + using LI_preserves_welltypedness[OF *(2) assms(3,4,7) tfr] + LI_preserves_wellformedness[OF *(2) assms(3)] + LI_preserves_tfr[OF *(2) assms(3,4,7) tfr] + by metis+ + + define A where "A \ {x \ vars\<^sub>s\<^sub>t S'. \X F. Inequality X F \ set S' \ x \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \ x \ set X}" + define B where "B \ UNIV - A" + + let ?\ = "rm_vars B \" + + have gr\: "ground (subst_range \)" "ground (subst_range ?\)" + using assms(1) rm_vars_img_subset[of B \] by (auto simp add: subst_domain_def) + + { fix X F + assume "Inequality X F \ set S'" + hence *: "ineq_model \ X F" + using strand_sem_c_imp_ineq_model[OF *(3)] + by (auto simp del: subst_range.simps) + hence "ineq_model ?\ X F" + proof - + { fix \ + assume 1: "subst_domain \ = set X" "ground (subst_range \)" + and 2: "list_ex (\f. fst f \ \ \\<^sub>s \ \ snd f \ \ \\<^sub>s \) F" + have "list_ex (\f. fst f \ \ \\<^sub>s rm_vars B \ \ snd f \ \ \\<^sub>s rm_vars B \) F" using 2 + proof (induction F) + case (Cons g G) + obtain t t' where g: "g = (t,t')" by (metis surj_pair) + thus ?case + using Cons Unifier_ground_rm_vars[OF gr\(1), of "t \ \" B "t' \ \"] + by auto + qed simp + } thus ?thesis using * unfolding ineq_model_def by simp + qed + } moreover have "subst_domain \ = UNIV" using assms(1) by metis + hence "subst_domain ?\ = A" using rm_vars_dom[of B \] B_def by blast + ultimately obtain \\<^sub>\ where + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "\\<^sub>\ \\<^sub>c \S', \'\" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)" + using wt_sat_if_simple[OF *(1) **(1,2,5,4) _ gr\(2) _ **(3)] A_def + by (auto simp del: subst_range.simps) + thus ?thesis using that LI_soundness[OF assms(3) *(2)] by metis +qed + +text \ + Contra-positive version: if a type-flaw resistant constraint does not have a well-typed model + then it is unsatisfiable +\ +corollary secure_if_wt_secure: + assumes "\(\\\<^sub>\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ (\\<^sub>\ \\<^sub>c \S, \\) \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\)" + and "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "tfr\<^sub>s\<^sub>t S" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \)" + shows "\(\\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ (\ \\<^sub>c \S, \\))" +using wt_attack_if_tfr_attack[OF _ _ assms(2,3,4,5,6)] assms(1) by metis + +end + + +subsection \Lifting the Composition-Only Typing Result to the Full Intruder Model\ +context typed_model +begin + +subsubsection \Analysis Invariance\ +definition (in typed_model) Ana_invar_subst where + "Ana_invar_subst \ \ + (\f T K M \. Fun f T \ (subterms\<^sub>s\<^sub>e\<^sub>t \) \ + Ana (Fun f T) = (K, M) \ Ana (Fun f T \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \))" + +lemma (in typed_model) Ana_invar_subst_subset: + assumes "Ana_invar_subst M" "N \ M" + shows "Ana_invar_subst N" +using assms unfolding Ana_invar_subst_def by blast + +lemma (in typed_model) Ana_invar_substD: + assumes "Ana_invar_subst \" + and "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t \" "Ana (Fun f T) = (K, M)" + shows "Ana (Fun f T \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" +using assms Ana_invar_subst_def by blast + +end + + +subsubsection \Preliminary Definitions\ +text \Strands extended with "decomposition steps"\ +datatype (funs\<^sub>e\<^sub>s\<^sub>t\<^sub>p: 'a, vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p: 'b) extstrand_step = + Step "('a,'b) strand_step" +| Decomp "('a,'b) term" + +context typed_model +begin + +context +begin +private fun trms\<^sub>e\<^sub>s\<^sub>t\<^sub>p where + "trms\<^sub>e\<^sub>s\<^sub>t\<^sub>p (Step x) = trms\<^sub>s\<^sub>t\<^sub>p x" +| "trms\<^sub>e\<^sub>s\<^sub>t\<^sub>p (Decomp t) = {t}" + +private abbreviation trms\<^sub>e\<^sub>s\<^sub>t where "trms\<^sub>e\<^sub>s\<^sub>t S \ \(trms\<^sub>e\<^sub>s\<^sub>t\<^sub>p ` set S)" + +private type_synonym ('a,'b) extstrand = "('a,'b) extstrand_step list" +private type_synonym ('a,'b) extstrands = "('a,'b) extstrand set" + +private definition decomp::"('fun,'var) term \ ('fun,'var) strand" where + "decomp t \ (case (Ana t) of (K,T) \ send\t\\<^sub>s\<^sub>t#map Send K@map Receive T)" + +private fun to_st where + "to_st [] = []" +| "to_st (Step x#S) = x#(to_st S)" +| "to_st (Decomp t#S) = (decomp t)@(to_st S)" + +private fun to_est where + "to_est [] = []" +| "to_est (x#S) = Step x#to_est S" + +private abbreviation "ik\<^sub>e\<^sub>s\<^sub>t A \ ik\<^sub>s\<^sub>t (to_st A)" +private abbreviation "wf\<^sub>e\<^sub>s\<^sub>t V A \ wf\<^sub>s\<^sub>t V (to_st A)" +private abbreviation "assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>s\<^sub>t (to_st A)" +private abbreviation "vars\<^sub>e\<^sub>s\<^sub>t A \ vars\<^sub>s\<^sub>t (to_st A)" +private abbreviation "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A \ wfrestrictedvars\<^sub>s\<^sub>t (to_st A)" +private abbreviation "bvars\<^sub>e\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>t (to_st A)" +private abbreviation "fv\<^sub>e\<^sub>s\<^sub>t A \ fv\<^sub>s\<^sub>t (to_st A)" +private abbreviation "funs\<^sub>e\<^sub>s\<^sub>t A \ funs\<^sub>s\<^sub>t (to_st A)" + +private definition wf\<^sub>s\<^sub>t\<^sub>s'::"('fun,'var) strands \ ('fun,'var) extstrand \ bool" where + "wf\<^sub>s\<^sub>t\<^sub>s' \ \ \ (\S \ \. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \) (dual\<^sub>s\<^sub>t S)) \ + (\S \ \. \S' \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}) \ + (\S \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t \ = {}) \ + (\S \ \. fv\<^sub>s\<^sub>t (to_st \) \ bvars\<^sub>s\<^sub>t S = {})" + +private definition wf\<^sub>s\<^sub>t\<^sub>s::"('fun,'var) strands \ bool" where + "wf\<^sub>s\<^sub>t\<^sub>s \ \ (\S \ \. wf\<^sub>s\<^sub>t {} (dual\<^sub>s\<^sub>t S)) \ (\S \ \. \S' \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {})" + +private inductive well_analyzed::"('fun,'var) extstrand \ bool" where + Nil[simp]: "well_analyzed []" +| Step: "well_analyzed A \ well_analyzed (A@[Step x])" +| Decomp: "\well_analyzed A; t \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) - (Var ` \)\ + \ well_analyzed (A@[Decomp t])" + +private fun subst_apply_extstrandstep (infix "\\<^sub>e\<^sub>s\<^sub>t\<^sub>p" 51) where + "subst_apply_extstrandstep (Step x) \ = Step (x \\<^sub>s\<^sub>t\<^sub>p \)" +| "subst_apply_extstrandstep (Decomp t) \ = Decomp (t \ \)" + +private lemma subst_apply_extstrandstep'_simps[simp]: + "(Step (send\t\\<^sub>s\<^sub>t)) \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \ = Step (send\t \ \\\<^sub>s\<^sub>t)" + "(Step (receive\t\\<^sub>s\<^sub>t)) \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \ = Step (receive\t \ \\\<^sub>s\<^sub>t)" + "(Step (\a: t \ t'\\<^sub>s\<^sub>t)) \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \ = Step (\a: (t \ \) \ (t' \ \)\\<^sub>s\<^sub>t)" + "(Step (\X\\\: F\\<^sub>s\<^sub>t)) \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \ = Step (\X\\\: (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)\\<^sub>s\<^sub>t)" +by simp_all + +private lemma vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p_subst_apply_simps[simp]: + "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (send\t\\<^sub>s\<^sub>t)) \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (receive\t\\<^sub>s\<^sub>t)) \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \)" + "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (\a: t \ t'\\<^sub>s\<^sub>t)) \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \) = fv (t \ \) \ fv (t' \ \)" + "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (\X\\\: F\\<^sub>s\<^sub>t)) \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \) = set X \ fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \)" +by auto + +private definition subst_apply_extstrand (infix "\\<^sub>e\<^sub>s\<^sub>t" 51) where "S \\<^sub>e\<^sub>s\<^sub>t \ \ map (\x. x \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \) S" + +private abbreviation update\<^sub>s\<^sub>t::"('fun,'var) strands \ ('fun,'var) strand \ ('fun,'var) strands" +where + "update\<^sub>s\<^sub>t \ S \ (case S of Nil \ \ - {S} | Cons _ S' \ insert S' (\ - {S}))" + +private inductive_set decomps\<^sub>e\<^sub>s\<^sub>t:: + "('fun,'var) terms \ ('fun,'var) terms \ ('fun,'var) subst \ ('fun,'var) extstrands" +(* \: intruder knowledge + \: additional messages +*) +for \ and \ and \ where + Nil: "[] \ decomps\<^sub>e\<^sub>s\<^sub>t \ \ \" +| Decomp: "\\ \ decomps\<^sub>e\<^sub>s\<^sub>t \ \ \; Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (\ \ \); + Ana (Fun f T) = (K,M); M \ []; + (\ \ ik\<^sub>e\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c Fun f T \ \; + \k. k \ set K \ (\ \ ik\<^sub>e\<^sub>s\<^sub>t \) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c k \ \\ + \ \@[Decomp (Fun f T)] \ decomps\<^sub>e\<^sub>s\<^sub>t \ \ \" + +private fun decomp_rm\<^sub>e\<^sub>s\<^sub>t::"('fun,'var) extstrand \ ('fun,'var) extstrand" where + "decomp_rm\<^sub>e\<^sub>s\<^sub>t [] = []" +| "decomp_rm\<^sub>e\<^sub>s\<^sub>t (Decomp t#S) = decomp_rm\<^sub>e\<^sub>s\<^sub>t S" +| "decomp_rm\<^sub>e\<^sub>s\<^sub>t (Step x#S) = Step x#(decomp_rm\<^sub>e\<^sub>s\<^sub>t S)" + +private inductive sem\<^sub>e\<^sub>s\<^sub>t_d::"('fun,'var) terms \ ('fun,'var) subst \ ('fun,'var) extstrand \ bool" +where + Nil[simp]: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ []" +| Send: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ S \ (ik\<^sub>e\<^sub>s\<^sub>t S \ M\<^sub>0) \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \ \ sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ (S@[Step (send\t\\<^sub>s\<^sub>t)])" +| Receive: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ S \ sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ (S@[Step (receive\t\\<^sub>s\<^sub>t)])" +| Equality: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ S \ t \ \ = t' \ \ \ sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ (S@[Step (\a: t \ t'\\<^sub>s\<^sub>t)])" +| Inequality: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ S + \ ineq_model \ X F + \ sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ (S@[Step (\X\\\: F\\<^sub>s\<^sub>t)])" +| Decompose: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ S \ (ik\<^sub>e\<^sub>s\<^sub>t S \ M\<^sub>0) \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \ \ Ana t = (K, M) + \ (\k. k \ set K \ (ik\<^sub>e\<^sub>s\<^sub>t S \ M\<^sub>0) \\<^sub>s\<^sub>e\<^sub>t \ \ k \ \) \ sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ (S@[Decomp t])" + +private inductive sem\<^sub>e\<^sub>s\<^sub>t_c::"('fun,'var) terms \ ('fun,'var) subst \ ('fun,'var) extstrand \ bool" +where + Nil[simp]: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ []" +| Send: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ S \ (ik\<^sub>e\<^sub>s\<^sub>t S \ M\<^sub>0) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \ \ sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ (S@[Step (send\t\\<^sub>s\<^sub>t)])" +| Receive: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ S \ sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ (S@[Step (receive\t\\<^sub>s\<^sub>t)])" +| Equality: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ S \ t \ \ = t' \ \ \ sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ (S@[Step (\a: t \ t'\\<^sub>s\<^sub>t)])" +| Inequality: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ S + \ ineq_model \ X F + \ sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ (S@[Step (\X\\\: F\\<^sub>s\<^sub>t)])" +| Decompose: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ S \ (ik\<^sub>e\<^sub>s\<^sub>t S \ M\<^sub>0) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \ \ Ana t = (K, M) + \ (\k. k \ set K \ (ik\<^sub>e\<^sub>s\<^sub>t S \ M\<^sub>0) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c k \ \) \ sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ (S@[Decomp t])" + + +subsubsection \Preliminary Lemmata\ +private lemma wf\<^sub>s\<^sub>t\<^sub>s_wf\<^sub>s\<^sub>t\<^sub>s': + "wf\<^sub>s\<^sub>t\<^sub>s \ = wf\<^sub>s\<^sub>t\<^sub>s' \ []" +by (simp add: wf\<^sub>s\<^sub>t\<^sub>s_def wf\<^sub>s\<^sub>t\<^sub>s'_def) + +private lemma decomp_ik: + assumes "Ana t = (K,M)" + shows "ik\<^sub>s\<^sub>t (decomp t) = set M" +using ik_rcv_map[of _ M] ik_rcv_map'[of _ M] +by (auto simp add: decomp_def inv_def assms) + +private lemma decomp_assignment_rhs_empty: + assumes "Ana t = (K,M)" + shows "assignment_rhs\<^sub>s\<^sub>t (decomp t) = {}" +by (auto simp add: decomp_def inv_def assms) + +private lemma decomp_tfr\<^sub>s\<^sub>t\<^sub>p: + "list_all tfr\<^sub>s\<^sub>t\<^sub>p (decomp t)" +by (auto simp add: decomp_def list_all_def) + +private lemma trms\<^sub>e\<^sub>s\<^sub>t_ikI: + "t \ ik\<^sub>e\<^sub>s\<^sub>t A \ t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t A)" +proof (induction A rule: to_st.induct) + case (2 x S) thus ?case by (cases x) auto +next + case (3 t' A) + obtain K M where Ana: "Ana t' = (K,M)" by (metis surj_pair) + show ?case using 3 decomp_ik[OF Ana] Ana_subterm[OF Ana] by auto +qed simp + +private lemma trms\<^sub>e\<^sub>s\<^sub>t_ik_assignment_rhsI: + "t \ ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \ t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t A)" +proof (induction A rule: to_st.induct) + case (2 x S) thus ?case + proof (cases x) + case (Equality ac t t') thus ?thesis using 2 by (cases ac) auto + qed auto +next + case (3 t' A) + obtain K M where Ana: "Ana t' = (K,M)" by (metis surj_pair) + show ?case + using 3 decomp_ik[OF Ana] decomp_assignment_rhs_empty[OF Ana] Ana_subterm[OF Ana] + by auto +qed simp + +private lemma trms\<^sub>e\<^sub>s\<^sub>t_ik_subtermsI: + assumes "t \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A)" + shows "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t A)" +proof - + obtain t' where "t' \ ik\<^sub>e\<^sub>s\<^sub>t A" "t \ t'" using trms\<^sub>e\<^sub>s\<^sub>t_ikI assms by auto + thus ?thesis by (meson contra_subsetD in_subterms_subset_Union trms\<^sub>e\<^sub>s\<^sub>t_ikI) +qed + +private lemma trms\<^sub>e\<^sub>s\<^sub>tD: + assumes "t \ trms\<^sub>e\<^sub>s\<^sub>t A" + shows "t \ trms\<^sub>s\<^sub>t (to_st A)" +using assms +proof (induction A) + case (Cons a A) + obtain K M where Ana: "Ana t = (K,M)" by (metis surj_pair) + hence "t \ trms\<^sub>s\<^sub>t (decomp t)" unfolding decomp_def by force + thus ?case using Cons.IH Cons.prems by (cases a) auto +qed simp + +private lemma subst_apply_extstrand_nil[simp]: + "[] \\<^sub>e\<^sub>s\<^sub>t \ = []" +by (simp add: subst_apply_extstrand_def) + +private lemma subst_apply_extstrand_singleton[simp]: + "[Step (receive\t\\<^sub>s\<^sub>t)] \\<^sub>e\<^sub>s\<^sub>t \ = [Step (Receive (t \ \))]" + "[Step (send\t\\<^sub>s\<^sub>t)] \\<^sub>e\<^sub>s\<^sub>t \ = [Step (Send (t \ \))]" + "[Step (\a: t \ t'\\<^sub>s\<^sub>t)] \\<^sub>e\<^sub>s\<^sub>t \ = [Step (Equality a (t \ \) (t' \ \))]" + "[Decomp t] \\<^sub>e\<^sub>s\<^sub>t \ = [Decomp (t \ \)]" +unfolding subst_apply_extstrand_def by auto + +private lemma extstrand_subst_hom: + "(S@S') \\<^sub>e\<^sub>s\<^sub>t \ = (S \\<^sub>e\<^sub>s\<^sub>t \)@(S' \\<^sub>e\<^sub>s\<^sub>t \)" "(x#S) \\<^sub>e\<^sub>s\<^sub>t \ = (x \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \)#(S \\<^sub>e\<^sub>s\<^sub>t \)" +unfolding subst_apply_extstrand_def by auto + +private lemma decomp_vars: + "wfrestrictedvars\<^sub>s\<^sub>t (decomp t) = fv t" "vars\<^sub>s\<^sub>t (decomp t) = fv t" "bvars\<^sub>s\<^sub>t (decomp t) = {}" + "fv\<^sub>s\<^sub>t (decomp t) = fv t" +proof - + obtain K M where Ana: "Ana t = (K,M)" by (metis surj_pair) + hence "decomp t = send\t\\<^sub>s\<^sub>t#map Send K@map Receive M" + unfolding decomp_def by simp + moreover have "\(set (map fv K)) = fv\<^sub>s\<^sub>e\<^sub>t (set K)" "\(set (map fv M)) = fv\<^sub>s\<^sub>e\<^sub>t (set M)" by auto + moreover have "fv\<^sub>s\<^sub>e\<^sub>t (set K) \ fv t" "fv\<^sub>s\<^sub>e\<^sub>t (set M) \ fv t" + using Ana_subterm[OF Ana(1)] Ana_keys_fv[OF Ana(1)] + by (simp_all add: UN_least psubsetD subtermeq_vars_subset) + ultimately show + "wfrestrictedvars\<^sub>s\<^sub>t (decomp t) = fv t" "vars\<^sub>s\<^sub>t (decomp t) = fv t" "bvars\<^sub>s\<^sub>t (decomp t) = {}" + "fv\<^sub>s\<^sub>t (decomp t) = fv t" + by auto +qed + +private lemma bvars\<^sub>e\<^sub>s\<^sub>t_cons: "bvars\<^sub>e\<^sub>s\<^sub>t (x#X) = bvars\<^sub>e\<^sub>s\<^sub>t [x] \ bvars\<^sub>e\<^sub>s\<^sub>t X" +by (cases x) auto + +private lemma bvars\<^sub>e\<^sub>s\<^sub>t_append: "bvars\<^sub>e\<^sub>s\<^sub>t (A@B) = bvars\<^sub>e\<^sub>s\<^sub>t A \ bvars\<^sub>e\<^sub>s\<^sub>t B" +proof (induction A) + case (Cons x A) thus ?case using bvars\<^sub>e\<^sub>s\<^sub>t_cons[of x "A@B"] bvars\<^sub>e\<^sub>s\<^sub>t_cons[of x A] by force +qed simp + +private lemma fv\<^sub>e\<^sub>s\<^sub>t_cons: "fv\<^sub>e\<^sub>s\<^sub>t (x#X) = fv\<^sub>e\<^sub>s\<^sub>t [x] \ fv\<^sub>e\<^sub>s\<^sub>t X" +by (cases x) auto + +private lemma fv\<^sub>e\<^sub>s\<^sub>t_append: "fv\<^sub>e\<^sub>s\<^sub>t (A@B) = fv\<^sub>e\<^sub>s\<^sub>t A \ fv\<^sub>e\<^sub>s\<^sub>t B" +proof (induction A) + case (Cons x A) thus ?case using fv\<^sub>e\<^sub>s\<^sub>t_cons[of x "A@B"] fv\<^sub>e\<^sub>s\<^sub>t_cons[of x A] by auto +qed simp + +private lemma bvars_decomp: "bvars\<^sub>e\<^sub>s\<^sub>t (A@[Decomp t]) = bvars\<^sub>e\<^sub>s\<^sub>t A" "bvars\<^sub>e\<^sub>s\<^sub>t (Decomp t#A) = bvars\<^sub>e\<^sub>s\<^sub>t A" +using bvars\<^sub>e\<^sub>s\<^sub>t_append decomp_vars(3) by fastforce+ + +private lemma bvars_decomp_rm: "bvars\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) = bvars\<^sub>e\<^sub>s\<^sub>t A" +using bvars_decomp by (induct A rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) simp_all+ + +private lemma fv_decomp_rm: "fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \ fv\<^sub>e\<^sub>s\<^sub>t A" +by (induct A rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) auto + +private lemma ik_assignment_rhs_decomp_fv: + assumes "t \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)" + shows "fv\<^sub>e\<^sub>s\<^sub>t (A@[Decomp t]) = fv\<^sub>e\<^sub>s\<^sub>t A" +proof - + have "fv\<^sub>e\<^sub>s\<^sub>t (A@[Decomp t]) = fv\<^sub>e\<^sub>s\<^sub>t A \ fv t" using fv\<^sub>e\<^sub>s\<^sub>t_append decomp_vars by simp + moreover have "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \ fv\<^sub>e\<^sub>s\<^sub>t A" by force + moreover have "fv t \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)" + using fv_subset_subterms[OF assms(1)] by simp + ultimately show ?thesis by blast +qed + +private lemma wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_decomp_rm\<^sub>e\<^sub>s\<^sub>t_subset: + "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \ wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A" +by (induct A rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) auto+ + +private lemma wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_eq_wfrestrictedvars\<^sub>s\<^sub>t: + "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A = wfrestrictedvars\<^sub>s\<^sub>t (to_st A)" +by simp + +private lemma decomp_set_unfold: + assumes "Ana t = (K, M)" + shows "set (decomp t) = {send\t\\<^sub>s\<^sub>t} \ (Send ` set K) \ (Receive ` set M)" +using assms unfolding decomp_def by auto + +private lemma ik\<^sub>e\<^sub>s\<^sub>t_finite: "finite (ik\<^sub>e\<^sub>s\<^sub>t A)" +by (rule finite_ik\<^sub>s\<^sub>t) + +private lemma assignment_rhs\<^sub>e\<^sub>s\<^sub>t_finite: "finite (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)" +by (rule finite_assignment_rhs\<^sub>s\<^sub>t) + +private lemma to_est_append: "to_est (A@B) = to_est A@to_est B" +by (induct A rule: to_est.induct) auto + +private lemma to_st_to_est_inv: "to_st (to_est A) = A" +by (induct A rule: to_est.induct) auto + +private lemma to_st_append: "to_st (A@B) = (to_st A)@(to_st B)" +by (induct A rule: to_st.induct) auto + +private lemma to_st_cons: "to_st (a#B) = (to_st [a])@(to_st B)" +using to_st_append[of "[a]" B] by simp + +private lemma wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split: + "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t (x#S) = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t [x] \ wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t S" + "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t (S@S') = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t S \ wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t S'" +using to_st_cons[of x S] to_st_append[of S S'] by auto + +private lemma ik\<^sub>e\<^sub>s\<^sub>t_append: "ik\<^sub>e\<^sub>s\<^sub>t (A@B) = ik\<^sub>e\<^sub>s\<^sub>t A \ ik\<^sub>e\<^sub>s\<^sub>t B" +by (metis ik_append to_st_append) + +private lemma assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append: + "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B) = assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t B" +by (metis assignment_rhs_append to_st_append) + +private lemma ik\<^sub>e\<^sub>s\<^sub>t_cons: "ik\<^sub>e\<^sub>s\<^sub>t (a#A) = ik\<^sub>e\<^sub>s\<^sub>t [a] \ ik\<^sub>e\<^sub>s\<^sub>t A" +by (metis ik_append to_st_cons) + +private lemma ik\<^sub>e\<^sub>s\<^sub>t_append_subst: + "ik\<^sub>e\<^sub>s\<^sub>t (A@B \\<^sub>e\<^sub>s\<^sub>t \) = ik\<^sub>e\<^sub>s\<^sub>t (A \\<^sub>e\<^sub>s\<^sub>t \) \ ik\<^sub>e\<^sub>s\<^sub>t (B \\<^sub>e\<^sub>s\<^sub>t \)" + "ik\<^sub>e\<^sub>s\<^sub>t (A@B) \\<^sub>s\<^sub>e\<^sub>t \ = (ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t B \\<^sub>s\<^sub>e\<^sub>t \)" +by (metis ik\<^sub>e\<^sub>s\<^sub>t_append extstrand_subst_hom(1), simp add: image_Un to_st_append) + +private lemma assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append_subst: + "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B \\<^sub>e\<^sub>s\<^sub>t \) = assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A \\<^sub>e\<^sub>s\<^sub>t \) \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t (B \\<^sub>e\<^sub>s\<^sub>t \)" + "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B) \\<^sub>s\<^sub>e\<^sub>t \ = (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t B \\<^sub>s\<^sub>e\<^sub>t \)" +by (metis assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append extstrand_subst_hom(1), use assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append in blast) + +private lemma ik\<^sub>e\<^sub>s\<^sub>t_cons_subst: + "ik\<^sub>e\<^sub>s\<^sub>t (a#A \\<^sub>e\<^sub>s\<^sub>t \) = ik\<^sub>e\<^sub>s\<^sub>t ([a \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \]) \ ik\<^sub>e\<^sub>s\<^sub>t (A \\<^sub>e\<^sub>s\<^sub>t \)" + "ik\<^sub>e\<^sub>s\<^sub>t (a#A) \\<^sub>s\<^sub>e\<^sub>t \ = (ik\<^sub>e\<^sub>s\<^sub>t [a] \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \)" +by (metis ik\<^sub>e\<^sub>s\<^sub>t_cons extstrand_subst_hom(2), metis image_Un ik\<^sub>e\<^sub>s\<^sub>t_cons) + +private lemma decomp_rm\<^sub>e\<^sub>s\<^sub>t_append: "decomp_rm\<^sub>e\<^sub>s\<^sub>t (S@S') = (decomp_rm\<^sub>e\<^sub>s\<^sub>t S)@(decomp_rm\<^sub>e\<^sub>s\<^sub>t S')" +by (induct S rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) auto + +private lemma decomp_rm\<^sub>e\<^sub>s\<^sub>t_single[simp]: + "decomp_rm\<^sub>e\<^sub>s\<^sub>t [Step (send\t\\<^sub>s\<^sub>t)] = [Step (send\t\\<^sub>s\<^sub>t)]" + "decomp_rm\<^sub>e\<^sub>s\<^sub>t [Step (receive\t\\<^sub>s\<^sub>t)] = [Step (receive\t\\<^sub>s\<^sub>t)]" + "decomp_rm\<^sub>e\<^sub>s\<^sub>t [Decomp t] = []" +by auto + +private lemma decomp_rm\<^sub>e\<^sub>s\<^sub>t_ik_subset: "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t S) \ ik\<^sub>e\<^sub>s\<^sub>t S" +proof (induction S rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) + case (3 x S) thus ?case by (cases x) auto +qed auto + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_ik_subset: "D \ decomps\<^sub>e\<^sub>s\<^sub>t M N \ \ ik\<^sub>e\<^sub>s\<^sub>t D \ subterms\<^sub>s\<^sub>e\<^sub>t (M \ N)" +proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct) + case (Decomp D f T K M') + have "ik\<^sub>s\<^sub>t (decomp (Fun f T)) \ subterms (Fun f T)" + "ik\<^sub>s\<^sub>t (decomp (Fun f T)) = ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f T)]" + using decomp_ik[OF Decomp.hyps(3)] Ana_subterm[OF Decomp.hyps(3)] + by auto + hence "ik\<^sub>s\<^sub>t (to_st [Decomp (Fun f T)]) \ subterms\<^sub>s\<^sub>e\<^sub>t (M \ N)" + using in_subterms_subset_Union[OF Decomp.hyps(2)] + by blast + thus ?case using ik\<^sub>e\<^sub>s\<^sub>t_append[of D "[Decomp (Fun f T)]"] using Decomp.IH by auto +qed simp + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_decomp_rm\<^sub>e\<^sub>s\<^sub>t_empty: "D \ decomps\<^sub>e\<^sub>s\<^sub>t M N \ \ decomp_rm\<^sub>e\<^sub>s\<^sub>t D = []" +by (induct D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct) (auto simp add: decomp_rm\<^sub>e\<^sub>s\<^sub>t_append) + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_append: + assumes "A \ decomps\<^sub>e\<^sub>s\<^sub>t S N \" "B \ decomps\<^sub>e\<^sub>s\<^sub>t S N \" + shows "A@B \ decomps\<^sub>e\<^sub>s\<^sub>t S N \" +using assms(2) +proof (induction B rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct) + case Nil show ?case using assms(1) by simp +next + case (Decomp B f X K T) + hence "S \ ik\<^sub>e\<^sub>s\<^sub>t B \\<^sub>s\<^sub>e\<^sub>t \ \ S \ ik\<^sub>e\<^sub>s\<^sub>t (A@B) \\<^sub>s\<^sub>e\<^sub>t \" using ik\<^sub>e\<^sub>s\<^sub>t_append by auto + thus ?case + using decomps\<^sub>e\<^sub>s\<^sub>t.Decomp[OF Decomp.IH(1) Decomp.hyps(2,3,4)] + ideduct_synth_mono[OF Decomp.hyps(5)] + ideduct_synth_mono[OF Decomp.hyps(6)] + by auto +qed + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_subterms: + assumes "A' \ decomps\<^sub>e\<^sub>s\<^sub>t M N \" + shows "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A') \ subterms\<^sub>s\<^sub>e\<^sub>t (M \ N)" +using assms +proof (induction A' rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct) + case (Decomp D f X K T) + hence "Fun f X \ subterms\<^sub>s\<^sub>e\<^sub>t (M \ N)" by auto + hence "subterms\<^sub>s\<^sub>e\<^sub>t (set X) \ subterms\<^sub>s\<^sub>e\<^sub>t (M \ N)" + using in_subterms_subset_Union[of "Fun f X" "M \ N"] params_subterms_Union[of X f] + by blast + moreover have "ik\<^sub>s\<^sub>t (to_st [Decomp (Fun f X)]) = set T" using Decomp.hyps(3) decomp_ik by simp + hence "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t (to_st [Decomp (Fun f X)])) \ subterms\<^sub>s\<^sub>e\<^sub>t (set X)" + using Ana_fun_subterm[OF Decomp.hyps(3)] by auto + ultimately show ?case + using ik\<^sub>e\<^sub>s\<^sub>t_append[of D "[Decomp (Fun f X)]"] Decomp.IH + by auto +qed simp + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_assignment_rhs_empty: + assumes "A' \ decomps\<^sub>e\<^sub>s\<^sub>t M N \" + shows "assignment_rhs\<^sub>e\<^sub>s\<^sub>t A' = {}" +using assms +by (induction A' rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct) + (simp_all add: decomp_assignment_rhs_empty assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append) + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_finite_ik_append: + assumes "finite M" "M \ decomps\<^sub>e\<^sub>s\<^sub>t A N \" + shows "\D \ decomps\<^sub>e\<^sub>s\<^sub>t A N \. ik\<^sub>e\<^sub>s\<^sub>t D = (\m \ M. ik\<^sub>e\<^sub>s\<^sub>t m)" +using assms +proof (induction M rule: finite_induct) + case empty + moreover have "[] \ decomps\<^sub>e\<^sub>s\<^sub>t A N \" "ik\<^sub>s\<^sub>t (to_st []) = {}" using decomps\<^sub>e\<^sub>s\<^sub>t.Nil by auto + ultimately show ?case by blast +next + case (insert m M) + then obtain D where "D \ decomps\<^sub>e\<^sub>s\<^sub>t A N \" "ik\<^sub>e\<^sub>s\<^sub>t D = (\m\M. ik\<^sub>s\<^sub>t (to_st m))" by moura + moreover have "m \ decomps\<^sub>e\<^sub>s\<^sub>t A N \" using insert.prems(1) by blast + ultimately show ?case using decomps\<^sub>e\<^sub>s\<^sub>t_append[of D A N \ m] ik\<^sub>e\<^sub>s\<^sub>t_append[of D m] by blast +qed + +private lemma decomp_snd_exists[simp]: "\D. decomp t = send\t\\<^sub>s\<^sub>t#D" +by (metis (mono_tags, lifting) decomp_def prod.case surj_pair) + +private lemma decomp_nonnil[simp]: "decomp t \ []" +using decomp_snd_exists[of t] by fastforce + +private lemma to_st_nil_inv[dest]: "to_st A = [] \ A = []" +by (induct A rule: to_st.induct) auto + +private lemma well_analyzedD: + assumes "well_analyzed A" "Decomp t \ set A" + shows "\f T. t = Fun f T" +using assms +proof (induction A rule: well_analyzed.induct) + case (Decomp A t') + hence "\f T. t' = Fun f T" by (cases t') auto + moreover have "Decomp t \ set A \ t = t'" using Decomp by auto + ultimately show ?case using Decomp.IH by auto +qed auto + +private lemma well_analyzed_inv: + assumes "well_analyzed (A@[Decomp t])" + shows "t \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) - (Var ` \)" +using assms well_analyzed.cases[of "A@[Decomp t]"] by fastforce + +private lemma well_analyzed_split_left_single: "well_analyzed (A@[a]) \ well_analyzed A" +by (induction "A@[a]" rule: well_analyzed.induct) auto + +private lemma well_analyzed_split_left: "well_analyzed (A@B) \ well_analyzed A" +proof (induction B rule: List.rev_induct) + case (snoc b B) thus ?case using well_analyzed_split_left_single[of "A@B" b] by simp +qed simp + +private lemma well_analyzed_append: + assumes "well_analyzed A" "well_analyzed B" + shows "well_analyzed (A@B)" +using assms(2,1) +proof (induction B rule: well_analyzed.induct) + case (Step B x) show ?case using well_analyzed.Step[OF Step.IH[OF Step.prems]] by simp +next + case (Decomp B t) thus ?case + using well_analyzed.Decomp[OF Decomp.IH[OF Decomp.prems]] ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append + by auto +qed simp_all + +private lemma well_analyzed_singleton: + "well_analyzed [Step (send\t\\<^sub>s\<^sub>t)]" "well_analyzed [Step (receive\t\\<^sub>s\<^sub>t)]" + "well_analyzed [Step (\a: t \ t'\\<^sub>s\<^sub>t)]" "well_analyzed [Step (\X\\\: F\\<^sub>s\<^sub>t)]" + "\well_analyzed [Decomp t]" +proof - + show "well_analyzed [Step (send\t\\<^sub>s\<^sub>t)]" "well_analyzed [Step (receive\t\\<^sub>s\<^sub>t)]" + "well_analyzed [Step (\a: t \ t'\\<^sub>s\<^sub>t)]" "well_analyzed [Step (\X\\\: F\\<^sub>s\<^sub>t)]" + using well_analyzed.Step[OF well_analyzed.Nil] + by simp_all + + show "\well_analyzed [Decomp t]" using well_analyzed.cases[of "[Decomp t]"] by auto +qed + +private lemma well_analyzed_decomp_rm\<^sub>e\<^sub>s\<^sub>t_fv: "well_analyzed A \ fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) = fv\<^sub>e\<^sub>s\<^sub>t A" +proof + assume "well_analyzed A" thus "fv\<^sub>e\<^sub>s\<^sub>t A \ fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A)" + proof (induction A rule: well_analyzed.induct) + case Decomp thus ?case using ik_assignment_rhs_decomp_fv decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto + next + case (Step A x) + have "fv\<^sub>e\<^sub>s\<^sub>t (A@[Step x]) = fv\<^sub>e\<^sub>s\<^sub>t A \ fv\<^sub>s\<^sub>t\<^sub>p x" + "fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t (A@[Step x])) = fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \ fv\<^sub>s\<^sub>t\<^sub>p x" + using fv\<^sub>e\<^sub>s\<^sub>t_append decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto + thus ?case using Step by auto + qed simp +qed (rule fv_decomp_rm) + +private lemma sem\<^sub>e\<^sub>s\<^sub>t_d_split_left: assumes "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ (\@\')" shows "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ \" +using assms sem\<^sub>e\<^sub>s\<^sub>t_d.cases by (induction \' rule: List.rev_induct) fastforce+ + +private lemma sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ \ = \M\<^sub>0; to_st \\\<^sub>d' \" +proof + show "\M\<^sub>0; to_st \\\<^sub>d' \ \ sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ \" + proof (induction \ arbitrary: M\<^sub>0 rule: List.rev_induct) + case Nil show ?case using to_st_nil_inv by simp + next + case (snoc a \) + hence IH: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ \" and *: "\ik\<^sub>e\<^sub>s\<^sub>t \ \ M\<^sub>0; to_st [a]\\<^sub>d' \" + using to_st_append by (auto simp add: sup.commute) + thus ?case using snoc + proof (cases a) + case (Step b) thus ?thesis + proof (cases b) + case (Send t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_d.Send[OF IH] * Step by auto + next + case (Receive t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_d.Receive[OF IH] Step by auto + next + case (Equality a t t') thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_d.Equality[OF IH] * Step by auto + next + case (Inequality X F) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_d.Inequality[OF IH] * Step by auto + qed + next + case (Decomp t) + obtain K M where Ana: "Ana t = (K,M)" by moura + have "to_st [a] = decomp t" using Decomp by auto + hence "to_st [a] = send\t\\<^sub>s\<^sub>t#map Send K@map Receive M" + using Ana unfolding decomp_def by auto + hence **: "ik\<^sub>e\<^sub>s\<^sub>t \ \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" and "\ik\<^sub>e\<^sub>s\<^sub>t \ \ M\<^sub>0; map Send K\\<^sub>d' \" + using * by auto + hence "\k. k \ set K \ ik\<^sub>e\<^sub>s\<^sub>t \ \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \ k \ \" + using * + by (metis (full_types) strand_sem_d.simps(2) strand_sem_eq_defs(2) strand_sem_Send_split(2)) + thus ?thesis using Decomp sem\<^sub>e\<^sub>s\<^sub>t_d.Decompose[OF IH ** Ana] by metis + qed + qed + + show "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ \ \ \M\<^sub>0; to_st \\\<^sub>d' \" + proof (induction rule: sem\<^sub>e\<^sub>s\<^sub>t_d.induct) + case Nil thus ?case by simp + next + case (Send M\<^sub>0 \ \ t) thus ?case + using strand_sem_append'[of M\<^sub>0 "to_st \" \ "[send\t\\<^sub>s\<^sub>t]"] + to_st_append[of \ "[Step (send\t\\<^sub>s\<^sub>t)]"] + by (simp add: sup.commute) + next + case (Receive M\<^sub>0 \ \ t) thus ?case + using strand_sem_append'[of M\<^sub>0 "to_st \" \ "[receive\t\\<^sub>s\<^sub>t]"] + to_st_append[of \ "[Step (receive\t\\<^sub>s\<^sub>t)]"] + by (simp add: sup.commute) + next + case (Equality M\<^sub>0 \ \ t t' a) thus ?case + using strand_sem_append'[of M\<^sub>0 "to_st \" \ "[\a: t \ t'\\<^sub>s\<^sub>t]"] + to_st_append[of \ "[Step (\a: t \ t'\\<^sub>s\<^sub>t)]"] + by (simp add: sup.commute) + next + case (Inequality M\<^sub>0 \ \ X F) thus ?case + using strand_sem_append'[of M\<^sub>0 "to_st \" \ "[\X\\\: F\\<^sub>s\<^sub>t]"] + to_st_append[of \ "[Step (\X\\\: F\\<^sub>s\<^sub>t)]"] + by (simp add: sup.commute) + next + case (Decompose M\<^sub>0 \ \ t K M) + have "\M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \); decomp t\\<^sub>d' \" + proof - + have "\M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \); [send\t\\<^sub>s\<^sub>t]\\<^sub>d' \" + using Decompose.hyps(2) by (auto simp add: sup.commute) + moreover have "\k. k \ set K \ M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \) \\<^sub>s\<^sub>e\<^sub>t \ \ k \ \" + using Decompose by (metis sup.commute) + hence "\k. k \ set K \ \M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \); [Send k]\\<^sub>d' \" by auto + hence "\M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \); map Send K\\<^sub>d' \" + using strand_sem_Send_map(2)[of K, of "M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \) \\<^sub>s\<^sub>e\<^sub>t \" \] strand_sem_eq_defs(2) + by auto + moreover have "\M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \); map Receive M\\<^sub>d' \" + by (metis strand_sem_Receive_map(2) strand_sem_eq_defs(2)) + ultimately have + "\M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \); send\t\\<^sub>s\<^sub>t#map Send K@map Receive M\\<^sub>d' \" + by auto + thus ?thesis using Decompose.hyps(3) unfolding decomp_def by auto + qed + hence "\M\<^sub>0; to_st \@decomp t\\<^sub>d' \" + using strand_sem_append'[of M\<^sub>0 "to_st \" \ "decomp t"] Decompose.IH + by simp + thus ?case using to_st_append[of \ "[Decomp t]"] by simp + qed +qed + +private lemma sem\<^sub>e\<^sub>s\<^sub>t_c_eq_sem_st: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ \ = \M\<^sub>0; to_st \\\<^sub>c' \" +proof + show "\M\<^sub>0; to_st \\\<^sub>c' \ \ sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ \" + proof (induction \ arbitrary: M\<^sub>0 rule: List.rev_induct) + case Nil show ?case using to_st_nil_inv by simp + next + case (snoc a \) + hence IH: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ \" and *: "\ik\<^sub>e\<^sub>s\<^sub>t \ \ M\<^sub>0; to_st [a]\\<^sub>c' \" + using to_st_append + by (auto simp add: sup.commute) + thus ?case using snoc + proof (cases a) + case (Step b) thus ?thesis + proof (cases b) + case (Send t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_c.Send[OF IH] * Step by auto + next + case (Receive t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_c.Receive[OF IH] Step by auto + next + case (Equality t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_c.Equality[OF IH] * Step by auto + next + case (Inequality t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_c.Inequality[OF IH] * Step by auto + qed + next + case (Decomp t) + obtain K M where Ana: "Ana t = (K,M)" by moura + have "to_st [a] = decomp t" using Decomp by auto + hence "to_st [a] = send\t\\<^sub>s\<^sub>t#map Send K@map Receive M" + using Ana unfolding decomp_def by auto + hence **: "ik\<^sub>e\<^sub>s\<^sub>t \ \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \" and "\ik\<^sub>e\<^sub>s\<^sub>t \ \ M\<^sub>0; map Send K\\<^sub>c' \" + using * by auto + hence "\k. k \ set K \ ik\<^sub>e\<^sub>s\<^sub>t \ \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c k \ \" + using * strand_sem_Send_split(1) strand_sem_eq_defs(1) + by auto + thus ?thesis using Decomp sem\<^sub>e\<^sub>s\<^sub>t_c.Decompose[OF IH ** Ana] by metis + qed + qed + + show "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ \ \ \M\<^sub>0; to_st \\\<^sub>c' \" + proof (induction rule: sem\<^sub>e\<^sub>s\<^sub>t_c.induct) + case Nil thus ?case by simp + next + case (Send M\<^sub>0 \ \ t) thus ?case + using strand_sem_append'[of M\<^sub>0 "to_st \" \ "[send\t\\<^sub>s\<^sub>t]"] + to_st_append[of \ "[Step (send\t\\<^sub>s\<^sub>t)]"] + by (simp add: sup.commute) + next + case (Receive M\<^sub>0 \ \ t) thus ?case + using strand_sem_append'[of M\<^sub>0 "to_st \" \ "[receive\t\\<^sub>s\<^sub>t]"] + to_st_append[of \ "[Step (receive\t\\<^sub>s\<^sub>t)]"] + by (simp add: sup.commute) + next + case (Equality M\<^sub>0 \ \ t t' a) thus ?case + using strand_sem_append'[of M\<^sub>0 "to_st \" \ "[\a: t \ t'\\<^sub>s\<^sub>t]"] + to_st_append[of \ "[Step (\a: t \ t'\\<^sub>s\<^sub>t)]"] + by (simp add: sup.commute) + next + case (Inequality M\<^sub>0 \ \ X F) thus ?case + using strand_sem_append'[of M\<^sub>0 "to_st \" \ "[\X\\\: F\\<^sub>s\<^sub>t]"] + to_st_append[of \ "[Step (\X\\\: F\\<^sub>s\<^sub>t)]"] + by (auto simp add: sup.commute) + next + case (Decompose M\<^sub>0 \ \ t K M) + have "\M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \); decomp t\\<^sub>c' \" + proof - + have "\M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \); [send\t\\<^sub>s\<^sub>t]\\<^sub>c' \" + using Decompose.hyps(2) by (auto simp add: sup.commute) + moreover have "\k. k \ set K \ M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c k \ \" + using Decompose by (metis sup.commute) + hence "\k. k \ set K \ \M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \); [Send k]\\<^sub>c' \" by auto + hence "\M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \); map Send K\\<^sub>c' \" + using strand_sem_Send_map(1)[of K, of "M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \) \\<^sub>s\<^sub>e\<^sub>t \" \] + strand_sem_eq_defs(1) + by auto + moreover have "\M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \); map Receive M\\<^sub>c' \" + by (metis strand_sem_Receive_map(1) strand_sem_eq_defs(1)) + ultimately have + "\M\<^sub>0 \ ik\<^sub>s\<^sub>t (to_st \); send\t\\<^sub>s\<^sub>t#map Send K@map Receive M\\<^sub>c' \" + by auto + thus ?thesis using Decompose.hyps(3) unfolding decomp_def by auto + qed + hence "\M\<^sub>0; to_st \@decomp t\\<^sub>c' \" + using strand_sem_append'[of M\<^sub>0 "to_st \" \ "decomp t"] Decompose.IH + by simp + thus ?case using to_st_append[of \ "[Decomp t]"] by simp + qed +qed + +private lemma sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct_aux: + assumes "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ A" "t \ ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \" "t \ ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \\<^sub>s\<^sub>e\<^sub>t \" + shows "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \ t" +using assms +proof (induction M\<^sub>0 \ A arbitrary: t rule: sem\<^sub>e\<^sub>s\<^sub>t_c.induct) + case (Send M\<^sub>0 \ A t') thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto +next + case (Receive M\<^sub>0 \ A t') + hence "t \ ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \" "t \ ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \\<^sub>s\<^sub>e\<^sub>t \" + using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto + hence IH: "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \ t" using Receive.IH by auto + show ?case using ideduct_mono[OF IH] decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto +next + case (Equality M\<^sub>0 \ A t') thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto +next + case (Inequality M\<^sub>0 \ A t') thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto +next + case (Decompose M\<^sub>0 \ A t' K M t) + have *: "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \ t' \ \" using Decompose.hyps(2) + proof (induction rule: intruder_synth_induct) + case (AxiomC t'') + moreover { + assume "t'' \ ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \" "t'' \ ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \\<^sub>s\<^sub>e\<^sub>t \" + hence ?case using Decompose.IH by auto + } + ultimately show ?case by force + qed simp + + { fix k assume "k \ set K" + hence "ik\<^sub>e\<^sub>s\<^sub>t A \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c k \ \" using Decompose.hyps by auto + hence "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \ k \ \" + proof (induction rule: intruder_synth_induct) + case (AxiomC t'') + moreover { + assume "t'' \ ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \" "t'' \ ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \\<^sub>s\<^sub>e\<^sub>t \" + hence ?case using Decompose.IH by auto + } + ultimately show ?case by force + qed simp + } + hence **: "\k. k \ set (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \) \ ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \ k" by auto + + show ?case + proof (cases "t \ ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \") + case True thus ?thesis using Decompose.IH Decompose.prems(2) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto + next + case False + hence "t \ ik\<^sub>s\<^sub>t (decomp t') \\<^sub>s\<^sub>e\<^sub>t \" using Decompose.prems(1) ik\<^sub>e\<^sub>s\<^sub>t_append by auto + hence ***: "t \ set (M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" using Decompose.hyps(3) decomp_ik by auto + hence "M \ []" by auto + hence ****: "Ana (t' \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" using Ana_subst[OF Decompose.hyps(3)] by auto + + have "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \ t" by (rule intruder_deduct.Decompose[OF * **** ** ***]) + thus ?thesis using ideduct_mono decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto + qed +qed simp + +private lemma sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct: + assumes "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ A" "ik\<^sub>e\<^sub>s\<^sub>t A \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t" + shows "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \ \ t" +using assms(2) +proof (induction t rule: intruder_synth_induct) + case (AxiomC t) + hence "t \ ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \ \ t \ M\<^sub>0 \\<^sub>s\<^sub>e\<^sub>t \" by auto + moreover { + assume "t \ ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \" "t \ ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \\<^sub>s\<^sub>e\<^sub>t \" + hence ?case using ideduct_mono[OF intruder_deduct.Axiom] by auto + } + moreover { + assume "t \ ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \" "t \ ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \\<^sub>s\<^sub>e\<^sub>t \" + hence ?case using sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct_aux[OF assms(1)] by auto + } + ultimately show ?case by auto +qed simp + +private lemma sem\<^sub>e\<^sub>s\<^sub>t_d_decomp_rm\<^sub>e\<^sub>s\<^sub>t_if_sem\<^sub>e\<^sub>s\<^sub>t_c: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ A \ sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \ (decomp_rm\<^sub>e\<^sub>s\<^sub>t A)" +proof (induction M\<^sub>0 \ A rule: sem\<^sub>e\<^sub>s\<^sub>t_c.induct) + case (Send M\<^sub>0 \ A t) + thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append sem\<^sub>e\<^sub>s\<^sub>t_d.Send[OF Send.IH] sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct by auto +next + case (Receive t) thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append sem\<^sub>e\<^sub>s\<^sub>t_d.Receive by auto +next + case (Equality M\<^sub>0 \ A t) + thus ?case + using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append sem\<^sub>e\<^sub>s\<^sub>t_d.Equality[OF Equality.IH] sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct + by auto +next + case (Inequality M\<^sub>0 \ A t) + thus ?case + using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append sem\<^sub>e\<^sub>s\<^sub>t_d.Inequality[OF Inequality.IH] sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct + by auto +next + case Decompose thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto +qed auto + +private lemma sem\<^sub>e\<^sub>s\<^sub>t_c_decomps\<^sub>e\<^sub>s\<^sub>t_append: + assumes "sem\<^sub>e\<^sub>s\<^sub>t_c {} \ A" "D \ decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \) \" + shows "sem\<^sub>e\<^sub>s\<^sub>t_c {} \ (A@D)" +using assms(2,1) +proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct) + case (Decomp D f T K M) + hence *: "sem\<^sub>e\<^sub>s\<^sub>t_c {} \ (A @ D)" "ik\<^sub>e\<^sub>s\<^sub>t (A@D) \ {} \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c Fun f T \ \" + "\k. k \ set K \ ik\<^sub>e\<^sub>s\<^sub>t (A @ D) \ {} \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c k \ \" + using ik\<^sub>e\<^sub>s\<^sub>t_append by auto + show ?case using sem\<^sub>e\<^sub>s\<^sub>t_c.Decompose[OF *(1,2) Decomp.hyps(3) *(3)] by simp +qed auto + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_preserves_wf: + assumes "D \ decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \" "wf\<^sub>e\<^sub>s\<^sub>t V A" + shows "wf\<^sub>e\<^sub>s\<^sub>t V (A@D)" +using assms +proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct) + case (Decomp D f T K M) + have "wfrestrictedvars\<^sub>s\<^sub>t (decomp (Fun f T)) \ fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)" + using decomp_vars fv_subset_subterms[OF Decomp.hyps(2)] by fast + hence "wfrestrictedvars\<^sub>s\<^sub>t (decomp (Fun f T)) \ wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A" + using ik\<^sub>s\<^sub>t_assignment_rhs\<^sub>s\<^sub>t_wfrestrictedvars_subset[of "to_st A"] by blast + hence "wfrestrictedvars\<^sub>s\<^sub>t (decomp (Fun f T)) \ wfrestrictedvars\<^sub>s\<^sub>t (to_st (A@D)) \ V" + using to_st_append[of A D] strand_vars_split(2)[of "to_st A" "to_st D"] + by (metis le_supI1) + thus ?case + using wf_append_suffix[OF Decomp.IH[OF Decomp.prems], of "decomp (Fun f T)"] + to_st_append[of "A@D" "[Decomp (Fun f T)]"] + by auto +qed auto + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_preserves_model_c: + assumes "D \ decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \" "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ A" + shows "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \ (A@D)" +using assms +proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct) + case (Decomp D f T K M) show ?case + using sem\<^sub>e\<^sub>s\<^sub>t_c.Decompose[OF Decomp.IH[OF Decomp.prems] _ Decomp.hyps(3)] + Decomp.hyps(5,6) ideduct_synth_mono ik\<^sub>e\<^sub>s\<^sub>t_append + by (metis (mono_tags, lifting) List.append_assoc image_Un sup_ge1) +qed auto + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_exist_aux: + assumes "D \ decomps\<^sub>e\<^sub>s\<^sub>t M N \" "M \ ik\<^sub>e\<^sub>s\<^sub>t D \ t" "\(M \ (ik\<^sub>e\<^sub>s\<^sub>t D) \\<^sub>c t)" + obtains D' where + "D@D' \ decomps\<^sub>e\<^sub>s\<^sub>t M N \" "M \ ik\<^sub>e\<^sub>s\<^sub>t (D@D') \\<^sub>c t" "M \ ik\<^sub>e\<^sub>s\<^sub>t D \ M \ ik\<^sub>e\<^sub>s\<^sub>t (D@D')" +proof - + have "\D' \ decomps\<^sub>e\<^sub>s\<^sub>t M N \. M \ ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>c t" using assms(2) + proof (induction t rule: intruder_deduct_induct) + case (Compose X f) + from Compose.IH have "\D \ decomps\<^sub>e\<^sub>s\<^sub>t M N \. \x \ set X. M \ ik\<^sub>e\<^sub>s\<^sub>t D \\<^sub>c x" + proof (induction X) + case (Cons t X) + then obtain D' D'' where + D': "D' \ decomps\<^sub>e\<^sub>s\<^sub>t M N \" "M \ ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>c t" and + D'': "D'' \ decomps\<^sub>e\<^sub>s\<^sub>t M N \" "\x \ set X. M \ ik\<^sub>e\<^sub>s\<^sub>t D'' \\<^sub>c x" + by moura + hence "M \ ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \\<^sub>c t" "\x \ set X. M \ ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \\<^sub>c x" + by (auto intro: ideduct_synth_mono simp add: ik\<^sub>e\<^sub>s\<^sub>t_append) + thus ?case using decomps\<^sub>e\<^sub>s\<^sub>t_append[OF D'(1) D''(1)] by (metis set_ConsD) + qed (auto intro: decomps\<^sub>e\<^sub>s\<^sub>t.Nil) + thus ?case using intruder_synth.ComposeC[OF Compose.hyps(1,2)] by metis + next + case (Decompose t K T t\<^sub>i) + have "\D \ decomps\<^sub>e\<^sub>s\<^sub>t M N \. \k \ set K. M \ ik\<^sub>e\<^sub>s\<^sub>t D \\<^sub>c k" using Decompose.IH + proof (induction K) + case (Cons t X) + then obtain D' D'' where + D': "D' \ decomps\<^sub>e\<^sub>s\<^sub>t M N \" "M \ ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>c t" and + D'': "D'' \ decomps\<^sub>e\<^sub>s\<^sub>t M N \" "\x \ set X. M \ ik\<^sub>e\<^sub>s\<^sub>t D'' \\<^sub>c x" + using assms(1) by moura + hence "M \ ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \\<^sub>c t" "\x \ set X. M \ ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \\<^sub>c x" + by (auto intro: ideduct_synth_mono simp add: ik\<^sub>e\<^sub>s\<^sub>t_append) + thus ?case using decomps\<^sub>e\<^sub>s\<^sub>t_append[OF D'(1) D''(1)] by auto + qed auto + then obtain D' where D': "D' \ decomps\<^sub>e\<^sub>s\<^sub>t M N \" "\k. k \ set K \ M \ ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>c k" by metis + obtain D'' where D'': "D'' \ decomps\<^sub>e\<^sub>s\<^sub>t M N \" "M \ ik\<^sub>e\<^sub>s\<^sub>t D'' \\<^sub>c t" by (metis Decompose.IH(1)) + obtain f X where fX: "t = Fun f X" "t\<^sub>i \ set X" + using Decompose.hyps(2,4) by (cases t) (auto dest: Ana_fun_subterm) + + from decomps\<^sub>e\<^sub>s\<^sub>t_append[OF D'(1) D''(1)] D'(2) D''(2) have *: + "D'@D'' \ decomps\<^sub>e\<^sub>s\<^sub>t M N \" "\k. k \ set K \ M \ ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \\<^sub>c k" + "M \ ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \\<^sub>c t" + by (auto intro: ideduct_synth_mono simp add: ik\<^sub>e\<^sub>s\<^sub>t_append) + hence **: "\k. k \ set K \ M \ ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c k \ \" + using ideduct_synth_subst by auto + + have "t\<^sub>i \ ik\<^sub>s\<^sub>t (decomp t)" using Decompose.hyps(2,4) ik_rcv_map unfolding decomp_def by auto + with *(3) fX(1) Decompose.hyps(2) show ?case + proof (induction t rule: intruder_synth_induct) + case (AxiomC t) + hence t_in_subterms: "t \ subterms\<^sub>s\<^sub>e\<^sub>t (M \ N)" + using decomps\<^sub>e\<^sub>s\<^sub>t_ik_subset[OF *(1)] subset_subterms_Union + by auto + have "M \ ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \" + using ideduct_synth_subst[OF intruder_synth.AxiomC[OF AxiomC.hyps(1)]] by metis + moreover have "T \ []" using decomp_ik[OF \Ana t = (K,T)\] \t\<^sub>i \ ik\<^sub>s\<^sub>t (decomp t)\ by auto + ultimately have "D'@D''@[Decomp (Fun f X)] \ decomps\<^sub>e\<^sub>s\<^sub>t M N \" + using AxiomC decomps\<^sub>e\<^sub>s\<^sub>t.Decomp[OF *(1) _ _ _ _ **] subset_subterms_Union t_in_subterms + by (simp add: subset_eq) + moreover have "decomp t = to_st [Decomp (Fun f X)]" using AxiomC.prems(1,2) by auto + ultimately show ?case + by (metis AxiomC.prems(3) UnCI intruder_synth.AxiomC ik\<^sub>e\<^sub>s\<^sub>t_append to_st_append) + qed (auto intro!: fX(2) *(1)) + qed (fastforce intro: intruder_synth.AxiomC assms(1)) + hence "\D' \ decomps\<^sub>e\<^sub>s\<^sub>t M N \. M \ ik\<^sub>e\<^sub>s\<^sub>t (D@D') \\<^sub>c t" + by (auto intro: ideduct_synth_mono simp add: ik\<^sub>e\<^sub>s\<^sub>t_append) + thus thesis using that[OF decomps\<^sub>e\<^sub>s\<^sub>t_append[OF assms(1)]] assms ik\<^sub>e\<^sub>s\<^sub>t_append by moura +qed + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_ik_max_exist: + assumes "finite A" "finite N" + shows "\D \ decomps\<^sub>e\<^sub>s\<^sub>t A N \. \D' \ decomps\<^sub>e\<^sub>s\<^sub>t A N \. ik\<^sub>e\<^sub>s\<^sub>t D' \ ik\<^sub>e\<^sub>s\<^sub>t D" +proof - + let ?IK = "\M. \D \ M. ik\<^sub>e\<^sub>s\<^sub>t D" + have "?IK (decomps\<^sub>e\<^sub>s\<^sub>t A N \) \ (\t \ A \ N. subterms t)" by (auto dest!: decomps\<^sub>e\<^sub>s\<^sub>t_ik_subset) + hence "finite (?IK (decomps\<^sub>e\<^sub>s\<^sub>t A N \))" + using subterms_union_finite[OF assms(1)] subterms_union_finite[OF assms(2)] infinite_super + by auto + then obtain M where M: "finite M" "M \ decomps\<^sub>e\<^sub>s\<^sub>t A N \" "?IK M = ?IK (decomps\<^sub>e\<^sub>s\<^sub>t A N \)" + using finite_subset_Union by moura + show ?thesis using decomps\<^sub>e\<^sub>s\<^sub>t_finite_ik_append[OF M(1,2)] M(3) by auto +qed + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_exist: + assumes "finite A" "finite N" + shows "\D \ decomps\<^sub>e\<^sub>s\<^sub>t A N \. \t. A \ t \ A \ ik\<^sub>e\<^sub>s\<^sub>t D \\<^sub>c t" +proof (rule ccontr) + assume neg: "\(\D \ decomps\<^sub>e\<^sub>s\<^sub>t A N \. \t. A \ t \ A \ ik\<^sub>e\<^sub>s\<^sub>t D \\<^sub>c t)" + + obtain D where D: "D \ decomps\<^sub>e\<^sub>s\<^sub>t A N \" "\D' \ decomps\<^sub>e\<^sub>s\<^sub>t A N \. ik\<^sub>e\<^sub>s\<^sub>t D' \ ik\<^sub>e\<^sub>s\<^sub>t D" + using decomps\<^sub>e\<^sub>s\<^sub>t_ik_max_exist[OF assms] by moura + then obtain t where t: "A \ ik\<^sub>e\<^sub>s\<^sub>t D \ t" "\(A \ ik\<^sub>e\<^sub>s\<^sub>t D \\<^sub>c t)" + using neg by (fastforce intro: ideduct_mono) + + obtain D' where D': + "D@D' \ decomps\<^sub>e\<^sub>s\<^sub>t A N \" "A \ ik\<^sub>e\<^sub>s\<^sub>t (D@D') \\<^sub>c t" + "A \ ik\<^sub>e\<^sub>s\<^sub>t D \ A \ ik\<^sub>e\<^sub>s\<^sub>t (D@D')" + by (metis decomps\<^sub>e\<^sub>s\<^sub>t_exist_aux t D(1)) + hence "ik\<^sub>e\<^sub>s\<^sub>t D \ ik\<^sub>e\<^sub>s\<^sub>t (D@D')" using ik\<^sub>e\<^sub>s\<^sub>t_append by auto + moreover have "ik\<^sub>e\<^sub>s\<^sub>t (D@D') \ ik\<^sub>e\<^sub>s\<^sub>t D" using D(2) D'(1) by auto + ultimately show False by simp +qed + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_exist_subst: + assumes "ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" + and "sem\<^sub>e\<^sub>s\<^sub>t_c {} \ A" "wf\<^sub>e\<^sub>s\<^sub>t {} A" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + and "Ana_invar_subst (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)" + and "well_analyzed A" + shows "\D \ decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \. ik\<^sub>e\<^sub>s\<^sub>t (A@D) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \" +proof - + have ik_eq: "ik\<^sub>e\<^sub>s\<^sub>t (A \\<^sub>e\<^sub>s\<^sub>t \) = ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \" using assms(5,6) + proof (induction A rule: List.rev_induct) + case (snoc a A) + hence "Ana_invar_subst (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)" + using Ana_invar_subst_subset[OF snoc.prems(1)] ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append + unfolding Ana_invar_subst_def by simp + with snoc have IH: + "ik\<^sub>e\<^sub>s\<^sub>t (A@[a] \\<^sub>e\<^sub>s\<^sub>t \) = (ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ ik\<^sub>e\<^sub>s\<^sub>t ([a] \\<^sub>e\<^sub>s\<^sub>t \)" + "ik\<^sub>e\<^sub>s\<^sub>t (A@[a]) \\<^sub>s\<^sub>e\<^sub>t \ = (ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t [a] \\<^sub>s\<^sub>e\<^sub>t \)" + using well_analyzed_split_left[OF snoc.prems(2)] + by (auto simp add: to_st_append ik\<^sub>e\<^sub>s\<^sub>t_append_subst) + + have "ik\<^sub>e\<^sub>s\<^sub>t [a \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \] = ik\<^sub>e\<^sub>s\<^sub>t [a] \\<^sub>s\<^sub>e\<^sub>t \" + proof (cases a) + case (Step b) thus ?thesis by (cases b) auto + next + case (Decomp t) + then obtain f T where t: "t = Fun f T" using well_analyzedD[OF snoc.prems(2)] by force + obtain K M where Ana_t: "Ana (Fun f T) = (K,M)" by (metis surj_pair) + moreover have "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t ((ik\<^sub>e\<^sub>s\<^sub>t (A@[a]) \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@[a])))" + using t Decomp snoc.prems(2) + by (auto dest: well_analyzed_inv simp add: ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append) + hence "Ana (Fun f T \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" + using Ana_t snoc.prems(1) + unfolding Ana_invar_subst_def by force + ultimately show ?thesis using Decomp t by (auto simp add: decomp_ik) + qed + thus ?case using IH unfolding subst_apply_extstrand_def by simp + qed simp + moreover have assignment_rhs_eq: "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A \\<^sub>e\<^sub>s\<^sub>t \) = assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \" + using assms(5,6) + proof (induction A rule: List.rev_induct) + case (snoc a A) + hence "Ana_invar_subst (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)" + using Ana_invar_subst_subset[OF snoc.prems(1)] ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append + unfolding Ana_invar_subst_def by simp + hence "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A \\<^sub>e\<^sub>s\<^sub>t \) = assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \" + using snoc.IH well_analyzed_split_left[OF snoc.prems(2)] + by simp + hence IH: + "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@[a] \\<^sub>e\<^sub>s\<^sub>t \) = (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t ([a] \\<^sub>e\<^sub>s\<^sub>t \)" + "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@[a]) \\<^sub>s\<^sub>e\<^sub>t \ = (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t [a] \\<^sub>s\<^sub>e\<^sub>t \)" + by (metis assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append_subst(1), metis assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append_subst(2)) + + have "assignment_rhs\<^sub>e\<^sub>s\<^sub>t [a \\<^sub>e\<^sub>s\<^sub>t\<^sub>p \] = assignment_rhs\<^sub>e\<^sub>s\<^sub>t [a] \\<^sub>s\<^sub>e\<^sub>t \" + proof (cases a) + case (Step b) thus ?thesis by (cases b) auto + next + case (Decomp t) + then obtain f T where t: "t = Fun f T" using well_analyzedD[OF snoc.prems(2)] by force + obtain K M where Ana_t: "Ana (Fun f T) = (K,M)" by (metis surj_pair) + moreover have "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t ((ik\<^sub>e\<^sub>s\<^sub>t (A@[a]) \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@[a])))" + using t Decomp snoc.prems(2) + by (auto dest: well_analyzed_inv simp add: ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append) + hence "Ana (Fun f T \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" + using Ana_t snoc.prems(1) unfolding Ana_invar_subst_def by force + ultimately show ?thesis using Decomp t by (auto simp add: decomp_assignment_rhs_empty) + qed + thus ?case using IH unfolding subst_apply_extstrand_def by simp + qed simp + ultimately obtain D where D: + "D \ decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) Var" + "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t D) \\<^sub>c t \ \" + using decomps\<^sub>e\<^sub>s\<^sub>t_exist[OF ik\<^sub>e\<^sub>s\<^sub>t_finite assignment_rhs\<^sub>e\<^sub>s\<^sub>t_finite, of "A \\<^sub>e\<^sub>s\<^sub>t \" "A \\<^sub>e\<^sub>s\<^sub>t \"] + ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append assms(1) + by force + + let ?P = "\D D'. \t. (ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t D) \\<^sub>c t \ (ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>c t" + + have "\D' \ decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \. ?P D D'" using D(1) + proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct) + case Nil + have "ik\<^sub>e\<^sub>s\<^sub>t [] = ik\<^sub>e\<^sub>s\<^sub>t [] \\<^sub>s\<^sub>e\<^sub>t \" by auto + thus ?case by (metis decomps\<^sub>e\<^sub>s\<^sub>t.Nil) + next + case (Decomp D f T K M) + obtain D' where D': "D' \ decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \" "?P D D'" + using Decomp.IH by auto + hence IH: "\k. k \ set K \ (ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>c k" + "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>c Fun f T" + using Decomp.hyps(5,6) by auto + + have D'_ik: "ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \ \ subterms\<^sub>s\<^sub>e\<^sub>t ((ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)) \\<^sub>s\<^sub>e\<^sub>t \" + "ik\<^sub>e\<^sub>s\<^sub>t D' \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)" + using decomps\<^sub>e\<^sub>s\<^sub>t_ik_subset[OF D'(1)] by (metis subst_all_mono, metis) + + show ?case using IH(2,1) Decomp.hyps(2,3,4) + proof (induction "Fun f T" arbitrary: f T K M rule: intruder_synth_induct) + case (AxiomC f T) + then obtain s where s: "s \ ik\<^sub>e\<^sub>s\<^sub>t A \ ik\<^sub>e\<^sub>s\<^sub>t D'" "Fun f T = s \ \" using AxiomC.prems by blast + hence fT_s_in: "Fun f T \ (subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)) \\<^sub>s\<^sub>e\<^sub>t \" + "s \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)" + using AxiomC D'_ik subset_subterms_Union[of "ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A"] + subst_all_mono[OF subset_subterms_Union, of \] + by (metis (no_types) Un_iff image_eqI subset_Un_eq, metis (no_types) Un_iff subset_Un_eq) + obtain Ks Ms where Ana_s: "Ana s = (Ks,Ms)" by moura + + have AD'_props: "wf\<^sub>e\<^sub>s\<^sub>t {} (A@D')" "\{}; to_st (A@D')\\<^sub>c \" + using decomps\<^sub>e\<^sub>s\<^sub>t_preserves_model_c[OF D'(1) assms(2)] + decomps\<^sub>e\<^sub>s\<^sub>t_preserves_wf[OF D'(1) assms(3)] + sem\<^sub>e\<^sub>s\<^sub>t_c_eq_sem_st strand_sem_eq_defs(1) + by auto + + show ?case + proof (cases s) + case (Var x) + \ \In this case \\ x\ (is a subterm of something that) was derived from an + "earlier intruder knowledge" because \A\ is well-formed and has \\\ as a model. + So either the intruder composed \Fun f T\ himself (making \Decomp (Fun f T)\ + unnecessary) or \Fun f T\ is an instance of something else in the intruder + knowledge (in which case the "something" can be used in place of \Fun f T\)\ + hence "Var x \ ik\<^sub>e\<^sub>s\<^sub>t (A@D')" "\ x = Fun f T" using s ik\<^sub>e\<^sub>s\<^sub>t_append by auto + + show ?thesis + proof (cases "\m \ set M. ik\<^sub>e\<^sub>s\<^sub>t A \ ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c m") + case True + \ \All terms acquired by decomposing \Fun f T\ are already derivable. + Hence there is no need to consider decomposition of \Fun f T\ at all.\ + have *: "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ ik\<^sub>e\<^sub>s\<^sub>t (D@[Decomp (Fun f T)]) = (ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ ik\<^sub>e\<^sub>s\<^sub>t D \ set M" + using decomp_ik[OF \Ana (Fun f T) = (K,M)\] ik\<^sub>e\<^sub>s\<^sub>t_append[of D "[Decomp (Fun f T)]"] + by auto + + { fix t' assume "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ ik\<^sub>e\<^sub>s\<^sub>t D \ set M \\<^sub>c t'" + hence "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>c t'" + proof (induction t' rule: intruder_synth_induct) + case (AxiomC t') thus ?case + proof + assume "t' \ set M" + moreover have "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \) = ik\<^sub>e\<^sub>s\<^sub>t A \ ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \" by auto + ultimately show ?case using True by auto + qed (metis D'(2) intruder_synth.AxiomC) + qed auto + } + thus ?thesis using D'(1) * by metis + next + case False + \ \Some term acquired by decomposition of \Fun f T\ cannot be derived in \\\<^sub>c\. + \Fun f T\ must therefore be an instance of something else in the intruder knowledge, + because of well-formedness.\ + then obtain t\<^sub>i where t\<^sub>i: "t\<^sub>i \ set T" "\ik\<^sub>e\<^sub>s\<^sub>t (A@D') \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t\<^sub>i" + using Ana_fun_subterm[OF \Ana (Fun f T) = (K,M)\] by (auto simp add: ik\<^sub>e\<^sub>s\<^sub>t_append) + obtain S where fS: + "Fun f S \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t (A@D')) \ + Fun f S \ subterms\<^sub>s\<^sub>e\<^sub>t (assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@D'))" + "\ x = Fun f S \ \" + using strand_sem_wf_ik_or_assignment_rhs_fun_subterm[ + OF AD'_props \Var x \ ik\<^sub>e\<^sub>s\<^sub>t (A@D')\ _ t\<^sub>i \interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\] + \\ x = Fun f T\ + by moura + hence fS_in: "Fun f S \ \ \ ik\<^sub>e\<^sub>s\<^sub>t A \ ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \" + "Fun f S \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)" + using imageI[OF s(1), of "\x. x \ \"] Var + ik\<^sub>e\<^sub>s\<^sub>t_append[of A D'] assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append[of A D'] + decomps\<^sub>e\<^sub>s\<^sub>t_subterms[OF D'(1)] decomps\<^sub>e\<^sub>s\<^sub>t_assignment_rhs_empty[OF D'(1)] + by auto + obtain KS MS where Ana_fS: "Ana (Fun f S) = (KS, MS)" by moura + hence "K = KS \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \" "M = MS \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \" + using Ana_invar_substD[OF assms(5) fS_in(2)] + s(2) fS(2) \s = Var x\ \Ana (Fun f T) = (K,M)\ + by simp_all + hence "MS \ []" using \M \ []\ by simp + have "\k. k \ set KS \ ik\<^sub>e\<^sub>s\<^sub>t A \ ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c k \ \" + using AxiomC.prems(1) \K = KS \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \\ by (simp add: image_Un) + hence D'': "D'@[Decomp (Fun f S)] \ decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \" + using decomps\<^sub>e\<^sub>s\<^sub>t.Decomp[OF D'(1) fS_in(2) Ana_fS \MS \ []\] AxiomC.prems(1) + intruder_synth.AxiomC[OF fS_in(1)] + by simp + moreover { + fix t' assume "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ ik\<^sub>e\<^sub>s\<^sub>t (D@[Decomp (Fun f T)]) \\<^sub>c t'" + hence "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t (D'@[Decomp (Fun f S)]) \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>c t'" + proof (induction t' rule: intruder_synth_induct) + case (AxiomC t') + hence "t' \ (ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ ik\<^sub>e\<^sub>s\<^sub>t D \ t' \ ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f T)]" + by (simp add: ik\<^sub>e\<^sub>s\<^sub>t_append) + thus ?case + proof + assume "t' \ ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f T)]" + hence "t' \ ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f S)] \\<^sub>s\<^sub>e\<^sub>t \" + using decomp_ik \Ana (Fun f T) = (K,M)\ \Ana (Fun f S) = (KS,MS)\ \M = MS \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \\ + by simp + thus ?case + using ideduct_synth_mono[ + OF intruder_synth.AxiomC[of t' "ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f S)] \\<^sub>s\<^sub>e\<^sub>t \"], + of "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t (D'@[Decomp (Fun f S)]) \\<^sub>s\<^sub>e\<^sub>t \)"] + by (auto simp add: ik\<^sub>e\<^sub>s\<^sub>t_append) + next + assume "t' \ (ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ ik\<^sub>e\<^sub>s\<^sub>t D" + hence "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>c t'" + by (metis D'(2) intruder_synth.AxiomC) + hence "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f S)] \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>c t'" + by (simp add: ideduct_synth_mono) + thus ?case + using ik\<^sub>e\<^sub>s\<^sub>t_append[of D' "[Decomp (Fun f S)]"] + image_Un[of "\x. x \ \" "ik\<^sub>e\<^sub>s\<^sub>t D'" "ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f S)]"] + by (simp add: sup_aci(2)) + qed + qed auto + } + ultimately show ?thesis using D'' by auto + qed + next + case (Fun g S) \ \Hence \Decomp (Fun f T)\ can be substituted for \Decomp (Fun g S)\\ + hence KM: "K = Ks \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \" "M = Ms \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \" "set K = set Ks \\<^sub>s\<^sub>e\<^sub>t \" "set M = set Ms \\<^sub>s\<^sub>e\<^sub>t \" + using fT_s_in(2) \Ana (Fun f T) = (K,M)\ Ana_s s(2) + Ana_invar_substD[OF assms(5), of g S] + by auto + hence Ms_nonempty: "Ms \ []" using \M \ []\ by auto + { fix t' assume "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ ik\<^sub>e\<^sub>s\<^sub>t (D@[Decomp (Fun f T)]) \\<^sub>c t'" + hence "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t (D'@[Decomp (Fun g S)]) \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>c t'" using AxiomC + proof (induction t' rule: intruder_synth_induct) + case (AxiomC t') + hence "t' \ ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \ \ t' \ ik\<^sub>e\<^sub>s\<^sub>t D \ t' \ set M" + by (simp add: decomp_ik ik\<^sub>e\<^sub>s\<^sub>t_append) + thus ?case + proof (elim disjE) + assume "t' \ ik\<^sub>e\<^sub>s\<^sub>t D" + hence *: "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>c t'" using D'(2) by simp + show ?case by (auto intro: ideduct_synth_mono[OF *] simp add: ik\<^sub>e\<^sub>s\<^sub>t_append_subst(2)) + next + assume "t' \ set M" + hence "t' \ ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun g S)] \\<^sub>s\<^sub>e\<^sub>t \" + using KM(2) Fun decomp_ik[OF Ana_s] by auto + thus ?case by (simp add: image_Un ik\<^sub>e\<^sub>s\<^sub>t_append) + qed (simp add: ideduct_synth_mono[OF intruder_synth.AxiomC]) + qed auto + } + thus ?thesis + using s Fun Ana_s AxiomC.prems(1) KM(3) fT_s_in + decomps\<^sub>e\<^sub>s\<^sub>t.Decomp[OF D'(1) _ _ Ms_nonempty, of g S Ks] + by (metis AxiomC.hyps image_Un image_eqI intruder_synth.AxiomC) + qed + next + case (ComposeC T f) + have *: "\m. m \ set M \ (ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>c m" + using Ana_fun_subterm[OF \Ana (Fun f T) = (K, M)\] ComposeC.hyps(3) + by auto + + have **: "ik\<^sub>e\<^sub>s\<^sub>t (D@[Decomp (Fun f T)]) = ik\<^sub>e\<^sub>s\<^sub>t D \ set M" + using decomp_ik[OF \Ana (Fun f T) = (K, M)\] ik\<^sub>e\<^sub>s\<^sub>t_append by auto + + { fix t' assume "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ ik\<^sub>e\<^sub>s\<^sub>t (D@[Decomp (Fun f T)]) \\<^sub>c t'" + hence "(ik\<^sub>e\<^sub>s\<^sub>t A \\<^sub>s\<^sub>e\<^sub>t \) \ (ik\<^sub>e\<^sub>s\<^sub>t D' \\<^sub>s\<^sub>e\<^sub>t \) \\<^sub>c t'" + by (induct rule: intruder_synth_induct) (auto simp add: D'(2) * **) + } + thus ?case using D'(1) by auto + qed + qed + thus ?thesis using D(2) assms(1) by (auto simp add: ik\<^sub>e\<^sub>s\<^sub>t_append_subst(2)) +qed + +private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_nil: assumes "wf\<^sub>s\<^sub>t\<^sub>s' \ \" shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \ []) \" +using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto + +private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_snd: + assumes "wf\<^sub>s\<^sub>t\<^sub>s' \ \" "send\t\\<^sub>s\<^sub>t#S \ \" + shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \ (send\t\\<^sub>s\<^sub>t#S)) (\@[Step (receive\t\\<^sub>s\<^sub>t)])" +unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def +proof (intro conjI) + let ?S = "send\t\\<^sub>s\<^sub>t#S" + let ?A = "\@[Step (receive\t\\<^sub>s\<^sub>t)]" + + have \: "\S'. S' \ update\<^sub>s\<^sub>t \ ?S \ S' = S \ S' \ \" by auto + + have 1: "\S \ \. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \) (dual\<^sub>s\<^sub>t S)" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto + moreover have 2: "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \ \ fv t" + using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2) by (auto simp add: Un_assoc) + ultimately have 3: "\S \ \. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis wf_vars_mono) + + have 4: "\S \ \. \S' \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by simp + + have "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" using 1 2 3 assms(2) by auto + thus "\S \ update\<^sub>s\<^sub>t \ ?S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis 3 \) + + have "fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S = {}" + "\S' \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}" + "\S' \ \. fv\<^sub>s\<^sub>t S' \ bvars\<^sub>s\<^sub>t S = {}" + using 4 assms(2) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by force+ + thus "\S \ update\<^sub>s\<^sub>t \ ?S. \S' \ update\<^sub>s\<^sub>t \ ?S. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}" by (metis 4 \) + + have "\S' \ \. fv\<^sub>s\<^sub>t ?S \ bvars\<^sub>s\<^sub>t S' = {}" "\S' \ \. fv\<^sub>s\<^sub>t S' \ bvars\<^sub>s\<^sub>t ?S = {}" + using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by metis+ + hence 5: "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \ \ fv t" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = bvars\<^sub>e\<^sub>s\<^sub>t \" "\S' \ \. fv t \ bvars\<^sub>s\<^sub>t S' = {}" + using to_st_append by fastforce+ + + have *: "\S \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" + using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast + hence "fv\<^sub>s\<^sub>t ?S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using assms(2) by metis + hence "fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by auto + thus "\S \ update\<^sub>s\<^sub>t \ ?S. fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by (metis * \) + + have **: "\S \ \. fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t S = {}" + using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast + hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t ?S = {}" using assms(2) by metis + hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t S = {}" by fastforce + thus "\S \ update\<^sub>s\<^sub>t \ ?S. fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t S = {}" by (metis ** \) +qed + +private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_rcv: + assumes "wf\<^sub>s\<^sub>t\<^sub>s' \ \" "receive\t\\<^sub>s\<^sub>t#S \ \" + shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \ (receive\t\\<^sub>s\<^sub>t#S)) (\@[Step (send\t\\<^sub>s\<^sub>t)])" +unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def +proof (intro conjI) + let ?S = "receive\t\\<^sub>s\<^sub>t#S" + let ?A = "\@[Step (send\t\\<^sub>s\<^sub>t)]" + + have \: "\S'. S' \ update\<^sub>s\<^sub>t \ ?S \ S' = S \ S' \ \" by auto + + have 1: "\S \ \. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \) (dual\<^sub>s\<^sub>t S)" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto + moreover have 2: "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \ \ fv t" + using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2) by (auto simp add: Un_assoc) + ultimately have 3: "\S \ \. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis wf_vars_mono) + + have 4: "\S \ \. \S' \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by simp + + have "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" using 1 2 3 assms(2) by auto + thus "\S \ update\<^sub>s\<^sub>t \ ?S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis 3 \) + + have "fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S = {}" + "\S' \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}" + "\S' \ \. fv\<^sub>s\<^sub>t S' \ bvars\<^sub>s\<^sub>t S = {}" + using 4 assms(2) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by force+ + thus "\S \ update\<^sub>s\<^sub>t \ ?S. \S' \ update\<^sub>s\<^sub>t \ ?S. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}" by (metis 4 \) + + have "\S' \ \. fv\<^sub>s\<^sub>t ?S \ bvars\<^sub>s\<^sub>t S' = {}" "\S' \ \. fv\<^sub>s\<^sub>t S' \ bvars\<^sub>s\<^sub>t ?S = {}" + using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by metis+ + hence 5: "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \ \ fv t" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = bvars\<^sub>e\<^sub>s\<^sub>t \" "\S' \ \. fv t \ bvars\<^sub>s\<^sub>t S' = {}" + using to_st_append by fastforce+ + + have *: "\S \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" + using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast + hence "fv\<^sub>s\<^sub>t ?S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using assms(2) by metis + hence "fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by auto + thus "\S \ update\<^sub>s\<^sub>t \ ?S. fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by (metis * \) + + have **: "\S \ \. fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t S = {}" + using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast + hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t ?S = {}" using assms(2) by metis + hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t S = {}" by fastforce + thus "\S \ update\<^sub>s\<^sub>t \ ?S. fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t S = {}" by (metis ** \) +qed + +private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_eq: + assumes "wf\<^sub>s\<^sub>t\<^sub>s' \ \" "\a: t \ t'\\<^sub>s\<^sub>t#S \ \" + shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \ (\a: t \ t'\\<^sub>s\<^sub>t#S)) (\@[Step (\a: t \ t'\\<^sub>s\<^sub>t)])" +unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def +proof (intro conjI) + let ?S = "\a: t \ t'\\<^sub>s\<^sub>t#S" + let ?A = "\@[Step (\a: t \ t'\\<^sub>s\<^sub>t)]" + + have \: "\S'. S' \ update\<^sub>s\<^sub>t \ ?S \ S' = S \ S' \ \" by auto + + have 1: "\S \ \. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \) (dual\<^sub>s\<^sub>t S)" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto + moreover have 2: + "a = Assign \ wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \ \ fv t \ fv t'" + "a = Check \ wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \" + using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2) by (auto simp add: Un_assoc) + ultimately have 3: "\S \ \. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" + by (cases a) (metis wf_vars_mono, metis) + + have 4: "\S \ \. \S' \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by simp + + have "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" using 1 2 3 assms(2) by (cases a) auto + thus "\S \ update\<^sub>s\<^sub>t \ ?S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis 3 \) + + have "fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S = {}" + "\S' \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}" + "\S' \ \. fv\<^sub>s\<^sub>t S' \ bvars\<^sub>s\<^sub>t S = {}" + using 4 assms(2) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by force+ + thus "\S \ update\<^sub>s\<^sub>t \ ?S. \S' \ update\<^sub>s\<^sub>t \ ?S. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}" by (metis 4 \) + + have "\S' \ \. fv\<^sub>s\<^sub>t ?S \ bvars\<^sub>s\<^sub>t S' = {}" "\S' \ \. fv\<^sub>s\<^sub>t S' \ bvars\<^sub>s\<^sub>t ?S = {}" + using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by metis+ + hence 5: "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \ \ fv t \ fv t'" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = bvars\<^sub>e\<^sub>s\<^sub>t \" + "\S' \ \. fv t \ bvars\<^sub>s\<^sub>t S' = {}" "\S' \ \. fv t' \ bvars\<^sub>s\<^sub>t S' = {}" + using to_st_append by fastforce+ + + have *: "\S \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" + using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast + hence "fv\<^sub>s\<^sub>t ?S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using assms(2) by metis + hence "fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by auto + thus "\S \ update\<^sub>s\<^sub>t \ ?S. fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by (metis * \) + + have **: "\S \ \. fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t S = {}" + using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast + hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t ?S = {}" using assms(2) by metis + hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t S = {}" by fastforce + thus "\S \ update\<^sub>s\<^sub>t \ ?S. fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t S = {}" by (metis ** \) +qed + +private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_ineq: + assumes "wf\<^sub>s\<^sub>t\<^sub>s' \ \" "\X\\\: F\\<^sub>s\<^sub>t#S \ \" + shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \ (\X\\\: F\\<^sub>s\<^sub>t#S)) (\@[Step (\X\\\: F\\<^sub>s\<^sub>t)])" +unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def +proof (intro conjI) + let ?S = "\X\\\: F\\<^sub>s\<^sub>t#S" + let ?A = "\@[Step (\X\\\: F\\<^sub>s\<^sub>t)]" + + have \: "\S'. S' \ update\<^sub>s\<^sub>t \ ?S \ S' = S \ S' \ \" by auto + + have 1: "\S \ \. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \) (dual\<^sub>s\<^sub>t S)" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto + moreover have 2: "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \" + using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2) by (auto simp add: Un_assoc) + ultimately have 3: "\S \ \. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by metis + + have 4: "\S \ \. \S' \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by simp + + have "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" using 1 2 3 assms(2) by auto + thus "\S \ update\<^sub>s\<^sub>t \ ?S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis 3 \) + + have "fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S = {}" + "\S' \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}" + "\S' \ \. fv\<^sub>s\<^sub>t S' \ bvars\<^sub>s\<^sub>t S = {}" + using 4 assms(2) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by force+ + thus "\S \ update\<^sub>s\<^sub>t \ ?S. \S' \ update\<^sub>s\<^sub>t \ ?S. fv\<^sub>s\<^sub>t S \ bvars\<^sub>s\<^sub>t S' = {}" by (metis 4 \) + + have "\S' \ \. fv\<^sub>s\<^sub>t ?S \ bvars\<^sub>s\<^sub>t S' = {}" "\S' \ \. fv\<^sub>s\<^sub>t S' \ bvars\<^sub>s\<^sub>t ?S = {}" + using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by metis+ + moreover have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \ fv\<^sub>s\<^sub>t (\X\\\: F\\<^sub>s\<^sub>t # S)" by auto + ultimately have 5: + "\S' \ \. (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X) \ bvars\<^sub>s\<^sub>t S' = {}" + "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \ \ (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X)" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = set X \ bvars\<^sub>e\<^sub>s\<^sub>t \" + "\S \ \. fv\<^sub>s\<^sub>t S \ set X = {}" + using to_st_append + by (blast, force, force, force) + + have *: "\S \ \. fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using 5(3,4) assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by blast + hence "fv\<^sub>s\<^sub>t ?S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using assms(2) by metis + hence "fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by auto + thus "\S \ update\<^sub>s\<^sub>t \ ?S. fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by (metis * \) + + have **: "\S \ \. fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t S = {}" + using 5(1,2) assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast + hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t ?S = {}" using assms(2) by metis + hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t S = {}" by auto + thus "\S \ update\<^sub>s\<^sub>t \ ?S. fv\<^sub>e\<^sub>s\<^sub>t ?A \ bvars\<^sub>s\<^sub>t S = {}" by (metis ** \) +qed + +private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq: + assumes "x#S \ \" + shows "\(trms\<^sub>s\<^sub>t ` update\<^sub>s\<^sub>t \ (x#S)) \ trms\<^sub>s\<^sub>t\<^sub>p x = \(trms\<^sub>s\<^sub>t ` \)" (is "?A = ?B") +proof + show "?B \ ?A" + proof + have "trms\<^sub>s\<^sub>t\<^sub>p x \ trms\<^sub>s\<^sub>t (x#S)" by auto + hence "\t'. t' \ ?B \ t' \ trms\<^sub>s\<^sub>t\<^sub>p x \ t' \ ?A" by simp + moreover { + fix t' assume t': "t' \ ?B" "t' \ trms\<^sub>s\<^sub>t\<^sub>p x" + then obtain S' where S': "t' \ trms\<^sub>s\<^sub>t S'" "S' \ \" by auto + hence "S' = x#S \ S' \ update\<^sub>s\<^sub>t \ (x#S)" by auto + moreover { + assume "S' = x#S" + hence "t' \ trms\<^sub>s\<^sub>t S" using S' t' by simp + hence "t' \ ?A" by auto + } + ultimately have "t' \ ?A" using t' S' by auto + } + ultimately show "\t'. t' \ ?B \ t' \ ?A" by metis + qed + + show "?A \ ?B" + proof + have "\t'. t' \ ?A \ t' \ trms\<^sub>s\<^sub>t\<^sub>p x \ trms\<^sub>s\<^sub>t\<^sub>p x \ ?B" + using assms by force+ + moreover { + fix t' assume t': "t' \ ?A" "t' \ trms\<^sub>s\<^sub>t\<^sub>p x" + then obtain S' where "t' \ trms\<^sub>s\<^sub>t S'" "S' \ update\<^sub>s\<^sub>t \ (x#S)" by auto + hence "S' = S \ S' \ \" by auto + moreover have "trms\<^sub>s\<^sub>t S \ ?B" using assms trms\<^sub>s\<^sub>t_cons[of x S] by blast + ultimately have "t' \ ?B" using t' by fastforce + } + ultimately show "\t'. t' \ ?A \ t' \ ?B" by blast + qed +qed + +private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_snd: + assumes "send\t\\<^sub>s\<^sub>t#S \ \" "\' = update\<^sub>s\<^sub>t \ (send\t\\<^sub>s\<^sub>t#S)" "\' = \@[Step (receive\t\\<^sub>s\<^sub>t)]" + shows "(\(trms\<^sub>s\<^sub>t ` \)) \ (trms\<^sub>e\<^sub>s\<^sub>t \) = (\(trms\<^sub>s\<^sub>t ` \')) \ (trms\<^sub>e\<^sub>s\<^sub>t \')" +proof - + have "(trms\<^sub>e\<^sub>s\<^sub>t \') = (trms\<^sub>e\<^sub>s\<^sub>t \) \ {t}" "\(trms\<^sub>s\<^sub>t ` \') \ {t} = \(trms\<^sub>s\<^sub>t ` \)" + using to_st_append trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq[OF assms(1)] assms(2,3) by auto + thus ?thesis + by (metis (no_types, lifting) Un_insert_left Un_insert_right sup_bot.right_neutral) +qed + +private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_rcv: + assumes "receive\t\\<^sub>s\<^sub>t#S \ \" "\' = update\<^sub>s\<^sub>t \ (receive\t\\<^sub>s\<^sub>t#S)" "\' = \@[Step (send\t\\<^sub>s\<^sub>t)]" + shows "(\(trms\<^sub>s\<^sub>t ` \)) \ (trms\<^sub>e\<^sub>s\<^sub>t \) = (\(trms\<^sub>s\<^sub>t ` \')) \ (trms\<^sub>e\<^sub>s\<^sub>t \')" +proof - + have "(trms\<^sub>e\<^sub>s\<^sub>t \') = (trms\<^sub>e\<^sub>s\<^sub>t \) \ {t}" "\(trms\<^sub>s\<^sub>t ` \') \ {t} = \(trms\<^sub>s\<^sub>t ` \)" + using to_st_append trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq[OF assms(1)] assms(2,3) by auto + thus ?thesis + by (metis (no_types, lifting) Un_insert_left Un_insert_right sup_bot.right_neutral) +qed + +private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_eq: + assumes "\a: t \ t'\\<^sub>s\<^sub>t#S \ \" "\' = update\<^sub>s\<^sub>t \ (\a: t \ t'\\<^sub>s\<^sub>t#S)" "\' = \@[Step (\a: t \ t'\\<^sub>s\<^sub>t)]" + shows "(\(trms\<^sub>s\<^sub>t ` \)) \ (trms\<^sub>e\<^sub>s\<^sub>t \) = (\(trms\<^sub>s\<^sub>t ` \')) \ (trms\<^sub>e\<^sub>s\<^sub>t \')" +proof - + have "(trms\<^sub>e\<^sub>s\<^sub>t \') = (trms\<^sub>e\<^sub>s\<^sub>t \) \ {t,t'}" "\(trms\<^sub>s\<^sub>t ` \') \ {t,t'} = \(trms\<^sub>s\<^sub>t ` \)" + using to_st_append trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq[OF assms(1)] assms(2,3) by auto + thus ?thesis + by (metis (no_types, lifting) Un_insert_left Un_insert_right sup_bot.right_neutral) +qed + +private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_ineq: + assumes "\X\\\: F\\<^sub>s\<^sub>t#S \ \" "\' = update\<^sub>s\<^sub>t \ (\X\\\: F\\<^sub>s\<^sub>t#S)" "\' = \@[Step (\X\\\: F\\<^sub>s\<^sub>t)]" + shows "(\(trms\<^sub>s\<^sub>t ` \)) \ (trms\<^sub>e\<^sub>s\<^sub>t \) = (\(trms\<^sub>s\<^sub>t ` \')) \ (trms\<^sub>e\<^sub>s\<^sub>t \')" +proof - + have "(trms\<^sub>e\<^sub>s\<^sub>t \') = (trms\<^sub>e\<^sub>s\<^sub>t \) \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" "\(trms\<^sub>s\<^sub>t ` \') \ trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = \(trms\<^sub>s\<^sub>t ` \)" + using to_st_append trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq[OF assms(1)] assms(2,3) by auto + thus ?thesis by (simp add: Un_commute sup_left_commute) +qed + +private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset: + assumes "x#S \ \" + shows "\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` (update\<^sub>s\<^sub>t \ (x#S))) \ \(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \)" (is ?A) + "\(assignment_rhs\<^sub>s\<^sub>t ` (update\<^sub>s\<^sub>t \ (x#S))) \ \(assignment_rhs\<^sub>s\<^sub>t ` \)" (is ?B) +proof - + { fix t assume "t \ \(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` (update\<^sub>s\<^sub>t \ (x#S)))" + then obtain S' where S': "S' \ update\<^sub>s\<^sub>t \ (x#S)" "t \ ik\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t S')" by auto + + have *: "ik\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t S) \ ik\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t (x#S))" + using ik_append[of "dual\<^sub>s\<^sub>t [x]" "dual\<^sub>s\<^sub>t S"] dual\<^sub>s\<^sub>t_append[of "[x]" S] + by auto + + hence "t \ \(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \)" + proof (cases "S' = S") + case True thus ?thesis using * assms S' by auto + next + case False thus ?thesis using S' by auto + qed + } + moreover + { fix t assume "t \ \(assignment_rhs\<^sub>s\<^sub>t ` (update\<^sub>s\<^sub>t \ (x#S)))" + then obtain S' where S': "S' \ update\<^sub>s\<^sub>t \ (x#S)" "t \ assignment_rhs\<^sub>s\<^sub>t S'" by auto + + have "assignment_rhs\<^sub>s\<^sub>t S \ assignment_rhs\<^sub>s\<^sub>t (x#S)" + using assignment_rhs_append[of "[x]" S] by simp + hence "t \ \(assignment_rhs\<^sub>s\<^sub>t ` \)" + using assms S' by (cases "S' = S") auto + } + ultimately show ?A ?B by (metis subsetI)+ +qed + +private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_snd: + assumes "send\t\\<^sub>s\<^sub>t#S \ \" + "\' = update\<^sub>s\<^sub>t \ (send\t\\<^sub>s\<^sub>t#S)" + "\' = \@[Step (receive\t\\<^sub>s\<^sub>t)]" + shows "(\(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \')) \ (ik\<^sub>e\<^sub>s\<^sub>t \') \ + (\(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \)) \ (ik\<^sub>e\<^sub>s\<^sub>t \)" (is ?A) + "(\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \') \ + (\(assignment_rhs\<^sub>s\<^sub>t ` \)) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \)" (is ?B) +proof - + { fix t' assume t'_in: "t' \ (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \')) \ (ik\<^sub>e\<^sub>s\<^sub>t \')" + hence "t' \ (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \')) \ (ik\<^sub>e\<^sub>s\<^sub>t \) \ {t}" using assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto + moreover have "t \ \(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \)" using assms(1) by force + ultimately have "t' \ (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \)) \ (ik\<^sub>e\<^sub>s\<^sub>t \)" + using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto + } + moreover + { fix t' assume t'_in: "t' \ (\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \')" + hence "t' \ (\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \)" + using assms assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append by auto + hence "t' \ (\(assignment_rhs\<^sub>s\<^sub>t ` \)) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \)" + using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto + } + ultimately show ?A ?B by (metis subsetI)+ +qed + +private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_rcv: + assumes "receive\t\\<^sub>s\<^sub>t#S \ \" + "\' = update\<^sub>s\<^sub>t \ (receive\t\\<^sub>s\<^sub>t#S)" + "\' = \@[Step (send\t\\<^sub>s\<^sub>t)]" + shows "(\(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \')) \ (ik\<^sub>e\<^sub>s\<^sub>t \') \ + (\(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \)) \ (ik\<^sub>e\<^sub>s\<^sub>t \)" (is ?A) + "(\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \') \ + (\(assignment_rhs\<^sub>s\<^sub>t ` \)) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \)" (is ?B) +proof - + { fix t' assume t'_in: "t' \ (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \')) \ (ik\<^sub>e\<^sub>s\<^sub>t \')" + hence "t' \ (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \')) \ (ik\<^sub>e\<^sub>s\<^sub>t \)" using assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto + hence "t' \ (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \)) \ (ik\<^sub>e\<^sub>s\<^sub>t \)" + using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto + } + moreover + { fix t' assume t'_in: "t' \ (\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \')" + hence "t' \ (\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \)" + using assms assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append by auto + hence "t' \ (\(assignment_rhs\<^sub>s\<^sub>t ` \)) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \)" + using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto + } + ultimately show ?A ?B by (metis subsetI)+ +qed + +private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_eq: + assumes "\a: t \ t'\\<^sub>s\<^sub>t#S \ \" + "\' = update\<^sub>s\<^sub>t \ (\a: t \ t'\\<^sub>s\<^sub>t#S)" + "\' = \@[Step (\a: t \ t'\\<^sub>s\<^sub>t)]" + shows "(\(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \')) \ (ik\<^sub>e\<^sub>s\<^sub>t \') \ + (\(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \)) \ (ik\<^sub>e\<^sub>s\<^sub>t \)" (is ?A) + "(\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \') \ + (\(assignment_rhs\<^sub>s\<^sub>t ` \)) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \)" (is ?B) +proof - + have 1: "t' \ (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \)) \ (ik\<^sub>e\<^sub>s\<^sub>t \)" + when "t' \ (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \')) \ (ik\<^sub>e\<^sub>s\<^sub>t \')" + for t' + proof - + have "t' \ (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \')) \ (ik\<^sub>e\<^sub>s\<^sub>t \)" using that assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto + thus ?thesis using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto + qed + + have 2: "t'' \ (\(assignment_rhs\<^sub>s\<^sub>t ` \)) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \)" + when "t'' \ (\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \')" "a = Assign" + for t'' + proof - + have "t'' \ (\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \) \ {t'}" + using that assms assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append by auto + moreover have "t' \ \(assignment_rhs\<^sub>s\<^sub>t ` \)" using assms(1) that by force + ultimately show ?thesis using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) that by auto + qed + + have 3: "assignment_rhs\<^sub>e\<^sub>s\<^sub>t \' = assignment_rhs\<^sub>e\<^sub>s\<^sub>t \" (is ?C) + "(\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (\(assignment_rhs\<^sub>s\<^sub>t ` \))" (is ?D) + when "a = Check" + proof - + show ?C using that assms(2,3) by (simp add: assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append) + show ?D using assms(1,2,3) ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset(2) by auto + qed + + show ?A using 1 2 by (metis subsetI) + show ?B using 1 2 3 by (cases a) blast+ +qed + +private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_ineq: + assumes "\X\\\: F\\<^sub>s\<^sub>t#S \ \" + "\' = update\<^sub>s\<^sub>t \ (\X\\\: F\\<^sub>s\<^sub>t#S)" + "\' = \@[Step (\X\\\: F\\<^sub>s\<^sub>t)]" + shows "(\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \')) \ (ik\<^sub>e\<^sub>s\<^sub>t \') \ + (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \)) \ (ik\<^sub>e\<^sub>s\<^sub>t \)" (is ?A) + "(\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \') \ + (\(assignment_rhs\<^sub>s\<^sub>t ` \)) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \)" (is ?B) +proof - + { fix t' assume t'_in: "t' \ (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \')) \ (ik\<^sub>e\<^sub>s\<^sub>t \')" + hence "t' \ (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \')) \ (ik\<^sub>e\<^sub>s\<^sub>t \)" using assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto + hence "t' \ (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \)) \ (ik\<^sub>e\<^sub>s\<^sub>t \)" + using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto + } + moreover + { fix t' assume t'_in: "t' \ (\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \')" + hence "t' \ (\(assignment_rhs\<^sub>s\<^sub>t ` \')) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \)" + using assms assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append by auto + hence "t' \ (\(assignment_rhs\<^sub>s\<^sub>t ` \)) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \)" + using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto + } + ultimately show ?A ?B by (metis subsetI)+ +qed + + +subsubsection \Transition Systems Definitions\ +inductive pts_symbolic:: + "(('fun,'var) strands \ ('fun,'var) strand) \ + (('fun,'var) strands \ ('fun,'var) strand) \ bool" +(infix "\\<^sup>\" 50) where + Nil[simp]: "[] \ \ \ (\,\) \\<^sup>\ (update\<^sub>s\<^sub>t \ [],\)" +| Send[simp]: "send\t\\<^sub>s\<^sub>t#S \ \ \ (\,\) \\<^sup>\ (update\<^sub>s\<^sub>t \ (send\t\\<^sub>s\<^sub>t#S),\@[receive\t\\<^sub>s\<^sub>t])" +| Receive[simp]: "receive\t\\<^sub>s\<^sub>t#S \ \ \ (\,\) \\<^sup>\ (update\<^sub>s\<^sub>t \ (receive\t\\<^sub>s\<^sub>t#S),\@[send\t\\<^sub>s\<^sub>t])" +| Equality[simp]: "\a: t \ t'\\<^sub>s\<^sub>t#S \ \ \ (\,\) \\<^sup>\ (update\<^sub>s\<^sub>t \ (\a: t \ t'\\<^sub>s\<^sub>t#S),\@[\a: t \ t'\\<^sub>s\<^sub>t])" +| Inequality[simp]: "\X\\\: F\\<^sub>s\<^sub>t#S \ \ \ (\,\) \\<^sup>\ (update\<^sub>s\<^sub>t \ (\X\\\: F\\<^sub>s\<^sub>t#S),\@[\X\\\: F\\<^sub>s\<^sub>t])" + +private inductive pts_symbolic_c:: + "(('fun,'var) strands \ ('fun,'var) extstrand) \ + (('fun,'var) strands \ ('fun,'var) extstrand) \ bool" +(infix "\\<^sup>\\<^sub>c" 50) where + Nil[simp]: "[] \ \ \ (\,\) \\<^sup>\\<^sub>c (update\<^sub>s\<^sub>t \ [],\)" +| Send[simp]: "send\t\\<^sub>s\<^sub>t#S \ \ \ (\,\) \\<^sup>\\<^sub>c (update\<^sub>s\<^sub>t \ (send\t\\<^sub>s\<^sub>t#S),\@[Step (receive\t\\<^sub>s\<^sub>t)])" +| Receive[simp]: "receive\t\\<^sub>s\<^sub>t#S \ \ \ (\,\) \\<^sup>\\<^sub>c (update\<^sub>s\<^sub>t \ (receive\t\\<^sub>s\<^sub>t#S),\@[Step (send\t\\<^sub>s\<^sub>t)])" +| Equality[simp]: "\a: t \ t'\\<^sub>s\<^sub>t#S \ \ \ (\,\) \\<^sup>\\<^sub>c (update\<^sub>s\<^sub>t \ (\a: t \ t'\\<^sub>s\<^sub>t#S),\@[Step (\a: t \ t'\\<^sub>s\<^sub>t)])" +| Inequality[simp]: "\X\\\: F\\<^sub>s\<^sub>t#S \ \ \ (\,\) \\<^sup>\\<^sub>c (update\<^sub>s\<^sub>t \ (\X\\\: F\\<^sub>s\<^sub>t#S),\@[Step (\X\\\: F\\<^sub>s\<^sub>t)])" +| Decompose[simp]: "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \ \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t \) + \ (\,\) \\<^sup>\\<^sub>c (\,\@[Decomp (Fun f T)])" + +abbreviation pts_symbolic_rtrancl (infix "\\<^sup>\\<^sup>*" 50) where "a \\<^sup>\\<^sup>* b \ pts_symbolic\<^sup>*\<^sup>* a b" +private abbreviation pts_symbolic_c_rtrancl (infix "\\<^sup>\\<^sub>c\<^sup>*" 50) where "a \\<^sup>\\<^sub>c\<^sup>* b \ pts_symbolic_c\<^sup>*\<^sup>* a b" + +lemma pts_symbolic_induct[consumes 1, case_names Nil Send Receive Equality Inequality]: + assumes "(\,\) \\<^sup>\ (\',\')" + and "\[] \ \; \' = update\<^sub>s\<^sub>t \ []; \' = \\ \ P" + and "\t S. \send\t\\<^sub>s\<^sub>t#S \ \; \' = update\<^sub>s\<^sub>t \ (send\t\\<^sub>s\<^sub>t#S); \' = \@[receive\t\\<^sub>s\<^sub>t]\ \ P" + and "\t S. \receive\t\\<^sub>s\<^sub>t#S \ \; \' = update\<^sub>s\<^sub>t \ (receive\t\\<^sub>s\<^sub>t#S); \' = \@[send\t\\<^sub>s\<^sub>t]\ \ P" + and "\a t t' S. \\a: t \ t'\\<^sub>s\<^sub>t#S \ \; \' = update\<^sub>s\<^sub>t \ (\a: t \ t'\\<^sub>s\<^sub>t#S); \' = \@[\a: t \ t'\\<^sub>s\<^sub>t]\ \ P" + and "\X F S. \\X\\\: F\\<^sub>s\<^sub>t#S \ \; \' = update\<^sub>s\<^sub>t \ (\X\\\: F\\<^sub>s\<^sub>t#S); \' = \@[\X\\\: F\\<^sub>s\<^sub>t]\ \ P" + shows "P" +apply (rule pts_symbolic.cases[OF assms(1)]) +using assms(2,3,4,5,6) by simp_all + +private lemma pts_symbolic_c_induct[consumes 1, case_names Nil Send Receive Equality Inequality Decompose]: + assumes "(\,\) \\<^sup>\\<^sub>c (\',\')" + and "\[] \ \; \' = update\<^sub>s\<^sub>t \ []; \' = \\ \ P" + and "\t S. \send\t\\<^sub>s\<^sub>t#S \ \; \' = update\<^sub>s\<^sub>t \ (send\t\\<^sub>s\<^sub>t#S); \' = \@[Step (receive\t\\<^sub>s\<^sub>t)]\ \ P" + and "\t S. \receive\t\\<^sub>s\<^sub>t#S \ \; \' = update\<^sub>s\<^sub>t \ (receive\t\\<^sub>s\<^sub>t#S); \' = \@[Step (send\t\\<^sub>s\<^sub>t)]\ \ P" + and "\a t t' S. \\a: t \ t'\\<^sub>s\<^sub>t#S \ \; \' = update\<^sub>s\<^sub>t \ (\a: t \ t'\\<^sub>s\<^sub>t#S); \' = \@[Step (\a: t \ t'\\<^sub>s\<^sub>t)]\ \ P" + and "\X F S. \\X\\\: F\\<^sub>s\<^sub>t#S \ \; \' = update\<^sub>s\<^sub>t \ (\X\\\: F\\<^sub>s\<^sub>t#S); \' = \@[Step (\X\\\: F\\<^sub>s\<^sub>t)]\ \ P" + and "\f T. \Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \ \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t \); \' = \; \' = \@[Decomp (Fun f T)]\ \ P" + shows "P" +apply (rule pts_symbolic_c.cases[OF assms(1)]) +using assms(2,3,4,5,6,7) by simp_all + +private lemma pts_symbolic_c_preserves_wf_prot: + assumes "(\,\) \\<^sup>\\<^sub>c\<^sup>* (\',\')" "wf\<^sub>s\<^sub>t\<^sub>s' \ \" + shows "wf\<^sub>s\<^sub>t\<^sub>s' \' \'" +using assms +proof (induction rule: rtranclp_induct2) + case (step \1 \1 \2 \2) + from step.hyps(2) step.IH[OF step.prems] show ?case + proof (induction rule: pts_symbolic_c_induct) + case Decompose + hence "fv\<^sub>e\<^sub>s\<^sub>t \2 = fv\<^sub>e\<^sub>s\<^sub>t \1" "bvars\<^sub>e\<^sub>s\<^sub>t \2 = bvars\<^sub>e\<^sub>s\<^sub>t \1" + using bvars_decomp ik_assignment_rhs_decomp_fv by metis+ + thus ?case using Decompose unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def + by (metis wf_vars_mono wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2)) + qed (metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_nil, metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_snd, + metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_rcv, metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_eq, + metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_ineq) +qed metis + +private lemma pts_symbolic_c_preserves_wf_is: + assumes "(\,\) \\<^sup>\\<^sub>c\<^sup>* (\',\')" "wf\<^sub>s\<^sub>t\<^sub>s' \ \" "wf\<^sub>s\<^sub>t V (to_st \)" + shows "wf\<^sub>s\<^sub>t V (to_st \')" +using assms +proof (induction rule: rtranclp_induct2) + case (step \1 \1 \2 \2) + hence "(\, \) \\<^sup>\\<^sub>c\<^sup>* (\2, \2)" by auto + hence *: "wf\<^sub>s\<^sub>t\<^sub>s' \1 \1" "wf\<^sub>s\<^sub>t\<^sub>s' \2 \2" + using pts_symbolic_c_preserves_wf_prot[OF _ step.prems(1)] step.hyps(1) + by auto + + from step.hyps(2) step.IH[OF step.prems] show ?case + proof (induction rule: pts_symbolic_c_induct) + case Nil thus ?case by auto + next + case (Send t S) + hence "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \1) (receive\t\\<^sub>s\<^sub>t#(dual\<^sub>s\<^sub>t S))" + using *(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fastforce + hence "fv t \ wfrestrictedvars\<^sub>s\<^sub>t (to_st \1) \ V" + using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_eq_wfrestrictedvars\<^sub>s\<^sub>t by auto + thus ?case using Send wf_rcv_append''' to_st_append by simp + next + case (Receive t) thus ?case using wf_snd_append to_st_append by simp + next + case (Equality a t t' S) + hence "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \1) (\a: t \ t'\\<^sub>s\<^sub>t#(dual\<^sub>s\<^sub>t S))" + using *(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fastforce + hence "fv t' \ wfrestrictedvars\<^sub>s\<^sub>t (to_st \1) \ V" when "a = Assign" + using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_eq_wfrestrictedvars\<^sub>s\<^sub>t that by auto + thus ?case using Equality wf_eq_append''' to_st_append by (cases a) auto + next + case (Inequality t t' S) thus ?case using wf_ineq_append'' to_st_append by simp + next + case (Decompose f T) + hence "fv (Fun f T) \ wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \1" + by (metis fv_subterms_set fv_subset subset_trans + ik\<^sub>s\<^sub>t_assignment_rhs\<^sub>s\<^sub>t_wfrestrictedvars_subset) + hence "vars\<^sub>s\<^sub>t (decomp (Fun f T)) \ wfrestrictedvars\<^sub>s\<^sub>t (to_st \1) \ V" + using decomp_vars[of "Fun f T"] wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_eq_wfrestrictedvars\<^sub>s\<^sub>t[of \1] by auto + thus ?case + using to_st_append[of \1 "[Decomp (Fun f T)]"] + wf_append_suffix[OF Decompose.prems] Decompose.hyps(3) + by (metis append_Nil2 decomp_vars(1,2) to_st.simps(1,3)) + qed +qed metis + +private lemma pts_symbolic_c_preserves_tfr\<^sub>s\<^sub>e\<^sub>t: + assumes "(\,\) \\<^sup>\\<^sub>c\<^sup>* (\',\')" + and "tfr\<^sub>s\<^sub>e\<^sub>t ((\(trms\<^sub>s\<^sub>t ` \)) \ (trms\<^sub>e\<^sub>s\<^sub>t \))" + and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s ((\(trms\<^sub>s\<^sub>t ` \)) \ (trms\<^sub>e\<^sub>s\<^sub>t \))" + shows "tfr\<^sub>s\<^sub>e\<^sub>t ((\(trms\<^sub>s\<^sub>t ` \')) \ (trms\<^sub>e\<^sub>s\<^sub>t \')) \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s ((\(trms\<^sub>s\<^sub>t ` \')) \ (trms\<^sub>e\<^sub>s\<^sub>t \'))" +using assms +proof (induction rule: rtranclp_induct2) + case (step \1 \1 \2 \2) + from step.hyps(2) step.IH[OF step.prems] show ?case + proof (induction rule: pts_symbolic_c_induct) + case Nil + hence "\(trms\<^sub>s\<^sub>t ` \1) = \(trms\<^sub>s\<^sub>t ` \2)" by force + thus ?case using Nil by metis + next + case (Decompose f T) + obtain t where t: "t \ ik\<^sub>e\<^sub>s\<^sub>t \1 \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t \1" "Fun f T \ t" + using Decompose.hyps(1) by auto + have t_wf: "wf\<^sub>t\<^sub>r\<^sub>m t" + using Decompose.prems wf_trm_subterm[of _ t] + trms\<^sub>e\<^sub>s\<^sub>t_ik_assignment_rhsI[OF t(1)] + unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def + by (metis UN_E Un_iff) + have "t \ subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t \1)" using trms\<^sub>e\<^sub>s\<^sub>t_ik_assignment_rhsI t by auto + hence "Fun f T \ SMP (trms\<^sub>e\<^sub>s\<^sub>t \1)" + by (metis (no_types) SMP.MP SMP.Subterm UN_E t(2)) + hence "{Fun f T} \ SMP (trms\<^sub>e\<^sub>s\<^sub>t \1)" using SMP.Subterm[of "Fun f T"] by auto + moreover have "trms\<^sub>e\<^sub>s\<^sub>t \2 = insert (Fun f T) (trms\<^sub>e\<^sub>s\<^sub>t \1)" + using Decompose.hyps(3) by auto + ultimately have *: "SMP (trms\<^sub>e\<^sub>s\<^sub>t \1) = SMP (trms\<^sub>e\<^sub>s\<^sub>t \2)" + using SMP_subset_union_eq[of "{Fun f T}"] + by (simp add: Un_commute) + hence "SMP ((\(trms\<^sub>s\<^sub>t ` \1)) \ (trms\<^sub>e\<^sub>s\<^sub>t \1)) = SMP ((\(trms\<^sub>s\<^sub>t ` \2)) \ (trms\<^sub>e\<^sub>s\<^sub>t \2))" + using Decompose.hyps(2) SMP_union by auto + moreover have "\t \ trms\<^sub>e\<^sub>s\<^sub>t \1. wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" + using Decompose.prems wf_trm_subterm t(2) t_wf unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by auto + hence "\t \ trms\<^sub>e\<^sub>s\<^sub>t \2. wf\<^sub>t\<^sub>r\<^sub>m t" by (metis * SMP.MP SMP_wf_trm) + hence "\t \ (\(trms\<^sub>s\<^sub>t ` \2)) \ (trms\<^sub>e\<^sub>s\<^sub>t \2). wf\<^sub>t\<^sub>r\<^sub>m t" + using Decompose.prems Decompose.hyps(2) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by force + ultimately show ?thesis using Decompose.prems unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by presburger + qed (metis trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_snd, metis trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_rcv, + metis trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_eq, metis trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_ineq) +qed metis + +private lemma pts_symbolic_c_preserves_tfr\<^sub>s\<^sub>t\<^sub>p: + assumes "(\,\) \\<^sup>\\<^sub>c\<^sup>* (\',\')" "\S \ \ \ {to_st \}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + shows "\S \ \' \ {to_st \'}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" +using assms +proof (induction rule: rtranclp_induct2) + case (step \1 \1 \2 \2) + from step.hyps(2) step.IH[OF step.prems] show ?case + proof (induction rule: pts_symbolic_c_induct) + case Nil + have 1: "\S \ {to_st \2}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Nil by simp + have 2: "\2 = \1 - {[]}" "\S \ \1. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Nil by simp_all + have "\S \ \2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + proof + fix S assume "S \ \2" + hence "S \ \1" using 2(1) by simp + thus "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using 2(2) by simp + qed + thus ?case using 1 by auto + next + case (Send t S) + have 1: "\S \ {to_st \2}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Send by (simp add: to_st_append) + have 2: "\2 = insert S (\1 - {send\t\\<^sub>s\<^sub>t#S})" "\S \ \1. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Send by simp_all + have 3: "\S \ \2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + proof + fix S' assume "S' \ \2" + hence "S' \ \1 \ S' = S" using 2(1) by auto + moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Send.hyps 2(2) by auto + ultimately show "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" using 2(2) by blast + qed + thus ?case using 1 by auto + next + case (Receive t S) + have 1: "\S \ {to_st \2}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Receive by (simp add: to_st_append) + have 2: "\2 = insert S (\1 - {receive\t\\<^sub>s\<^sub>t#S})" "\S \ \1. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + using Receive by simp_all + have 3: "\S \ \2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + proof + fix S' assume "S' \ \2" + hence "S' \ \1 \ S' = S" using 2(1) by auto + moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Receive.hyps 2(2) by auto + ultimately show "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" using 2(2) by blast + qed + show ?case using 1 3 by auto + next + case (Equality a t t' S) + have 1: "to_st \2 = to_st \1@[\a: t \ t'\\<^sub>s\<^sub>t]" "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \1)" + using Equality by (simp_all add: to_st_append) + have 2: "list_all tfr\<^sub>s\<^sub>t\<^sub>p [\a: t \ t'\\<^sub>s\<^sub>t]" using Equality by fastforce + have 3: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \2)" + using tfr_stp_all_append[of "to_st \1" "[\a: t \ t'\\<^sub>s\<^sub>t]"] 1 2 by metis + hence 4: "\S \ {to_st \2}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Equality by simp + have 5: "\2 = insert S (\1 - {\a: t \ t'\\<^sub>s\<^sub>t#S})" "\S \ \1. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + using Equality by simp_all + have 6: "\S \ \2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + proof + fix S' assume "S' \ \2" + hence "S' \ \1 \ S' = S" using 5(1) by auto + moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Equality.hyps 5(2) by auto + ultimately show "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" using 5(2) by blast + qed + thus ?case using 4 by auto + next + case (Inequality X F S) + have 1: "to_st \2 = to_st \1@[\X\\\: F\\<^sub>s\<^sub>t]" "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \1)" + using Inequality by (simp_all add: to_st_append) + have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (\X\\\: F\\<^sub>s\<^sub>t#S)" using Inequality(1,4) by blast + hence 2: "list_all tfr\<^sub>s\<^sub>t\<^sub>p [\X\\\: F\\<^sub>s\<^sub>t]" by simp + have 3: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \2)" + using tfr_stp_all_append[of "to_st \1" "[\X\\\: F\\<^sub>s\<^sub>t]"] 1 2 by metis + hence 4: "\S \ {to_st \2}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Inequality by simp + have 5: "\2 = insert S (\1 - {\X\\\: F\\<^sub>s\<^sub>t#S})" "\S \ \1. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + using Inequality by simp_all + have 6: "\S \ \2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + proof + fix S' assume "S' \ \2" + hence "S' \ \1 \ S' = S" using 5(1) by auto + moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Inequality.hyps 5(2) by auto + ultimately show "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" using 5(2) by blast + qed + thus ?case using 4 by auto + next + case (Decompose f T) + hence 1: "\S \ \2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" by blast + have 2: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \1)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st [Decomp (Fun f T)])" + using Decompose.prems decomp_tfr\<^sub>s\<^sub>t\<^sub>p by auto + hence "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \1@to_st [Decomp (Fun f T)])" by auto + hence "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \2)" + using Decompose.hyps(3) to_st_append[of \1 "[Decomp (Fun f T)]"] + by auto + thus ?case using 1 by blast + qed +qed + +private lemma pts_symbolic_c_preserves_well_analyzed: + assumes "(\,\) \\<^sup>\\<^sub>c\<^sup>* (\',\')" "well_analyzed \" + shows "well_analyzed \'" +using assms +proof (induction rule: rtranclp_induct2) + case (step \1 \1 \2 \2) + from step.hyps(2) step.IH[OF step.prems] show ?case + proof (induction rule: pts_symbolic_c_induct) + case Receive thus ?case by (metis well_analyzed_singleton(1) well_analyzed_append) + next + case Send thus ?case by (metis well_analyzed_singleton(2) well_analyzed_append) + next + case Equality thus ?case by (metis well_analyzed_singleton(3) well_analyzed_append) + next + case Inequality thus ?case by (metis well_analyzed_singleton(4) well_analyzed_append) + next + case (Decompose f T) + hence "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \1 \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t \1) - (Var`\)" by auto + thus ?case by (metis well_analyzed.Decomp Decompose.prems Decompose.hyps(3)) + qed simp +qed metis + +private lemma pts_symbolic_c_preserves_Ana_invar_subst: + assumes "(\,\) \\<^sup>\\<^sub>c\<^sup>* (\',\')" + and "Ana_invar_subst ( + (\(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \) \ (ik\<^sub>e\<^sub>s\<^sub>t \)) \ + (\(assignment_rhs\<^sub>s\<^sub>t ` \) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \)))" + shows "Ana_invar_subst ( + (\(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \') \ (ik\<^sub>e\<^sub>s\<^sub>t \')) \ + (\(assignment_rhs\<^sub>s\<^sub>t ` \') \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \')))" +using assms +proof (induction rule: rtranclp_induct2) + case (step \1 \1 \2 \2) + from step.hyps(2) step.IH[OF step.prems] show ?case + proof (induction rule: pts_symbolic_c_induct) + case Nil + hence "\(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \1) = \(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \2)" + "\(assignment_rhs\<^sub>s\<^sub>t ` \1) = \(assignment_rhs\<^sub>s\<^sub>t ` \2)" + by force+ + thus ?case using Nil by metis + next + case Send show ?case + using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_snd[OF Send.hyps] + Ana_invar_subst_subset[OF Send.prems] + by (metis Un_mono) + next + case Receive show ?case + using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_rcv[OF Receive.hyps] + Ana_invar_subst_subset[OF Receive.prems] + by (metis Un_mono) + next + case Equality show ?case + using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_eq[OF Equality.hyps] + Ana_invar_subst_subset[OF Equality.prems] + by (metis Un_mono) + next + case Inequality show ?case + using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_ineq[OF Inequality.hyps] + Ana_invar_subst_subset[OF Inequality.prems] + by (metis Un_mono) + next + case (Decompose f T) + let ?X = "\(assignment_rhs\<^sub>s\<^sub>t`\2) \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t \2" + let ?Y = "\(assignment_rhs\<^sub>s\<^sub>t`\1) \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t \1" + obtain K M where Ana: "Ana (Fun f T) = (K,M)" by moura + hence *: "ik\<^sub>e\<^sub>s\<^sub>t \2 = ik\<^sub>e\<^sub>s\<^sub>t \1 \ set M" "assignment_rhs\<^sub>e\<^sub>s\<^sub>t \2 = assignment_rhs\<^sub>e\<^sub>s\<^sub>t \1" + using ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append decomp_ik + decomp_assignment_rhs_empty Decompose.hyps(3) + by auto + { fix g S assume "Fun g S \ subterms\<^sub>s\<^sub>e\<^sub>t (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t`\2) \ ik\<^sub>e\<^sub>s\<^sub>t \2 \ ?X)" + hence "Fun g S \ subterms\<^sub>s\<^sub>e\<^sub>t (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \1) \ ik\<^sub>e\<^sub>s\<^sub>t \1 \ set M \ ?X)" + using * Decompose.hyps(2) by auto + hence "Fun g S \ subterms\<^sub>s\<^sub>e\<^sub>t (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \1)) + \ Fun g S \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \1) + \ Fun g S \ subterms\<^sub>s\<^sub>e\<^sub>t (set M) + \ Fun g S \ subterms\<^sub>s\<^sub>e\<^sub>t (\(assignment_rhs\<^sub>s\<^sub>t`\1)) + \ Fun g S \ subterms\<^sub>s\<^sub>e\<^sub>t (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \1)" + using Decompose * Ana_fun_subterm[OF Ana] by auto + moreover have "Fun f T \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \1 \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t \1)" + using trms\<^sub>e\<^sub>s\<^sub>t_ik_subtermsI Decompose.hyps(1) by auto + hence "subterms (Fun f T) \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \1 \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t \1)" + by (metis in_subterms_subset_Union) + hence "subterms\<^sub>s\<^sub>e\<^sub>t (set M) \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \1 \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t \1)" + by (meson Un_upper2 Ana_subterm[OF Ana] subterms_subset_set psubsetE subset_trans) + ultimately have "Fun g S \ subterms\<^sub>s\<^sub>e\<^sub>t (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \1) \ ik\<^sub>e\<^sub>s\<^sub>t \1 \ ?Y)" + by auto + } + thus ?case using Decompose unfolding Ana_invar_subst_def by metis + qed +qed + +private lemma pts_symbolic_c_preserves_constr_disj_vars: + assumes "(\,\) \\<^sup>\\<^sub>c\<^sup>* (\',\')" "wf\<^sub>s\<^sub>t\<^sub>s' \ \" "fv\<^sub>e\<^sub>s\<^sub>t \ \ bvars\<^sub>e\<^sub>s\<^sub>t \ = {}" + shows "fv\<^sub>e\<^sub>s\<^sub>t \' \ bvars\<^sub>e\<^sub>s\<^sub>t \' = {}" +using assms +proof (induction rule: rtranclp_induct2) + case (step \1 \1 \2 \2) + have *: "\S. S \ \1 \ fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t \1 = {}" "\S. S \ \1 \ fv\<^sub>e\<^sub>s\<^sub>t \1 \ bvars\<^sub>s\<^sub>t S = {}" + using pts_symbolic_c_preserves_wf_prot[OF step.hyps(1) step.prems(1)] + unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto + from step.hyps(2) step.IH[OF step.prems] + show ?case + proof (induction rule: pts_symbolic_c_induct) + case Nil thus ?case by auto + next + case (Send t S) + hence "fv\<^sub>e\<^sub>s\<^sub>t \2 = fv\<^sub>e\<^sub>s\<^sub>t \1 \ fv t" "bvars\<^sub>e\<^sub>s\<^sub>t \2 = bvars\<^sub>e\<^sub>s\<^sub>t \1" + "fv\<^sub>s\<^sub>t (send\t\\<^sub>s\<^sub>t#S) = fv t \ fv\<^sub>s\<^sub>t S" + using fv\<^sub>e\<^sub>s\<^sub>t_append bvars\<^sub>e\<^sub>s\<^sub>t_append by simp+ + thus ?case using *(1)[OF Send(1)] Send(4) by auto + next + case (Receive t S) + hence "fv\<^sub>e\<^sub>s\<^sub>t \2 = fv\<^sub>e\<^sub>s\<^sub>t \1 \ fv t" "bvars\<^sub>e\<^sub>s\<^sub>t \2 = bvars\<^sub>e\<^sub>s\<^sub>t \1" + "fv\<^sub>s\<^sub>t (receive\t\\<^sub>s\<^sub>t#S) = fv t \ fv\<^sub>s\<^sub>t S" + using fv\<^sub>e\<^sub>s\<^sub>t_append bvars\<^sub>e\<^sub>s\<^sub>t_append by simp+ + thus ?case using *(1)[OF Receive(1)] Receive(4) by auto + next + case (Equality a t t' S) + hence "fv\<^sub>e\<^sub>s\<^sub>t \2 = fv\<^sub>e\<^sub>s\<^sub>t \1 \ fv t \ fv t'" "bvars\<^sub>e\<^sub>s\<^sub>t \2 = bvars\<^sub>e\<^sub>s\<^sub>t \1" + "fv\<^sub>s\<^sub>t (\a: t \ t'\\<^sub>s\<^sub>t#S) = fv t \ fv t' \ fv\<^sub>s\<^sub>t S" + using fv\<^sub>e\<^sub>s\<^sub>t_append bvars\<^sub>e\<^sub>s\<^sub>t_append by fastforce+ + thus ?case using *(1)[OF Equality(1)] Equality(4) by auto + next + case (Inequality X F S) + hence "fv\<^sub>e\<^sub>s\<^sub>t \2 = fv\<^sub>e\<^sub>s\<^sub>t \1 \ (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X)" "bvars\<^sub>e\<^sub>s\<^sub>t \2 = bvars\<^sub>e\<^sub>s\<^sub>t \1 \ set X" + "fv\<^sub>s\<^sub>t (\X\\\: F\\<^sub>s\<^sub>t#S) = (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X) \ fv\<^sub>s\<^sub>t S" + using fv\<^sub>e\<^sub>s\<^sub>t_append bvars\<^sub>e\<^sub>s\<^sub>t_append strand_vars_split(3)[of "[\X\\\: F\\<^sub>s\<^sub>t]" S] + by auto+ + moreover have "fv\<^sub>e\<^sub>s\<^sub>t \1 \ set X = {}" using *(2)[OF Inequality(1)] by auto + ultimately show ?case using *(1)[OF Inequality(1)] Inequality(4) by auto + next + case (Decompose f T) + thus ?case + using Decompose(3,4) bvars_decomp ik_assignment_rhs_decomp_fv[OF Decompose(1)] by auto + qed +qed + + +subsubsection \Theorem: The Typing Result Lifted to the Transition System Level\ +private lemma wf\<^sub>s\<^sub>t\<^sub>s'_decomp_rm: + assumes "well_analyzed A" "wf\<^sub>s\<^sub>t\<^sub>s' S (decomp_rm\<^sub>e\<^sub>s\<^sub>t A)" shows "wf\<^sub>s\<^sub>t\<^sub>s' S A" +unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def +proof (intro conjI) + show "\S\S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A) (dual\<^sub>s\<^sub>t S)" + by (metis (no_types) assms(2) wf\<^sub>s\<^sub>t\<^sub>s'_def wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_decomp_rm\<^sub>e\<^sub>s\<^sub>t_subset + wf_vars_mono le_iff_sup) + + show "\Sa\S. \S'\S. fv\<^sub>s\<^sub>t Sa \ bvars\<^sub>s\<^sub>t S' = {}" by (metis assms(2) wf\<^sub>s\<^sub>t\<^sub>s'_def) + + show "\S\S. fv\<^sub>s\<^sub>t S \ bvars\<^sub>e\<^sub>s\<^sub>t A = {}" by (metis assms(2) wf\<^sub>s\<^sub>t\<^sub>s'_def bvars_decomp_rm) + + show "\S\S. fv\<^sub>e\<^sub>s\<^sub>t A \ bvars\<^sub>s\<^sub>t S = {}" by (metis assms wf\<^sub>s\<^sub>t\<^sub>s'_def well_analyzed_decomp_rm\<^sub>e\<^sub>s\<^sub>t_fv) +qed + +private lemma decomps\<^sub>e\<^sub>s\<^sub>t_pts_symbolic_c: + assumes "D \ decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \" + shows "(S,A) \\<^sup>\\<^sub>c\<^sup>* (S,A@D)" +using assms(1) +proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct) + case (Decomp B f X K T) + have "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \ + subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t (A@B) \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B))" + using ik\<^sub>e\<^sub>s\<^sub>t_append[of A B] assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append[of A B] + by auto + hence "Fun f X \ subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t (A@B) \ assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B))" using Decomp.hyps by auto + hence "(S,A@B) \\<^sup>\\<^sub>c (S,A@B@[Decomp (Fun f X)])" + using pts_symbolic_c.Decompose[of f X "A@B"] + by simp + thus ?case + using Decomp.IH rtrancl_into_rtrancl + rtranclp_rtrancl_eq[of pts_symbolic_c "(S,A)" "(S,A@B)"] + by auto +qed simp + +private lemma pts_symbolic_to_pts_symbolic_c: + assumes "(\,to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \\<^sub>d)) \\<^sup>\\<^sup>* (\',\')" "sem\<^sub>e\<^sub>s\<^sub>t_d {} \ (to_est \')" "sem\<^sub>e\<^sub>s\<^sub>t_c {} \ \\<^sub>d" + and wf: "wf\<^sub>s\<^sub>t\<^sub>s' \ (decomp_rm\<^sub>e\<^sub>s\<^sub>t \\<^sub>d)" "wf\<^sub>e\<^sub>s\<^sub>t {} \\<^sub>d" + and tar: "Ana_invar_subst ((\(ik\<^sub>s\<^sub>t` dual\<^sub>s\<^sub>t` \) \ (ik\<^sub>e\<^sub>s\<^sub>t \\<^sub>d)) + \ (\(assignment_rhs\<^sub>s\<^sub>t` \) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \\<^sub>d)))" + and wa: "well_analyzed \\<^sub>d" + and \: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + shows "\\\<^sub>d'. \' = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \\<^sub>d') \ (\,\\<^sub>d) \\<^sup>\\<^sub>c\<^sup>* (\',\\<^sub>d') \ sem\<^sub>e\<^sub>s\<^sub>t_c {} \ \\<^sub>d'" +using assms(1,2) +proof (induction rule: rtranclp_induct2) + case refl thus ?case using assms by auto +next + case (step \1 \1 \2 \2) + have "sem\<^sub>e\<^sub>s\<^sub>t_d {} \ (to_est \1)" using step.hyps(2) step.prems + by (induct rule: pts_symbolic_induct, metis, (metis sem\<^sub>e\<^sub>s\<^sub>t_d_split_left to_est_append)+) + then obtain \1d where + \1d: "\1 = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \1d)" "(\, \\<^sub>d) \\<^sup>\\<^sub>c\<^sup>* (\1, \1d)" "sem\<^sub>e\<^sub>s\<^sub>t_c {} \ \1d" + using step.IH by moura + + show ?case using step.hyps(2) + proof (induction rule: pts_symbolic_induct) + case Nil + hence "(\, \\<^sub>d) \\<^sup>\\<^sub>c\<^sup>* (\2, \1d)" using \1d pts_symbolic_c.Nil[OF Nil.hyps(1), of \1d] by simp + thus ?case using \1d Nil by auto + next + case (Send t S) + hence "sem\<^sub>e\<^sub>s\<^sub>t_c {} \ (\1d@[Step (receive\t\\<^sub>s\<^sub>t)])" using sem\<^sub>e\<^sub>s\<^sub>t_c.Receive[OF \1d(3)] by simp + moreover have "(\1, \1d) \\<^sup>\\<^sub>c (\2, \1d@[Step (receive\t\\<^sub>s\<^sub>t)])" + using Send.hyps(2) pts_symbolic_c.Send[OF Send.hyps(1), of \1d] by simp + moreover have "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t (\1d@[Step (receive\t\\<^sub>s\<^sub>t)])) = \2" + using Send.hyps(3) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append \1d(1) by (simp add: to_st_append) + ultimately show ?case using \1d(2) by auto + next + case (Equality a t t' S) + hence "t \ \ = t' \ \" + using step.prems sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st[of "{}" \ "to_est \2"] + to_st_append to_est_append to_st_to_est_inv + by auto + hence "sem\<^sub>e\<^sub>s\<^sub>t_c {} \ (\1d@[Step (\a: t \ t'\\<^sub>s\<^sub>t)])" using sem\<^sub>e\<^sub>s\<^sub>t_c.Equality[OF \1d(3)] by simp + moreover have "(\1, \1d) \\<^sup>\\<^sub>c (\2, \1d@[Step (\a: t \ t'\\<^sub>s\<^sub>t)])" + using Equality.hyps(2) pts_symbolic_c.Equality[OF Equality.hyps(1), of \1d] by simp + moreover have "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t (\1d@[Step (\a: t \ t'\\<^sub>s\<^sub>t)])) = \2" + using Equality.hyps(3) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append \1d(1) by (simp add: to_st_append) + ultimately show ?case using \1d(2) by auto + next + case (Inequality X F S) + hence "ineq_model \ X F" + using step.prems sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st[of "{}" \ "to_est \2"] + to_st_append to_est_append to_st_to_est_inv + by auto + hence "sem\<^sub>e\<^sub>s\<^sub>t_c {} \ (\1d@[Step (\X\\\: F\\<^sub>s\<^sub>t)])" using sem\<^sub>e\<^sub>s\<^sub>t_c.Inequality[OF \1d(3)] by simp + moreover have "(\1, \1d) \\<^sup>\\<^sub>c (\2, \1d@[Step (\X\\\: F\\<^sub>s\<^sub>t)])" + using Inequality.hyps(2) pts_symbolic_c.Inequality[OF Inequality.hyps(1), of \1d] by simp + moreover have "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t (\1d@[Step (\X\\\: F\\<^sub>s\<^sub>t)])) = \2" + using Inequality.hyps(3) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append \1d(1) by (simp add: to_st_append) + ultimately show ?case using \1d(2) by auto + next + case (Receive t S) + hence "ik\<^sub>s\<^sub>t \1 \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" + using step.prems sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st[of "{}" \ "to_est \2"] + strand_sem_split(4)[of "{}" \1 "[send\t\\<^sub>s\<^sub>t]" \] + to_st_append to_est_append to_st_to_est_inv + by auto + moreover have "ik\<^sub>s\<^sub>t \1 \\<^sub>s\<^sub>e\<^sub>t \ \ ik\<^sub>e\<^sub>s\<^sub>t \1d \\<^sub>s\<^sub>e\<^sub>t \" using \1d(1) decomp_rm\<^sub>e\<^sub>s\<^sub>t_ik_subset by auto + ultimately have *: "ik\<^sub>e\<^sub>s\<^sub>t \1d \\<^sub>s\<^sub>e\<^sub>t \ \ t \ \" using ideduct_mono by auto + + have "wf\<^sub>s\<^sub>t\<^sub>s' \ \\<^sub>d" by (rule wf\<^sub>s\<^sub>t\<^sub>s'_decomp_rm[OF wa assms(4)]) + hence **: "wf\<^sub>e\<^sub>s\<^sub>t {} \1d" by (rule pts_symbolic_c_preserves_wf_is[OF \1d(2) _ assms(5)]) + + have "Ana_invar_subst (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t`\1) \ (ik\<^sub>e\<^sub>s\<^sub>t \1d) \ + (\(assignment_rhs\<^sub>s\<^sub>t`\1) \ (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \1d)))" + using tar \1d(2) pts_symbolic_c_preserves_Ana_invar_subst by metis + hence "Ana_invar_subst (ik\<^sub>e\<^sub>s\<^sub>t \1d)" "Ana_invar_subst (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \1d)" + using Ana_invar_subst_subset by blast+ + moreover have "well_analyzed \1d" + using pts_symbolic_c_preserves_well_analyzed[OF \1d(2) wa] by metis + ultimately obtain D where D: + "D \ decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \1d) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \1d) \" + "ik\<^sub>e\<^sub>s\<^sub>t (\1d@D) \\<^sub>s\<^sub>e\<^sub>t \ \\<^sub>c t \ \" + using decomps\<^sub>e\<^sub>s\<^sub>t_exist_subst[OF * \1d(3) ** assms(8)] unfolding Ana_invar_subst_def by auto + + have "(\, \\<^sub>d) \\<^sup>\\<^sub>c\<^sup>* (\1, \1d@D)" using \1d(2) decomps\<^sub>e\<^sub>s\<^sub>t_pts_symbolic_c[OF D(1), of \1] by auto + hence "(\, \\<^sub>d) \\<^sup>\\<^sub>c\<^sup>* (\2, \1d@D@[Step (send\t\\<^sub>s\<^sub>t)])" + using Receive(2) pts_symbolic_c.Receive[OF Receive.hyps(1), of "\1d@D"] by auto + moreover have "\2 = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t (\1d@D@[Step (send\t\\<^sub>s\<^sub>t)]))" + using Receive.hyps(3) \1d(1) decomps\<^sub>e\<^sub>s\<^sub>t_decomp_rm\<^sub>e\<^sub>s\<^sub>t_empty[OF D(1)] + decomp_rm\<^sub>e\<^sub>s\<^sub>t_append to_st_append + by auto + moreover have "sem\<^sub>e\<^sub>s\<^sub>t_c {} \ (\1d@D@[Step (send\t\\<^sub>s\<^sub>t)])" + using D(2) sem\<^sub>e\<^sub>s\<^sub>t_c.Send[OF sem\<^sub>e\<^sub>s\<^sub>t_c_decomps\<^sub>e\<^sub>s\<^sub>t_append[OF \1d(3) D(1)]] by simp + ultimately show ?case by auto + qed +qed + +private lemma pts_symbolic_c_to_pts_symbolic: + assumes "(\,\) \\<^sup>\\<^sub>c\<^sup>* (\',\')" "sem\<^sub>e\<^sub>s\<^sub>t_c {} \ \'" + shows "(\,to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \)) \\<^sup>\\<^sup>* (\',to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \'))" + "sem\<^sub>e\<^sub>s\<^sub>t_d {} \ (decomp_rm\<^sub>e\<^sub>s\<^sub>t \')" +proof - + show "(\,to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \)) \\<^sup>\\<^sup>* (\',to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \'))" using assms(1) + proof (induction rule: rtranclp_induct2) + case (step \1 \1 \2 \2) show ?case using step.hyps(2,1) step.IH + proof (induction rule: pts_symbolic_c_induct) + case Nil thus ?case + using pts_symbolic.Nil[OF Nil.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \1)"] by simp + next + case (Send t S) thus ?case + using pts_symbolic.Send[OF Send.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \1)"] + by (simp add: decomp_rm\<^sub>e\<^sub>s\<^sub>t_append to_st_append) + next + case (Receive t S) thus ?case + using pts_symbolic.Receive[OF Receive.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \1)"] + by (simp add: decomp_rm\<^sub>e\<^sub>s\<^sub>t_append to_st_append) + next + case (Equality a t t' S) thus ?case + using pts_symbolic.Equality[OF Equality.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \1)"] + by (simp add: decomp_rm\<^sub>e\<^sub>s\<^sub>t_append to_st_append) + next + case (Inequality t t' S) thus ?case + using pts_symbolic.Inequality[OF Inequality.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \1)"] + by (simp add: decomp_rm\<^sub>e\<^sub>s\<^sub>t_append to_st_append) + next + case (Decompose t) thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by simp + qed + qed simp +qed (rule sem\<^sub>e\<^sub>s\<^sub>t_d_decomp_rm\<^sub>e\<^sub>s\<^sub>t_if_sem\<^sub>e\<^sub>s\<^sub>t_c[OF assms(2)]) + +private lemma pts_symbolic_to_pts_symbolic_c_from_initial: + assumes "(\\<^sub>0,[]) \\<^sup>\\<^sup>* (\,\)" "\ \ \\\" "wf\<^sub>s\<^sub>t\<^sub>s' \\<^sub>0 []" + and "Ana_invar_subst (\(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \\<^sub>0) \ \(assignment_rhs\<^sub>s\<^sub>t ` \\<^sub>0))" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" + shows "\\\<^sub>d. \ = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \\<^sub>d) \ (\\<^sub>0,[]) \\<^sup>\\<^sub>c\<^sup>* (\,\\<^sub>d) \ (\ \\<^sub>c \to_st \\<^sub>d\)" +using assms pts_symbolic_to_pts_symbolic_c[of \\<^sub>0 "[]" \ \ \] + sem\<^sub>e\<^sub>s\<^sub>t_c_eq_sem_st[of "{}" \] sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st[of "{}" \] + to_st_to_est_inv[of \] strand_sem_eq_defs +by (auto simp add: constr_sem_c_def constr_sem_d_def simp del: subst_range.simps) + +private lemma pts_symbolic_c_to_pts_symbolic_from_initial: + assumes "(\\<^sub>0,[]) \\<^sup>\\<^sub>c\<^sup>* (\,\)" "\ \\<^sub>c \to_st \\" + shows "(\\<^sub>0,[]) \\<^sup>\\<^sup>* (\,to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \))" "\ \ \to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \)\" +using assms pts_symbolic_c_to_pts_symbolic[of \\<^sub>0 "[]" \ \ \] + sem\<^sub>e\<^sub>s\<^sub>t_c_eq_sem_st[of "{}" \] sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st[of "{}" \] strand_sem_eq_defs +by (auto simp add: constr_sem_c_def constr_sem_d_def) + +private lemma to_st_trms_wf: + assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>e\<^sub>s\<^sub>t A)" + shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t (to_st A))" +using assms +proof (induction A) + case (Cons x A) + hence IH: "\t \ trms\<^sub>s\<^sub>t (to_st A). wf\<^sub>t\<^sub>r\<^sub>m t" by auto + with Cons show ?case + proof (cases x) + case (Decomp t) + hence "wf\<^sub>t\<^sub>r\<^sub>m t" using Cons.prems by auto + obtain K T where Ana_t: "Ana t = (K,T)" by moura + hence "trms\<^sub>s\<^sub>t (decomp t) \ {t} \ set K \ set T" using decomp_set_unfold[OF Ana_t] by force + moreover have "\t \ set T. wf\<^sub>t\<^sub>r\<^sub>m t" using Ana_subterm[OF Ana_t] \wf\<^sub>t\<^sub>r\<^sub>m t\ wf_trm_subterm by auto + ultimately have "\t \ trms\<^sub>s\<^sub>t (decomp t). wf\<^sub>t\<^sub>r\<^sub>m t" using Ana_keys_wf'[OF Ana_t] \wf\<^sub>t\<^sub>r\<^sub>m t\ by auto + thus ?thesis using IH Decomp by auto + qed auto +qed simp + +private lemma to_st_trms_SMP_subset: "trms\<^sub>s\<^sub>t (to_st A) \ SMP (trms\<^sub>e\<^sub>s\<^sub>t A)" +proof + fix t assume "t \ trms\<^sub>s\<^sub>t (to_st A)" thus "t \ SMP (trms\<^sub>e\<^sub>s\<^sub>t A)" + proof (induction A) + case (Cons x A) + hence *: "t \ trms\<^sub>s\<^sub>t (to_st [x]) \ trms\<^sub>s\<^sub>t (to_st A)" using to_st_append[of "[x]" A] by auto + have **: "trms\<^sub>s\<^sub>t (to_st A) \ trms\<^sub>s\<^sub>t (to_st (x#A))" "trms\<^sub>e\<^sub>s\<^sub>t A \ trms\<^sub>e\<^sub>s\<^sub>t (x#A)" + using to_st_append[of "[x]" A] by auto + show ?case + proof (cases "t \ trms\<^sub>s\<^sub>t (to_st A)") + case True thus ?thesis using Cons.IH SMP_mono[OF **(2)] by auto + next + case False + hence ***: "t \ trms\<^sub>s\<^sub>t (to_st [x])" using * by auto + thus ?thesis + proof (cases x) + case (Decomp t') + hence ****: "t \ trms\<^sub>s\<^sub>t (decomp t')" "t' \ trms\<^sub>e\<^sub>s\<^sub>t (x#A)" using *** by auto + obtain K T where Ana_t': "Ana t' = (K,T)" by moura + hence "t \ {t'} \ set K \ set T" using decomp_set_unfold[OF Ana_t'] ****(1) by force + moreover + { assume "t = t'" hence ?thesis using SMP.MP[OF ****(2)] by simp } + moreover + { assume "t \ set K" hence ?thesis using SMP.Ana[OF SMP.MP[OF ****(2)] Ana_t'] by auto } + moreover + { assume "t \ set T" "t \ t'" + hence "t \ t'" using Ana_subterm[OF Ana_t'] by blast + hence ?thesis using SMP.Subterm[OF SMP.MP[OF ****(2)]] by auto + } + ultimately show ?thesis using Decomp by auto + qed auto + qed + qed simp +qed + +private lemma to_st_trms_tfr\<^sub>s\<^sub>e\<^sub>t: + assumes "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t A)" + shows "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t (to_st A))" +proof - + have *: "trms\<^sub>s\<^sub>t (to_st A) \ SMP (trms\<^sub>e\<^sub>s\<^sub>t A)" + using to_st_trms_wf to_st_trms_SMP_subset assms unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by auto + have "trms\<^sub>s\<^sub>t (to_st A) = trms\<^sub>s\<^sub>t (to_st A) \ trms\<^sub>e\<^sub>s\<^sub>t A" by (blast dest!: trms\<^sub>e\<^sub>s\<^sub>tD) + hence "SMP (trms\<^sub>e\<^sub>s\<^sub>t A) = SMP (trms\<^sub>s\<^sub>t (to_st A))" using SMP_subset_union_eq[OF *] by auto + thus ?thesis using * assms unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by presburger +qed + +theorem wt_attack_if_tfr_attack_pts: + assumes "wf\<^sub>s\<^sub>t\<^sub>s \\<^sub>0" "tfr\<^sub>s\<^sub>e\<^sub>t (\(trms\<^sub>s\<^sub>t ` \\<^sub>0))" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\(trms\<^sub>s\<^sub>t ` \\<^sub>0))" "\S \ \\<^sub>0. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + and "Ana_invar_subst (\(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \\<^sub>0) \ \(assignment_rhs\<^sub>s\<^sub>t ` \\<^sub>0))" + and "(\\<^sub>0,[]) \\<^sup>\\<^sup>* (\,\)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "\ \ \\, Var\" + shows "\\\<^sub>\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ (\\<^sub>\ \ \\, Var\) \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)" +proof - + have "(\(trms\<^sub>s\<^sub>t ` \\<^sub>0)) \ (trms\<^sub>e\<^sub>s\<^sub>t []) = \(trms\<^sub>s\<^sub>t ` \\<^sub>0)" "to_st [] = []" "list_all tfr\<^sub>s\<^sub>t\<^sub>p []" + using assms by simp_all + hence *: "tfr\<^sub>s\<^sub>e\<^sub>t ((\(trms\<^sub>s\<^sub>t ` \\<^sub>0)) \ (trms\<^sub>e\<^sub>s\<^sub>t []))" + "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s ((\(trms\<^sub>s\<^sub>t ` \\<^sub>0)) \ (trms\<^sub>e\<^sub>s\<^sub>t []))" + "wf\<^sub>s\<^sub>t\<^sub>s' \\<^sub>0 []" "\S \ \\<^sub>0 \ {to_st []}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + using assms wf\<^sub>s\<^sub>t\<^sub>s_wf\<^sub>s\<^sub>t\<^sub>s' by (metis, metis, metis, simp) + + obtain \\<^sub>d where \\<^sub>d: "\ = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \\<^sub>d)" "(\\<^sub>0,[]) \\<^sup>\\<^sub>c\<^sup>* (\,\\<^sub>d)" "\ \\<^sub>c \to_st \\<^sub>d\" + using pts_symbolic_to_pts_symbolic_c_from_initial assms *(3) by metis + hence "tfr\<^sub>s\<^sub>e\<^sub>t (\(trms\<^sub>s\<^sub>t ` \) \ (trms\<^sub>e\<^sub>s\<^sub>t \\<^sub>d))" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\(trms\<^sub>s\<^sub>t ` \) \ (trms\<^sub>e\<^sub>s\<^sub>t \\<^sub>d))" + using pts_symbolic_c_preserves_tfr\<^sub>s\<^sub>e\<^sub>t[OF _ *(1,2)] by blast+ + hence "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t \\<^sub>d)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>e\<^sub>s\<^sub>t \\<^sub>d)" + unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (metis DiffE DiffI SMP_union UnCI, metis UnCI) + hence "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t (to_st \\<^sub>d))" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t (to_st \\<^sub>d))" + by (metis to_st_trms_tfr\<^sub>s\<^sub>e\<^sub>t, metis to_st_trms_wf) + moreover have "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r (to_st \\<^sub>d) Var" + proof - + have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" "subst_domain Var \ vars\<^sub>e\<^sub>s\<^sub>t \\<^sub>d = {}" + "range_vars Var \ bvars\<^sub>e\<^sub>s\<^sub>t \\<^sub>d = {}" + by (simp_all add: range_vars_alt_def) + moreover have "wf\<^sub>e\<^sub>s\<^sub>t {} \\<^sub>d" + using pts_symbolic_c_preserves_wf_is[OF \\<^sub>d(2) *(3), of "{}"] + by auto + moreover have "fv\<^sub>s\<^sub>t (to_st \\<^sub>d) \ bvars\<^sub>e\<^sub>s\<^sub>t \\<^sub>d = {}" + using pts_symbolic_c_preserves_constr_disj_vars[OF \\<^sub>d(2)] assms(1) wf\<^sub>s\<^sub>t\<^sub>s_wf\<^sub>s\<^sub>t\<^sub>s' + by fastforce + ultimately show ?thesis 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 simp + qed + moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \\<^sub>d)" + using pts_symbolic_c_preserves_tfr\<^sub>s\<^sub>t\<^sub>p[OF \\<^sub>d(2) *(4)] by blast + moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" by simp_all + ultimately obtain \\<^sub>\ where \\<^sub>\: + "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "\\<^sub>\ \\<^sub>c \to_st \\<^sub>d, Var\" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)" + using wt_attack_if_tfr_attack[OF assms(7) \\<^sub>d(3)] + \tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t (to_st \\<^sub>d))\ \list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \\<^sub>d)\ + unfolding tfr\<^sub>s\<^sub>t_def by metis + hence "\\<^sub>\ \ \\, Var\" using pts_symbolic_c_to_pts_symbolic_from_initial \\<^sub>d by metis + thus ?thesis using \\<^sub>\(1,3,4) by metis +qed + + +subsubsection \Corollary: The Typing Result on the Level of Constraints\ +text \There exists well-typed models of satisfiable type-flaw resistant constraints\ +corollary wt_attack_if_tfr_attack_d: + assumes "wf\<^sub>s\<^sub>t {} \" "fv\<^sub>s\<^sub>t \ \ bvars\<^sub>s\<^sub>t \ = {}" "tfr\<^sub>s\<^sub>t \" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t \)" + and "Ana_invar_subst (ik\<^sub>s\<^sub>t \ \ assignment_rhs\<^sub>s\<^sub>t \)" + and "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \" "\ \ \\\" + shows "\\\<^sub>\. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ (\\<^sub>\ \ \\\) \ wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \\<^sub>\ \ wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \\<^sub>\)" +proof - + { fix S A have "({S},A) \\<^sup>\\<^sup>* ({},A@dual\<^sub>s\<^sub>t S)" + proof (induction S arbitrary: A) + case Nil thus ?case using pts_symbolic.Nil[of "{[]}"] by auto + next + case (Cons x S) + hence "({S}, A@dual\<^sub>s\<^sub>t [x]) \\<^sup>\\<^sup>* ({}, A@dual\<^sub>s\<^sub>t (x#S))" + by (metis dual\<^sub>s\<^sub>t_append List.append_assoc List.append_Nil List.append_Cons) + moreover have "({x#S}, A) \\<^sup>\ ({S}, A@dual\<^sub>s\<^sub>t [x])" + using pts_symbolic.Send[of _ S "{x#S}"] pts_symbolic.Receive[of _ S "{x#S}"] + pts_symbolic.Equality[of _ _ _ S "{x#S}"] pts_symbolic.Inequality[of _ _ S "{x#S}"] + by (cases x) auto + ultimately show ?case by simp + qed + } + hence 0: "({dual\<^sub>s\<^sub>t \},[]) \\<^sup>\\<^sup>* ({},\)" using dual\<^sub>s\<^sub>t_self_inverse by (metis List.append_Nil) + + have "fv\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t \) \ bvars\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t \) = {}" using assms(2) dual\<^sub>s\<^sub>t_fv dual\<^sub>s\<^sub>t_bvars by metis+ + hence 1: "wf\<^sub>s\<^sub>t\<^sub>s {dual\<^sub>s\<^sub>t \}" using assms(1,2) dual\<^sub>s\<^sub>t_self_inverse[of \] unfolding wf\<^sub>s\<^sub>t\<^sub>s_def by auto + + have "\(trms\<^sub>s\<^sub>t ` {\}) = trms\<^sub>s\<^sub>t \" "\(trms\<^sub>s\<^sub>t ` {dual\<^sub>s\<^sub>t \}) = trms\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t \)" by auto + hence "tfr\<^sub>s\<^sub>e\<^sub>t (\(trms\<^sub>s\<^sub>t ` {\}))" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\(trms\<^sub>s\<^sub>t ` {\}))" + "(\(trms\<^sub>s\<^sub>t ` {\})) = \(trms\<^sub>s\<^sub>t ` {dual\<^sub>s\<^sub>t \})" + using assms(3,4) unfolding tfr\<^sub>s\<^sub>t_def + by (metis, metis, metis dual\<^sub>s\<^sub>t_trms_eq) + hence 2: "tfr\<^sub>s\<^sub>e\<^sub>t (\(trms\<^sub>s\<^sub>t ` {dual\<^sub>s\<^sub>t \}))" and 3: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\(trms\<^sub>s\<^sub>t ` {dual\<^sub>s\<^sub>t \}))" by metis+ + + have 4: "\S \ {dual\<^sub>s\<^sub>t \}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" + using dual\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>t\<^sub>p assms(3) unfolding tfr\<^sub>s\<^sub>t_def by blast + + have "assignment_rhs\<^sub>s\<^sub>t \ = assignment_rhs\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t \)" + by (induct \ rule: assignment_rhs\<^sub>s\<^sub>t.induct) auto + hence 5: "Ana_invar_subst (\(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t`{dual\<^sub>s\<^sub>t \}) \ \(assignment_rhs\<^sub>s\<^sub>t`{dual\<^sub>s\<^sub>t \}))" + using assms(5) dual\<^sub>s\<^sub>t_self_inverse[of \] by auto + + show ?thesis by (rule wt_attack_if_tfr_attack_pts[OF 1 2 3 4 5 0 assms(6,7)]) +qed + +end + +end + +end + diff --git a/thys/Stateful_Protocol_Composition_and_Typing/document/root.bib b/thys/Stateful_Protocol_Composition_and_Typing/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/document/root.bib @@ -0,0 +1,47 @@ + +@InProceedings{ hess.ea:formalizing:2017, + author = {Andreas V. Hess and Sebastian M{\"{o}}dersheim}, + title = {{Formalizing and Proving a Typing Result for Security Protocols in Isabelle/HOL}}, + booktitle = {30th {IEEE} Computer Security Foundations Symposium, {CSF} 2017, Santa Barbara, CA, USA, August + 21-25, 2017}, + pages = {451--463}, + publisher = {{IEEE} Computer Society}, + year = 2017, + doi = {10.1109/CSF.2017.27} +} + +@InProceedings{ hess.ea:typing:2018, + author = {Andreas V. Hess and Sebastian M{\"{o}}dersheim}, + title = {{A Typing Result for Stateful Protocols}}, + booktitle = {31st {IEEE} Computer Security Foundations Symposium, {CSF} 2018, Oxford, United Kingdom, July 9-12, + 2018}, + pages = {374--388}, + publisher = {{IEEE} Computer Society}, + year = 2018, + doi = {10.1109/CSF.2018.00034} +} + +@InProceedings{ hess.ea:stateful:2018, + author = {Andreas V. Hess and Sebastian M{\"{o}}dersheim and Achim D. Brucker}, + editor = {Javier L{\'{o}}pez and Jianying Zhou and Miguel Soriano}, + title = {{Stateful Protocol Composition}}, + booktitle = {Computer Security - 23rd European Symposium on Research in Computer Security, {ESORICS} 2018, + Barcelona, Spain, September 3-7, 2018, Proceedings, Part {I}}, + series = {Lecture Notes in Computer Science}, + volume = 11098, + pages = {427--446}, + publisher = {Springer}, + year = 2018, + doi = {10.1007/978-3-319-99073-6_21} +} + +@PhDThesis{ hess:typing:2018, + author = {Andreas Viktor Hess}, + title = {Typing and Compositionality for Stateful Security Protocols}, + year = {2019}, + url = {https://orbit.dtu.dk/en/publications/typing-and-compositionality-for-stateful-security-protocols}, + language = {English}, + series = {TU Compute PHD-2018}, + publisher = {DTU Compute} +} + diff --git a/thys/Stateful_Protocol_Composition_and_Typing/document/root.tex b/thys/Stateful_Protocol_Composition_and_Typing/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/document/root.tex @@ -0,0 +1,151 @@ +\documentclass[10pt,DIV16,a4paper,abstract=true,twoside=semi,openright] +{scrreprt} +\usepackage[USenglish]{babel} +\usepackage[numbers, sort&compress]{natbib} +\usepackage{isabelle,isabellesym} +\usepackage{booktabs} +\usepackage{paralist} +\usepackage{graphicx} +\usepackage{amssymb} +\usepackage{xspace} +\usepackage{xcolor} +\usepackage{hyperref} + +\sloppy +\pagestyle{headings} +\isabellestyle{default} +\setcounter{tocdepth}{1} +\newcommand{\ie}{i.\,e.\xspace} +\newcommand{\eg}{e.\,g.\xspace} +\newcommand{\thy}{\isabellecontext} +\renewcommand{\isamarkupsection}[1]{% + \begingroup% + \def\isacharunderscore{\textunderscore}% + \section{#1 (\thy)}% + \def\isacharunderscore{-}% + \expandafter\label{sec:\isabellecontext}% + \endgroup% +} + +\title{Stateful Protocol Composition and Typing} +\author{% + \href{https://www.dtu.dk/english/service/phonebook/person?id=64207}{Andreas~V.~Hess}\footnotemark[1] + \and + \href{https://people.compute.dtu.dk/samo/}{Sebastian~M{\"o}dersheim}\footnotemark[1] + \and + \href{http://www.brucker.ch/}{Achim~D.~Brucker}\footnotemark[2] +} +\publishers{% + \footnotemark[1]~DTU Compute, Technical University of Denmark, Lyngby, Denmark\texorpdfstring{\\}{, } + \texttt{\{avhe, samo\}@dtu.dk}\\[2em] + % + \footnotemark[2]~ + Department of Computer Science, University of Exeter, Exeter, UK\texorpdfstring{\\}{, } + \texttt{a.brucker@exeter.ac.uk} + % +} + +\begin{document} + \maketitle + \begin{abstract} + \begin{quote} + 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. + + \bigskip + \noindent{\textbf{Keywords:}} + Security protocols, stateful protocols, relative soundness results, proof assistants, Isabelle/HOL, compositionality + \end{quote} + \end{abstract} + + +\tableofcontents +\cleardoublepage + +\chapter{Introduction} +The rest of this document is automatically generated from the formalization in Isabelle/HOL, i.e., all content is checked by Isabelle. +The formalization presented in this entry is described in more detail in several publications: +\begin{itemize} +\item The typing result (\autoref{sec:Typing{-}Result} ``Typing\_Result'') for stateless protocols, the TLS formalization (\autoref{sec:Example{-}TLS} ``Example\_TLS''), and the theories depending on those (see \autoref{fig:session-graph}) are described in~\cite{hess.ea:formalizing:2017} and~\cite[chapter 3]{hess:typing:2018}. +\item The typing result for stateful protocols (\autoref{sec:Stateful{-}Typing} ``Stateful\_Typing'') and the keyserver example (\autoref{sec:Example{-}Keyserver} ``Example\_Keyserver'') are described in~\cite{hess.ea:typing:2018} and~\cite[chapter 4]{hess:typing:2018}. +\item The results on parallel composition for stateless protocols (\autoref{sec:Parallel{-}Compositionality} ``Parallel\_Compositionality'') and stateful protocols (\autoref{sec:Stateful{-}Compositionality} ``Stateful\_Compositionality'') are described in~\cite{hess.ea:stateful:2018} and~\cite[chapter 5]{hess:typing:2018}. +\end{itemize} +Overall, the structure of this document follows the theory dependencies (see \autoref{fig:session-graph}): we start with introducing the technical preliminaries of our formalization (\autoref{cha:preliminaries}). +Next, we introduce the typing results in \autoref{cha:typing} and \autoref{cha:stateful-typing}. +We introduce our compositionality results in \autoref{cha:composition} and \autoref{cha:stateful-composition}. +Finally, we present two example protocols \autoref{cha:examples}. + +\paragraph{Acknowledgments} +This work was supported by the Sapere-Aude project ``Composec: Secure Composition of Distributed Systems'', grant 4184-00334B of the Danish Council for Independent Research. + +\clearpage + +\begin{figure} + \centering + \includegraphics[height=\textheight]{session_graph} + \caption{The Dependency Graph of the Isabelle Theories.\label{fig:session-graph}} +\end{figure} + +\clearpage + +% \input{session} + +\chapter{Preliminaries and Intruder Model} +\label{cha:preliminaries} +In this chapter, we introduce the formal preliminaries, including the intruder model and related lemmata. +\input{Miscellaneous.tex} +\input{Messages.tex} +\input{More_Unification.tex} +\input{Intruder_Deduction.tex} + +\chapter{The Typing Result for Non-Stateful Protocols} +\label{cha:typing} +In this chapter, we formalize and prove a typing result for ``stateless'' security protocols. +This work is described in more detail in~\cite{hess.ea:formalizing:2017} and~\cite[chapter 3]{hess:typing:2018}. +\input{Strands_and_Constraints.tex} +\input{Lazy_Intruder.tex} +\input{Typed_Model.tex} +\input{Typing_Result.tex} + +\chapter{The Typing Result for Stateful Protocols} +\label{cha:stateful-typing} +In this chapter, we lift the typing result to stateful protocols. +For more details, we refer the reader to~\cite{hess.ea:typing:2018} and~\cite[chapter 4]{hess:typing:2018}. +\input{Stateful_Strands.tex} +\input{Stateful_Typing.tex} + +\chapter{The Parallel Composition Result for Non-Stateful Protocols} +\label{cha:composition} +In this chapter, we formalize and prove a compositionality result for security protocols. +This work is an extension of the work described in~\cite{hess.ea:stateful:2018} and~\cite[chapter 5]{hess:typing:2018}. +\input{Labeled_Strands.tex} +\input{Parallel_Compositionality.tex} + +\chapter{The Stateful Protocol Composition Result} +\label{cha:stateful-composition} +In this chapter, we extend the compositionality result to stateful security protocols. +This work is an extension of the work described in~\cite{hess.ea:stateful:2018} and~\cite[chapter 5]{hess:typing:2018}. +\input{Labeled_Stateful_Strands.tex} +\input{Stateful_Compositionality.tex} + +\chapter{Examples} +\label{cha:examples} +In this chapter, we present two examples illustrating our results: +In \autoref{sec:Example{-}TLS} we show that the TLS example from~\cite{hess.ea:formalizing:2017} is type-flaw resistant. +In \autoref{sec:Example{-}Keyserver} we show that the keyserver examples from~\cite{hess.ea:typing:2018,hess.ea:stateful:2018} are also type-flaw resistant and that the steps of the composed keyserver protocol from~\cite{hess.ea:stateful:2018} satisfy our conditions for protocol composition. +\input{Example_TLS.tex} +\input{Example_Keyserver.tex} + +{\small + \bibliographystyle{abbrvnat} + \bibliography{root} +} +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: diff --git a/thys/Stateful_Protocol_Composition_and_Typing/examples/Example_Keyserver.thy b/thys/Stateful_Protocol_Composition_and_Typing/examples/Example_Keyserver.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/examples/Example_Keyserver.thy @@ -0,0 +1,404 @@ +(* +(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: Example_Keyserver.thy + Author: Andreas Viktor Hess, DTU +*) + + +section \The Keyserver Example\ +theory Example_Keyserver +imports "../Stateful_Compositionality" +begin + +declare [[code_timing]] + +subsection \Setup\ +subsubsection \Datatypes and functions setup\ +datatype ex_lbl = Label1 ("\") | Label2 ("\") + +datatype ex_atom = + Agent | Value | Attack | PrivFunSec +| Bot + +datatype ex_fun = + ring | valid | revoked | events | beginauth nat | endauth nat | pubkeys | seen +| invkey | tuple | tuple' | attack nat +| sign | crypt | update | pw +| encodingsecret | pubkey nat +| pubconst ex_atom nat + +type_synonym ex_type = "(ex_fun, ex_atom) term_type" +type_synonym ex_var = "ex_type \ nat" + +lemma ex_atom_UNIV: + "(UNIV::ex_atom set) = {Agent, Value, Attack, PrivFunSec, Bot}" +by (auto intro: ex_atom.exhaust) + +instance ex_atom::finite +by intro_classes (metis ex_atom_UNIV finite.emptyI finite.insertI) + +lemma ex_lbl_UNIV: + "(UNIV::ex_lbl set) = {Label1, Label2}" +by (auto intro: ex_lbl.exhaust) + +type_synonym ex_term = "(ex_fun, ex_var) term" +type_synonym ex_terms = "(ex_fun, ex_var) terms" + +primrec arity::"ex_fun \ nat" where + "arity ring = 2" +| "arity valid = 3" +| "arity revoked = 3" +| "arity events = 1" +| "arity (beginauth _) = 3" +| "arity (endauth _) = 3" +| "arity pubkeys = 2" +| "arity seen = 2" +| "arity invkey = 2" +| "arity tuple = 2" +| "arity tuple' = 2" +| "arity (attack _) = 0" +| "arity sign = 2" +| "arity crypt = 2" +| "arity update = 4" +| "arity pw = 2" +| "arity (pubkey _) = 0" +| "arity encodingsecret = 0" +| "arity (pubconst _ _) = 0" + +fun public::"ex_fun \ bool" where + "public (pubkey _) = False" +| "public encodingsecret = False" +| "public _ = True" + +fun Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t::"ex_term list \ (ex_term list \ ex_term list)" where + "Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t [k,m] = ([Fun invkey [Fun encodingsecret [], k]], [m])" +| "Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t _ = ([], [])" + +fun Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n::"ex_term list \ (ex_term list \ ex_term list)" where + "Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n [k,m] = ([], [m])" +| "Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n _ = ([], [])" + +fun Ana::"ex_term \ (ex_term list \ ex_term list)" where + "Ana (Fun tuple T) = ([], T)" +| "Ana (Fun tuple' T) = ([], T)" +| "Ana (Fun sign T) = Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n T" +| "Ana (Fun crypt T) = Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t T" +| "Ana _ = ([], [])" + + +subsubsection \Keyserver example: Locale interpretation\ +lemma assm1: + "Ana t = (K,M) \ fv\<^sub>s\<^sub>e\<^sub>t (set K) \ fv t" + "Ana t = (K,M) \ (\g S'. Fun g S' \ t \ length S' = arity g) + \ k \ set K \ Fun f T' \ k \ length T' = arity f" + "Ana t = (K,M) \ K \ [] \ M \ [] \ Ana (t \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" +by (rule Ana.cases[of "t"], auto elim!: Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t.elims Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n.elims)+ + +lemma assm2: "Ana (Fun f T) = (K, M) \ set M \ set T" +by (rule Ana.cases[of "Fun f T"]) (auto elim!: Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t.elims Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n.elims) + +lemma assm6: "0 < arity f \ public f" by (cases f) simp_all + +global_interpretation im: intruder_model arity public Ana + defines wf\<^sub>t\<^sub>r\<^sub>m = "im.wf\<^sub>t\<^sub>r\<^sub>m" +by unfold_locales (metis assm1(1), metis assm1(2),rule Ana.simps, metis assm2, metis assm1(3)) + +type_synonym ex_strand_step = "(ex_fun,ex_var) strand_step" +type_synonym ex_strand = "(ex_fun,ex_var) strand" + + +subsubsection \Typing function\ +definition \\<^sub>v::"ex_var \ ex_type" where + "\\<^sub>v v = (if (\t \ subterms (fst v). case t of + (TComp f T) \ arity f > 0 \ arity f = length T + | _ \ True) + then fst v else TAtom Bot)" + +fun \::"ex_term \ ex_type" where + "\ (Var v) = \\<^sub>v v" +| "\ (Fun (attack _) _) = TAtom Attack" +| "\ (Fun (pubkey _) _) = TAtom Value" +| "\ (Fun encodingsecret _) = TAtom PrivFunSec" +| "\ (Fun (pubconst \ _) _) = TAtom \" +| "\ (Fun f T) = TComp f (map \ T)" + + +subsubsection \Locale interpretation: typed model\ +lemma assm7: "arity c = 0 \ \a. \X. \ (Fun c X) = TAtom a" by (cases c) simp_all + +lemma assm8: "0 < arity f \ \ (Fun f X) = TComp f (map \ X)" by (cases f) simp_all + +lemma assm9: "infinite {c. \ (Fun c []) = TAtom a \ public c}" +proof - + let ?T = "(range (pubconst a))::ex_fun set" + have *: + "\x y::nat. x \ UNIV \ y \ UNIV \ (pubconst a x = pubconst a y) = (x = y)" + "\x::nat. x \ UNIV \ pubconst a x \ ?T" + "\y::ex_fun. y \ ?T \ \x \ UNIV. y = pubconst a x" + by auto + have "?T \ {c. \ (Fun c []) = TAtom a \ public c}" by auto + moreover have "\f::nat \ ex_fun. bij_betw f UNIV ?T" + using bij_betwI'[OF *] by blast + hence "infinite ?T" by (metis nat_not_finite bij_betw_finite) + ultimately show ?thesis using infinite_super by blast +qed + +lemma assm10: "TComp f T \ \ t \ arity f > 0" +proof (induction rule: \.induct) + case (1 x) + hence *: "TComp f T \ \\<^sub>v x" by simp + hence "\\<^sub>v x \ TAtom Bot" unfolding \\<^sub>v_def by force + hence "\t \ subterms (fst x). case t of + (TComp f T) \ arity f > 0 \ arity f = length T + | _ \ True" + unfolding \\<^sub>v_def by argo + thus ?case using * unfolding \\<^sub>v_def by fastforce +qed auto + +lemma assm11: "im.wf\<^sub>t\<^sub>r\<^sub>m (\ (Var x))" +proof - + have "im.wf\<^sub>t\<^sub>r\<^sub>m (\\<^sub>v x)" unfolding \\<^sub>v_def im.wf\<^sub>t\<^sub>r\<^sub>m_def by auto + thus ?thesis by simp +qed + +lemma assm12: "\ (Var (\, n)) = \ (Var (\, m))" +apply (cases "\t \ subterms \. case t of + (TComp f T) \ arity f > 0 \ arity f = length T + | _ \ True") +by (auto simp add: \\<^sub>v_def) + +lemma Ana_const: "arity c = 0 \ Ana (Fun c T) = ([], [])" +by (cases c) simp_all + +lemma Ana_subst': "Ana (Fun f T) = (K,M) \ Ana (Fun f T \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \,M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" +by (cases f) (auto elim!: Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t.elims Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n.elims) + +global_interpretation tm: typed_model' arity public Ana \ +by (unfold_locales, unfold wf\<^sub>t\<^sub>r\<^sub>m_def[symmetric]) + (metis assm7, metis assm8, metis assm9, metis assm10, metis assm11, metis assm6, + metis assm12, metis Ana_const, metis Ana_subst') + + +subsubsection \Locale interpretation: labeled stateful typed model\ +global_interpretation stm: labeled_stateful_typed_model' arity public Ana \ tuple \ \ +by standard (rule arity.simps, metis Ana_subst', metis assm12, metis Ana_const, simp) + +type_synonym ex_stateful_strand_step = "(ex_fun,ex_var) stateful_strand_step" +type_synonym ex_stateful_strand = "(ex_fun,ex_var) stateful_strand" + +type_synonym ex_labeled_stateful_strand_step = + "(ex_fun,ex_var,ex_lbl) labeled_stateful_strand_step" + +type_synonym ex_labeled_stateful_strand = + "(ex_fun,ex_var,ex_lbl) labeled_stateful_strand" + + +subsection \Theorem: Type-flaw resistance of the keyserver example from the CSF18 paper\ +abbreviation "PK n \ Var (TAtom Value,n)" +abbreviation "A n \ Var (TAtom Agent,n)" +abbreviation "X n \ (TAtom Agent,n)" + +abbreviation "ringset t \ Fun ring [Fun encodingsecret [], t]" +abbreviation "validset t t' \ Fun valid [Fun encodingsecret [], t, t']" +abbreviation "revokedset t t' \ Fun revoked [Fun encodingsecret [], t, t']" +abbreviation "eventsset \ Fun events [Fun encodingsecret []]" + +(* Note: We will use S\<^sub>k\<^sub>s as a constraint, but it actually represents all steps that might occur + in the protocol *) +abbreviation S\<^sub>k\<^sub>s::"(ex_fun,ex_var) stateful_strand_step list" where + "S\<^sub>k\<^sub>s \ [ + insert\Fun (attack 0) [], eventsset\, + delete\PK 0, validset (A 0) (A 0)\, + \(TAtom Agent,0)\PK 0 not in revokedset (A 0) (A 0)\, + \(TAtom Agent,0)\PK 0 not in validset (A 0) (A 0)\, + insert\PK 0, validset (A 0) (A 0)\, + insert\PK 0, ringset (A 0)\, + insert\PK 0, revokedset (A 0) (A 0)\, + select\PK 0, validset (A 0) (A 0)\, + select\PK 0, ringset (A 0)\, + receive\Fun invkey [Fun encodingsecret [], PK 0]\, + receive\Fun sign [Fun invkey [Fun encodingsecret [], PK 0], Fun tuple' [A 0, PK 0]]\, + send\Fun invkey [Fun encodingsecret [], PK 0]\, + send\Fun sign [Fun invkey [Fun encodingsecret [], PK 0], Fun tuple' [A 0, PK 0]]\ +]" + +theorem "stm.tfr\<^sub>s\<^sub>s\<^sub>t S\<^sub>k\<^sub>s" +proof - + let ?M = "concat (map subterms_list (trms_list\<^sub>s\<^sub>s\<^sub>t S\<^sub>k\<^sub>s@map (pair' tuple) (setops_list\<^sub>s\<^sub>s\<^sub>t S\<^sub>k\<^sub>s)))" + have "comp_tfr\<^sub>s\<^sub>s\<^sub>t arity Ana \ tuple ?M S\<^sub>k\<^sub>s" by eval + thus ?thesis by (rule stm.tfr\<^sub>s\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>s\<^sub>t) +qed + + +subsection \Theorem: Type-flaw resistance of the keyserver examples from the ESORICS18 paper\ +abbreviation "signmsg t t' \ Fun sign [t, t']" +abbreviation "cryptmsg t t' \ Fun crypt [t, t']" +abbreviation "invkeymsg t \ Fun invkey [Fun encodingsecret [], t]" +abbreviation "updatemsg a b c d \ Fun update [a,b,c,d]" +abbreviation "pwmsg t t' \ Fun pw [t, t']" + +abbreviation "beginauthset n t t' \ Fun (beginauth n) [Fun encodingsecret [], t, t']" +abbreviation "endauthset n t t' \ Fun (endauth n) [Fun encodingsecret [], t, t']" +abbreviation "pubkeysset t \ Fun pubkeys [Fun encodingsecret [], t]" +abbreviation "seenset t \ Fun seen [Fun encodingsecret [], t]" + +declare [[coercion "Var::ex_var \ ex_term"]] +declare [[coercion_enabled]] + +(* Note: S'\<^sub>k\<^sub>s contains the (slightly over-approximated) steps that can occur in the + reachable constraints of \

\<^sub>k\<^sub>s,\<^sub>1 and \

\<^sub>k\<^sub>s,\<^sub>2 modulo variable renaming *) +definition S'\<^sub>k\<^sub>s::"ex_labeled_stateful_strand_step list" where + "S'\<^sub>k\<^sub>s \ [ +\<^cancel>\constraint steps from the first protocol (duplicate steps are ignored)\ + + \<^cancel>\rule R^1_1\ + \\, send\invkeymsg (PK 0)\\, + \\, \PK 0 in validset (A 0) (A 1)\\, + \\, receive\Fun (attack 0) []\\, + + \<^cancel>\rule R^2_1\ + \\, send\signmsg (invkeymsg (PK 0)) (Fun tuple' [A 0, PK 0])\\, + \\, \PK 0 in validset (A 0) (A 1)\\, + \\, \X 0, X 1\PK 0 not in validset (Var (X 0)) (Var (X 1))\\, + \\, \X 0, X 1\PK 0 not in revokedset (Var (X 0)) (Var (X 1))\\, + \\, \PK 0 not in beginauthset 0 (A 0) (A 1)\\, + + \<^cancel>\rule R^3_1\ + \\, \PK 0 in beginauthset 0 (A 0) (A 1)\\, + \\, \PK 0 in endauthset 0 (A 0) (A 1)\\, + + \<^cancel>\rule R^4_1\ + \\, receive\PK 0\\, + \\, receive\invkeymsg (PK 0)\\, + + \<^cancel>\rule R^5_1\ + \\, insert\PK 0, ringset (A 0)\\, + \\, insert\PK 0, validset (A 0) (A 1)\\, + \\, insert\PK 0, beginauthset 0 (A 0) (A 1)\\, + \\, insert\PK 0, endauthset 0 (A 0) (A 1)\\, + + \<^cancel>\rule R^6_1\ + \\, select\PK 0, ringset (A 0)\\, + \\, delete\PK 0, ringset (A 0)\\, + + \<^cancel>\rule R^7_1\ + \\, \PK 0 not in endauthset 0 (A 0) (A 1)\\, + \\, delete\PK 0, validset (A 0) (A 1)\\, + \\, insert\PK 0, revokedset (A 0) (A 1)\\, + + \<^cancel>\rule R^8_1\ + \<^cancel>\nothing new\ + + \<^cancel>\rule R^9_1\ + \\, send\PK 0\\, + + \<^cancel>\rule R^10_1\ + \\, send\Fun (attack 0) []\\, + +\<^cancel>\constraint steps from the second protocol (duplicate steps are ignored)\ + \<^cancel>\rule R^2_1\ + \\, send\invkeymsg (PK 0)\\, + \\, \PK 0 in validset (A 0) (A 1)\\, + \\, receive\Fun (attack 1) []\\, + + \<^cancel>\rule R^2_2\ + \\, send\cryptmsg (PK 0) (updatemsg (A 0) (A 1) (PK 1) (pwmsg (A 0) (A 1)))\\, + \\, select\PK 0, pubkeysset (A 0)\\, + \\, \X 0\PK 0 not in pubkeysset (Var (X 0))\\, + \\, \X 0\PK 0 not in seenset (Var (X 0))\\, + + \<^cancel>\rule R^3_2\ + \\, \PK 0 in beginauthset 1 (A 0) (A 1)\\, + \\, \PK 0 in endauthset 1 (A 0) (A 1)\\, + + \<^cancel>\rule R^4_2\ + \\, receive\PK 0\\, + \\, receive\invkeymsg (PK 0)\\, + + \<^cancel>\rule R^5_2\ + \\, select\PK 0, pubkeysset (A 0)\\, + \\, insert\PK 0, beginauthset 1 (A 0) (A 1)\\, + \\, receive\cryptmsg (PK 0) (updatemsg (A 0) (A 1) (PK 1) (pwmsg (A 0) (A 1)))\\, + + \<^cancel>\rule R^6_2\ + \\, \PK 0 not in endauthset 1 (A 0) (A 1)\\, + \\, insert\PK 0, validset (A 0) (A 1)\\, + \\, insert\PK 0, endauthset 1 (A 0) (A 1)\\, + \\, insert\PK 0, seenset (A 0)\\, + + \<^cancel>\rule R^7_2\ + \\, receive\pwmsg (A 0) (A 1)\\, + + \<^cancel>\rule R^8_2\ + \<^cancel>\nothing new\ + + \<^cancel>\rule R^9_2\ + \\, insert\PK 0, pubkeysset (A 0)\\, + + \<^cancel>\rule R^10_2\ + \\, send\Fun (attack 1) []\\ +]" + +theorem "stm.tfr\<^sub>s\<^sub>s\<^sub>t (unlabel S'\<^sub>k\<^sub>s)" +proof - + let ?S = "unlabel S'\<^sub>k\<^sub>s" + let ?M = "concat (map subterms_list (trms_list\<^sub>s\<^sub>s\<^sub>t ?S@map (pair' tuple) (setops_list\<^sub>s\<^sub>s\<^sub>t ?S)))" + have "comp_tfr\<^sub>s\<^sub>s\<^sub>t arity Ana \ tuple ?M ?S" by eval + thus ?thesis by (rule stm.tfr\<^sub>s\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>s\<^sub>t) +qed + + +subsection \Theorem: The steps of the keyserver protocols from the ESORICS18 paper satisfy the conditions for parallel composition\ +theorem + fixes S f + defines "S \ [PK 0, invkeymsg (PK 0), Fun encodingsecret []]@concat ( + map (\s. [s, Fun tuple [PK 0, s]]) + [validset (A 0) (A 1), beginauthset 0 (A 0) (A 1), endauthset 0 (A 0) (A 1), + beginauthset 1 (A 0) (A 1), endauthset 1 (A 0) (A 1)])@ + [A 0]" + and "f \ \M. {t \ \ | t \. t \ M \ tm.wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \ \ im.wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \) \ fv (t \ \) = {}}" + and "Sec \ (f (set S)) - {m. im.intruder_synth {} m}" + shows "stm.par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t S'\<^sub>k\<^sub>s Sec" +proof - + let ?N = "\P. concat (map subterms_list (trms_list\<^sub>s\<^sub>s\<^sub>t P@map (pair' tuple) (setops_list\<^sub>s\<^sub>s\<^sub>t P)))" + let ?M = "\l. ?N (proj_unl l S'\<^sub>k\<^sub>s)" + have "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \ tuple S'\<^sub>k\<^sub>s ?M S" + unfolding S_def by eval + thus ?thesis + using stm.par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_if_comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t[of S'\<^sub>k\<^sub>s ?M S] + unfolding Sec_def f_def wf\<^sub>t\<^sub>r\<^sub>m_def[symmetric] by blast +qed + +end diff --git a/thys/Stateful_Protocol_Composition_and_Typing/examples/Example_TLS.thy b/thys/Stateful_Protocol_Composition_and_Typing/examples/Example_TLS.thy new file mode 100644 --- /dev/null +++ b/thys/Stateful_Protocol_Composition_and_Typing/examples/Example_TLS.thy @@ -0,0 +1,305 @@ +(* +(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: Example_TLS.thy + Author: Andreas Viktor Hess, DTU +*) + +section \Proving Type-Flaw Resistance of the TLS Handshake Protocol\ +theory Example_TLS +imports "../Typed_Model" +begin + +declare [[code_timing]] + +subsection \TLS example: Datatypes and functions setup\ +datatype ex_atom = PrivKey | SymKey | PubConst | Agent | Nonce | Bot + +datatype ex_fun = + clientHello | clientKeyExchange | clientFinished +| serverHello | serverCert | serverHelloDone +| finished | changeCipher | x509 | prfun | master | pmsForm +| sign | hash | crypt | pub | concat | privkey nat +| pubconst ex_atom nat + +type_synonym ex_type = "(ex_fun, ex_atom) term_type" +type_synonym ex_var = "ex_type \ nat" + +instance ex_atom::finite +proof + let ?S = "UNIV::ex_atom set" + have "?S = {PrivKey, SymKey, PubConst, Agent, Nonce, Bot}" by (auto intro: ex_atom.exhaust) + thus "finite ?S" by (metis finite.emptyI finite.insertI) +qed + +type_synonym ex_term = "(ex_fun, ex_var) term" +type_synonym ex_terms = "(ex_fun, ex_var) terms" + +primrec arity::"ex_fun \ nat" where + "arity changeCipher = 0" +| "arity clientFinished = 4" +| "arity clientHello = 5" +| "arity clientKeyExchange = 1" +| "arity concat = 5" +| "arity crypt = 2" +| "arity finished = 1" +| "arity hash = 1" +| "arity master = 3" +| "arity pmsForm = 1" +| "arity prfun = 1" +| "arity (privkey _) = 0" +| "arity pub = 1" +| "arity (pubconst _ _) = 0" +| "arity serverCert = 1" +| "arity serverHello = 5" +| "arity serverHelloDone = 0" +| "arity sign = 2" +| "arity x509 = 2" + +fun public::"ex_fun \ bool" where + "public (privkey _) = False" +| "public _ = True" + +fun Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t::"ex_term list \ (ex_term list \ ex_term list)" where + "Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t [Fun pub [k],m] = ([k], [m])" +| "Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t _ = ([], [])" + +fun Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n::"ex_term list \ (ex_term list \ ex_term list)" where + "Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n [k,m] = ([], [m])" +| "Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n _ = ([], [])" + +fun Ana::"ex_term \ (ex_term list \ ex_term list)" where + "Ana (Fun crypt T) = Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t T" +| "Ana (Fun finished T) = ([], T)" +| "Ana (Fun master T) = ([], T)" +| "Ana (Fun pmsForm T) = ([], T)" +| "Ana (Fun serverCert T) = ([], T)" +| "Ana (Fun serverHello T) = ([], T)" +| "Ana (Fun sign T) = Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n T" +| "Ana (Fun x509 T) = ([], T)" +| "Ana _ = ([], [])" + + +subsection \TLS example: Locale interpretation\ +lemma assm1: + "Ana t = (K,M) \ fv\<^sub>s\<^sub>e\<^sub>t (set K) \ fv t" + "Ana t = (K,M) \ (\g S'. Fun g S' \ t \ length S' = arity g) + \ k \ set K \ Fun f T' \ k \ length T' = arity f" + "Ana t = (K,M) \ K \ [] \ M \ [] \ Ana (t \ \) = (K \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \, M \\<^sub>l\<^sub>i\<^sub>s\<^sub>t \)" +by (rule Ana.cases[of "t"], auto elim!: Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t.elims Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n.elims)+ + +lemma assm2: "Ana (Fun f T) = (K, M) \ set M \ set T" +by (rule Ana.cases[of "Fun f T"]) (auto elim!: Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t.elims Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n.elims) + +lemma assm6: "0 < arity f \ public f" by (cases f) simp_all + +global_interpretation im: intruder_model arity public Ana + defines wf\<^sub>t\<^sub>r\<^sub>m = "im.wf\<^sub>t\<^sub>r\<^sub>m" + and wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s = "im.wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s" +by unfold_locales (metis assm1(1), metis assm1(2), rule Ana.simps, metis assm2, metis assm1(3)) + + +subsection \TLS Example: Typing function\ +definition \\<^sub>v::"ex_var \ ex_type" where + "\\<^sub>v v = (if (\t \ subterms (fst v). case t of + (TComp f T) \ arity f > 0 \ arity f = length T + | _ \ True) + then fst v else TAtom Bot)" + +fun \::"ex_term \ ex_type" where + "\ (Var v) = \\<^sub>v v" +| "\ (Fun (privkey _) _) = TAtom PrivKey" +| "\ (Fun changeCipher _) = TAtom PubConst" +| "\ (Fun serverHelloDone _) = TAtom PubConst" +| "\ (Fun (pubconst \ _) _) = TAtom \" +| "\ (Fun f T) = TComp f (map \ T)" + + +subsection \TLS Example: Locale interpretation (typed model)\ +lemma assm7: "arity c = 0 \ \a. \X. \ (Fun c X) = TAtom a" by (cases c) simp_all + +lemma assm8: "0 < arity f \ \ (Fun f X) = TComp f (map \ X)" by (cases f) simp_all + +lemma assm9: "infinite {c. \ (Fun c []) = TAtom a \ public c}" +proof - + let ?T = "(range (pubconst a))::ex_fun set" + have *: + "\x y::nat. x \ UNIV \ y \ UNIV \ (pubconst a x = pubconst a y) = (x = y)" + "\x::nat. x \ UNIV \ pubconst a x \ ?T" + "\y::ex_fun. y \ ?T \ \x \ UNIV. y = pubconst a x" + by auto + have "?T \ {c. \ (Fun c []) = TAtom a \ public c}" by auto + moreover have "\f::nat \ ex_fun. bij_betw f UNIV ?T" + using bij_betwI'[OF *] by blast + hence "infinite ?T" by (metis nat_not_finite bij_betw_finite) + ultimately show ?thesis using infinite_super by blast +qed + +lemma assm10: "TComp f T \ \ t \ arity f > 0" +proof (induction rule: \.induct) + case (1 x) + hence *: "TComp f T \ \\<^sub>v x" by simp + hence "\\<^sub>v x \ TAtom Bot" unfolding \\<^sub>v_def by force + hence "\t \ subterms (fst x). case t of + (TComp f T) \ arity f > 0 \ arity f = length T + | _ \ True" + unfolding \\<^sub>v_def by argo + thus ?case using * unfolding \\<^sub>v_def by fastforce +qed auto + +lemma assm11: "im.wf\<^sub>t\<^sub>r\<^sub>m (\ (Var x))" +proof - + have "im.wf\<^sub>t\<^sub>r\<^sub>m (\\<^sub>v x)" unfolding \\<^sub>v_def im.wf\<^sub>t\<^sub>r\<^sub>m_def by auto + thus ?thesis by simp +qed + +lemma assm12: "\ (Var (\, n)) = \ (Var (\, m))" + apply (cases "\t \ subterms \. case t of + (TComp f T) \ arity f > 0 \ arity f = length T + | _ \ True") + by (auto simp add: \\<^sub>v_def) + +lemma Ana_const: "arity c = 0 \ Ana (Fun c T) = ([],[])" +by (cases c) simp_all + +lemma Ana_keys_subterm: "Ana t = (K,T) \ k \ set K \ k \ t" +proof (induct t rule: Ana.induct) + case (1 U) + then obtain m where "U = [Fun pub [k], m]" "K = [k]" "T = [m]" + by (auto elim!: Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t.elims Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n.elims) + thus ?case using Fun_subterm_inside_params[of k crypt U] by auto +qed (auto elim!: Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t.elims Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n.elims) + +global_interpretation tm: typed_model' arity public Ana \ +by (unfold_locales, unfold wf\<^sub>t\<^sub>r\<^sub>m_def[symmetric], + metis assm7, metis assm8, metis assm9, metis assm10, metis assm11, metis assm6, + metis assm12, metis Ana_const, metis Ana_keys_subterm) + +subsection \TLS example: Proving type-flaw resistance\ +abbreviation \\<^sub>v_clientHello where + "\\<^sub>v_clientHello \ + TComp clientHello [TAtom Nonce, TAtom Nonce, TAtom Nonce, TAtom Nonce, TAtom Nonce]" + +abbreviation \\<^sub>v_serverHello where + "\\<^sub>v_serverHello \ + TComp serverHello [TAtom Nonce, TAtom Nonce, TAtom Nonce, TAtom Nonce, TAtom Nonce]" + +abbreviation \\<^sub>v_pub where + "\\<^sub>v_pub \ TComp pub [TAtom PrivKey]" + +abbreviation \\<^sub>v_x509 where + "\\<^sub>v_x509 \ TComp x509 [TAtom Agent, \\<^sub>v_pub]" + +abbreviation \\<^sub>v_sign where + "\\<^sub>v_sign \ TComp sign [TAtom PrivKey, \\<^sub>v_x509]" + +abbreviation \\<^sub>v_serverCert where + "\\<^sub>v_serverCert \ TComp serverCert [\\<^sub>v_sign]" + +abbreviation \\<^sub>v_pmsForm where + "\\<^sub>v_pmsForm \ TComp pmsForm [TAtom SymKey]" + +abbreviation \\<^sub>v_crypt where + "\\<^sub>v_crypt \ TComp crypt [\\<^sub>v_pub, \\<^sub>v_pmsForm]" + +abbreviation \\<^sub>v_clientKeyExchange where + "\\<^sub>v_clientKeyExchange \ + TComp clientKeyExchange [\\<^sub>v_crypt]" + +abbreviation \\<^sub>v_HSMsgs where + "\\<^sub>v_HSMsgs \ TComp concat [ + \\<^sub>v_clientHello, + \\<^sub>v_serverHello, + \\<^sub>v_serverCert, + TAtom PubConst, + \\<^sub>v_clientKeyExchange]" + +(* Variables from TLS *) +abbreviation "T\<^sub>1 n \ Var (TAtom Nonce,n)" +abbreviation "T\<^sub>2 n \ Var (TAtom Nonce,n)" +abbreviation "R\<^sub>A n \ Var (TAtom Nonce,n)" +abbreviation "R\<^sub>B n \ Var (TAtom Nonce,n)" +abbreviation "S n \ Var (TAtom Nonce,n)" +abbreviation "Cipher n \ Var (TAtom Nonce,n)" +abbreviation "Comp n \ Var (TAtom Nonce,n)" +abbreviation "B n \ Var (TAtom Agent,n)" +abbreviation "Pr\<^sub>c\<^sub>a n \ Var (TAtom PrivKey,n)" +abbreviation "PMS n \ Var (TAtom SymKey,n)" +abbreviation "P\<^sub>B n \ Var (TComp pub [TAtom PrivKey],n)" +abbreviation "HSMsgs n \ Var (\\<^sub>v_HSMsgs,n)" + +subsubsection \Defining the over-approximation set\ +abbreviation clientHello\<^sub>t\<^sub>r\<^sub>m where + "clientHello\<^sub>t\<^sub>r\<^sub>m \ Fun clientHello [T\<^sub>1 0, R\<^sub>A 1, S 2, Cipher 3, Comp 4]" + +abbreviation serverHello\<^sub>t\<^sub>r\<^sub>m where + "serverHello\<^sub>t\<^sub>r\<^sub>m \ Fun serverHello [T\<^sub>2 0, R\<^sub>B 1, S 2, Cipher 3, Comp 4]" + +abbreviation serverCert\<^sub>t\<^sub>r\<^sub>m where + "serverCert\<^sub>t\<^sub>r\<^sub>m \ Fun serverCert [Fun sign [Pr\<^sub>c\<^sub>a 0, Fun x509 [B 1, P\<^sub>B 2]]]" + +abbreviation serverHelloDone\<^sub>t\<^sub>r\<^sub>m where + "serverHelloDone\<^sub>t\<^sub>r\<^sub>m \ Fun serverHelloDone []" + +abbreviation clientKeyExchange\<^sub>t\<^sub>r\<^sub>m where + "clientKeyExchange\<^sub>t\<^sub>r\<^sub>m \ Fun clientKeyExchange [Fun crypt [P\<^sub>B 0, Fun pmsForm [PMS 1]]]" + +abbreviation changeCipher\<^sub>t\<^sub>r\<^sub>m where + "changeCipher\<^sub>t\<^sub>r\<^sub>m \ Fun changeCipher []" + +abbreviation finished\<^sub>t\<^sub>r\<^sub>m where + "finished\<^sub>t\<^sub>r\<^sub>m \ Fun finished [Fun prfun [ + Fun clientFinished [ + Fun prfun [Fun master [PMS 0, R\<^sub>A 1, R\<^sub>B 2]], + R\<^sub>A 3, R\<^sub>B 4, Fun hash [HSMsgs 5] + ] + ]]" + +definition M\<^sub>T\<^sub>L\<^sub>S::"ex_term list" where + "M\<^sub>T\<^sub>L\<^sub>S \ [ + clientHello\<^sub>t\<^sub>r\<^sub>m, + serverHello\<^sub>t\<^sub>r\<^sub>m, + serverCert\<^sub>t\<^sub>r\<^sub>m, + serverHelloDone\<^sub>t\<^sub>r\<^sub>m, + clientKeyExchange\<^sub>t\<^sub>r\<^sub>m, + changeCipher\<^sub>t\<^sub>r\<^sub>m, + finished\<^sub>t\<^sub>r\<^sub>m +]" + + +subsection \Theorem: The TLS handshake protocol is type-flaw resistant\ +theorem "tm.tfr\<^sub>s\<^sub>e\<^sub>t (set M\<^sub>T\<^sub>L\<^sub>S)" +by (rule tm.tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t') eval + +end diff --git a/web/entries/Automated_Stateful_Protocol_Verification.html b/web/entries/Automated_Stateful_Protocol_Verification.html new file mode 100644 --- /dev/null +++ b/web/entries/Automated_Stateful_Protocol_Verification.html @@ -0,0 +1,196 @@ + + + + +Automated Stateful Protocol Verification - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +
+

 

+ + + +

 

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download
+

 

+

 

+		 +
+

 

+

Automated + + Stateful + + Protocol + + Verification + +

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Title:Automated Stateful Protocol Verification
+ Authors: + + Andreas V. Hess (avhe /at/ dtu /dot/ dk), + Sebastian Mödersheim, + Achim D. Brucker and + Anders Schlichtkrull +
Submission date:2020-04-08
Abstract: +In protocol verification we observe a wide spectrum from fully +automated methods to interactive theorem proving with proof assistants +like Isabelle/HOL. In this AFP entry, we present a fully-automated +approach for verifying stateful security protocols, i.e., protocols +with mutable state that may span several sessions. The approach +supports reachability goals like secrecy and authentication. We also +include a simple user-friendly transaction-based protocol +specification language that is embedded into Isabelle.
BibTeX: + 
@article{Automated_Stateful_Protocol_Verification-AFP,
+  author  = {Andreas V. Hess and Sebastian Mödersheim and Achim D. Brucker and Anders Schlichtkrull},
+  title   = {Automated Stateful Protocol Verification},
+  journal = {Archive of Formal Proofs},
+  month   = apr,
+  year    = 2020,
+  note    = {\url{http://isa-afp.org/entries/Automated_Stateful_Protocol_Verification.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
+
License:BSD License
Depends on:Stateful_Protocol_Composition_and_Typing
+ +

+ + + + + + + + + + + + + + + + +
+ Proof outline
+ Proof document +
+ Browse theories +
+ Download this entry +
Older releases: + None +
+ +
+
+ + + + + + \ No newline at end of file diff --git a/web/entries/First_Order_Terms.html b/web/entries/First_Order_Terms.html --- a/web/entries/First_Order_Terms.html +++ b/web/entries/First_Order_Terms.html @@ -1,214 +1,214 @@ First-Order Terms - Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

First-Order Terms

 

- +
Title: First-Order Terms
Authors: Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) and René Thiemann
Submission date: 2018-02-06
Abstract: We formalize basic results on first-order terms, including matching and a first-order unification algorithm, as well as well-foundedness of the subsumption order. This entry is part of the Isabelle Formalization of Rewriting IsaFoR, where first-order terms are omni-present: the unification algorithm is used to certify several confluence and termination techniques, like critical-pair computation and dependency graph approximations; and the subsumption order is a crucial ingredient for completion.
BibTeX: 
@article{First_Order_Terms-AFP,
   author  = {Christian Sternagel and René Thiemann},
   title   = {First-Order Terms},
   journal = {Archive of Formal Proofs},
   month   = feb,
   year    = 2018,
   note    = {\url{http://isa-afp.org/entries/First_Order_Terms.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: GNU Lesser General Public License (LGPL)
Depends on: Abstract-Rewriting
Used by:Functional_Ordered_Resolution_Prover, Knuth_Bendix_Order, Resolution_FOL
Functional_Ordered_Resolution_Prover, Knuth_Bendix_Order, Resolution_FOL, Stateful_Protocol_Composition_and_Typing

Proof outline
Proof document
Browse theories
Download this entry
Older releases:
\ No newline at end of file diff --git a/web/entries/Stateful_Protocol_Composition_and_Typing.html b/web/entries/Stateful_Protocol_Composition_and_Typing.html new file mode 100644 --- /dev/null +++ b/web/entries/Stateful_Protocol_Composition_and_Typing.html @@ -0,0 +1,205 @@ + + + + +Stateful Protocol Composition and Typing - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +
+

 

+ + + +

 

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download
+

 

+

 

+		 +
+

 

+

Stateful + + Protocol + + Composition + + and + + Typing + +

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Title:Stateful Protocol Composition and Typing
+ Authors: + + Andreas V. Hess (avhe /at/ dtu /dot/ dk), + Sebastian Mödersheim and + Achim D. Brucker +
Submission date:2020-04-08
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.
BibTeX: + 
@article{Stateful_Protocol_Composition_and_Typing-AFP,
+  author  = {Andreas V. Hess and Sebastian Mödersheim and Achim D. Brucker},
+  title   = {Stateful Protocol Composition and Typing},
+  journal = {Archive of Formal Proofs},
+  month   = apr,
+  year    = 2020,
+  note    = {\url{http://isa-afp.org/entries/Stateful_Protocol_Composition_and_Typing.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
+
License:BSD License
Depends on:First_Order_Terms
Used by:Automated_Stateful_Protocol_Verification
+ +

+ + + + + + + + + + + + + + + + +
+ Proof outline
+ Proof document +
+ Browse theories +
+ Download this entry +
Older releases: + None +
+ +
+
+ + + + + + \ No newline at end of file diff --git a/web/index.html b/web/index.html --- a/web/index.html +++ b/web/index.html @@ -1,4961 +1,4982 @@ Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

Archive of Formal Proofs

 

The Archive of Formal Proofs is a collection of proof libraries, examples, and larger scientific developments, mechanically checked in the theorem prover Isabelle. It is organized in the way of a scientific journal, is indexed by dblp and has an ISSN: 2150-914x. Submissions are refereed. The preferred citation style is available [here]. We encourage companion AFP submissions to conference and journal publications.

A development version of the archive is available as well.

 

 

+ + + + + +
2020
2020-05-13: A Formalization of Knuth–Bendix Orders
Authors: Christian Sternagel and René Thiemann
2020-05-12: Irrationality Criteria for Series by Erdős and Straus
Authors: Angeliki Koutsoukou-Argyraki and Wenda Li
2020-05-11: Recursion Theorem in ZF
Author: Georgy Dunaev
2020-05-08: An Efficient Normalisation Procedure for Linear Temporal Logic: Isabelle/HOL Formalisation
Author: Salomon Sickert
2020-05-06: Formalization of Forcing in Isabelle/ZF
Authors: Emmanuel Gunther, Miguel Pagano and Pedro Sánchez Terraf
2020-05-02: Banach-Steinhaus Theorem
Authors: Dominique Unruh and Jose Manuel Rodriguez Caballero
2020-04-27: Attack Trees in Isabelle for GDPR compliance of IoT healthcare systems
Author: Florian Kammueller
2020-04-24: Power Sum Polynomials
Author: Manuel Eberl
2020-04-24: The Lambert W Function on the Reals
Author: Manuel Eberl
2020-04-24: Gaussian Integers
Author: Manuel Eberl
2020-04-19: Matrices for ODEs
Author: Jonathan Julian Huerta y Munive
2020-04-16: Authenticated Data Structures As Functors
Authors: Andreas Lochbihler and Ognjen Marić
2020-04-10: Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows
Authors: Lukas Heimes, Dmitriy Traytel and Joshua Schneider
2020-04-09: A Comprehensive Framework for Saturation Theorem Proving
Author: Sophie Tourret
2020-04-09: Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations
Authors: Thibault Dardinier, Lukas Heimes, Martin Raszyk, Joshua Schneider and Dmitriy Traytel
+ 2020-04-08: Stateful Protocol Composition and Typing +
+ Authors: + Andreas V. Hess, + Sebastian Mödersheim + and Achim D. Brucker +
+ 2020-04-08: Automated Stateful Protocol Verification +
+ Authors: + Andreas V. Hess, + Sebastian Mödersheim, + Achim D. Brucker + and Anders Schlichtkrull +
2020-04-07: Lucas's Theorem
Author: Chelsea Edmonds
2020-03-25: Strong Eventual Consistency of the Collaborative Editing Framework WOOT
Authors: Emin Karayel and Edgar Gonzàlez
2020-03-22: Furstenberg's topology and his proof of the infinitude of primes
Author: Manuel Eberl
2020-03-12: An Under-Approximate Relational Logic
Author: Toby Murray
2020-03-07: Hello World
Authors: Cornelius Diekmann and Lars Hupel
2020-02-21: Implementing the Goodstein Function in λ-Calculus
Author: Bertram Felgenhauer
2020-02-10: A Generic Framework for Verified Compilers
Author: Martin Desharnais
2020-02-01: Arithmetic progressions and relative primes
Author: José Manuel Rodríguez Caballero
2020-01-31: A Hierarchy of Algebras for Boolean Subsets
Authors: Walter Guttmann and Bernhard Möller
2020-01-17: Mersenne primes and the Lucas–Lehmer test
Author: Manuel Eberl
2020-01-16: Verified Approximation Algorithms
Authors: Robin Eßmann, Tobias Nipkow and Simon Robillard
2020-01-13: Closest Pair of Points Algorithms
Authors: Martin Rau and Tobias Nipkow
2020-01-09: Skip Lists
Authors: Max W. Haslbeck and Manuel Eberl
2020-01-06: Bicategories
Author: Eugene W. Stark

 

2019
2019-12-27: The Irrationality of ζ(3)
Author: Manuel Eberl
2019-12-20: Formalizing a Seligman-Style Tableau System for Hybrid Logic
Author: Asta Halkjær From
2019-12-18: The Poincaré-Bendixson Theorem
Authors: Fabian Immler and Yong Kiam Tan
2019-12-16: Poincaré Disc Model
Authors: Danijela Simić, Filip Marić and Pierre Boutry
2019-12-16: Complex Geometry
Authors: Filip Marić and Danijela Simić
2019-12-10: Gauss Sums and the Pólya–Vinogradov Inequality
Authors: Rodrigo Raya and Manuel Eberl
2019-12-04: An Efficient Generalization of Counting Sort for Large, possibly Infinite Key Ranges
Author: Pasquale Noce
2019-11-27: Interval Arithmetic on 32-bit Words
Author: Brandon Bohrer
2019-10-24: Zermelo Fraenkel Set Theory in Higher-Order Logic
Author: Lawrence C. Paulson
2019-10-22: Isabelle/C
Authors: Frédéric Tuong and Burkhart Wolff
2019-10-16: VerifyThis 2019 -- Polished Isabelle Solutions
Authors: Peter Lammich and Simon Wimmer
2019-10-08: Aristotle's Assertoric Syllogistic
Author: Angeliki Koutsoukou-Argyraki
2019-10-07: Sigma Protocols and Commitment Schemes
Authors: David Butler and Andreas Lochbihler
2019-10-04: Clean - An Abstract Imperative Programming Language and its Theory
Authors: Frédéric Tuong and Burkhart Wolff
2019-09-16: Formalization of Multiway-Join Algorithms
Author: Thibault Dardinier
2019-09-10: Verification Components for Hybrid Systems
Author: Jonathan Julian Huerta y Munive
2019-09-06: Fourier Series
Author: Lawrence C Paulson
2019-08-30: A Case Study in Basic Algebra
Author: Clemens Ballarin
2019-08-16: Formalisation of an Adaptive State Counting Algorithm
Author: Robert Sachtleben
2019-08-14: Laplace Transform
Author: Fabian Immler
2019-08-06: Linear Programming
Authors: Julian Parsert and Cezary Kaliszyk
2019-08-06: Communicating Concurrent Kleene Algebra for Distributed Systems Specification
Authors: Maxime Buyse and Jason Jaskolka
2019-08-05: Selected Problems from the International Mathematical Olympiad 2019
Author: Manuel Eberl
2019-08-01: Stellar Quorum Systems
Author: Giuliano Losa
2019-07-30: A Formal Development of a Polychronous Polytimed Coordination Language
Authors: Hai Nguyen Van, Frédéric Boulanger and Burkhart Wolff
2019-07-27: Szpilrajn Extension Theorem
Author: Peter Zeller
2019-07-18: A Sequent Calculus for First-Order Logic
Author: Asta Halkjær From
2019-07-08: A Verified Code Generator from Isabelle/HOL to CakeML
Author: Lars Hupel
2019-07-04: Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic
Authors: Joshua Schneider and Dmitriy Traytel
2019-06-27: Complete Non-Orders and Fixed Points
Authors: Akihisa Yamada and Jérémy Dubut
2019-06-25: Priority Search Trees
Authors: Peter Lammich and Tobias Nipkow
2019-06-25: Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra
Authors: Peter Lammich and Tobias Nipkow
2019-06-21: Linear Inequalities
Authors: Ralph Bottesch, Alban Reynaud and René Thiemann
2019-06-16: Hilbert's Nullstellensatz
Author: Alexander Maletzky
2019-06-15: Gröbner Bases, Macaulay Matrices and Dubé's Degree Bounds
Author: Alexander Maletzky
2019-06-13: Binary Heaps for IMP2
Author: Simon Griebel
2019-06-03: Differential Game Logic
Author: André Platzer
2019-05-30: Multidimensional Binary Search Trees
Author: Martin Rau
2019-05-14: Formalization of Generic Authenticated Data Structures
Authors: Matthias Brun and Dmitriy Traytel
2019-05-09: Multi-Party Computation
Authors: David Aspinall and David Butler
2019-04-26: HOL-CSP Version 2.0
Authors: Safouan Taha, Lina Ye and Burkhart Wolff
2019-04-16: A Compositional and Unified Translation of LTL into ω-Automata
Authors: Benedikt Seidl and Salomon Sickert
2019-04-06: A General Theory of Syntax with Bindings
Authors: Lorenzo Gheri and Andrei Popescu
2019-03-27: The Transcendence of Certain Infinite Series
Authors: Angeliki Koutsoukou-Argyraki and Wenda Li
2019-03-24: Quantum Hoare Logic
Authors: Junyi Liu, Bohua Zhan, Shuling Wang, Shenggang Ying, Tao Liu, Yangjia Li, Mingsheng Ying and Naijun Zhan
2019-03-09: Safe OCL
Author: Denis Nikiforov
2019-02-21: Elementary Facts About the Distribution of Primes
Author: Manuel Eberl
2019-02-14: Kruskal's Algorithm for Minimum Spanning Forest
Authors: Maximilian P.L. Haslbeck, Peter Lammich and Julian Biendarra
2019-02-11: Probabilistic Primality Testing
Authors: Daniel Stüwe and Manuel Eberl
2019-02-08: Universal Turing Machine
Authors: Jian Xu, Xingyuan Zhang, Christian Urban and Sebastiaan J. C. Joosten
2019-02-01: Isabelle/UTP: Mechanised Theory Engineering for Unifying Theories of Programming
Authors: Simon Foster, Frank Zeyda, Yakoub Nemouchi, Pedro Ribeiro and Burkhart Wolff
2019-02-01: The Inversions of a List
Author: Manuel Eberl
2019-01-17: Farkas' Lemma and Motzkin's Transposition Theorem
Authors: Ralph Bottesch, Max W. Haslbeck and René Thiemann
2019-01-15: IMP2 – Simple Program Verification in Isabelle/HOL
Authors: Peter Lammich and Simon Wimmer
2019-01-15: An Algebra for Higher-Order Terms
Author: Lars Hupel
2019-01-07: A Reduction Theorem for Store Buffers
Authors: Ernie Cohen and Norbert Schirmer

 

2018
2018-12-26: A Formal Model of the Document Object Model
Authors: Achim D. Brucker and Michael Herzberg
2018-12-25: Formalization of Concurrent Revisions
Author: Roy Overbeek
2018-12-21: Verifying Imperative Programs using Auto2
Author: Bohua Zhan
2018-12-17: Constructive Cryptography in HOL
Authors: Andreas Lochbihler and S. Reza Sefidgar
2018-12-11: Transformer Semantics
Author: Georg Struth
2018-12-11: Quantales
Author: Georg Struth
2018-12-11: Properties of Orderings and Lattices
Author: Georg Struth
2018-11-23: Graph Saturation
Author: Sebastiaan J. C. Joosten
2018-11-23: A Verified Functional Implementation of Bachmair and Ganzinger's Ordered Resolution Prover
Authors: Anders Schlichtkrull, Jasmin Christian Blanchette and Dmitriy Traytel
2018-11-20: Auto2 Prover
Author: Bohua Zhan
2018-11-16: Matroids
Author: Jonas Keinholz
2018-11-06: Deriving generic class instances for datatypes
Authors: Jonas Rädle and Lars Hupel
2018-10-30: Formalisation and Evaluation of Alan Gewirth's Proof for the Principle of Generic Consistency in Isabelle/HOL
Authors: David Fuenmayor and Christoph Benzmüller
2018-10-29: Epistemic Logic
Author: Asta Halkjær From
2018-10-22: Smooth Manifolds
Authors: Fabian Immler and Bohua Zhan
2018-10-19: Randomised Binary Search Trees
Author: Manuel Eberl
2018-10-19: Formalization of the Embedding Path Order for Lambda-Free Higher-Order Terms
Author: Alexander Bentkamp
2018-10-12: Upper Bounding Diameters of State Spaces of Factored Transition Systems
Authors: Friedrich Kurz and Mohammad Abdulaziz
2018-09-28: The Transcendence of π
Author: Manuel Eberl
2018-09-25: Symmetric Polynomials
Author: Manuel Eberl
2018-09-20: Signature-Based Gröbner Basis Algorithms
Author: Alexander Maletzky
2018-09-19: The Prime Number Theorem
Authors: Manuel Eberl and Lawrence C. Paulson
2018-09-15: Aggregation Algebras
Author: Walter Guttmann
2018-09-14: Octonions
Author: Angeliki Koutsoukou-Argyraki
2018-09-05: Quaternions
Author: Lawrence C. Paulson
2018-09-02: The Budan-Fourier Theorem and Counting Real Roots with Multiplicity
Author: Wenda Li
2018-08-24: An Incremental Simplex Algorithm with Unsatisfiable Core Generation
Authors: Filip Marić, Mirko Spasić and René Thiemann
2018-08-14: Minsky Machines
Author: Bertram Felgenhauer
2018-07-16: Pricing in discrete financial models
Author: Mnacho Echenim
2018-07-04: Von-Neumann-Morgenstern Utility Theorem
Authors: Julian Parsert and Cezary Kaliszyk
2018-06-23: Pell's Equation
Author: Manuel Eberl
2018-06-14: Projective Geometry
Author: Anthony Bordg
2018-06-14: The Localization of a Commutative Ring
Author: Anthony Bordg
2018-06-05: Partial Order Reduction
Author: Julian Brunner
2018-05-27: Optimal Binary Search Trees
Authors: Tobias Nipkow and Dániel Somogyi
2018-05-25: Hidden Markov Models
Author: Simon Wimmer
2018-05-24: Probabilistic Timed Automata
Authors: Simon Wimmer and Johannes Hölzl
2018-05-23: Irrational Rapidly Convergent Series
Authors: Angeliki Koutsoukou-Argyraki and Wenda Li
2018-05-23: Axiom Systems for Category Theory in Free Logic
Authors: Christoph Benzmüller and Dana Scott
2018-05-22: Monadification, Memoization and Dynamic Programming
Authors: Simon Wimmer, Shuwei Hu and Tobias Nipkow
2018-05-10: OpSets: Sequential Specifications for Replicated Datatypes
Authors: Martin Kleppmann, Victor B. F. Gomes, Dominic P. Mulligan and Alastair R. Beresford
2018-05-07: An Isabelle/HOL Formalization of the Modular Assembly Kit for Security Properties
Authors: Oliver Bračevac, Richard Gay, Sylvia Grewe, Heiko Mantel, Henning Sudbrock and Markus Tasch
2018-04-29: WebAssembly
Author: Conrad Watt
2018-04-27: VerifyThis 2018 - Polished Isabelle Solutions
Authors: Peter Lammich and Simon Wimmer
2018-04-24: Bounded Natural Functors with Covariance and Contravariance
Authors: Andreas Lochbihler and Joshua Schneider
2018-03-22: The Incompatibility of Fishburn-Strategyproofness and Pareto-Efficiency
Authors: Felix Brandt, Manuel Eberl, Christian Saile and Christian Stricker
2018-03-13: Weight-Balanced Trees
Authors: Tobias Nipkow and Stefan Dirix
2018-03-12: CakeML
Authors: Lars Hupel and Yu Zhang
2018-03-01: A Theory of Architectural Design Patterns
Author: Diego Marmsoler
2018-02-26: Hoare Logics for Time Bounds
Authors: Maximilian P. L. Haslbeck and Tobias Nipkow
2018-02-06: Treaps
Authors: Maximilian Haslbeck, Manuel Eberl and Tobias Nipkow
2018-02-06: A verified factorization algorithm for integer polynomials with polynomial complexity
Authors: Jose Divasón, Sebastiaan Joosten, René Thiemann and Akihisa Yamada
2018-02-06: First-Order Terms
Authors: Christian Sternagel and René Thiemann
2018-02-06: The Error Function
Author: Manuel Eberl
2018-02-02: A verified LLL algorithm
Authors: Ralph Bottesch, Jose Divasón, Maximilian Haslbeck, Sebastiaan Joosten, René Thiemann and Akihisa Yamada
2018-01-18: Formalization of Bachmair and Ganzinger's Ordered Resolution Prover
Authors: Anders Schlichtkrull, Jasmin Christian Blanchette, Dmitriy Traytel and Uwe Waldmann
2018-01-16: Gromov Hyperbolicity
Author: Sebastien Gouezel
2018-01-11: An Isabelle/HOL formalisation of Green's Theorem
Authors: Mohammad Abdulaziz and Lawrence C. Paulson
2018-01-08: Taylor Models
Authors: Christoph Traut and Fabian Immler

 

2017
2017-12-22: The Falling Factorial of a Sum
Author: Lukas Bulwahn
2017-12-21: The Median-of-Medians Selection Algorithm
Author: Manuel Eberl
2017-12-21: The Mason–Stothers Theorem
Author: Manuel Eberl
2017-12-21: Dirichlet L-Functions and Dirichlet's Theorem
Author: Manuel Eberl
2017-12-19: Operations on Bounded Natural Functors
Authors: Jasmin Christian Blanchette, Andrei Popescu and Dmitriy Traytel
2017-12-18: The string search algorithm by Knuth, Morris and Pratt
Authors: Fabian Hellauer and Peter Lammich
2017-11-22: Stochastic Matrices and the Perron-Frobenius Theorem
Author: René Thiemann
2017-11-09: The IMAP CmRDT
Authors: Tim Jungnickel, Lennart Oldenburg and Matthias Loibl
2017-11-06: Hybrid Multi-Lane Spatial Logic
Author: Sven Linker
2017-10-26: The Kuratowski Closure-Complement Theorem
Authors: Peter Gammie and Gianpaolo Gioiosa
2017-10-19: Transition Systems and Automata
Author: Julian Brunner
2017-10-19: Büchi Complementation
Author: Julian Brunner
2017-10-17: Evaluate Winding Numbers through Cauchy Indices
Author: Wenda Li
2017-10-17: Count the Number of Complex Roots
Author: Wenda Li
2017-10-14: Homogeneous Linear Diophantine Equations
Authors: Florian Messner, Julian Parsert, Jonas Schöpf and Christian Sternagel
2017-10-12: The Hurwitz and Riemann ζ Functions
Author: Manuel Eberl
2017-10-12: Linear Recurrences
Author: Manuel Eberl
2017-10-12: Dirichlet Series
Author: Manuel Eberl
2017-09-21: Computer-assisted Reconstruction and Assessment of E. J. Lowe's Modal Ontological Argument
Authors: David Fuenmayor and Christoph Benzmüller
2017-09-17: Representation and Partial Automation of the Principia Logico-Metaphysica in Isabelle/HOL
Author: Daniel Kirchner
2017-09-06: Anselm's God in Isabelle/HOL
Author: Ben Blumson
2017-09-01: Microeconomics and the First Welfare Theorem
Authors: Julian Parsert and Cezary Kaliszyk
2017-08-20: Root-Balanced Tree
Author: Tobias Nipkow
2017-08-20: Orbit-Stabiliser Theorem with Application to Rotational Symmetries
Author: Jonas Rädle
2017-08-16: The LambdaMu-calculus
Authors: Cristina Matache, Victor B. F. Gomes and Dominic P. Mulligan
2017-07-31: Stewart's Theorem and Apollonius' Theorem
Author: Lukas Bulwahn
2017-07-28: Dynamic Architectures
Author: Diego Marmsoler
2017-07-21: Declarative Semantics for Functional Languages
Author: Jeremy Siek
2017-07-15: HOLCF-Prelude
Authors: Joachim Breitner, Brian Huffman, Neil Mitchell and Christian Sternagel
2017-07-13: Minkowski's Theorem
Author: Manuel Eberl
2017-07-09: Verified Metatheory and Type Inference for a Name-Carrying Simply-Typed Lambda Calculus
Author: Michael Rawson
2017-07-07: A framework for establishing Strong Eventual Consistency for Conflict-free Replicated Datatypes
Authors: Victor B. F. Gomes, Martin Kleppmann, Dominic P. Mulligan and Alastair R. Beresford
2017-07-06: Stone-Kleene Relation Algebras
Author: Walter Guttmann
2017-06-21: Propositional Proof Systems
Authors: Julius Michaelis and Tobias Nipkow
2017-06-13: Partial Semigroups and Convolution Algebras
Authors: Brijesh Dongol, Victor B. F. Gomes, Ian J. Hayes and Georg Struth
2017-06-06: Buffon's Needle Problem
Author: Manuel Eberl
2017-06-01: Formalizing Push-Relabel Algorithms
Authors: Peter Lammich and S. Reza Sefidgar
2017-06-01: Flow Networks and the Min-Cut-Max-Flow Theorem
Authors: Peter Lammich and S. Reza Sefidgar
2017-05-25: Optics
Authors: Simon Foster and Frank Zeyda
2017-05-24: Developing Security Protocols by Refinement
Authors: Christoph Sprenger and Ivano Somaini
2017-05-24: Dictionary Construction
Author: Lars Hupel
2017-05-08: The Floyd-Warshall Algorithm for Shortest Paths
Authors: Simon Wimmer and Peter Lammich
2017-05-05: Probabilistic while loop
Author: Andreas Lochbihler
2017-05-05: Effect polymorphism in higher-order logic
Author: Andreas Lochbihler
2017-05-05: Monad normalisation
Authors: Joshua Schneider, Manuel Eberl and Andreas Lochbihler
2017-05-05: Game-based cryptography in HOL
Authors: Andreas Lochbihler, S. Reza Sefidgar and Bhargav Bhatt
2017-05-05: CryptHOL
Author: Andreas Lochbihler
2017-05-04: Monoidal Categories
Author: Eugene W. Stark
2017-05-01: Types, Tableaus and Gödel’s God in Isabelle/HOL
Authors: David Fuenmayor and Christoph Benzmüller
2017-04-28: Local Lexing
Author: Steven Obua
2017-04-19: Constructor Functions
Author: Lars Hupel
2017-04-18: Lazifying case constants
Author: Lars Hupel
2017-04-06: Subresultants
Authors: Sebastiaan Joosten, René Thiemann and Akihisa Yamada
2017-04-04: Expected Shape of Random Binary Search Trees
Author: Manuel Eberl
2017-03-15: The number of comparisons in QuickSort
Author: Manuel Eberl
2017-03-15: Lower bound on comparison-based sorting algorithms
Author: Manuel Eberl
2017-03-10: The Euler–MacLaurin Formula
Author: Manuel Eberl
2017-02-28: The Group Law for Elliptic Curves
Author: Stefan Berghofer
2017-02-26: Menger's Theorem
Author: Christoph Dittmann
2017-02-13: Differential Dynamic Logic
Author: Brandon Bohrer
2017-02-10: Abstract Soundness
Authors: Jasmin Christian Blanchette, Andrei Popescu and Dmitriy Traytel
2017-02-07: Stone Relation Algebras
Author: Walter Guttmann
2017-01-31: Refining Authenticated Key Agreement with Strong Adversaries
Authors: Joseph Lallemand and Christoph Sprenger
2017-01-24: Bernoulli Numbers
Authors: Lukas Bulwahn and Manuel Eberl
2017-01-17: Minimal Static Single Assignment Form
Authors: Max Wagner and Denis Lohner
2017-01-17: Bertrand's postulate
Authors: Julian Biendarra and Manuel Eberl
2017-01-12: The Transcendence of e
Author: Manuel Eberl
2017-01-08: Formal Network Models and Their Application to Firewall Policies
Authors: Achim D. Brucker, Lukas Brügger and Burkhart Wolff
2017-01-03: Verification of a Diffie-Hellman Password-based Authentication Protocol by Extending the Inductive Method
Author: Pasquale Noce
2017-01-01: First-Order Logic According to Harrison
Authors: Alexander Birch Jensen, Anders Schlichtkrull and Jørgen Villadsen

 

2016
2016-12-30: Concurrent Refinement Algebra and Rely Quotients
Authors: Julian Fell, Ian J. Hayes and Andrius Velykis
2016-12-29: The Twelvefold Way
Author: Lukas Bulwahn
2016-12-20: Proof Strategy Language
Author: Yutaka Nagashima
2016-12-07: Paraconsistency
Authors: Anders Schlichtkrull and Jørgen Villadsen
2016-11-29: COMPLX: A Verification Framework for Concurrent Imperative Programs
Authors: Sidney Amani, June Andronick, Maksym Bortin, Corey Lewis, Christine Rizkallah and Joseph Tuong
2016-11-23: Abstract Interpretation of Annotated Commands
Author: Tobias Nipkow
2016-11-16: Separata: Isabelle tactics for Separation Algebra
Authors: Zhe Hou, David Sanan, Alwen Tiu, Rajeev Gore and Ranald Clouston
2016-11-12: Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals
Authors: Jasmin Christian Blanchette, Mathias Fleury and Dmitriy Traytel
2016-11-12: Formalization of Knuth–Bendix Orders for Lambda-Free Higher-Order Terms
Authors: Heiko Becker, Jasmin Christian Blanchette, Uwe Waldmann and Daniel Wand
2016-11-10: Expressiveness of Deep Learning
Author: Alexander Bentkamp
2016-10-25: Modal Logics for Nominal Transition Systems
Authors: Tjark Weber, Lars-Henrik Eriksson, Joachim Parrow, Johannes Borgström and Ramunas Gutkovas
2016-10-24: Stable Matching
Author: Peter Gammie
2016-10-21: LOFT — Verified Migration of Linux Firewalls to SDN
Authors: Julius Michaelis and Cornelius Diekmann
2016-10-19: Source Coding Theorem
Authors: Quentin Hibon and Lawrence C. Paulson
2016-10-19: A formal model for the SPARCv8 ISA and a proof of non-interference for the LEON3 processor
Authors: Zhe Hou, David Sanan, Alwen Tiu and Yang Liu
2016-10-14: The Factorization Algorithm of Berlekamp and Zassenhaus
Authors: Jose Divasón, Sebastiaan Joosten, René Thiemann and Akihisa Yamada
2016-10-11: Intersecting Chords Theorem
Author: Lukas Bulwahn
2016-10-05: Lp spaces
Author: Sebastien Gouezel
2016-09-30: Fisher–Yates shuffle
Author: Manuel Eberl
2016-09-29: Allen's Interval Calculus
Author: Fadoua Ghourabi
2016-09-23: Formalization of Recursive Path Orders for Lambda-Free Higher-Order Terms
Authors: Jasmin Christian Blanchette, Uwe Waldmann and Daniel Wand
2016-09-09: Iptables Semantics
Authors: Cornelius Diekmann and Lars Hupel
2016-09-06: A Variant of the Superposition Calculus
Author: Nicolas Peltier
2016-09-06: Stone Algebras
Author: Walter Guttmann
2016-09-01: Stirling's formula
Author: Manuel Eberl
2016-08-31: Routing
Authors: Julius Michaelis and Cornelius Diekmann
2016-08-24: Simple Firewall
Authors: Cornelius Diekmann, Julius Michaelis and Maximilian Haslbeck
2016-08-18: Infeasible Paths Elimination by Symbolic Execution Techniques: Proof of Correctness and Preservation of Paths
Authors: Romain Aissat, Frederic Voisin and Burkhart Wolff
2016-08-12: Formalizing the Edmonds-Karp Algorithm
Authors: Peter Lammich and S. Reza Sefidgar
2016-08-08: The Imperative Refinement Framework
Author: Peter Lammich
2016-08-07: Ptolemy's Theorem
Author: Lukas Bulwahn
2016-07-17: Surprise Paradox
Author: Joachim Breitner
2016-07-14: Pairing Heap
Authors: Hauke Brinkop and Tobias Nipkow
2016-07-05: A Framework for Verifying Depth-First Search Algorithms
Authors: Peter Lammich and René Neumann
2016-07-01: Chamber Complexes, Coxeter Systems, and Buildings
Author: Jeremy Sylvestre
2016-06-30: The Z Property
Authors: Bertram Felgenhauer, Julian Nagele, Vincent van Oostrom and Christian Sternagel
2016-06-30: The Resolution Calculus for First-Order Logic
Author: Anders Schlichtkrull
2016-06-28: IP Addresses
Authors: Cornelius Diekmann, Julius Michaelis and Lars Hupel
2016-06-28: Compositional Security-Preserving Refinement for Concurrent Imperative Programs
Authors: Toby Murray, Robert Sison, Edward Pierzchalski and Christine Rizkallah
2016-06-26: Category Theory with Adjunctions and Limits
Author: Eugene W. Stark
2016-06-26: Cardinality of Multisets
Author: Lukas Bulwahn
2016-06-25: A Dependent Security Type System for Concurrent Imperative Programs
Authors: Toby Murray, Robert Sison, Edward Pierzchalski and Christine Rizkallah
2016-06-21: Catalan Numbers
Author: Manuel Eberl
2016-06-18: Program Construction and Verification Components Based on Kleene Algebra
Authors: Victor B. F. Gomes and Georg Struth
2016-06-13: Conservation of CSP Noninterference Security under Concurrent Composition
Author: Pasquale Noce
2016-06-09: Finite Machine Word Library
Authors: Joel Beeren, Matthew Fernandez, Xin Gao, Gerwin Klein, Rafal Kolanski, Japheth Lim, Corey Lewis, Daniel Matichuk and Thomas Sewell
2016-05-31: Tree Decomposition
Author: Christoph Dittmann
2016-05-24: POSIX Lexing with Derivatives of Regular Expressions
Authors: Fahad Ausaf, Roy Dyckhoff and Christian Urban
2016-05-24: Cardinality of Equivalence Relations
Author: Lukas Bulwahn
2016-05-20: Perron-Frobenius Theorem for Spectral Radius Analysis
Authors: Jose Divasón, Ondřej Kunčar, René Thiemann and Akihisa Yamada
2016-05-20: The meta theory of the Incredible Proof Machine
Authors: Joachim Breitner and Denis Lohner
2016-05-18: A Constructive Proof for FLP
Authors: Benjamin Bisping, Paul-David Brodmann, Tim Jungnickel, Christina Rickmann, Henning Seidler, Anke Stüber, Arno Wilhelm-Weidner, Kirstin Peters and Uwe Nestmann
2016-05-09: A Formal Proof of the Max-Flow Min-Cut Theorem for Countable Networks
Author: Andreas Lochbihler
2016-05-05: Randomised Social Choice Theory
Author: Manuel Eberl
2016-05-04: The Incompatibility of SD-Efficiency and SD-Strategy-Proofness
Author: Manuel Eberl
2016-05-04: Spivey's Generalized Recurrence for Bell Numbers
Author: Lukas Bulwahn
2016-05-02: Gröbner Bases Theory
Authors: Fabian Immler and Alexander Maletzky
2016-04-28: No Faster-Than-Light Observers
Authors: Mike Stannett and István Németi
2016-04-27: Algorithms for Reduced Ordered Binary Decision Diagrams
Authors: Julius Michaelis, Maximilian Haslbeck, Peter Lammich and Lars Hupel
2016-04-27: A formalisation of the Cocke-Younger-Kasami algorithm
Author: Maksym Bortin
2016-04-26: Conservation of CSP Noninterference Security under Sequential Composition
Author: Pasquale Noce
2016-04-12: Kleene Algebras with Domain
Authors: Victor B. F. Gomes, Walter Guttmann, Peter Höfner, Georg Struth and Tjark Weber
2016-03-11: Propositional Resolution and Prime Implicates Generation
Author: Nicolas Peltier
2016-03-08: Timed Automata
Author: Simon Wimmer
2016-03-08: The Cartan Fixed Point Theorems
Author: Lawrence C. Paulson
2016-03-01: Linear Temporal Logic
Author: Salomon Sickert
2016-02-17: Analysis of List Update Algorithms
Authors: Maximilian P.L. Haslbeck and Tobias Nipkow
2016-02-05: Verified Construction of Static Single Assignment Form
Authors: Sebastian Ullrich and Denis Lohner
2016-01-29: Polynomial Interpolation
Authors: René Thiemann and Akihisa Yamada
2016-01-29: Polynomial Factorization
Authors: René Thiemann and Akihisa Yamada
2016-01-20: Knot Theory
Author: T.V.H. Prathamesh
2016-01-18: Tensor Product of Matrices
Author: T.V.H. Prathamesh
2016-01-14: Cardinality of Number Partitions
Author: Lukas Bulwahn

 

2015
2015-12-28: Basic Geometric Properties of Triangles
Author: Manuel Eberl
2015-12-28: The Divergence of the Prime Harmonic Series
Author: Manuel Eberl
2015-12-28: Liouville numbers
Author: Manuel Eberl
2015-12-28: Descartes' Rule of Signs
Author: Manuel Eberl
2015-12-22: The Stern-Brocot Tree
Authors: Peter Gammie and Andreas Lochbihler
2015-12-22: Applicative Lifting
Authors: Andreas Lochbihler and Joshua Schneider
2015-12-22: Algebraic Numbers in Isabelle/HOL
Authors: René Thiemann, Akihisa Yamada and Sebastiaan Joosten
2015-12-12: Cardinality of Set Partitions
Author: Lukas Bulwahn
2015-12-02: Latin Square
Author: Alexander Bentkamp
2015-12-01: Ergodic Theory
Author: Sebastien Gouezel
2015-11-19: Euler's Partition Theorem
Author: Lukas Bulwahn
2015-11-18: The Tortoise and Hare Algorithm
Author: Peter Gammie
2015-11-11: Planarity Certificates
Author: Lars Noschinski
2015-11-02: Positional Determinacy of Parity Games
Author: Christoph Dittmann
2015-09-16: A Meta-Model for the Isabelle API
Authors: Frédéric Tuong and Burkhart Wolff
2015-09-04: Converting Linear Temporal Logic to Deterministic (Generalized) Rabin Automata
Author: Salomon Sickert
2015-08-21: Matrices, Jordan Normal Forms, and Spectral Radius Theory
Authors: René Thiemann and Akihisa Yamada
2015-08-20: Decreasing Diagrams II
Author: Bertram Felgenhauer
2015-08-18: The Inductive Unwinding Theorem for CSP Noninterference Security
Author: Pasquale Noce
2015-08-12: Representations of Finite Groups
Author: Jeremy Sylvestre
2015-08-10: Analysing and Comparing Encodability Criteria for Process Calculi
Authors: Kirstin Peters and Rob van Glabbeek
2015-07-21: Generating Cases from Labeled Subgoals
Author: Lars Noschinski
2015-07-14: Landau Symbols
Author: Manuel Eberl
2015-07-14: The Akra-Bazzi theorem and the Master theorem
Author: Manuel Eberl
2015-07-07: Hermite Normal Form
Authors: Jose Divasón and Jesús Aransay
2015-06-27: Derangements Formula
Author: Lukas Bulwahn
2015-06-11: The Ipurge Unwinding Theorem for CSP Noninterference Security
Author: Pasquale Noce
2015-06-11: The Generic Unwinding Theorem for CSP Noninterference Security
Author: Pasquale Noce
2015-06-11: Binary Multirelations
Authors: Hitoshi Furusawa and Georg Struth
2015-06-11: Reasoning about Lists via List Interleaving
Author: Pasquale Noce
2015-06-07: Parameterized Dynamic Tables
Author: Tobias Nipkow
2015-05-28: Derivatives of Logical Formulas
Author: Dmitriy Traytel
2015-05-27: A Zoo of Probabilistic Systems
Authors: Johannes Hölzl, Andreas Lochbihler and Dmitriy Traytel
2015-04-30: VCG - Combinatorial Vickrey-Clarke-Groves Auctions
Authors: Marco B. Caminati, Manfred Kerber, Christoph Lange and Colin Rowat
2015-04-15: Residuated Lattices
Authors: Victor B. F. Gomes and Georg Struth
2015-04-13: Concurrent IMP
Author: Peter Gammie
2015-04-13: Relaxing Safely: Verified On-the-Fly Garbage Collection for x86-TSO
Authors: Peter Gammie, Tony Hosking and Kai Engelhardt
2015-03-30: Trie
Authors: Andreas Lochbihler and Tobias Nipkow
2015-03-18: Consensus Refined
Authors: Ognjen Maric and Christoph Sprenger
2015-03-11: Deriving class instances for datatypes
Authors: Christian Sternagel and René Thiemann
2015-02-20: The Safety of Call Arity
Author: Joachim Breitner
2015-02-12: QR Decomposition
Authors: Jose Divasón and Jesús Aransay
2015-02-12: Echelon Form
Authors: Jose Divasón and Jesús Aransay
2015-02-05: Finite Automata in Hereditarily Finite Set Theory
Author: Lawrence C. Paulson
2015-01-28: Verification of the UpDown Scheme
Author: Johannes Hölzl

 

2014
2014-11-28: The Unified Policy Framework (UPF)
Authors: Achim D. Brucker, Lukas Brügger and Burkhart Wolff
2014-10-23: Loop freedom of the (untimed) AODV routing protocol
Authors: Timothy Bourke and Peter Höfner
2014-10-13: Lifting Definition Option
Author: René Thiemann
2014-10-10: Stream Fusion in HOL with Code Generation
Authors: Andreas Lochbihler and Alexandra Maximova
2014-10-09: A Verified Compiler for Probability Density Functions
Authors: Manuel Eberl, Johannes Hölzl and Tobias Nipkow
2014-10-08: Formalization of Refinement Calculus for Reactive Systems
Author: Viorel Preoteasa
2014-10-03: XML
Authors: Christian Sternagel and René Thiemann
2014-10-03: Certification Monads
Authors: Christian Sternagel and René Thiemann
2014-09-25: Imperative Insertion Sort
Author: Christian Sternagel
2014-09-19: The Sturm-Tarski Theorem
Author: Wenda Li
2014-09-15: The Cayley-Hamilton Theorem
Authors: Stephan Adelsberger, Stefan Hetzl and Florian Pollak
2014-09-09: The Jordan-Hölder Theorem
Author: Jakob von Raumer
2014-09-04: Priority Queues Based on Braun Trees
Author: Tobias Nipkow
2014-09-03: Gauss-Jordan Algorithm and Its Applications
Authors: Jose Divasón and Jesús Aransay
2014-08-29: Vector Spaces
Author: Holden Lee
2014-08-29: Real-Valued Special Functions: Upper and Lower Bounds
Author: Lawrence C. Paulson
2014-08-13: Skew Heap
Author: Tobias Nipkow
2014-08-12: Splay Tree
Author: Tobias Nipkow
2014-07-29: Haskell's Show Class in Isabelle/HOL
Authors: Christian Sternagel and René Thiemann
2014-07-18: Formal Specification of a Generic Separation Kernel
Authors: Freek Verbeek, Sergey Tverdyshev, Oto Havle, Holger Blasum, Bruno Langenstein, Werner Stephan, Yakoub Nemouchi, Abderrahmane Feliachi, Burkhart Wolff and Julien Schmaltz
2014-07-13: pGCL for Isabelle
Author: David Cock
2014-07-07: Amortized Complexity Verified
Author: Tobias Nipkow
2014-07-04: Network Security Policy Verification
Author: Cornelius Diekmann
2014-07-03: Pop-Refinement
Author: Alessandro Coglio
2014-06-12: Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions
Authors: Dmitriy Traytel and Tobias Nipkow
2014-06-08: Boolean Expression Checkers
Author: Tobias Nipkow
2014-05-28: Promela Formalization
Author: René Neumann
2014-05-28: Converting Linear-Time Temporal Logic to Generalized Büchi Automata
Authors: Alexander Schimpf and Peter Lammich
2014-05-28: Verified Efficient Implementation of Gabow's Strongly Connected Components Algorithm
Author: Peter Lammich
2014-05-28: A Fully Verified Executable LTL Model Checker
Authors: Javier Esparza, Peter Lammich, René Neumann, Tobias Nipkow, Alexander Schimpf and Jan-Georg Smaus
2014-05-28: The CAVA Automata Library
Author: Peter Lammich
2014-05-23: Transitive closure according to Roy-Floyd-Warshall
Author: Makarius Wenzel
2014-05-23: Noninterference Security in Communicating Sequential Processes
Author: Pasquale Noce
2014-05-21: Regular Algebras
Authors: Simon Foster and Georg Struth
2014-04-28: Formalisation and Analysis of Component Dependencies
Author: Maria Spichkova
2014-04-23: A Formalization of Declassification with WHAT-and-WHERE-Security
Authors: Sylvia Grewe, Alexander Lux, Heiko Mantel and Jens Sauer
2014-04-23: A Formalization of Strong Security
Authors: Sylvia Grewe, Alexander Lux, Heiko Mantel and Jens Sauer
2014-04-23: A Formalization of Assumptions and Guarantees for Compositional Noninterference
Authors: Sylvia Grewe, Heiko Mantel and Daniel Schoepe
2014-04-22: Bounded-Deducibility Security
Authors: Andrei Popescu and Peter Lammich
2014-04-16: A shallow embedding of HyperCTL*
Authors: Markus N. Rabe, Peter Lammich and Andrei Popescu
2014-04-16: Abstract Completeness
Authors: Jasmin Christian Blanchette, Andrei Popescu and Dmitriy Traytel
2014-04-13: Discrete Summation
Author: Florian Haftmann
2014-04-03: Syntax and semantics of a GPU kernel programming language
Author: John Wickerson
2014-03-11: Probabilistic Noninterference
Authors: Andrei Popescu and Johannes Hölzl
2014-03-08: Mechanization of the Algebra for Wireless Networks (AWN)
Author: Timothy Bourke
2014-02-18: Mutually Recursive Partial Functions
Author: René Thiemann
2014-02-13: Properties of Random Graphs -- Subgraph Containment
Author: Lars Hupel
2014-02-11: Verification of Selection and Heap Sort Using Locales
Author: Danijela Petrovic
2014-02-07: Affine Arithmetic
Author: Fabian Immler
2014-02-06: Implementing field extensions of the form Q[sqrt(b)]
Author: René Thiemann
2014-01-30: Unified Decision Procedures for Regular Expression Equivalence
Authors: Tobias Nipkow and Dmitriy Traytel
2014-01-28: Secondary Sylow Theorems
Author: Jakob von Raumer
2014-01-25: Relation Algebra
Authors: Alasdair Armstrong, Simon Foster, Georg Struth and Tjark Weber
2014-01-23: Kleene Algebra with Tests and Demonic Refinement Algebras
Authors: Alasdair Armstrong, Victor B. F. Gomes and Georg Struth
2014-01-16: Featherweight OCL: A Proposal for a Machine-Checked Formal Semantics for OCL 2.5
Authors: Achim D. Brucker, Frédéric Tuong and Burkhart Wolff
2014-01-11: Sturm's Theorem
Author: Manuel Eberl
2014-01-11: Compositional Properties of Crypto-Based Components
Author: Maria Spichkova

 

2013
2013-12-01: A General Method for the Proof of Theorems on Tail-recursive Functions
Author: Pasquale Noce
2013-11-17: Gödel's Incompleteness Theorems
Author: Lawrence C. Paulson
2013-11-17: The Hereditarily Finite Sets
Author: Lawrence C. Paulson
2013-11-15: A Codatatype of Formal Languages
Author: Dmitriy Traytel
2013-11-14: Stream Processing Components: Isabelle/HOL Formalisation and Case Studies
Author: Maria Spichkova
2013-11-12: Gödel's God in Isabelle/HOL
Authors: Christoph Benzmüller and Bruno Woltzenlogel Paleo
2013-11-01: Decreasing Diagrams
Author: Harald Zankl
2013-10-02: Automatic Data Refinement
Author: Peter Lammich
2013-09-17: Native Word
Author: Andreas Lochbihler
2013-07-27: A Formal Model of IEEE Floating Point Arithmetic
Author: Lei Yu
2013-07-22: Pratt's Primality Certificates
Authors: Simon Wimmer and Lars Noschinski
2013-07-22: Lehmer's Theorem
Authors: Simon Wimmer and Lars Noschinski
2013-07-19: The Königsberg Bridge Problem and the Friendship Theorem
Author: Wenda Li
2013-06-27: Sound and Complete Sort Encodings for First-Order Logic
Authors: Jasmin Christian Blanchette and Andrei Popescu
2013-05-22: An Axiomatic Characterization of the Single-Source Shortest Path Problem
Author: Christine Rizkallah
2013-04-28: Graph Theory
Author: Lars Noschinski
2013-04-15: Light-weight Containers
Author: Andreas Lochbihler
2013-02-21: Nominal 2
Authors: Christian Urban, Stefan Berghofer and Cezary Kaliszyk
2013-01-31: The Correctness of Launchbury's Natural Semantics for Lazy Evaluation
Author: Joachim Breitner
2013-01-19: Ribbon Proofs
Author: John Wickerson
2013-01-16: Rank-Nullity Theorem in Linear Algebra
Authors: Jose Divasón and Jesús Aransay
2013-01-15: Kleene Algebra
Authors: Alasdair Armstrong, Georg Struth and Tjark Weber
2013-01-03: Computing N-th Roots using the Babylonian Method
Author: René Thiemann

 

2012
2012-11-14: A Separation Logic Framework for Imperative HOL
Authors: Peter Lammich and Rene Meis
2012-11-02: Open Induction
Authors: Mizuhito Ogawa and Christian Sternagel
2012-10-30: The independence of Tarski's Euclidean axiom
Author: T. J. M. Makarios
2012-10-27: Bondy's Theorem
Authors: Jeremy Avigad and Stefan Hetzl
2012-09-10: Possibilistic Noninterference
Authors: Andrei Popescu and Johannes Hölzl
2012-08-07: Generating linear orders for datatypes
Author: René Thiemann
2012-08-05: Proving the Impossibility of Trisecting an Angle and Doubling the Cube
Authors: Ralph Romanos and Lawrence C. Paulson
2012-07-27: Verifying Fault-Tolerant Distributed Algorithms in the Heard-Of Model
Authors: Henri Debrat and Stephan Merz
2012-07-01: Logical Relations for PCF
Author: Peter Gammie
2012-06-26: Type Constructor Classes and Monad Transformers
Author: Brian Huffman
2012-05-29: Psi-calculi in Isabelle
Author: Jesper Bengtson
2012-05-29: The pi-calculus in nominal logic
Author: Jesper Bengtson
2012-05-29: CCS in nominal logic
Author: Jesper Bengtson
2012-05-27: Isabelle/Circus
Authors: Abderrahmane Feliachi, Burkhart Wolff and Marie-Claude Gaudel
2012-05-11: Separation Algebra
Authors: Gerwin Klein, Rafal Kolanski and Andrew Boyton
2012-05-07: Stuttering Equivalence
Author: Stephan Merz
2012-05-02: Inductive Study of Confidentiality
Author: Giampaolo Bella
2012-04-26: Ordinary Differential Equations
Authors: Fabian Immler and Johannes Hölzl
2012-04-13: Well-Quasi-Orders
Author: Christian Sternagel
2012-03-01: Abortable Linearizable Modules
Authors: Rachid Guerraoui, Viktor Kuncak and Giuliano Losa
2012-02-29: Executable Transitive Closures
Author: René Thiemann
2012-02-06: A Probabilistic Proof of the Girth-Chromatic Number Theorem
Author: Lars Noschinski
2012-01-30: Refinement for Monadic Programs
Author: Peter Lammich
2012-01-30: Dijkstra's Shortest Path Algorithm
Authors: Benedikt Nordhoff and Peter Lammich
2012-01-03: Markov Models
Authors: Johannes Hölzl and Tobias Nipkow

 

2011
2011-11-19: A Definitional Encoding of TLA* in Isabelle/HOL
Authors: Gudmund Grov and Stephan Merz
2011-11-09: Efficient Mergesort
Author: Christian Sternagel
2011-09-22: Pseudo Hoops
Authors: George Georgescu, Laurentiu Leustean and Viorel Preoteasa
2011-09-22: Algebra of Monotonic Boolean Transformers
Author: Viorel Preoteasa
2011-09-22: Lattice Properties
Author: Viorel Preoteasa
2011-08-26: The Myhill-Nerode Theorem Based on Regular Expressions
Authors: Chunhan Wu, Xingyuan Zhang and Christian Urban
2011-08-19: Gauss-Jordan Elimination for Matrices Represented as Functions
Author: Tobias Nipkow
2011-07-21: Maximum Cardinality Matching
Author: Christine Rizkallah
2011-05-17: Knowledge-based programs
Author: Peter Gammie
2011-04-01: The General Triangle Is Unique
Author: Joachim Breitner
2011-03-14: Executable Transitive Closures of Finite Relations
Authors: Christian Sternagel and René Thiemann
2011-02-23: Interval Temporal Logic on Natural Numbers
Author: David Trachtenherz
2011-02-23: Infinite Lists
Author: David Trachtenherz
2011-02-23: AutoFocus Stream Processing for Single-Clocking and Multi-Clocking Semantics
Author: David Trachtenherz
2011-02-07: Lightweight Java
Authors: Rok Strniša and Matthew Parkinson
2011-01-10: RIPEMD-160
Author: Fabian Immler
2011-01-08: Lower Semicontinuous Functions
Author: Bogdan Grechuk

 

2010
2010-12-17: Hall's Marriage Theorem
Authors: Dongchen Jiang and Tobias Nipkow
2010-11-16: Shivers' Control Flow Analysis
Author: Joachim Breitner
2010-10-28: Finger Trees
Authors: Benedikt Nordhoff, Stefan Körner and Peter Lammich
2010-10-28: Functional Binomial Queues
Author: René Neumann
2010-10-28: Binomial Heaps and Skew Binomial Heaps
Authors: Rene Meis, Finn Nielsen and Peter Lammich
2010-08-29: Strong Normalization of Moggis's Computational Metalanguage
Author: Christian Doczkal
2010-08-10: Executable Multivariate Polynomials
Authors: Christian Sternagel, René Thiemann, Alexander Maletzky, Fabian Immler, Florian Haftmann, Andreas Lochbihler and Alexander Bentkamp
2010-08-08: Formalizing Statecharts using Hierarchical Automata
Authors: Steffen Helke and Florian Kammüller
2010-06-24: Free Groups
Author: Joachim Breitner
2010-06-20: Category Theory
Author: Alexander Katovsky
2010-06-17: Executable Matrix Operations on Matrices of Arbitrary Dimensions
Authors: Christian Sternagel and René Thiemann
2010-06-14: Abstract Rewriting
Authors: Christian Sternagel and René Thiemann
2010-05-28: Verification of the Deutsch-Schorr-Waite Graph Marking Algorithm using Data Refinement
Authors: Viorel Preoteasa and Ralph-Johan Back
2010-05-28: Semantics and Data Refinement of Invariant Based Programs
Authors: Viorel Preoteasa and Ralph-Johan Back
2010-05-22: A Complete Proof of the Robbins Conjecture
Author: Matthew Wampler-Doty
2010-05-12: Regular Sets and Expressions
Authors: Alexander Krauss and Tobias Nipkow
2010-04-30: Locally Nameless Sigma Calculus
Authors: Ludovic Henrio, Florian Kammüller, Bianca Lutz and Henry Sudhof
2010-03-29: Free Boolean Algebra
Author: Brian Huffman
2010-03-23: Inter-Procedural Information Flow Noninterference via Slicing
Author: Daniel Wasserrab
2010-03-23: Information Flow Noninterference via Slicing
Author: Daniel Wasserrab
2010-02-20: List Index
Author: Tobias Nipkow
2010-02-12: Coinductive
Author: Andreas Lochbihler

 

2009
2009-12-09: A Fast SAT Solver for Isabelle in Standard ML
Author: Armin Heller
2009-12-03: Formalizing the Logic-Automaton Connection
Authors: Stefan Berghofer and Markus Reiter
2009-11-25: Tree Automata
Author: Peter Lammich
2009-11-25: Collections Framework
Author: Peter Lammich
2009-11-22: Perfect Number Theorem
Author: Mark Ijbema
2009-11-13: Backing up Slicing: Verifying the Interprocedural Two-Phase Horwitz-Reps-Binkley Slicer
Author: Daniel Wasserrab
2009-10-30: The Worker/Wrapper Transformation
Author: Peter Gammie
2009-09-01: Ordinals and Cardinals
Author: Andrei Popescu
2009-08-28: Invertibility in Sequent Calculi
Author: Peter Chapman
2009-08-04: An Example of a Cofinitary Group in Isabelle/HOL
Author: Bart Kastermans
2009-05-06: Code Generation for Functions as Data
Author: Andreas Lochbihler
2009-04-29: Stream Fusion
Author: Brian Huffman

 

2008
2008-12-12: A Bytecode Logic for JML and Types
Authors: Lennart Beringer and Martin Hofmann
2008-11-10: Secure information flow and program logics
Authors: Lennart Beringer and Martin Hofmann
2008-11-09: Some classical results in Social Choice Theory
Author: Peter Gammie
2008-11-07: Fun With Tilings
Authors: Tobias Nipkow and Lawrence C. Paulson
2008-10-15: The Textbook Proof of Huffman's Algorithm
Author: Jasmin Christian Blanchette
2008-09-16: Towards Certified Slicing
Author: Daniel Wasserrab
2008-09-02: A Correctness Proof for the Volpano/Smith Security Typing System
Authors: Gregor Snelting and Daniel Wasserrab
2008-09-01: Arrow and Gibbard-Satterthwaite
Author: Tobias Nipkow
2008-08-26: Fun With Functions
Author: Tobias Nipkow
2008-07-23: Formal Verification of Modern SAT Solvers
Author: Filip Marić
2008-04-05: Recursion Theory I
Author: Michael Nedzelsky
2008-02-29: A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment
Author: Norbert Schirmer
2008-02-29: BDD Normalisation
Authors: Veronika Ortner and Norbert Schirmer
2008-02-18: Normalization by Evaluation
Authors: Klaus Aehlig and Tobias Nipkow
2008-01-11: Quantifier Elimination for Linear Arithmetic
Author: Tobias Nipkow

 

2007
2007-12-14: Formalization of Conflict Analysis of Programs with Procedures, Thread Creation, and Monitors
Authors: Peter Lammich and Markus Müller-Olm
2007-12-03: Jinja with Threads
Author: Andreas Lochbihler
2007-11-06: Much Ado About Two
Author: Sascha Böhme
2007-08-12: Sums of Two and Four Squares
Author: Roelof Oosterhuis
2007-08-12: Fermat's Last Theorem for Exponents 3 and 4 and the Parametrisation of Pythagorean Triples
Author: Roelof Oosterhuis
2007-08-08: Fundamental Properties of Valuation Theory and Hensel's Lemma
Author: Hidetsune Kobayashi
2007-08-02: POPLmark Challenge Via de Bruijn Indices
Author: Stefan Berghofer
2007-08-02: First-Order Logic According to Fitting
Author: Stefan Berghofer

 

2006
2006-09-09: Hotel Key Card System
Author: Tobias Nipkow
2006-08-08: Abstract Hoare Logics
Author: Tobias Nipkow
2006-05-22: Flyspeck I: Tame Graphs
Authors: Gertrud Bauer and Tobias Nipkow
2006-05-15: CoreC++
Author: Daniel Wasserrab
2006-03-31: A Theory of Featherweight Java in Isabelle/HOL
Authors: J. Nathan Foster and Dimitrios Vytiniotis
2006-03-15: Instances of Schneider's generalized protocol of clock synchronization
Author: Damián Barsotti
2006-03-14: Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality
Author: Benjamin Porter

 

2005
2005-11-11: Countable Ordinals
Author: Brian Huffman
2005-10-12: Fast Fourier Transform
Author: Clemens Ballarin
2005-06-24: Formalization of a Generalized Protocol for Clock Synchronization
Author: Alwen Tiu
2005-06-22: Proving the Correctness of Disk Paxos
Authors: Mauro Jaskelioff and Stephan Merz
2005-06-20: Jive Data and Store Model
Authors: Nicole Rauch and Norbert Schirmer
2005-06-01: Jinja is not Java
Authors: Gerwin Klein and Tobias Nipkow
2005-05-02: SHA1, RSA, PSS and more
Authors: Christina Lindenberg and Kai Wirt
2005-04-21: Category Theory to Yoneda's Lemma
Author: Greg O'Keefe

 

2004
2004-12-09: File Refinement
Authors: Karen Zee and Viktor Kuncak
2004-11-19: Integration theory and random variables
Author: Stefan Richter
2004-09-28: A Mechanically Verified, Efficient, Sound and Complete Theorem Prover For First Order Logic
Author: Tom Ridge
2004-09-20: Ramsey's theorem, infinitary version
Author: Tom Ridge
2004-09-20: Completeness theorem
Authors: James Margetson and Tom Ridge
2004-07-09: Compiling Exceptions Correctly
Author: Tobias Nipkow
2004-06-24: Depth First Search
Authors: Toshiaki Nishihara and Yasuhiko Minamide
2004-05-18: Groups, Rings and Modules
Authors: Hidetsune Kobayashi, L. Chen and H. Murao
2004-04-26: Topology
Author: Stefan Friedrich
2004-04-26: Lazy Lists II
Author: Stefan Friedrich
2004-04-05: Binary Search Trees
Author: Viktor Kuncak
2004-03-30: Functional Automata
Author: Tobias Nipkow
2004-03-19: Mini ML
Authors: Wolfgang Naraschewski and Tobias Nipkow
2004-03-19: AVL Trees
Authors: Tobias Nipkow and Cornelia Pusch
\ No newline at end of file diff --git a/web/rss.xml b/web/rss.xml --- a/web/rss.xml +++ b/web/rss.xml @@ -1,574 +1,574 @@ Archive of Formal Proofs https://www.isa-afp.org The Archive of Formal Proofs is a collection of proof libraries, examples, and larger scientific developments, mechanically checked in the theorem prover Isabelle. 13 May 2020 00:00:00 +0000 A Formalization of Knuth–Bendix Orders https://www.isa-afp.org/entries/Knuth_Bendix_Order.html https://www.isa-afp.org/entries/Knuth_Bendix_Order.html Christian Sternagel, René Thiemann 13 May 2020 00:00:00 +0000 We define a generalized version of Knuth&ndash;Bendix orders, including subterm coefficient functions. For these orders we formalize several properties such as strong normalization, the subterm property, closure properties under substitutions and contexts, as well as ground totality. Irrationality Criteria for Series by Erdős and Straus https://www.isa-afp.org/entries/Irrational_Series_Erdos_Straus.html https://www.isa-afp.org/entries/Irrational_Series_Erdos_Straus.html Angeliki Koutsoukou-Argyraki, Wenda Li 12 May 2020 00:00:00 +0000 We formalise certain irrationality criteria for infinite series of the form: \[\sum_{n=1}^\infty \frac{b_n}{\prod_{i=1}^n a_i} \] where $\{b_n\}$ is a sequence of integers and $\{a_n\}$ a sequence of positive integers with $a_n >1$ for all large n. The results are due to P. Erdős and E. G. Straus <a href="https://projecteuclid.org/euclid.pjm/1102911140">[1]</a>. In particular, we formalise Theorem 2.1, Corollary 2.10 and Theorem 3.1. The latter is an application of Theorem 2.1 involving the prime numbers. Recursion Theorem in ZF https://www.isa-afp.org/entries/Recursion-Addition.html https://www.isa-afp.org/entries/Recursion-Addition.html Georgy Dunaev 11 May 2020 00:00:00 +0000 This document contains a proof of the recursion theorem. This is a mechanization of the proof of the recursion theorem from the text <i>Introduction to Set Theory</i>, by Karel Hrbacek and Thomas Jech. This implementation may be used as the basis for a model of Peano arithmetic in ZF. While recursion and the natural numbers are already available in Isabelle/ZF, this clean development is much easier to follow. An Efficient Normalisation Procedure for Linear Temporal Logic: Isabelle/HOL Formalisation https://www.isa-afp.org/entries/LTL_Normal_Form.html https://www.isa-afp.org/entries/LTL_Normal_Form.html Salomon Sickert 08 May 2020 00:00:00 +0000 In the mid 80s, Lichtenstein, Pnueli, and Zuck proved a classical theorem stating that every formula of Past LTL (the extension of LTL with past operators) is equivalent to a formula of the form $\bigwedge_{i=1}^n \mathbf{G}\mathbf{F} \varphi_i \vee \mathbf{F}\mathbf{G} \psi_i$, where $\varphi_i$ and $\psi_i$ contain only past operators. Some years later, Chang, Manna, and Pnueli built on this result to derive a similar normal form for LTL. Both normalisation procedures have a non-elementary worst-case blow-up, and follow an involved path from formulas to counter-free automata to star-free regular expressions and back to formulas. We improve on both points. We present an executable formalisation of a direct and purely syntactic normalisation procedure for LTL yielding a normal form, comparable to the one by Chang, Manna, and Pnueli, that has only a single exponential blow-up. Formalization of Forcing in Isabelle/ZF https://www.isa-afp.org/entries/Forcing.html https://www.isa-afp.org/entries/Forcing.html Emmanuel Gunther, Miguel Pagano, Pedro Sánchez Terraf 06 May 2020 00:00:00 +0000 We formalize the theory of forcing in the set theory framework of Isabelle/ZF. Under the assumption of the existence of a countable transitive model of ZFC, we construct a proper generic extension and show that the latter also satisfies ZFC. Banach-Steinhaus Theorem https://www.isa-afp.org/entries/Banach_Steinhaus.html https://www.isa-afp.org/entries/Banach_Steinhaus.html Dominique Unruh, Jose Manuel Rodriguez Caballero 02 May 2020 00:00:00 +0000 We formalize in Isabelle/HOL a result due to S. Banach and H. Steinhaus known as the Banach-Steinhaus theorem or Uniform boundedness principle: a pointwise-bounded family of continuous linear operators from a Banach space to a normed space is uniformly bounded. Our approach is an adaptation to Isabelle/HOL of a proof due to A. Sokal. Attack Trees in Isabelle for GDPR compliance of IoT healthcare systems https://www.isa-afp.org/entries/Attack_Trees.html https://www.isa-afp.org/entries/Attack_Trees.html Florian Kammueller 27 Apr 2020 00:00:00 +0000 In this article, we present a proof theory for Attack Trees. Attack Trees are a well established and useful model for the construction of attacks on systems since they allow a stepwise exploration of high level attacks in application scenarios. Using the expressiveness of Higher Order Logic in Isabelle, we develop a generic theory of Attack Trees with a state-based semantics based on Kripke structures and CTL. The resulting framework allows mechanically supported logic analysis of the meta-theory of the proof calculus of Attack Trees and at the same time the developed proof theory enables application to case studies. A central correctness and completeness result proved in Isabelle establishes a connection between the notion of Attack Tree validity and CTL. The application is illustrated on the example of a healthcare IoT system and GDPR compliance verification. Power Sum Polynomials https://www.isa-afp.org/entries/Power_Sum_Polynomials.html https://www.isa-afp.org/entries/Power_Sum_Polynomials.html Manuel Eberl 24 Apr 2020 00:00:00 +0000 <p>This article provides a formalisation of the symmetric multivariate polynomials known as <em>power sum polynomials</em>. These are of the form p<sub>n</sub>(<em>X</em><sub>1</sub>,&hellip;, <em>X</em><sub><em>k</em></sub>) = <em>X</em><sub>1</sub><sup>n</sup> + &hellip; + X<sub><em>k</em></sub><sup>n</sup>. A formal proof of the Girard–Newton Theorem is also given. This theorem relates the power sum polynomials to the elementary symmetric polynomials s<sub><em>k</em></sub> in the form of a recurrence relation (-1)<sup><em>k</em></sup> <em>k</em> s<sub><em>k</em></sub> = &sum;<sub>i&isinv;[0,<em>k</em>)</sub> (-1)<sup>i</sup> s<sub>i</sub> p<sub><em>k</em>-<em>i</em></sub>&thinsp;.</p> <p>As an application, this is then used to solve a generalised form of a puzzle given as an exercise in Dummit and Foote's <em>Abstract Algebra</em>: For <em>k</em> complex unknowns <em>x</em><sub>1</sub>, &hellip;, <em>x</em><sub><em>k</em></sub>, define p<sub><em>j</em></sub> := <em>x</em><sub>1</sub><sup><em>j</em></sup> + &hellip; + <em>x</em><sub><em>k</em></sub><sup><em>j</em></sup>. Then for each vector <em>a</em> &isinv; &#x2102;<sup><em>k</em></sup>, show that there is exactly one solution to the system p<sub>1</sub> = a<sub>1</sub>, &hellip;, p<sub><em>k</em></sub> = a<sub><em>k</em></sub> up to permutation of the <em>x</em><sub><em>i</em></sub> and determine the value of p<sub><em>i</em></sub> for i&gt;k.</p> The Lambert W Function on the Reals https://www.isa-afp.org/entries/Lambert_W.html https://www.isa-afp.org/entries/Lambert_W.html Manuel Eberl 24 Apr 2020 00:00:00 +0000 <p>The Lambert <em>W</em> function is a multi-valued function defined as the inverse function of <em>x</em> &#x21A6; <em>x</em> e<sup><em>x</em></sup>. Besides numerous applications in combinatorics, physics, and engineering, it also frequently occurs when solving equations containing both e<sup><em>x</em></sup> and <em>x</em>, or both <em>x</em> and log <em>x</em>.</p> <p>This article provides a definition of the two real-valued branches <em>W</em><sub>0</sub>(<em>x</em>) and <em>W</em><sub>-1</sub>(<em>x</em>) and proves various properties such as basic identities and inequalities, monotonicity, differentiability, asymptotic expansions, and the MacLaurin series of <em>W</em><sub>0</sub>(<em>x</em>) at <em>x</em> = 0.</p> Gaussian Integers https://www.isa-afp.org/entries/Gaussian_Integers.html https://www.isa-afp.org/entries/Gaussian_Integers.html Manuel Eberl 24 Apr 2020 00:00:00 +0000 <p>The Gaussian integers are the subring &#8484;[i] of the complex numbers, i. e. the ring of all complex numbers with integral real and imaginary part. This article provides a definition of this ring as well as proofs of various basic properties, such as that they form a Euclidean ring and a full classification of their primes. An executable (albeit not very efficient) factorisation algorithm is also provided.</p> <p>Lastly, this Gaussian integer formalisation is used in two short applications:</p> <ol> <li> The characterisation of all positive integers that can be written as sums of two squares</li> <li> Euclid's formula for primitive Pythagorean triples</li> </ol> <p>While elementary proofs for both of these are already available in the AFP, the theory of Gaussian integers provides more concise proofs and a more high-level view.</p> Matrices for ODEs https://www.isa-afp.org/entries/Matrices_for_ODEs.html https://www.isa-afp.org/entries/Matrices_for_ODEs.html Jonathan Julian Huerta y Munive 19 Apr 2020 00:00:00 +0000 Our theories formalise various matrix properties that serve to establish existence, uniqueness and characterisation of the solution to affine systems of ordinary differential equations (ODEs). In particular, we formalise the operator and maximum norm of matrices. Then we use them to prove that square matrices form a Banach space, and in this setting, we show an instance of Picard-Lindelöf’s theorem for affine systems of ODEs. Finally, we use this formalisation to verify three simple hybrid programs. Authenticated Data Structures As Functors https://www.isa-afp.org/entries/ADS_Functor.html https://www.isa-afp.org/entries/ADS_Functor.html Andreas Lochbihler, Ognjen Marić 16 Apr 2020 00:00:00 +0000 Authenticated data structures allow several systems to convince each other that they are referring to the same data structure, even if each of them knows only a part of the data structure. Using inclusion proofs, knowledgeable systems can selectively share their knowledge with other systems and the latter can verify the authenticity of what is being shared. In this article, we show how to modularly define authenticated data structures, their inclusion proofs, and operations thereon as datatypes in Isabelle/HOL, using a shallow embedding. Modularity allows us to construct complicated trees from reusable building blocks, which we call Merkle functors. Merkle functors include sums, products, and function spaces and are closed under composition and least fixpoints. As a practical application, we model the hierarchical transactions of <a href="https://www.canton.io">Canton</a>, a practical interoperability protocol for distributed ledgers, as authenticated data structures. This is a first step towards formalizing the Canton protocol and verifying its integrity and security guarantees. Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows https://www.isa-afp.org/entries/Sliding_Window_Algorithm.html https://www.isa-afp.org/entries/Sliding_Window_Algorithm.html Lukas Heimes, Dmitriy Traytel, Joshua Schneider 10 Apr 2020 00:00:00 +0000 Basin et al.'s <a href="https://doi.org/10.1016/j.ipl.2014.09.009">sliding window algorithm (SWA)</a> is an algorithm for combining the elements of subsequences of a sequence with an associative operator. It is greedy and minimizes the number of operator applications. We formalize the algorithm and verify its functional correctness. We extend the algorithm with additional operations and provide an alternative interface to the slide operation that does not require the entire input sequence. A Comprehensive Framework for Saturation Theorem Proving https://www.isa-afp.org/entries/Saturation_Framework.html https://www.isa-afp.org/entries/Saturation_Framework.html Sophie Tourret 09 Apr 2020 00:00:00 +0000 This Isabelle/HOL formalization is the companion of the technical report “A comprehensive framework for saturation theorem proving”, itself companion of the eponym IJCAR 2020 paper, written by Uwe Waldmann, Sophie Tourret, Simon Robillard and Jasmin Blanchette. It verifies a framework for formal refutational completeness proofs of abstract provers that implement saturation calculi, such as ordered resolution or superposition, and allows to model entire prover architectures in such a way that the static refutational completeness of a calculus immediately implies the dynamic refutational completeness of a prover implementing the calculus using a variant of the given clause loop. The technical report “A comprehensive framework for saturation theorem proving” is available <a href="http://matryoshka.gforge.inria.fr/pubs/satur_report.pdf">on the Matryoshka website</a>. The names of the Isabelle lemmas and theorems corresponding to the results in the report are indicated in the margin of the report. Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations https://www.isa-afp.org/entries/MFODL_Monitor_Optimized.html https://www.isa-afp.org/entries/MFODL_Monitor_Optimized.html Thibault Dardinier, Lukas Heimes, Martin Raszyk, Joshua Schneider, Dmitriy Traytel 09 Apr 2020 00:00:00 +0000 A monitor is a runtime verification tool that solves the following problem: Given a stream of time-stamped events and a policy formulated in a specification language, decide whether the policy is satisfied at every point in the stream. We verify the correctness of an executable monitor for specifications given as formulas in metric first-order dynamic logic (MFODL), which combines the features of metric first-order temporal logic (MFOTL) and metric dynamic logic. Thus, MFODL supports real-time constraints, first-order parameters, and regular expressions. Additionally, the monitor supports aggregation operations such as count and sum. This formalization, which is described in a <a href="http://people.inf.ethz.ch/trayteld/papers/ijcar20-verimonplus/verimonplus.pdf"> forthcoming paper at IJCAR 2020</a>, significantly extends <a href="https://www.isa-afp.org/entries/MFOTL_Monitor.html">previous work on a verified monitor</a> for MFOTL. Apart from the addition of regular expressions and aggregations, we implemented <a href="https://www.isa-afp.org/entries/Generic_Join.html">multi-way joins</a> and a specialized sliding window algorithm to further optimize the monitor. + Stateful Protocol Composition and Typing + https://www.isa-afp.org/entries/Stateful_Protocol_Composition_and_Typing.html + https://www.isa-afp.org/entries/Stateful_Protocol_Composition_and_Typing.html + Andreas V. Hess, Sebastian Mödersheim, Achim D. Brucker + 08 Apr 2020 00:00:00 +0000 + +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. + + + Automated Stateful Protocol Verification + https://www.isa-afp.org/entries/Automated_Stateful_Protocol_Verification.html + https://www.isa-afp.org/entries/Automated_Stateful_Protocol_Verification.html + Andreas V. Hess, Sebastian Mödersheim, Achim D. Brucker, Anders Schlichtkrull + 08 Apr 2020 00:00:00 +0000 + +In protocol verification we observe a wide spectrum from fully +automated methods to interactive theorem proving with proof assistants +like Isabelle/HOL. In this AFP entry, we present a fully-automated +approach for verifying stateful security protocols, i.e., protocols +with mutable state that may span several sessions. The approach +supports reachability goals like secrecy and authentication. We also +include a simple user-friendly transaction-based protocol +specification language that is embedded into Isabelle. + + Lucas's Theorem https://www.isa-afp.org/entries/Lucas_Theorem.html https://www.isa-afp.org/entries/Lucas_Theorem.html Chelsea Edmonds 07 Apr 2020 00:00:00 +0000 This work presents a formalisation of a generating function proof for Lucas's theorem. We first outline extensions to the existing Formal Power Series (FPS) library, including an equivalence relation for coefficients modulo <em>n</em>, an alternate binomial theorem statement, and a formalised proof of the Freshman's dream (mod <em>p</em>) lemma. The second part of the work presents the formal proof of Lucas's Theorem. Working backwards, the formalisation first proves a well known corollary of the theorem which is easier to formalise, and then applies induction to prove the original theorem statement. The proof of the corollary aims to provide a good example of a formalised generating function equivalence proof using the FPS library. The final theorem statement is intended to be integrated into the formalised proof of Hilbert's 10th Problem. Strong Eventual Consistency of the Collaborative Editing Framework WOOT https://www.isa-afp.org/entries/WOOT_Strong_Eventual_Consistency.html https://www.isa-afp.org/entries/WOOT_Strong_Eventual_Consistency.html Emin Karayel, Edgar Gonzàlez 25 Mar 2020 00:00:00 +0000 Commutative Replicated Data Types (CRDTs) are a promising new class of data structures for large-scale shared mutable content in applications that only require eventual consistency. The WithOut Operational Transforms (WOOT) framework is a CRDT for collaborative text editing introduced by Oster et al. (CSCW 2006) for which the eventual consistency property was verified only for a bounded model to date. We contribute a formal proof for WOOTs strong eventual consistency. Furstenberg's topology and his proof of the infinitude of primes https://www.isa-afp.org/entries/Furstenberg_Topology.html https://www.isa-afp.org/entries/Furstenberg_Topology.html Manuel Eberl 22 Mar 2020 00:00:00 +0000 <p>This article gives a formal version of Furstenberg's topological proof of the infinitude of primes. He defines a topology on the integers based on arithmetic progressions (or, equivalently, residue classes). Using some fairly obvious properties of this topology, the infinitude of primes is then easily obtained.</p> <p>Apart from this, this topology is also fairly ‘nice’ in general: it is second countable, metrizable, and perfect. All of these (well-known) facts are formally proven, including an explicit metric for the topology given by Zulfeqarr.</p> An Under-Approximate Relational Logic https://www.isa-afp.org/entries/Relational-Incorrectness-Logic.html https://www.isa-afp.org/entries/Relational-Incorrectness-Logic.html Toby Murray 12 Mar 2020 00:00:00 +0000 Recently, authors have proposed under-approximate logics for reasoning about programs. So far, all such logics have been confined to reasoning about individual program behaviours. Yet there exist many over-approximate relational logics for reasoning about pairs of programs and relating their behaviours. We present the first under-approximate relational logic, for the simple imperative language IMP. We prove our logic is both sound and complete. Additionally, we show how reasoning in this logic can be decomposed into non-relational reasoning in an under-approximate Hoare logic, mirroring Beringer’s result for over-approximate relational logics. We illustrate the application of our logic on some small examples in which we provably demonstrate the presence of insecurity. Hello World https://www.isa-afp.org/entries/Hello_World.html https://www.isa-afp.org/entries/Hello_World.html Cornelius Diekmann, Lars Hupel 07 Mar 2020 00:00:00 +0000 In this article, we present a formalization of the well-known "Hello, World!" code, including a formal framework for reasoning about IO. Our model is inspired by the handling of IO in Haskell. We start by formalizing the 🌍 and embrace the IO monad afterwards. Then we present a sample main :: IO (), followed by its proof of correctness. Implementing the Goodstein Function in λ-Calculus https://www.isa-afp.org/entries/Goodstein_Lambda.html https://www.isa-afp.org/entries/Goodstein_Lambda.html Bertram Felgenhauer 21 Feb 2020 00:00:00 +0000 In this formalization, we develop an implementation of the Goodstein function G in plain &lambda;-calculus, linked to a concise, self-contained specification. The implementation works on a Church-encoded representation of countable ordinals. The initial conversion to hereditary base 2 is not covered, but the material is sufficient to compute the particular value G(16), and easily extends to other fixed arguments. A Generic Framework for Verified Compilers https://www.isa-afp.org/entries/VeriComp.html https://www.isa-afp.org/entries/VeriComp.html Martin Desharnais 10 Feb 2020 00:00:00 +0000 This is a generic framework for formalizing compiler transformations. It leverages Isabelle/HOL’s locales to abstract over concrete languages and transformations. It states common definitions for language semantics, program behaviours, forward and backward simulations, and compilers. We provide generic operations, such as simulation and compiler composition, and prove general (partial) correctness theorems, resulting in reusable proof components. Arithmetic progressions and relative primes https://www.isa-afp.org/entries/Arith_Prog_Rel_Primes.html https://www.isa-afp.org/entries/Arith_Prog_Rel_Primes.html José Manuel Rodríguez Caballero 01 Feb 2020 00:00:00 +0000 This article provides a formalization of the solution obtained by the author of the Problem “ARITHMETIC PROGRESSIONS” from the <a href="https://www.ocf.berkeley.edu/~wwu/riddles/putnam.shtml"> Putnam exam problems of 2002</a>. The statement of the problem is as follows: For which integers <em>n</em> > 1 does the set of positive integers less than and relatively prime to <em>n</em> constitute an arithmetic progression? A Hierarchy of Algebras for Boolean Subsets https://www.isa-afp.org/entries/Subset_Boolean_Algebras.html https://www.isa-afp.org/entries/Subset_Boolean_Algebras.html Walter Guttmann, Bernhard Möller 31 Jan 2020 00:00:00 +0000 We present a collection of axiom systems for the construction of Boolean subalgebras of larger overall algebras. The subalgebras are defined as the range of a complement-like operation on a semilattice. This technique has been used, for example, with the antidomain operation, dynamic negation and Stone algebras. We present a common ground for these constructions based on a new equational axiomatisation of Boolean algebras. Mersenne primes and the Lucas–Lehmer test https://www.isa-afp.org/entries/Mersenne_Primes.html https://www.isa-afp.org/entries/Mersenne_Primes.html Manuel Eberl 17 Jan 2020 00:00:00 +0000 <p>This article provides formal proofs of basic properties of Mersenne numbers, i. e. numbers of the form 2<sup><em>n</em></sup> - 1, and especially of Mersenne primes.</p> <p>In particular, an efficient, verified, and executable version of the Lucas&ndash;Lehmer test is developed. This test decides primality for Mersenne numbers in time polynomial in <em>n</em>.</p> Verified Approximation Algorithms https://www.isa-afp.org/entries/Approximation_Algorithms.html https://www.isa-afp.org/entries/Approximation_Algorithms.html Robin Eßmann, Tobias Nipkow, Simon Robillard 16 Jan 2020 00:00:00 +0000 We present the first formal verification of approximation algorithms for NP-complete optimization problems: vertex cover, independent set, load balancing, and bin packing. The proofs correct incompletenesses in existing proofs and improve the approximation ratio in one case. Closest Pair of Points Algorithms https://www.isa-afp.org/entries/Closest_Pair_Points.html https://www.isa-afp.org/entries/Closest_Pair_Points.html Martin Rau, Tobias Nipkow 13 Jan 2020 00:00:00 +0000 This entry provides two related verified divide-and-conquer algorithms solving the fundamental <em>Closest Pair of Points</em> problem in Computational Geometry. Functional correctness and the optimal running time of <em>O</em>(<em>n</em> log <em>n</em>) are proved. Executable code is generated which is empirically competitive with handwritten reference implementations. Skip Lists https://www.isa-afp.org/entries/Skip_Lists.html https://www.isa-afp.org/entries/Skip_Lists.html Max W. Haslbeck, Manuel Eberl 09 Jan 2020 00:00:00 +0000 <p> Skip lists are sorted linked lists enhanced with shortcuts and are an alternative to binary search trees. A skip lists consists of multiple levels of sorted linked lists where a list on level n is a subsequence of the list on level n − 1. In the ideal case, elements are skipped in such a way that a lookup in a skip lists takes O(log n) time. In a randomised skip list the skipped elements are choosen randomly. </p> <p> This entry contains formalized proofs of the textbook results about the expected height and the expected length of a search path in a randomised skip list. </p> - - Bicategories - https://www.isa-afp.org/entries/Bicategory.html - https://www.isa-afp.org/entries/Bicategory.html - Eugene W. Stark - 06 Jan 2020 00:00:00 +0000 - -Taking as a starting point the author's previous work on -developing aspects of category theory in Isabelle/HOL, this article -gives a compatible formalization of the notion of -"bicategory" and develops a framework within which formal -proofs of facts about bicategories can be given. The framework -includes a number of basic results, including the Coherence Theorem, -the Strictness Theorem, pseudofunctors and biequivalence, and facts -about internal equivalences and adjunctions in a bicategory. As a -driving application and demonstration of the utility of the framework, -it is used to give a formal proof of a theorem, due to Carboni, -Kasangian, and Street, that characterizes up to biequivalence the -bicategories of spans in a category with pullbacks. The formalization -effort necessitated the filling-in of many details that were not -evident from the brief presentation in the original paper, as well as -identifying a few minor corrections along the way. - - - The Irrationality of ζ(3) - https://www.isa-afp.org/entries/Zeta_3_Irrational.html - https://www.isa-afp.org/entries/Zeta_3_Irrational.html - Manuel Eberl - 27 Dec 2019 00:00:00 +0000 - -<p>This article provides a formalisation of Beukers's -straightforward analytic proof that ζ(3) is irrational. This was first -proven by Apéry (which is why this result is also often called -‘Apéry's Theorem’) using a more algebraic approach. This -formalisation follows <a -href="http://people.math.sc.edu/filaseta/gradcourses/Math785/Math785Notes4.pdf">Filaseta's -presentation</a> of Beukers's proof.</p> - diff --git a/web/statistics.html b/web/statistics.html --- a/web/statistics.html +++ b/web/statistics.html @@ -1,307 +1,307 @@ Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

Statistics

 

Statistics

- - - - + + + +
Number of Articles:540
Number of Authors:356
Number of lemmas:~145,100
Lines of Code:~2,515,100
Number of Articles:542
Number of Authors:358
Number of lemmas:~146,900
Lines of Code:~2,551,400

Most used AFP articles:

NameUsed by ? articles
1. List-Index 14
2. Coinductive 12
Collections 12
Regular-Sets 12
3. Landau_Symbols 11
4. Show 10
5. Abstract-Rewriting 9
Automatic_Refinement 9
Deriving 9
Polynomial_Factorization 9
6. Jordan_Normal_Form 8
Native_Word 8

Growth in number of articles:

Growth in lines of code:

Growth in number of authors:

Size of articles:
\ No newline at end of file diff --git a/web/topics.html b/web/topics.html --- a/web/topics.html +++ b/web/topics.html @@ -1,884 +1,887 @@ Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

Index by Topic

 

Computer science

Automata and formal languages

Partial_Order_Reduction   C2KA_DistributedSystems   Posix-Lexing   LocalLexing   KBPs   Regular-Sets   Regex_Equivalence   MSO_Regex_Equivalence   Formula_Derivatives   Myhill-Nerode   Universal_Turing_Machine   CYK   Presburger-Automata   Functional-Automata   Statecharts   Stuttering_Equivalence   Coinductive_Languages   Tree-Automata   Kleene_Algebra   KAT_and_DRA   KAD   Regular_Algebras   Markov_Models   Probabilistic_System_Zoo   CAVA_Automata   LTL   LTL_to_GBA   CAVA_LTL_Modelchecker   Probabilistic_Timed_Automata   Finite_Automata_HF   LTL_to_DRA   Timed_Automata   Stochastic_Matrices   Buchi_Complementation   Transition_Systems_and_Automata   Factored_Transition_System_Bounding   LTL_Master_Theorem   MFOTL_Monitor   Adaptive_State_Counting   MFODL_Monitor_Optimized   LTL_Normal_Form  

Algorithms

Knuth_Morris_Pratt   Probabilistic_While   Comparison_Sort_Lower_Bound   Quick_Sort_Cost   TortoiseHare   Selection_Heap_Sort   VerifyThis2018   CYK   Boolean_Expression_Checkers   Efficient-Mergesort   SATSolverVerification   MuchAdoAboutTwo   First_Order_Terms   Monad_Memo_DP   Hidden_Markov_Models   Imperative_Insertion_Sort   Formal_SSA   ROBDD   Median_Of_Medians_Selection   Fisher_Yates   Optimal_BST   IMP2   Auto2_Imperative_HOL   List_Inversions   IMP2_Binary_Heap   MFOTL_Monitor   Adaptive_State_Counting   Generic_Join   VerifyThis2019   Generalized_Counting_Sort   MFODL_Monitor_Optimized   Sliding_Window_Algorithm   Graph: DFS_Framework   Prpu_Maxflow   Floyd_Warshall   Roy_Floyd_Warshall   Dijkstra_Shortest_Path   EdmondsKarp_Maxflow   Depth-First-Search   GraphMarkingIBP   Transitive-Closure   Transitive-Closure-II   Gabow_SCC   Kruskal   Prim_Dijkstra_Simple   Distributed: DiskPaxos   GenClock   ClockSynchInst   Heard_Of   Consensus_Refined   Abortable_Linearizable_Modules   IMAP-CRDT   CRDT   OpSets   Stellar_Quorums   WOOT_Strong_Eventual_Consistency   Concurrent: ConcurrentGC   Online: List_Update   Geometry: Closest_Pair_Points   Approximation: Approximation_Algorithms   Mathematical: FFT   Gauss-Jordan-Elim-Fun   UpDown_Scheme   Polynomials   Gauss_Jordan   Echelon_Form   QR_Decomposition   Hermite   Groebner_Bases   Diophantine_Eqns_Lin_Hom   Taylor_Models   LLL_Basis_Reduction   Signature_Groebner   Optimization: Simplex  

Concurrency

FLP   Concurrent_Ref_Alg   Concurrent_Revisions   Store_Buffer_Reduction   TESL_Language   Process calculi: Noninterference_Generic_Unwinding   AODV   AWN   CCS   Pi_Calculus   Psi_Calculi   Encodability_Process_Calculi   Circus   Noninterference_Sequential_Composition   Noninterference_Concurrent_Composition   Modal_Logics_for_NTS   HOL-CSP  

Data structures

Generic_Deriving   Random_BSTs   Randomised_BSTs   List_Interleaving   Refine_Imperative_HOL   Amortized_Complexity   Dynamic_Tables   AVL-Trees   BDD   BinarySearchTree   Splay_Tree   Root_Balanced_Tree   Skew_Heap   Pairing_Heap   Priority_Queue_Braun   Binomial-Queues   Binomial-Heaps   Finger-Trees   Trie   FinFun   Collections   Containers   FileRefinement   Datatype_Order_Generator   Deriving   List-Index   List-Infinite   Matrix   Matrix_Tensor   Huffman   Lazy-Lists-II   IEEE_Floating_Point   Native_Word   XML   ROBDD   IMAP-CRDT   Word_Lib   CRDT   KD_Tree   Taylor_Models   Treaps   Skip_Lists   Weight_Balanced_Trees   OpSets   Optimal_BST   Core_DOM   Auto2_Imperative_HOL   IMP2_Binary_Heap   Priority_Search_Trees   Interval_Arithmetic_Word32   ADS_Functor  

Functional programming

Optics   CryptHOL   Probabilistic_While   Monad_Normalisation   Monomorphic_Monad   Show   Certification_Monads   Partial_Function_MR   Lifting_Definition_Option   Coinductive   Stream-Fusion   Tycon   Monad_Memo_DP   XML   Tail_Recursive_Functions   Stream_Fusion_Code   Applicative_Lifting   HOLCF-Prelude   BNF_CC   Binding_Syntax_Theory   Generalized_Counting_Sort   Hello_World  

Hardware

SPARCv8  

Machine learning

Deep_Learning  

Networks

UPF_Firewall   IP_Addresses   Simple_Firewall   Iptables_Semantics   Routing   LOFT  

Programming languages

Clean   Decl_Sem_Fun_PL   Language definitions: CakeML   WebAssembly   pGCL   GPU_Kernel_PL   LightweightJava   CoreC++   FeatherweightJava   Jinja   JinjaThreads   Locally-Nameless-Sigma   AutoFocus-Stream   FocusStreamsCaseStudies   Isabelle_Meta_Model   Simpl   Complx   Safe_OCL   Isabelle_C   Lambda calculi: Higher_Order_Terms   Launchbury   PCF   POPLmark-deBruijn   Lam-ml-Normalization   LambdaMu   Binding_Syntax_Theory   LambdaAuth   Type systems: Name_Carrying_Type_Inference   MiniML   Possibilistic_Noninterference   SIFUM_Type_Systems   Dependent_SIFUM_Type_Systems   Strong_Security   WHATandWHERE_Security   VolpanoSmith   Logics: ConcurrentIMP   Refine_Monadic   Automatic_Refinement   MonoBoolTranAlgebra   Simpl   Separation_Algebra   Separation_Logic_Imperative_HOL   Relational-Incorrectness-Logic   Abstract-Hoare-Logics   Kleene_Algebra   KAT_and_DRA   KAD   BytecodeLogicJmlTypes   DataRefinementIBP   RefinementReactive   SIFPL   TLA   Ribbon_Proofs   Separata   Complx   Differential_Dynamic_Logic   Hoare_Time   IMP2   UTP   QHLProver   Differential_Game_Logic   Compiling: CakeML_Codegen   Compiling-Exceptions-Correctly   NormByEval   Density_Compiler   VeriComp   Static analysis: RIPEMD-160-SPARK   Program-Conflict-Analysis   Shivers-CFA   Slicing   HRB-Slicing   InfPathElimination   Abs_Int_ITP2012   Transformations: Call_Arity   Refine_Imperative_HOL   WorkerWrapper   Monad_Memo_DP   Formal_SSA   Minimal_SSA   Misc: JiveDataStoreModel   Pop_Refinement   Case_Labeling  

Security

Multi_Party_Computation   Noninterference_Generic_Unwinding   Noninterference_Ipurge_Unwinding   UPF   UPF_Firewall   CISC-Kernel   Noninterference_CSP   Key_Agreement_Strong_Adversaries   Security_Protocol_Refinement   Attack_Trees   Inductive_Confidentiality   Possibilistic_Noninterference   SIFUM_Type_Systems   Dependent_SIFUM_Type_Systems   Dependent_SIFUM_Refinement   Relational-Incorrectness-Logic   Strong_Security   WHATandWHERE_Security   VolpanoSmith   SIFPL   HotelKeyCards   InformationFlowSlicing   InformationFlowSlicing_Inter   CryptoBasedCompositionalProperties   Probabilistic_Noninterference   HyperCTL   Bounded_Deducibility_Security   Network_Security_Policy_Verification   Noninterference_Inductive_Unwinding   Password_Authentication_Protocol   Noninterference_Sequential_Composition   Noninterference_Concurrent_Composition   SPARCv8   Modular_Assembly_Kit_Security   LambdaAuth   + Stateful_Protocol_Composition_and_Typing   + Automated_Stateful_Protocol_Verification   Cryptography: Game_Based_Crypto   Sigma_Commit_Crypto   CryptHOL   Constructive_Cryptography   RSAPSS   Elliptic_Curves_Group_Law  

Semantics

Launchbury   Clean   Transformer_Semantics   HOL-CSP   QHLProver   TESL_Language   Isabelle_C  

System description languages

Circus   ComponentDependencies   Promela   Featherweight_OCL   DynamicArchitectures   Architectural_Design_Patterns   TESL_Language  

Logic

Philosophical aspects

GoedelGod   Types_Tableaus_and_Goedels_God   GewirthPGCProof   Lowe_Ontological_Argument   AnselmGod   PLM   Aristotles_Assertoric_Syllogistic  

General logic

Classical propositional logic: Free-Boolean-Algebra   Classical first-order logic: FOL-Fitting   Decidability of theories: MSO_Regex_Equivalence   Formula_Derivatives   Presburger-Automata   LinearQuantifierElim   Mechanization of proofs: Boolean_Expression_Checkers   Verified-Prover   Sort_Encodings   PropResPI   Resolution_FOL   FOL_Harrison   Ordered_Resolution_Prover   Functional_Ordered_Resolution_Prover   Binding_Syntax_Theory   Saturation_Framework   Lambda calculus: LambdaMu   Logics of knowledge and belief: Epistemic_Logic   Temporal logic: Nat-Interval-Logic   LTL   HyperCTL   Allen_Calculus   MFOTL_Monitor   LTL_Normal_Form   Modal logic: Modal_Logics_for_NTS   Differential_Dynamic_Logic   Hybrid_Multi_Lane_Spatial_Logic   Hybrid_Logic   MFODL_Monitor_Optimized   Paraconsistent logics: Paraconsistency  

Computability

Universal_Turing_Machine   Recursion-Theory-I   Minsky_Machines  

Set theory

Ordinal   Ordinals_and_Cardinals   HereditarilyFinite   ZFC_in_HOL   Forcing   Recursion-Addition  

Proof theory

Propositional_Proof_Systems   Completeness   SequentInvertibility   Incompleteness   Abstract_Completeness   SuperCalc   Incredible_Proof_Machine   Surprise_Paradox   Abstract_Soundness   FOL_Seq_Calc1  

Rewriting

CakeML_Codegen   Monad_Normalisation   Lambda_Free_RPOs   Lambda_Free_KBOs   Lambda_Free_EPO   Nested_Multisets_Ordinals   Abstract-Rewriting   First_Order_Terms   Decreasing-Diagrams   Decreasing-Diagrams-II   Rewriting_Z   Graph_Saturation   Goodstein_Lambda   Knuth_Bendix_Order  

Mathematics

Order

LatticeProperties   Stone_Algebras   Allen_Calculus   Order_Lattice_Props   Complete_Non_Orders   Szpilrajn  

Algebra

Optics   Subresultants   Buildings   Algebraic_VCs   C2KA_DistributedSystems   Multirelations   Residuated_Lattices   PseudoHoops   Impossible_Geometry   Gauss-Jordan-Elim-Fun   Matrix_Tensor   Kleene_Algebra   KAT_and_DRA   KAD   Regular_Algebras   Free-Groups   CofGroups   Group-Ring-Module   Robbins-Conjecture   Valuation   Rank_Nullity_Theorem   Polynomials   Relation_Algebra   PSemigroupsConvolution   Secondary_Sylow   Jordan_Hoelder   Cayley_Hamilton   VectorSpace   Echelon_Form   QR_Decomposition   Hermite   Rep_Fin_Groups   Jordan_Normal_Form   Algebraic_Numbers   Polynomial_Interpolation   Polynomial_Factorization   Perron_Frobenius   Stochastic_Matrices   Groebner_Bases   Nullstellensatz   Mason_Stothers   Berlekamp_Zassenhaus   Stone_Relation_Algebras   Stone_Kleene_Relation_Algebras   Orbit_Stabiliser   Dirichlet_L   Symmetric_Polynomials   Taylor_Models   LLL_Basis_Reduction   LLL_Factorization   Localization_Ring   Quaternions   Octonions   Aggregation_Algebras   Signature_Groebner   Quantales   Transformer_Semantics   Farkas   Groebner_Macaulay   Linear_Inequalities   Linear_Programming   Jacobson_Basic_Algebra   Hybrid_Systems_VCs   Subset_Boolean_Algebras   Power_Sum_Polynomials   Matrices_for_ODEs  

Analysis

Banach_Steinhaus   Fourier   E_Transcendental   Liouville_Numbers   Descartes_Sign_Rule   Euler_MacLaurin   Real_Impl   Lower_Semicontinuous   Affine_Arithmetic   Laplace_Transform   Cauchy   Integration   Ordinary_Differential_Equations   Polynomials   Sqrt_Babylonian   Sturm_Sequences   Sturm_Tarski   Special_Function_Bounds   Landau_Symbols   Error_Function   Akra_Bazzi   Zeta_Function   Linear_Recurrences   Lambert_W   Cartan_FP   Deep_Learning   Stirling_Formula   Lp   Bernoulli   Winding_Number_Eval   Count_Complex_Roots   Taylor_Models   Green   Irrationality_J_Hancl   Budan_Fourier   Smooth_Manifolds   Transcendence_Series_Hancl_Rucki   Hybrid_Systems_VCs   Poincare_Bendixson   Matrices_for_ODEs   Irrational_Series_Erdos_Straus  

Probability theory

DiscretePricing   CryptHOL   Constructive_Cryptography   Probabilistic_While   Markov_Models   Density_Compiler   Probabilistic_Timed_Automata   Hidden_Markov_Models   Random_Graph_Subgraph_Threshold   Ergodic_Theory   Source_Coding_Theorem   Buffons_Needle  

Number theory

Arith_Prog_Rel_Primes   Pell   Minkowskis_Theorem   E_Transcendental   Pi_Transcendental   Liouville_Numbers   Prime_Harmonic_Series   Fermat3_4   Perfect-Number-Thm   SumSquares   Lehmer   Pratt_Certificate   Dirichlet_Series   Gauss_Sums   Zeta_Function   Stern_Brocot   Bertrands_Postulate   Bernoulli   Diophantine_Eqns_Lin_Hom   Dirichlet_L   Mersenne_Primes   Irrationality_J_Hancl   Prime_Number_Theorem   Probabilistic_Prime_Tests   Prime_Distribution_Elementary   Transcendence_Series_Hancl_Rucki   Zeta_3_Irrational   Furstenberg_Topology   Lucas_Theorem   Gaussian_Integers   Irrational_Series_Erdos_Straus  

Games and economics

DiscretePricing   ArrowImpossibilityGS   SenSocialChoice   Vickrey_Clarke_Groves   Parity_Game   First_Welfare_Theorem   Randomised_Social_Choice   SDS_Impossibility   Stable_Matching   Fishburn_Impossibility   Neumann_Morgenstern_Utility  

Geometry

Complex_Geometry   Poincare_Disc   Minkowskis_Theorem   Buildings   Chord_Segments   Triangle   Impossible_Geometry   Tarskis_Geometry   General-Triangle   Nullstellensatz   Ptolemys_Theorem   Buffons_Needle   Stewart_Apollonius   Gromov_Hyperbolicity   Projective_Geometry   Quaternions   Octonions  

Topology

Topology   Knot_Theory   Kuratowski_Closure_Complement   Smooth_Manifolds  

Graph theory

Flow_Networks   Prpu_Maxflow   MFMC_Countable   ShortestPath   Gabow_SCC   Graph_Theory   Planarity_Certificates   Max-Card-Matching   Girth_Chromatic   Random_Graph_Subgraph_Threshold   Flyspeck-Tame   Koenigsberg_Friendship   Tree_Decomposition   Menger   Parity_Game   Factored_Transition_System_Bounding   Graph_Saturation  

Combinatorics

Card_Equiv_Relations   Twelvefold_Way   Card_Multisets   Card_Partitions   Card_Number_Partitions   Well_Quasi_Orders   Marriage   Bondy   Ramsey-Infinite   Derangements   Euler_Partition   Discrete_Summation   Open_Induction   Latin_Square   Bell_Numbers_Spivey   Catalan_Numbers   Falling_Factorial_Sum   Matroids  

Category theory

Category3   MonoidalCategory   Category   Category2   AxiomaticCategoryTheory   Bicategory  

Physics

No_FTL_observers  

Misc

FunWithFunctions   FunWithTilings   IMO2019  

Tools

Monad_Normalisation   Constructor_Funs   Lazy_Case   Dict_Construction   Case_Labeling   DPT-SAT-Solver   Nominal2   Separata   Proof_Strategy_Language   Diophantine_Eqns_Lin_Hom   BNF_Operations   BNF_CC   Auto2_HOL   Isabelle_C   + Automated_Stateful_Protocol_Verification  
\ No newline at end of file